-- Copyright 2016 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE RecordWildCards, DeriveFunctor #-}
-- | Realize an abstract solkattu sequence to concrete kendang 'Note's.
module Solkattu.Instrument.KendangTunggal where
import qualified Derive.Expr as Expr
import qualified Derive.Symbols as Symbols
import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import qualified Solkattu.Solkattu as Solkattu

import Global


data Stroke =
    Plak -- both
    | Pak | Pang | TutL | DeL -- left
    | Ka | Tut | De -- right
    deriving (Stroke -> Stroke -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stroke -> Stroke -> Bool
$c/= :: Stroke -> Stroke -> Bool
== :: Stroke -> Stroke -> Bool
$c== :: Stroke -> Stroke -> Bool
Eq, Eq Stroke
Stroke -> Stroke -> Bool
Stroke -> Stroke -> Ordering
Stroke -> Stroke -> Stroke
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Stroke -> Stroke -> Stroke
$cmin :: Stroke -> Stroke -> Stroke
max :: Stroke -> Stroke -> Stroke
$cmax :: Stroke -> Stroke -> Stroke
>= :: Stroke -> Stroke -> Bool
$c>= :: Stroke -> Stroke -> Bool
> :: Stroke -> Stroke -> Bool
$c> :: Stroke -> Stroke -> Bool
<= :: Stroke -> Stroke -> Bool
$c<= :: Stroke -> Stroke -> Bool
< :: Stroke -> Stroke -> Bool
$c< :: Stroke -> Stroke -> Bool
compare :: Stroke -> Stroke -> Ordering
$ccompare :: Stroke -> Stroke -> Ordering
Ord, Int -> Stroke -> ShowS
[Stroke] -> ShowS
Stroke -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stroke] -> ShowS
$cshowList :: [Stroke] -> ShowS
show :: Stroke -> String
$cshow :: Stroke -> String
showsPrec :: Int -> Stroke -> ShowS
$cshowsPrec :: Int -> Stroke -> ShowS
Show)

-- * strokes

instance Solkattu.Notation Stroke where
    notation :: Stroke -> (Style, Text)
notation = Text -> (Style, Text)
Solkattu.textNotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        Stroke
Plak -> Text
"P"
        Stroke
Pak -> Text
"p"
        Stroke
Pang -> Text
"t"
        Stroke
TutL -> Text
"u"
        Stroke
DeL -> Text
"å"
        Stroke
Ka -> Text
"k"
        Stroke
Tut -> Text
"o"
        Stroke
De -> Text
"a"

instance Pretty Stroke where pretty :: Stroke -> Text
pretty = forall a. Notation a => a -> Text
Solkattu.notationText

-- | TODO should I make these consistent with 'Strokes'?
instance Expr.ToExpr Stroke where
    to_expr :: Stroke -> Expr MiniVal
to_expr = \case
        Stroke
Plak -> Expr MiniVal
"PL"
        Stroke
Pak -> Expr MiniVal
"P"
        Stroke
Pang -> Expr MiniVal
"T"
        Stroke
TutL -> Expr MiniVal
"Ø"
        Stroke
DeL -> Expr MiniVal
"`O+`"
        Stroke
Ka -> Expr MiniVal
".."
        Stroke
Tut -> Expr MiniVal
"o"
        Stroke
De -> Expr MiniVal
"+"

-- TODO unify with User.Elaforge.Instrument.Kontakt.KendangBali.Stroke
instance Expr.ToExpr (Realize.Stroke Stroke) where
    to_expr :: Stroke Stroke -> Expr MiniVal
to_expr (Realize.Stroke Emphasis
emphasis Stroke
stroke) = case Emphasis
emphasis of
        Emphasis
Realize.Normal -> forall a. ToExpr a => a -> Expr MiniVal
Expr.to_expr Stroke
stroke
        Emphasis
Realize.Light -> case Stroke
stroke of
            Stroke
Pak -> Expr MiniVal
"^"
            Stroke
TutL -> Expr MiniVal
"ø"
            Stroke
Ka -> Expr MiniVal
"."
            Stroke
De -> Expr MiniVal
"-"
            Stroke
_ -> forall a. ToExpr a => Symbol -> a -> Expr MiniVal
Expr.with Symbol
Symbols.weak Stroke
stroke
        Emphasis
Realize.Heavy -> forall a. ToExpr a => Symbol -> a -> Expr MiniVal
Expr.with Symbol
Symbols.accent Stroke
stroke

data Strokes a = Strokes {
    forall a. Strokes a -> a
pk :: a, forall a. Strokes a -> a
p :: a, forall a. Strokes a -> a
t :: a, forall a. Strokes a -> a
u :: a, forall a. Strokes a -> a
å :: a, forall a. Strokes a -> a
k :: a, forall a. Strokes a -> a
o :: a , forall a. Strokes a -> a
a :: a
    } deriving (Int -> Strokes a -> ShowS
forall a. Show a => Int -> Strokes a -> ShowS
forall a. Show a => [Strokes a] -> ShowS
forall a. Show a => Strokes a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strokes a] -> ShowS
$cshowList :: forall a. Show a => [Strokes a] -> ShowS
show :: Strokes a -> String
$cshow :: forall a. Show a => Strokes a -> String
showsPrec :: Int -> Strokes a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Strokes a -> ShowS
Show, forall a b. a -> Strokes b -> Strokes a
forall a b. (a -> b) -> Strokes a -> Strokes b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Strokes b -> Strokes a
$c<$ :: forall a b. a -> Strokes b -> Strokes a
fmap :: forall a b. (a -> b) -> Strokes a -> Strokes b
$cfmap :: forall a b. (a -> b) -> Strokes a -> Strokes b
Functor)

