-- 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
(Stroke -> Stroke -> Bool)
-> (Stroke -> Stroke -> Bool) -> Eq Stroke
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
Eq Stroke
-> (Stroke -> Stroke -> Ordering)
-> (Stroke -> Stroke -> Bool)
-> (Stroke -> Stroke -> Bool)
-> (Stroke -> Stroke -> Bool)
-> (Stroke -> Stroke -> Bool)
-> (Stroke -> Stroke -> Stroke)
-> (Stroke -> Stroke -> Stroke)
-> Ord 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
(Int -> Stroke -> ShowS)
-> (Stroke -> String) -> ([Stroke] -> ShowS) -> Show Stroke
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 (Text -> (Style, Text))
-> (Stroke -> Text) -> Stroke -> (Style, Text)
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 = Stroke -> Text
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 -> Stroke -> Expr MiniVal
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
_ -> Symbol -> Stroke -> Expr MiniVal
forall a. ToExpr a => Symbol -> a -> Expr MiniVal
Expr.with Symbol
Symbols.weak Stroke
stroke
        Emphasis
Realize.Heavy -> Symbol -> Stroke -> Expr MiniVal
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
[Strokes a] -> ShowS
Strokes a -> String
(Int -> Strokes a -> ShowS)
-> (Strokes a -> String)
-> ([Strokes a] -> ShowS)
-> Show (Strokes a)
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 -> b) -> Strokes a -> Strokes b)
-> (forall a b. a -> Strokes b -> Strokes a) -> Functor Strokes
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 = Stroke -> Sequence g (Note (Stroke Stroke))
forall stroke g. stroke -> Sequence g (Note (Stroke stroke))
Realize.strokeToSequence (Stroke -> Sequence g (Note (Stroke Stroke)))
-> Strokes Stroke -> Strokes (Sequence g (Note (Stroke Stroke)))
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 = Note () (Note Stroke) -> SequenceR
forall g a. Note g a -> Sequence g a
S.singleton (Note () (Note Stroke) -> SequenceR)
-> (Stroke -> Note () (Note Stroke)) -> Stroke -> SequenceR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note Stroke -> Note () (Note Stroke)
forall g a. a -> Note g a
S.Note (Note Stroke -> Note () (Note Stroke))
-> (Stroke -> Note Stroke) -> Stroke -> Note () (Note Stroke)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stroke Stroke -> Note Stroke
forall stroke. Stroke stroke -> Note stroke
Realize.Note (Stroke Stroke -> Note Stroke)
-> (Stroke -> Stroke Stroke) -> Stroke -> Note Stroke
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stroke -> Stroke Stroke
forall stroke. stroke -> Stroke stroke
Realize.stroke (Stroke -> SequenceR) -> Strokes Stroke -> Strokes SequenceR
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Strokes Stroke
strokes

-- * Patterns

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

defaultPatterns :: Realize.PatternMap Stroke
defaultPatterns :: PatternMap Stroke
defaultPatterns = Either Text (PatternMap Stroke) -> PatternMap Stroke
forall a. Stack => Either Text a -> a
Solkattu.check (Either Text (PatternMap Stroke) -> PatternMap Stroke)
-> Either Text (PatternMap Stroke) -> PatternMap Stroke
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
(.) = 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 = [(Pattern, SequenceR)] -> Either Text (PatternMap Stroke)
forall stroke.
[(Pattern, Sequence () (Note stroke))]
-> Either Text (PatternMap stroke)
Realize.patternMap ([(Pattern, SequenceR)] -> Either Text (PatternMap Stroke))
-> ([(Int, SequenceR)] -> [(Pattern, SequenceR)])
-> [(Int, SequenceR)]
-> Either Text (PatternMap Stroke)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, SequenceR) -> (Pattern, SequenceR))
-> [(Int, SequenceR)] -> [(Pattern, SequenceR)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Pattern) -> (Int, SequenceR) -> (Pattern, SequenceR)
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 = Sequence g (Note (Stroke Stroke))
forall g. Sequence g (Note (Stroke Stroke))
tSequence g (Note (Stroke Stroke))
-> Sequence 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))
.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))
.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))
.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))
.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))
.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))
.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
..} = Strokes (Sequence g (Note (Stroke Stroke)))
forall g. Strokes (Sequence g (Note (Stroke Stroke)))
notes
    . :: Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
(.) = Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
forall a. Semigroup a => a -> a -> a
(<>)