-- Copyright 2020 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 #-}
module Solkattu.Instrument.KendangPasang where

import qualified Derive.Expr as Expr
import qualified Derive.Symbols as Symbols
import qualified Solkattu.Instrument.KendangTunggal as T
import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import qualified Solkattu.Solkattu as Solkattu

import           Global


data Stroke = Plak | Ka | Pak | Kam | Pang | Kum | Pung | PungL | De | Tut
    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)

toTunggal :: Stroke -> (Maybe T.Stroke, Maybe T.Stroke)
toTunggal :: Stroke -> (Maybe Stroke, Maybe Stroke)
toTunggal = \case
    Stroke
Plak -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Stroke
T.Plak)
    Stroke
Ka   -> (forall a. a -> Maybe a
Just Stroke
T.Pak, forall a. Maybe a
Nothing)
    Stroke
Pak  -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Stroke
T.Pak)
    Stroke
Kam  -> (forall a. a -> Maybe a
Just Stroke
T.Pang, forall a. Maybe a
Nothing)
    Stroke
Pang -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Stroke
T.Pang)
    Stroke
Kum  -> (forall a. a -> Maybe a
Just Stroke
T.Tut, forall a. Maybe a
Nothing)
    Stroke
Pung -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Stroke
T.Tut)
    Stroke
PungL -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Stroke
T.TutL)
    Stroke
De   -> (forall a. a -> Maybe a
Just Stroke
T.De, forall a. a -> Maybe a
Just Stroke
T.Pang)
    Stroke
Tut  -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Stroke
T.De)

toWadon :: Realize.Stroke Stroke -> Realize.Stroke T.Stroke
toWadon :: Stroke Stroke -> Stroke Stroke
toWadon Stroke Stroke
stroke = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Stroke Stroke
filler forall {stroke}. stroke -> Stroke stroke
set forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Stroke -> (Maybe Stroke, Maybe Stroke)
toTunggal forall a b. (a -> b) -> a -> b
$ forall stroke. Stroke stroke -> stroke
Realize._stroke Stroke Stroke
stroke
    where set :: stroke -> Stroke stroke
set stroke
s = Stroke Stroke
stroke { _stroke :: stroke
Realize._stroke = stroke
s }

toLanang :: Realize.Stroke Stroke -> Realize.Stroke T.Stroke
toLanang :: Stroke Stroke -> Stroke Stroke
toLanang Stroke Stroke
stroke = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Stroke Stroke
filler forall {stroke}. stroke -> Stroke stroke
set forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Stroke -> (Maybe Stroke, Maybe Stroke)
toTunggal forall a b. (a -> b) -> a -> b
$ forall stroke. Stroke stroke -> stroke
Realize._stroke Stroke Stroke
stroke
    where set :: stroke -> Stroke stroke
set stroke
s = Stroke Stroke
stroke { _stroke :: stroke
Realize._stroke = stroke
s }

filler :: Realize.Stroke T.Stroke
filler :: Stroke Stroke
filler = forall stroke. Emphasis -> stroke -> Stroke stroke
Realize.Stroke Emphasis
Realize.Light Stroke
T.Ka

-- * 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
"PL"
        Stroke
Ka -> Text
"k"
        Stroke
Pak -> Text
"P"
        Stroke
Kam -> Text
"t"
        Stroke
Pang -> Text
"T"
        Stroke
Kum -> Text
"u"
        Stroke
Pung -> Text
"U"
        Stroke
PungL -> Text
"Ø"
        Stroke
De -> Text
"a"
        Stroke
Tut -> Text
"o"

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

-- | These have to match with "Cmd.Instrument.KendangBali".
instance Expr.ToExpr Stroke where
    to_expr :: Stroke -> Expr MiniVal
to_expr = \case
        Stroke
Plak -> Expr MiniVal
"PL"
        Stroke
Ka -> Expr MiniVal
"k"
        Stroke
Pak -> Expr MiniVal
"P"
        Stroke
Kam -> Expr MiniVal
"t"
        Stroke
Pang -> Expr MiniVal
"T"
        Stroke
Kum -> Expr MiniVal
"u"
        Stroke
Pung -> Expr MiniVal
"U"
        Stroke
PungL -> Expr MiniVal
"Ø"
        Stroke
De -> Expr MiniVal
"+"
        Stroke
Tut -> Expr MiniVal
"o"

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
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
k :: a, forall a. Strokes a -> a
p :: a -- ka pak
    , forall a. Strokes a -> a
t :: a, forall a. Strokes a -> a
l :: a -- kam pang
    , forall a. Strokes a -> a
u :: a, forall a. Strokes a -> a
y :: a -- kum pung
    , forall a. Strokes a -> a
yy :: a -- PungL
    , forall a. Strokes a -> a
a :: a, forall a. Strokes a -> a
o :: a -- de tut
    } 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
    , k :: Stroke
k = Stroke
Ka
    , p :: Stroke
p = Stroke
Pak
    , t :: Stroke
t = Stroke
Kam
    , l :: Stroke
l = Stroke
Pang -- can't write T, _T too much like rest, don't want 2 letters
    , u :: Stroke
u = Stroke
Kum
    , y :: Stroke
y = Stroke
Pung
    , yy :: Stroke
yy = Stroke
PungL
    , a :: Stroke
a = Stroke
De
    , o :: Stroke
o = Stroke
Tut
    }

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
kSequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
lSequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    , (Int
6, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
lSequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    , (Int
7, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
lSequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    , (Int
8, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
lSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    , (Int
9, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
pSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
lSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
a)
    ]
    where
    Strokes {SequenceR
yy :: SequenceR
y :: SequenceR
u :: SequenceR
t :: SequenceR
pk :: SequenceR
a :: SequenceR
l :: SequenceR
p :: SequenceR
k :: SequenceR
o :: SequenceR
o :: forall a. Strokes a -> a
a :: forall a. Strokes a -> a
yy :: forall a. Strokes a -> a
y :: forall a. Strokes a -> a
u :: forall a. Strokes a -> a
l :: forall a. Strokes a -> a
t :: forall a. Strokes a -> a
p :: forall a. Strokes a -> a
k :: forall a. Strokes a -> a
pk :: forall a. Strokes a -> a
..} = Strokes SequenceR
rnotes
    . :: SequenceR -> SequenceR -> SequenceR
(.) = forall a. Semigroup a => a -> a -> a
(<>)

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))
ySequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
-> Sequence g (Note (Stroke Stroke))
.forall g. Sequence g (Note (Stroke Stroke))
yySequence 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))
u :: Sequence g (Note (Stroke Stroke))
l :: Sequence g (Note (Stroke Stroke))
pk :: Sequence g (Note (Stroke Stroke))
o :: Sequence g (Note (Stroke Stroke))
a :: Sequence g (Note (Stroke Stroke))
p :: Sequence g (Note (Stroke Stroke))
k :: Sequence g (Note (Stroke Stroke))
yy :: Sequence g (Note (Stroke Stroke))
y :: Sequence g (Note (Stroke Stroke))
t :: Sequence g (Note (Stroke Stroke))
o :: forall a. Strokes a -> a
a :: forall a. Strokes a -> a
yy :: forall a. Strokes a -> a
y :: forall a. Strokes a -> a
u :: forall a. Strokes a -> a
l :: forall a. Strokes a -> a
t :: forall a. Strokes a -> a
p :: forall a. Strokes a -> a
k :: 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
(<>)