strokes :: Strokes Stroke
strokes :: Strokes Stroke
strokes = Strokes
    { pk :: Stroke
pk = Stroke
Plak
    , p :: Stroke
p = Stroke
Pak
    , t :: Stroke
t = Stroke
Pang
    , u :: Stroke
u = Stroke
TutL
    , å :: Stroke
å = Stroke
DeL
    , k :: Stroke
k = Stroke
Ka
    , o :: Stroke
o = Stroke
Tut
    , a :: Stroke
a = Stroke
De
    }

notes :: Strokes (S.Sequence g (Solkattu.Note (Realize.Stroke Stroke)))
notes :: forall g. Strokes (Sequence g (Note (Stroke Stroke)))
notes = forall stroke g. stroke -> Sequence g (Note (Stroke stroke))
Realize.strokeToSequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Strokes Stroke
strokes

type SequenceR = S.Sequence () (Realize.Note Stroke)

rnotes :: Strokes SequenceR
rnotes :: Strokes SequenceR
rnotes = forall g a. Note g a -> Sequence g a
S.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. a -> Note g a
S.Note forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stroke. Stroke stroke -> Note stroke
Realize.Note forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stroke. stroke -> Stroke stroke
Realize.stroke forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Strokes Stroke
strokes

-- * Patterns

__ :: SequenceR
__ :: SequenceR
__ = forall g a. Note g a -> Sequence g a
S.singleton forall stroke. SNote stroke
Realize.rest

defaultPatterns :: Realize.PatternMap Stroke
defaultPatterns :: PatternMap Stroke
defaultPatterns = forall a. Stack => Either Text a -> a
Solkattu.check forall a b. (a -> b) -> a -> b
$ [(Int, SequenceR)] -> Either Text (PatternMap Stroke)
patterns
    [ (Int
5, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
tSequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    , (Int
6, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
tSequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    , (Int
7, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
tSequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    , (Int
8, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
tSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    , (Int
9, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
tSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    ]
    where
    Strokes {SequenceR
å :: SequenceR
u :: SequenceR
pk :: SequenceR
a :: SequenceR
t :: SequenceR
k :: SequenceR
p :: SequenceR
o :: SequenceR
a :: forall a. Strokes a -> a
o :: forall a. Strokes a -> a
k :: forall a. Strokes a -> a
å :: forall a. Strokes a -> a
u :: forall a. Strokes a -> a
t :: forall a. Strokes a -> a
p :: forall a. Strokes a -> a
pk :: forall a. Strokes a -> a
..} = Strokes SequenceR
rnotes
    . :: SequenceR -> SequenceR -> SequenceR
(.) = forall a. Semigroup a => a -> a -> a
(<>)

-- defaultPatternsEmphasis :: [(Solkattu.Pattern, SequenceM g)]
-- defaultPatternsEmphasis =
--     map (second (map $ \s -> if s == p then a else s)) defaultPatterns
--     where Strokes {..} = rnotes

patterns :: [(S.Matra, SequenceR)]
    -> Either Realize.Error (Realize.PatternMap Stroke)
patterns :: [(Int, SequenceR)] -> Either Text (PatternMap Stroke)
patterns = forall stroke.
[(Pattern, Sequence () (Note stroke))]
-> Either Text (PatternMap stroke)
Realize.patternMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Pattern
Solkattu.pattern)

nakatiku :: S.Sequence g (Solkattu.Note (Realize.Stroke Stroke))
nakatiku :: forall g. Sequence g (Note (Stroke Stroke))
nakatiku = forall g. Sequence g (Note (Stroke Stroke))
tSequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
.forall g. Sequence g (Note (Stroke Stroke))
oSequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
.forall g. Sequence g (Note (Stroke Stroke))
uSequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
.forall g. Sequence g (Note (Stroke Stroke))
kSequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
.forall g. Sequence g (Note (Stroke Stroke))
pSequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
.forall g. Sequence g (Note (Stroke Stroke))
aSequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
.forall g. Sequence g (Note (Stroke Stroke))
oSequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
.forall g. Sequence g (Note (Stroke Stroke))
k
    where
    Strokes {Sequence g (Note (Stroke Stroke))
å :: Sequence g (Note (Stroke Stroke))
pk :: Sequence g (Note (Stroke Stroke))
a :: Sequence g (Note (Stroke Stroke))
p :: Sequence g (Note (Stroke Stroke))
k :: Sequence g (Note (Stroke Stroke))
u :: Sequence g (Note (Stroke Stroke))
o :: Sequence g (Note (Stroke Stroke))
t :: Sequence g (Note (Stroke Stroke))
a :: forall a. Strokes a -> a
o :: forall a. Strokes a -> a
k :: forall a. Strokes a -> a
å :: forall a. Strokes a -> a
u :: forall a. Strokes a -> a
t :: forall a. Strokes a -> a
p :: forall a. Strokes a -> a
pk :: forall a. Strokes a -> a
..} = forall g. Strokes (Sequence g (Note (Stroke Stroke)))
notes
    . :: Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
(.) = forall a. Semigroup a => a -> a -> a
(<>)