-- 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 abstract solkattu Notes to concrete reyong 'Note's.
module Solkattu.Instrument.Reyong where
import qualified Derive.Expr as Expr
import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import qualified Solkattu.Solkattu as Solkattu

import Global


-- Automatically infer two handed cek if they are isolated.
-- Maybe infer light byut if there is a note immediately afterwards?
data Stroke = N1 | N2 | N3 | N4 | N14 | Byut | Byong | CekC | CekO
    deriving (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, 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)

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
N1 -> Text
"1"
        Stroke
N2 -> Text
"2"
        Stroke
N3 -> Text
"3"
        Stroke
N4 -> Text
"4"
        Stroke
N14 -> Text
"i"
        Stroke
Byut -> Text
"b"
        Stroke
Byong -> Text
"o"
        Stroke
CekC -> Text
"k"
        Stroke
CekO -> Text
"x"

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

instance Expr.ToExpr Stroke where
    to_expr :: Stroke -> Expr MiniVal
to_expr Stroke
s = case Stroke
s of
        Stroke
N1 -> Expr MiniVal
"n1"
        Stroke
N2 -> Expr MiniVal
"n2"
        Stroke
N3 -> Expr MiniVal
"n3"
        Stroke
N4 -> Expr MiniVal
"n4"
        Stroke
N14 -> Expr MiniVal
"n14"
        Stroke
Byut -> Expr MiniVal
"+"
        Stroke
Byong -> Expr MiniVal
"O"
        Stroke
CekC -> Expr MiniVal
"X"
        Stroke
CekO -> Expr MiniVal
"/"

instance Expr.ToExpr (Realize.Stroke Stroke) where to_expr :: Stroke Stroke -> Expr MiniVal
to_expr = Stroke Stroke -> Expr MiniVal
forall a. ToExpr a => Stroke a -> Expr MiniVal
Realize.toExpr

data Strokes a = Strokes {
    forall a. Strokes a -> a
r1 :: a, forall a. Strokes a -> a
r2 :: a, forall a. Strokes a -> a
r3 :: a, forall a. Strokes a -> a
r4 :: a, forall a. Strokes a -> a
i :: a
    , forall a. Strokes a -> a
b :: a, forall a. Strokes a -> a
o :: a, forall a. Strokes a -> a
k :: a, forall a. Strokes a -> a
x :: a
    } deriving ((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, 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)

strokes :: Strokes Stroke
strokes :: Strokes Stroke
strokes = Strokes
    { r1 :: Stroke
r1 = Stroke
N1
    , r2 :: Stroke
r2 = Stroke
N2
    , r3 :: Stroke
r3 = Stroke
N3
    , r4 :: Stroke
r4 = Stroke
N4
    , i :: Stroke
i = Stroke
N14
    , b :: Stroke
b = Stroke
Byut
    , o :: Stroke
o = Stroke
Byong
    , k :: Stroke
k = Stroke
CekC
    , x :: Stroke
x = Stroke
CekO
    }

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

melodicPatterns :: Realize.PatternMap Stroke
melodicPatterns :: PatternMap Stroke
melodicPatterns = 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
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
r2SequenceR -> SequenceR -> SequenceR
.SequenceR
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
iSequenceR -> SequenceR -> SequenceR
.SequenceR
r2)
    , (Int
6, SequenceR
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
r2SequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
iSequenceR -> SequenceR -> SequenceR
.SequenceR
r2)
    , (Int
7, SequenceR
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
r2SequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
iSequenceR -> SequenceR -> SequenceR
.SequenceR
r2)
    , (Int
8, SequenceR
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
r2SequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
iSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
r2)
    , (Int
9, SequenceR
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
r2SequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
r3SequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
iSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
r2)
    ]
    where
    Strokes {SequenceR
x :: SequenceR
k :: SequenceR
o :: SequenceR
b :: SequenceR
r4 :: SequenceR
r1 :: SequenceR
i :: SequenceR
r2 :: SequenceR
r3 :: SequenceR
x :: forall a. Strokes a -> a
k :: forall a. Strokes a -> a
o :: forall a. Strokes a -> a
b :: forall a. Strokes a -> a
i :: forall a. Strokes a -> a
r4 :: forall a. Strokes a -> a
r3 :: forall a. Strokes a -> a
r2 :: forall a. Strokes a -> a
r1 :: forall a. Strokes a -> a
..} = Strokes SequenceR
rnotes
    . :: SequenceR -> SequenceR -> SequenceR
(.) = SequenceR -> SequenceR -> SequenceR
forall a. Semigroup a => a -> a -> a
(<>)

rhythmicPatterns :: Realize.PatternMap Stroke
rhythmicPatterns :: PatternMap Stroke
rhythmicPatterns = 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
bSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
__)
    , (Int
6, SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
bSequenceR -> SequenceR -> SequenceR
.SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
__)
    , (Int
7, SequenceR
xSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
xSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
__)
    , (Int
8, SequenceR
xSequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
xSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
__)
    , (Int
9, SequenceR
xSequenceR -> SequenceR -> SequenceR
.SequenceR
kSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
xSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
bSequenceR -> SequenceR -> SequenceR
.SequenceR
oSequenceR -> SequenceR -> SequenceR
.SequenceR
__SequenceR -> SequenceR -> SequenceR
.SequenceR
__)
    ]
    where
    Strokes {SequenceR
i :: SequenceR
r4 :: SequenceR
r3 :: SequenceR
r2 :: SequenceR
r1 :: SequenceR
k :: SequenceR
x :: SequenceR
o :: SequenceR
b :: SequenceR
x :: forall a. Strokes a -> a
k :: forall a. Strokes a -> a
o :: forall a. Strokes a -> a
b :: forall a. Strokes a -> a
i :: forall a. Strokes a -> a
r4 :: forall a. Strokes a -> a
r3 :: forall a. Strokes a -> a
r2 :: forall a. Strokes a -> a
r1 :: forall a. Strokes a -> a
..} = Strokes SequenceR
rnotes
    . :: SequenceR -> SequenceR -> SequenceR
(.) = 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 = [(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)