-- 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 DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
-- | Tie together generic Solkattu and specific instruments into a single
-- 'Korvai'.
module Solkattu.Korvai where
import qualified Data.Either as Either
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Time.Calendar as Calendar

import qualified GHC.Generics as Generics

import qualified Util.Maps as Maps
import qualified Util.Num as Num
import qualified Util.Pretty as Pretty
import qualified Util.Seq as Seq
import qualified Util.Styled as Styled

import qualified Derive.Expr as Expr
import qualified Solkattu.Instrument.KendangPasang as KendangPasang
import qualified Solkattu.Instrument.KendangTunggal as KendangTunggal
import qualified Solkattu.Instrument.Konnakol as Konnakol
import qualified Solkattu.Instrument.Mridangam as Mridangam
import qualified Solkattu.Instrument.Reyong as Reyong
import qualified Solkattu.Instrument.Sargam as Sargam
import qualified Solkattu.Instrument.ToScore as ToScore
import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import qualified Solkattu.Solkattu as Solkattu
import qualified Solkattu.Tags as Tags
import qualified Solkattu.Tala as Tala

import           Global


type Sequence = SequenceT Solkattu.Sollu
type SequenceT sollu = SequenceG Solkattu.Group sollu
type SequenceG g sollu = S.Sequence g (Solkattu.Note sollu)

type Error = Text

mapSollu :: (a -> b) -> S.Sequence g (Solkattu.Note a)
    -> S.Sequence g (Solkattu.Note b)
mapSollu :: forall a b g.
(a -> b) -> Sequence g (Note a) -> Sequence g (Note b)
mapSollu a -> b
f = (Note g (Note a) -> Note g (Note b))
-> Sequence g (Note a) -> Sequence g (Note b)
forall g1 a1 g2 a2.
(Note g1 a1 -> Note g2 a2) -> Sequence g1 a1 -> Sequence g2 a2
S.mapS ((Note g (Note a) -> Note g (Note b))
 -> Sequence g (Note a) -> Sequence g (Note b))
-> (Note g (Note a) -> Note g (Note b))
-> Sequence g (Note a)
-> Sequence g (Note b)
forall a b. (a -> b) -> a -> b
$ \case
    S.Note Note a
note -> Note b -> Note g (Note b)
forall g a. a -> Note g a
S.Note (a -> b
f (a -> b) -> Note a -> Note b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Note a
note)
    S.TempoChange TempoChange
change [Note g (Note a)]
notes -> TempoChange -> [Note g (Note b)] -> Note g (Note b)
forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange TempoChange
change ([Note g (Note a)] -> [Note g (Note b)]
mapS [Note g (Note a)]
notes)
    S.Group g
g [Note g (Note a)]
notes -> g -> [Note g (Note b)] -> Note g (Note b)
forall g a. g -> [Note g a] -> Note g a
S.Group g
g ([Note g (Note a)] -> [Note g (Note b)]
mapS [Note g (Note a)]
notes)
    where
    mapS :: [Note g (Note a)] -> [Note g (Note b)]
mapS = Sequence g (Note b) -> [Note g (Note b)]
forall g a. Sequence g a -> [Note g a]
S.toList (Sequence g (Note b) -> [Note g (Note b)])
-> ([Note g (Note a)] -> Sequence g (Note b))
-> [Note g (Note a)]
-> [Note g (Note b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Sequence g (Note a) -> Sequence g (Note b)
forall a b g.
(a -> b) -> Sequence g (Note a) -> Sequence g (Note b)
mapSollu a -> b
f (Sequence g (Note a) -> Sequence g (Note b))
-> ([Note g (Note a)] -> Sequence g (Note a))
-> [Note g (Note a)]
-> Sequence g (Note b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Note g (Note a)] -> Sequence g (Note a)
forall g a. [Note g a] -> Sequence g a
S.fromList

-- * Score

data Score = Single !Korvai | Tani !Metadata ![Part Korvai]
    deriving (Int -> Score -> ShowS
[Score] -> ShowS
Score -> String
(Int -> Score -> ShowS)
-> (Score -> String) -> ([Score] -> ShowS) -> Show Score
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Score] -> ShowS
$cshowList :: [Score] -> ShowS
show :: Score -> String
$cshow :: Score -> String
showsPrec :: Int -> Score -> ShowS
$cshowsPrec :: Int -> Score -> ShowS
Show)
data Part k = K !k | Comment !Text
    deriving (Int -> Part k -> ShowS
[Part k] -> ShowS
Part k -> String
(Int -> Part k -> ShowS)
-> (Part k -> String) -> ([Part k] -> ShowS) -> Show (Part k)
forall k. Show k => Int -> Part k -> ShowS
forall k. Show k => [Part k] -> ShowS
forall k. Show k => Part k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Part k] -> ShowS
$cshowList :: forall k. Show k => [Part k] -> ShowS
show :: Part k -> String
$cshow :: forall k. Show k => Part k -> String
showsPrec :: Int -> Part k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> Part k -> ShowS
Show, (forall a b. (a -> b) -> Part a -> Part b)
-> (forall a b. a -> Part b -> Part a) -> Functor Part
forall a b. a -> Part b -> Part a
forall a b. (a -> b) -> Part a -> Part 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 -> Part b -> Part a
$c<$ :: forall a b. a -> Part b -> Part a
fmap :: forall a b. (a -> b) -> Part a -> Part b
$cfmap :: forall a b. (a -> b) -> Part a -> Part b
Functor)

-- | Make a Tani Score, which is just a sequence of Korvais.
tani :: [Part Korvai] -> Score
tani :: [Part Korvai] -> Score
tani = Metadata -> [Part Korvai] -> Score
Tani (Metadata
forall a. Monoid a => a
mempty { _tags :: Tags
_tags = Text -> Tags
Tags.withType Text
"tani" })

mapScore :: (Korvai -> Korvai) -> Score -> Score
mapScore :: (Korvai -> Korvai) -> Score -> Score
mapScore Korvai -> Korvai
f = \case
    Single Korvai
k -> Korvai -> Score
Single (Korvai -> Korvai
f Korvai
k)
    Tani Metadata
meta [Part Korvai]
parts -> Metadata -> [Part Korvai] -> Score
Tani Metadata
meta ((Part Korvai -> Part Korvai) -> [Part Korvai] -> [Part Korvai]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Korvai -> Korvai) -> Part Korvai -> Part Korvai
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Korvai -> Korvai
f) [Part Korvai]
parts)

scoreKorvais :: Score -> [Korvai]
scoreKorvais :: Score -> [Korvai]
scoreKorvais (Single Korvai
k) = [Korvai
k]
scoreKorvais (Tani Metadata
_ [Part Korvai]
parts) = [Korvai
k | K Korvai
k <- [Part Korvai]
parts]

realizeScore :: (Korvai -> IO ()) -> Score -> IO ()
realizeScore :: (Korvai -> IO ()) -> Score -> IO ()
realizeScore Korvai -> IO ()
realize = \case
    Single Korvai
k -> Korvai -> IO ()
realize Korvai
k
    Tani Metadata
_ [Part Korvai]
parts -> [Part Korvai] -> (Part Korvai -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Part Korvai]
parts ((Part Korvai -> IO ()) -> IO ())
-> (Part Korvai -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
        -- TODO it would be nice to print the name, but it's only available
        -- through Db.  HasCallStack could get it... but I'd have to put it on
        -- every declaration.
        K Korvai
korvai -> Korvai -> IO ()
realize Korvai
korvai
        Comment Text
comment -> Styled -> IO ()
Styled.printLn (Styled -> IO ()) -> Styled -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Styled
forall a. ToStyled a => a -> Styled
Styled.bold Text
comment

-- * korvai

data Korvai = Korvai {
    Korvai -> KorvaiSections
korvaiSections :: !KorvaiSections
    , Korvai -> StrokeMaps
korvaiStrokeMaps :: !StrokeMaps
    , Korvai -> Tala
korvaiTala :: !Tala.Tala
    , Korvai -> Metadata
korvaiMetadata :: !Metadata
    } deriving (Int -> Korvai -> ShowS
[Korvai] -> ShowS
Korvai -> String
(Int -> Korvai -> ShowS)
-> (Korvai -> String) -> ([Korvai] -> ShowS) -> Show Korvai
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Korvai] -> ShowS
$cshowList :: [Korvai] -> ShowS
show :: Korvai -> String
$cshow :: Korvai -> String
showsPrec :: Int -> Korvai -> ShowS
$cshowsPrec :: Int -> Korvai -> ShowS
Show, (forall x. Korvai -> Rep Korvai x)
-> (forall x. Rep Korvai x -> Korvai) -> Generic Korvai
forall x. Rep Korvai x -> Korvai
forall x. Korvai -> Rep Korvai x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Korvai x -> Korvai
$cfrom :: forall x. Korvai -> Rep Korvai x
Generics.Generic)

instance Pretty Korvai where
    format :: Korvai -> Doc
format = Korvai -> Doc
forall a. (PrettyG (Rep a), Generic a) => a -> Doc
Pretty.formatGCamel

korvai :: Tala.Tala -> StrokeMaps -> [Section (SequenceT Solkattu.Sollu)]
    -> Korvai
korvai :: Tala -> StrokeMaps -> [Section (SequenceT Sollu)] -> Korvai
korvai Tala
tala StrokeMaps
strokeMaps [Section (SequenceT Sollu)]
sections = Korvai
    { korvaiSections :: KorvaiSections
korvaiSections = Instrument Sollu -> Sections Sollu -> KorvaiSections
forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument Sollu
IKonnakol
        ((Section (SequenceT Sollu) -> Section (SequenceT (Stroke Sollu)))
-> [Section (SequenceT Sollu)] -> Sections Sollu
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SequenceT Sollu -> SequenceT (Stroke Sollu))
-> Section (SequenceT Sollu) -> Section (SequenceT (Stroke Sollu))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Note Sollu -> Note (Stroke Sollu))
-> SequenceT Sollu -> SequenceT (Stroke Sollu)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sollu -> Stroke Sollu) -> Note Sollu -> Note (Stroke Sollu)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sollu -> Stroke Sollu
forall stroke. stroke -> Stroke stroke
Realize.stroke))) [Section (SequenceT Sollu)]
sections)
        -- Wrap up in dummy Realize.Strokes, see 'Realize.realizeSollu'.
    , korvaiStrokeMaps :: StrokeMaps
korvaiStrokeMaps = StrokeMaps
strokeMaps
    , korvaiTala :: Tala
korvaiTala = Tala
tala
    , korvaiMetadata :: Metadata
korvaiMetadata = Metadata
forall a. Monoid a => a
mempty
    }

korvaiInstruments :: Korvai -> [GInstrument]
korvaiInstruments :: Korvai -> [GInstrument]
korvaiInstruments Korvai
korvai = (GInstrument -> Bool) -> [GInstrument] -> [GInstrument]
forall a. (a -> Bool) -> [a] -> [a]
filter GInstrument -> Bool
hasInstrument [GInstrument]
instruments
    where
    hasInstrument :: GInstrument -> Bool
hasInstrument (GInstrument Instrument stroke
inst) =
        case Instrument stroke -> KorvaiSections -> Maybe (Sections stroke)
forall stroke.
Instrument stroke -> KorvaiSections -> Maybe (Sections stroke)
getSections Instrument stroke
inst (Korvai -> KorvaiSections
korvaiSections Korvai
korvai) of
            Just Sections stroke
_ -> Bool
True
            Maybe (Sections stroke)
Nothing -> case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
                KorvaiSections Instrument stroke
IKonnakol Sections stroke
_ -> Bool -> Bool
not (Instrument stroke -> Bool
forall stroke. Instrument stroke -> Bool
isEmpty Instrument stroke
inst)
                KorvaiSections
_ -> Bool
False
    -- Even if the stroke map is broken, at least there is one.
    isEmpty :: Instrument stroke -> Bool
    isEmpty :: forall stroke. Instrument stroke -> Bool
isEmpty Instrument stroke
inst = (Text -> Bool)
-> (StrokeMap stroke -> Bool)
-> Either Text (StrokeMap stroke)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
False) StrokeMap stroke -> Bool
forall stroke. StrokeMap stroke -> Bool
Realize.isInstrumentEmpty (Either Text (StrokeMap stroke) -> Bool)
-> Either Text (StrokeMap stroke) -> Bool
forall a b. (a -> b) -> a -> b
$
        Instrument stroke -> StrokeMaps -> Either Text (StrokeMap stroke)
forall stroke. Instrument stroke -> StrokeMaps -> StrokeMap stroke
getStrokeMap Instrument stroke
inst (Korvai -> StrokeMaps
korvaiStrokeMaps Korvai
korvai)

mridangamKorvai :: Tala.Tala -> Realize.PatternMap Mridangam.Stroke
    -> [Section (SequenceT (Realize.Stroke Mridangam.Stroke))] -> Korvai
mridangamKorvai :: Tala
-> PatternMap Stroke
-> [Section (SequenceT (Stroke Stroke))]
-> Korvai
mridangamKorvai = Instrument Stroke
-> Tala
-> PatternMap Stroke
-> [Section (SequenceT (Stroke Stroke))]
-> Korvai
forall stroke.
Instrument stroke
-> Tala
-> PatternMap stroke
-> [Section (SequenceT (Stroke stroke))]
-> Korvai
instrumentKorvai Instrument Stroke
IMridangam

kendangTunggalKorvai :: Tala.Tala -> Realize.PatternMap KendangTunggal.Stroke
    -> [Section (SequenceT (Realize.Stroke KendangTunggal.Stroke))] -> Korvai
kendangTunggalKorvai :: Tala
-> PatternMap Stroke
-> [Section (SequenceT (Stroke Stroke))]
-> Korvai
kendangTunggalKorvai = Instrument Stroke
-> Tala
-> PatternMap Stroke
-> [Section (SequenceT (Stroke Stroke))]
-> Korvai
forall stroke.
Instrument stroke
-> Tala
-> PatternMap stroke
-> [Section (SequenceT (Stroke stroke))]
-> Korvai
instrumentKorvai Instrument Stroke
IKendangTunggal

instrumentKorvai :: Instrument stroke -> Tala.Tala
    -> Realize.PatternMap stroke
    -> [Section (SequenceT (Realize.Stroke stroke))]
    -> Korvai
instrumentKorvai :: forall stroke.
Instrument stroke
-> Tala
-> PatternMap stroke
-> [Section (SequenceT (Stroke stroke))]
-> Korvai
instrumentKorvai Instrument stroke
inst Tala
tala PatternMap stroke
pmap [Section (SequenceT (Stroke stroke))]
sections = Korvai
    { korvaiSections :: KorvaiSections
korvaiSections = Instrument stroke
-> [Section (SequenceT (Stroke stroke))] -> KorvaiSections
forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument stroke
inst [Section (SequenceT (Stroke stroke))]
sections
    , korvaiStrokeMaps :: StrokeMaps
korvaiStrokeMaps =
        Instrument stroke -> StrokeMap stroke -> StrokeMaps
forall stroke. Instrument stroke -> StrokeMap stroke -> StrokeMaps
setStrokeMap Instrument stroke
inst (StrokeMap stroke -> StrokeMaps) -> StrokeMap stroke -> StrokeMaps
forall a b. (a -> b) -> a -> b
$ StrokeMap stroke -> StrokeMap stroke
forall a b. b -> Either a b
Right (StrokeMap stroke -> StrokeMap stroke)
-> StrokeMap stroke -> StrokeMap stroke
forall a b. (a -> b) -> a -> b
$ StrokeMap stroke
forall a. Monoid a => a
mempty { smapPatternMap :: PatternMap stroke
Realize.smapPatternMap = PatternMap stroke
pmap }
    , korvaiTala :: Tala
korvaiTala = Tala
tala
    , korvaiMetadata :: Metadata
korvaiMetadata = Metadata
forall a. Monoid a => a
mempty
    }

-- | Modify the korvai to extract a single Section.
index :: Int -> Korvai -> Korvai
index :: Int -> Korvai -> Korvai
index Int
i = Int -> Int -> Korvai -> Korvai
slice Int
i (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

slice :: Int -> Int -> Korvai -> Korvai
slice :: Int -> Int -> Korvai -> Korvai
slice Int
start Int
end Korvai
korvai = case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
    KorvaiSections Instrument stroke
inst Sections stroke
sections -> Korvai
korvai
        { korvaiSections :: KorvaiSections
korvaiSections = Instrument stroke -> Sections stroke -> KorvaiSections
forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument stroke
inst (Sections stroke -> KorvaiSections)
-> Sections stroke -> KorvaiSections
forall a b. (a -> b) -> a -> b
$
            Int -> Sections stroke -> Sections stroke
forall a. Int -> [a] -> [a]
get (if Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Sections stroke -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Sections stroke
sections Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
end else Int
end) Sections stroke
sections
        }
    where
    get :: Int -> [a] -> [a]
    get :: forall a. Int -> [a] -> [a]
get Int
end [a]
xs
        | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Int -> Bool
forall a. Ord a => a -> a -> a -> Bool
Num.inRange Int
0 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Int
start, Int
end] =
            Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
start [a]
xs
        | Bool
otherwise = String -> [a]
forall a. HasCallStack => String -> a
error (String -> [a]) -> String -> [a]
forall a b. (a -> b) -> a -> b
$ String
"(start, end) " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Int) -> String
forall a. Show a => a -> String
show (Int
start, Int
end)
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" out of range 0--" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)

-- ** Instrument

-- This seems like a dependent pair, Instrument lets me know what stroke is.
data KorvaiSections = forall stroke.
    KorvaiSections (Instrument stroke) (Sections stroke)

instance Show KorvaiSections where
    show :: KorvaiSections -> String
show (KorvaiSections Instrument stroke
inst Sections stroke
_) = Text -> String
untxt (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Instrument stroke -> Text
forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
inst
instance Pretty KorvaiSections where
    pretty :: KorvaiSections -> Text
pretty (KorvaiSections Instrument stroke
inst Sections stroke
_) = Instrument stroke -> Text
forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
inst

type Sections stroke = [Section (SequenceT (Realize.Stroke stroke))]

-- TODO: can I use Data.Type.Equality :~: ?
getSections :: Instrument stroke -> KorvaiSections -> Maybe (Sections stroke)
getSections :: forall stroke.
Instrument stroke -> KorvaiSections -> Maybe (Sections stroke)
getSections Instrument stroke
inst KorvaiSections
ktype = case (Instrument stroke
inst, KorvaiSections
ktype) of
    (Instrument stroke
IKonnakol, KorvaiSections Instrument stroke
IKonnakol Sections stroke
sections) -> Sections stroke -> Maybe (Sections stroke)
forall a. a -> Maybe a
Just Sections stroke
Sections stroke
sections
    (Instrument stroke
IMridangam, KorvaiSections Instrument stroke
IMridangam Sections stroke
sections) -> Sections stroke -> Maybe (Sections stroke)
forall a. a -> Maybe a
Just Sections stroke
Sections stroke
sections
    (Instrument stroke
IKendangTunggal, KorvaiSections Instrument stroke
IKendangTunggal Sections stroke
sections) -> Sections stroke -> Maybe (Sections stroke)
forall a. a -> Maybe a
Just Sections stroke
Sections stroke
sections
    (Instrument stroke
IKendangPasang, KorvaiSections Instrument stroke
IKendangPasang Sections stroke
sections) -> Sections stroke -> Maybe (Sections stroke)
forall a. a -> Maybe a
Just Sections stroke
Sections stroke
sections
    (Instrument stroke
IReyong, KorvaiSections Instrument stroke
IReyong Sections stroke
sections) -> Sections stroke -> Maybe (Sections stroke)
forall a. a -> Maybe a
Just Sections stroke
Sections stroke
sections
    (Instrument stroke
ISargam, KorvaiSections Instrument stroke
ISargam Sections stroke
sections) -> Sections stroke -> Maybe (Sections stroke)
forall a. a -> Maybe a
Just Sections stroke
Sections stroke
sections
    (Instrument stroke, KorvaiSections)
_ -> Maybe (Sections stroke)
forall a. Maybe a
Nothing

data GInstrument = forall stroke.
    (Solkattu.Notation stroke, Ord stroke, Expr.ToExpr (Realize.Stroke stroke))
    => GInstrument (Instrument stroke)

instruments :: [GInstrument]
instruments :: [GInstrument]
instruments =
    [ Instrument Sollu -> GInstrument
forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Sollu
IKonnakol
    , Instrument Stroke -> GInstrument
forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Stroke
IMridangam
    , Instrument Stroke -> GInstrument
forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Stroke
IKendangTunggal
    , Instrument Stroke -> GInstrument
forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Stroke
IReyong
    , Instrument Stroke -> GInstrument
forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Stroke
ISargam
    ]

ginstrumentName :: GInstrument -> Text
ginstrumentName :: GInstrument -> Text
ginstrumentName (GInstrument Instrument stroke
inst) = Instrument stroke -> Text
forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
inst

-- * Section

data Section a = Section {
    forall a. Section a -> a
sectionSequence :: a
    -- | Where the section should start.  0 means start on sam.
    , forall a. Section a -> Duration
sectionStart :: !S.Duration
    -- | Expect the section to end at this time.  It can be negative, in which
    -- case it falls before sam.  Useful for eddupu.
    , forall a. Section a -> Duration
sectionEnd :: !S.Duration
    -- | This is lazy because it might have a 'Solkattu.Exception' in it.  This
    -- is because 'inferSectionTags' has to evaluate the sequence.
    , forall a. Section a -> Tags
sectionTags :: Tags.Tags
    } deriving (Section a -> Section a -> Bool
(Section a -> Section a -> Bool)
-> (Section a -> Section a -> Bool) -> Eq (Section a)
forall a. Eq a => Section a -> Section a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section a -> Section a -> Bool
$c/= :: forall a. Eq a => Section a -> Section a -> Bool
== :: Section a -> Section a -> Bool
$c== :: forall a. Eq a => Section a -> Section a -> Bool
Eq, Int -> Section a -> ShowS
[Section a] -> ShowS
Section a -> String
(Int -> Section a -> ShowS)
-> (Section a -> String)
-> ([Section a] -> ShowS)
-> Show (Section a)
forall a. Show a => Int -> Section a -> ShowS
forall a. Show a => [Section a] -> ShowS
forall a. Show a => Section a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section a] -> ShowS
$cshowList :: forall a. Show a => [Section a] -> ShowS
show :: Section a -> String
$cshow :: forall a. Show a => Section a -> String
showsPrec :: Int -> Section a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Section a -> ShowS
Show, (forall a b. (a -> b) -> Section a -> Section b)
-> (forall a b. a -> Section b -> Section a) -> Functor Section
forall a b. a -> Section b -> Section a
forall a b. (a -> b) -> Section a -> Section 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 -> Section b -> Section a
$c<$ :: forall a b. a -> Section b -> Section a
fmap :: forall a b. (a -> b) -> Section a -> Section b
$cfmap :: forall a b. (a -> b) -> Section a -> Section b
Functor, (forall x. Section a -> Rep (Section a) x)
-> (forall x. Rep (Section a) x -> Section a)
-> Generic (Section a)
forall x. Rep (Section a) x -> Section a
forall x. Section a -> Rep (Section a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Section a) x -> Section a
forall a x. Section a -> Rep (Section a) x
$cto :: forall a x. Rep (Section a) x -> Section a
$cfrom :: forall a x. Section a -> Rep (Section a) x
Generics.Generic)

instance Pretty a => Pretty (Section a) where
    format :: Section a -> Doc
format = Section a -> Doc
forall a. (PrettyG (Rep a), Generic a) => a -> Doc
Pretty.formatGCamel

scoreSections :: Score -> [Section ()]
scoreSections :: Score -> [Section ()]
scoreSections = \case
    Single Korvai
k -> Korvai -> [Section ()]
genericSections Korvai
k
    Tani Metadata
_ [Part Korvai]
parts -> ((Part Korvai -> [Section ()]) -> [Part Korvai] -> [Section ()])
-> [Part Korvai] -> (Part Korvai -> [Section ()]) -> [Section ()]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Part Korvai -> [Section ()]) -> [Part Korvai] -> [Section ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Part Korvai]
parts ((Part Korvai -> [Section ()]) -> [Section ()])
-> (Part Korvai -> [Section ()]) -> [Section ()]
forall a b. (a -> b) -> a -> b
$ \case
        K Korvai
korvai -> Korvai -> [Section ()]
genericSections Korvai
korvai
        Part Korvai
_ -> []

genericSections :: Korvai -> [Section ()]
genericSections :: Korvai -> [Section ()]
genericSections Korvai
korvai = case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
    KorvaiSections Instrument stroke
_ Sections stroke
sections -> (Section (SequenceT (Stroke stroke)) -> Section ())
-> Sections stroke -> [Section ()]
forall a b. (a -> b) -> [a] -> [b]
map ((SequenceT (Stroke stroke) -> ())
-> Section (SequenceT (Stroke stroke)) -> Section ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> SequenceT (Stroke stroke) -> ()
forall a b. a -> b -> a
const ())) Sections stroke
sections

modifySections :: (Tags.Tags -> Tags.Tags) -> Korvai -> Korvai
modifySections :: (Tags -> Tags) -> Korvai -> Korvai
modifySections Tags -> Tags
modify Korvai
korvai = Korvai
korvai
    { korvaiSections :: KorvaiSections
korvaiSections = case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
        KorvaiSections Instrument stroke
inst Sections stroke
sections ->
            Instrument stroke -> Sections stroke -> KorvaiSections
forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument stroke
inst (Sections stroke -> KorvaiSections)
-> Sections stroke -> KorvaiSections
forall a b. (a -> b) -> a -> b
$ (Section (SequenceT (Stroke stroke))
 -> Section (SequenceT (Stroke stroke)))
-> Sections stroke -> Sections stroke
forall a b. (a -> b) -> [a] -> [b]
map ((Tags -> Tags)
-> Section (SequenceT (Stroke stroke))
-> Section (SequenceT (Stroke stroke))
forall a. (Tags -> Tags) -> Section a -> Section a
modifySectionTags Tags -> Tags
modify) Sections stroke
sections
    }

addSectionTags :: Tags.Tags -> Section a -> Section a
addSectionTags :: forall a. Tags -> Section a -> Section a
addSectionTags Tags
tags = (Tags -> Tags) -> Section a -> Section a
forall a. (Tags -> Tags) -> Section a -> Section a
modifySectionTags (Tags
tags<>)

modifySectionTags :: (Tags.Tags -> Tags.Tags) -> Section a -> Section a
modifySectionTags :: forall a. (Tags -> Tags) -> Section a -> Section a
modifySectionTags Tags -> Tags
modify Section a
section =
    Section a
section { sectionTags :: Tags
sectionTags = Tags -> Tags
modify (Section a -> Tags
forall a. Section a -> Tags
sectionTags Section a
section) }

section :: a -> Section a
section :: forall a. a -> Section a
section a
seq = Section
    { sectionSequence :: a
sectionSequence = a
seq
    , sectionStart :: Duration
sectionStart = Duration
0
    , sectionEnd :: Duration
sectionEnd = Duration
0
    , sectionTags :: Tags
sectionTags = Tags
forall a. Monoid a => a
mempty
    }

inferSections :: [SequenceT sollu] -> [Section (SequenceT sollu)]
inferSections :: forall sollu. [SequenceT sollu] -> [Section (SequenceT sollu)]
inferSections [SequenceT sollu]
seqs = case [Section (SequenceT sollu)]
-> Maybe ([Section (SequenceT sollu)], Section (SequenceT sollu))
forall a. [a] -> Maybe ([a], a)
Seq.viewr ((SequenceT sollu -> Section (SequenceT sollu))
-> [SequenceT sollu] -> [Section (SequenceT sollu)]
forall a b. (a -> b) -> [a] -> [b]
map SequenceT sollu -> Section (SequenceT sollu)
forall a. a -> Section a
section [SequenceT sollu]
seqs) of
    Just ([Section (SequenceT sollu)]
inits, Section (SequenceT sollu)
last) ->
        (Section (SequenceT sollu) -> Section (SequenceT sollu))
-> [Section (SequenceT sollu)] -> [Section (SequenceT sollu)]
forall a b. (a -> b) -> [a] -> [b]
map (Tags -> Section (SequenceT sollu) -> Section (SequenceT sollu)
forall a. Tags -> Section a -> Section a
addSectionTags (Text -> Tags
Tags.withType Text
Tags.development)) [Section (SequenceT sollu)]
inits
        [Section (SequenceT sollu)]
-> [Section (SequenceT sollu)] -> [Section (SequenceT sollu)]
forall a. [a] -> [a] -> [a]
++ [Tags -> Section (SequenceT sollu) -> Section (SequenceT sollu)
forall a. Tags -> Section a -> Section a
addSectionTags (Text -> Tags
Tags.withType Text
Tags.ending) Section (SequenceT sollu)
last]
    Maybe ([Section (SequenceT sollu)], Section (SequenceT sollu))
Nothing -> []

-- * Instrument

-- | Each instrument is matched up with a stroke type.
data Instrument stroke where
    IKonnakol :: Instrument Solkattu.Sollu
    IMridangam :: Instrument Mridangam.Stroke
    IKendangTunggal :: Instrument KendangTunggal.Stroke
    IKendangPasang :: Instrument KendangPasang.Stroke
    IReyong :: Instrument Reyong.Stroke
    ISargam :: Instrument Sargam.Stroke

instrumentName :: Instrument stroke -> Text
instrumentName :: forall stroke. Instrument stroke -> Text
instrumentName = \case
    Instrument stroke
IKonnakol -> Text
"konnakol"
    Instrument stroke
IMridangam -> Text
"mridangam"
    Instrument stroke
IKendangTunggal -> Text
"kendang tunggal"
    Instrument stroke
IKendangPasang -> Text
"kendang pasang"
    Instrument stroke
IReyong -> Text
"reyong"
    Instrument stroke
ISargam -> Text
"sargam"

getStrokeMap :: Instrument stroke -> StrokeMaps -> StrokeMap stroke
getStrokeMap :: forall stroke. Instrument stroke -> StrokeMaps -> StrokeMap stroke
getStrokeMap Instrument stroke
inst StrokeMaps
smap = case Instrument stroke
inst of
    Instrument stroke
IKonnakol -> StrokeMap stroke -> StrokeMap stroke
forall a b. b -> Either a b
Right (StrokeMap stroke -> StrokeMap stroke)
-> StrokeMap stroke -> StrokeMap stroke
forall a b. (a -> b) -> a -> b
$ StrokeMap Sollu
forall a. Monoid a => a
mempty
        { smapPatternMap :: PatternMap Sollu
Realize.smapPatternMap = PatternMap Sollu
Konnakol.defaultPatterns }
    Instrument stroke
IMridangam -> StrokeMaps -> StrokeMap Stroke
smapMridangam StrokeMaps
smap
    Instrument stroke
IKendangTunggal -> StrokeMaps -> StrokeMap Stroke
smapKendangTunggal StrokeMaps
smap
    Instrument stroke
IKendangPasang -> StrokeMaps -> StrokeMap Stroke
smapKendangPasang StrokeMaps
smap
    Instrument stroke
IReyong -> StrokeMaps -> StrokeMap Stroke
smapReyong StrokeMaps
smap
    Instrument stroke
ISargam -> StrokeMaps -> StrokeMap Stroke
smapSargam StrokeMaps
smap

setStrokeMap :: Instrument stroke -> StrokeMap stroke -> StrokeMaps
setStrokeMap :: forall stroke. Instrument stroke -> StrokeMap stroke -> StrokeMaps
setStrokeMap Instrument stroke
inst StrokeMap stroke
smap = case Instrument stroke
inst of
    Instrument stroke
IKonnakol -> StrokeMaps
forall a. Monoid a => a
mempty
    Instrument stroke
IMridangam -> StrokeMaps
forall a. Monoid a => a
mempty { smapMridangam :: StrokeMap Stroke
smapMridangam = StrokeMap stroke
StrokeMap Stroke
smap }
    Instrument stroke
IKendangTunggal -> StrokeMaps
forall a. Monoid a => a
mempty { smapKendangTunggal :: StrokeMap Stroke
smapKendangTunggal = StrokeMap stroke
StrokeMap Stroke
smap }
    Instrument stroke
IKendangPasang -> StrokeMaps
forall a. Monoid a => a
mempty { smapKendangPasang :: StrokeMap Stroke
smapKendangPasang = StrokeMap stroke
StrokeMap Stroke
smap }
    Instrument stroke
IReyong -> StrokeMaps
forall a. Monoid a => a
mempty { smapReyong :: StrokeMap Stroke
smapReyong = StrokeMap stroke
StrokeMap Stroke
smap }
    Instrument stroke
ISargam -> StrokeMaps
forall a. Monoid a => a
mempty { smapSargam :: StrokeMap Stroke
smapSargam = StrokeMap stroke
StrokeMap Stroke
smap }

instPostprocess :: Instrument stroke -> [Flat stroke] -> [Flat stroke]
instPostprocess :: forall stroke. Instrument stroke -> [Flat stroke] -> [Flat stroke]
instPostprocess = \case
    Instrument stroke
IMridangam -> [Flat stroke] -> [Flat stroke]
[Flat Stroke] -> [Flat Stroke]
Mridangam.postprocess
    Instrument stroke
_ -> [Flat stroke] -> [Flat stroke]
forall a. a -> a
id

instToScore :: Expr.ToExpr (Realize.Stroke stroke) => Instrument stroke
    -> ToScore.ToScore stroke
instToScore :: forall stroke.
ToExpr (Stroke stroke) =>
Instrument stroke -> ToScore stroke
instToScore = \case
    Instrument stroke
ISargam -> ToScore stroke
ToScore Stroke
Sargam.toScore
    Instrument stroke
_ -> ToScore stroke
forall stroke. ToExpr (Stroke stroke) => ToScore stroke
ToScore.toScore


-- * realize

-- | Fully realized notes.
type Flat stroke =
    S.Flat (Realize.Group (Realize.Stroke stroke)) (Realize.Note stroke)

type Realized stroke = ([Flat stroke], [Realize.Warning])

-- | Realize a Korvai on a particular instrument.
realize :: forall stroke. (Solkattu.Notation stroke, Ord stroke)
    => Instrument stroke -> Korvai -> [Either Error (Realized stroke)]
realize :: forall stroke.
(Notation stroke, Ord stroke) =>
Instrument stroke -> Korvai -> [Either Text (Realized stroke)]
realize Instrument stroke
inst Korvai
korvai = case Instrument stroke -> StrokeMaps -> StrokeMap stroke
forall stroke. Instrument stroke -> StrokeMaps -> StrokeMap stroke
getStrokeMap Instrument stroke
inst (Korvai -> StrokeMaps
korvaiStrokeMaps Korvai
korvai) of
    Left Text
err -> [Text -> Either Text (Realized stroke)
forall a b. a -> Either a b
Left Text
err]
    Right StrokeMap stroke
smap -> case Instrument stroke -> KorvaiSections -> Maybe (Sections stroke)
forall stroke.
Instrument stroke -> KorvaiSections -> Maybe (Sections stroke)
getSections Instrument stroke
inst (Korvai -> KorvaiSections
korvaiSections Korvai
korvai) of
        -- An instrument Korvai can be realized to the same instrument.
        Just Sections stroke
sections ->
            (Section (SequenceT (Stroke stroke))
 -> Either Text (Realized stroke))
-> Sections stroke -> [Either Text (Realized stroke)]
forall a b. (a -> b) -> [a] -> [b]
map (Tala
-> ToStrokes (Stroke stroke) stroke
-> StrokeMap stroke
-> ([Flat stroke] -> [Flat stroke])
-> Section (SequenceT (Stroke stroke))
-> Either Text (Realized stroke)
forall sollu stroke.
(Ord sollu, Pretty sollu, Notation stroke) =>
Tala
-> ToStrokes sollu stroke
-> StrokeMap stroke
-> ([Flat stroke] -> [Flat stroke])
-> Section (SequenceT sollu)
-> Either Text (Realized stroke)
realizeSection Tala
tala ToStrokes (Stroke stroke) stroke
forall stroke. ToStrokes (Stroke stroke) stroke
Realize.realizeStroke StrokeMap stroke
smap [Flat stroke] -> [Flat stroke]
postproc)
                Sections stroke
sections
        Maybe (Sections stroke)
Nothing -> case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
            -- IKonnakol korvai can be realized to any instrument.
            KorvaiSections Instrument stroke
IKonnakol Sections stroke
sections ->
                (Section (SequenceT (Stroke Sollu))
 -> Either Text (Realized stroke))
-> Sections Sollu -> [Either Text (Realized stroke)]
forall a b. (a -> b) -> [a] -> [b]
map (Tala
-> ToStrokes (Stroke Sollu) stroke
-> StrokeMap stroke
-> ([Flat stroke] -> [Flat stroke])
-> Section (SequenceT (Stroke Sollu))
-> Either Text (Realized stroke)
forall sollu stroke.
(Ord sollu, Pretty sollu, Notation stroke) =>
Tala
-> ToStrokes sollu stroke
-> StrokeMap stroke
-> ([Flat stroke] -> [Flat stroke])
-> Section (SequenceT sollu)
-> Either Text (Realized stroke)
realizeSection Tala
tala ToStrokes (Stroke Sollu) stroke
toStrokes StrokeMap stroke
smap [Flat stroke] -> [Flat stroke]
postproc) Sections stroke
Sections Sollu
sections
                where
                toStrokes :: ToStrokes (Stroke Sollu) stroke
toStrokes = SolluMap stroke -> ToStrokes (Stroke Sollu) stroke
forall stroke. SolluMap stroke -> ToStrokes (Stroke Sollu) stroke
Realize.realizeSollu (StrokeMap stroke -> SolluMap stroke
forall stroke. StrokeMap stroke -> SolluMap stroke
Realize.smapSolluMap StrokeMap stroke
smap)
            KorvaiSections Instrument stroke
kinst Sections stroke
_ -> (Either Text (Realized stroke)
-> [Either Text (Realized stroke)]
-> [Either Text (Realized stroke)]
forall a. a -> [a] -> [a]
:[]) (Either Text (Realized stroke) -> [Either Text (Realized stroke)])
-> Either Text (Realized stroke) -> [Either Text (Realized stroke)]
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Realized stroke)
forall a b. a -> Either a b
Left (Text -> Either Text (Realized stroke))
-> Text -> Either Text (Realized stroke)
forall a b. (a -> b) -> a -> b
$ Text
"can't realize "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Instrument stroke -> Text
forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
kinst Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Instrument stroke -> Text
forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
inst
    where
    tala :: Tala
tala = Korvai -> Tala
korvaiTala Korvai
korvai
    postproc :: [Flat stroke] -> [Flat stroke]
postproc = Instrument stroke -> [Flat stroke] -> [Flat stroke]
forall stroke. Instrument stroke -> [Flat stroke] -> [Flat stroke]
instPostprocess Instrument stroke
inst

realizeSection :: (Ord sollu, Pretty sollu, Solkattu.Notation stroke)
    => Tala.Tala
    -> Realize.ToStrokes sollu stroke
    -> Realize.StrokeMap stroke
    -> ([Flat stroke] -> [Flat stroke])
    -> Section (SequenceT sollu)
    -> Either Error (Realized stroke)
realizeSection :: forall sollu stroke.
(Ord sollu, Pretty sollu, Notation stroke) =>
Tala
-> ToStrokes sollu stroke
-> StrokeMap stroke
-> ([Flat stroke] -> [Flat stroke])
-> Section (SequenceT sollu)
-> Either Text (Realized stroke)
realizeSection Tala
tala ToStrokes sollu stroke
toStrokes StrokeMap stroke
smap [Flat stroke] -> [Flat stroke]
postproc Section (SequenceT sollu)
section = do
    [Flat stroke]
realized <- UntilFail Text (Flat stroke) -> Either Text [Flat stroke]
forall a g.
Notation a =>
UntilFail Text (Flat g a) -> Either Text [Flat g a]
Realize.formatError (UntilFail Text (Flat stroke) -> Either Text [Flat stroke])
-> UntilFail Text (Flat stroke) -> Either Text [Flat stroke]
forall a b. (a -> b) -> a -> b
$ (UntilFail Text (Flat stroke), Set (SolluMapKey sollu))
-> UntilFail Text (Flat stroke)
forall a b. (a, b) -> a
fst ((UntilFail Text (Flat stroke), Set (SolluMapKey sollu))
 -> UntilFail Text (Flat stroke))
-> (UntilFail Text (Flat stroke), Set (SolluMapKey sollu))
-> UntilFail Text (Flat stroke)
forall a b. (a -> b) -> a -> b
$
        StrokeMap stroke
-> ToStrokes sollu stroke
-> Tala
-> [Flat Group (Note sollu)]
-> (UntilFail Text (Flat stroke), Set (SolluMapKey sollu))
forall sollu stroke.
(Pretty sollu, Ord sollu) =>
StrokeMap stroke
-> ToStrokes sollu stroke
-> Tala
-> [Flat Group (Note sollu)]
-> (UntilFail Text (Realized stroke), Set (SolluMapKey sollu))
Realize.realize StrokeMap stroke
smap ToStrokes sollu stroke
toStrokes Tala
tala ([Flat Group (Note sollu)]
 -> (UntilFail Text (Flat stroke), Set (SolluMapKey sollu)))
-> [Flat Group (Note sollu)]
-> (UntilFail Text (Flat stroke), Set (SolluMapKey sollu))
forall a b. (a -> b) -> a -> b
$ SequenceT sollu -> [Flat Group (Note sollu)]
forall g sollu. SequenceG g sollu -> [Flat g (Note sollu)]
flatten (SequenceT sollu -> [Flat Group (Note sollu)])
-> SequenceT sollu -> [Flat Group (Note sollu)]
forall a b. (a -> b) -> a -> b
$
        Section (SequenceT sollu) -> SequenceT sollu
forall a. Section a -> a
sectionSequence Section (SequenceT sollu)
section
    let alignWarn :: Maybe Warning
alignWarn = Tala
-> Duration -> Duration -> [(Tempo, Note stroke)] -> Maybe Warning
forall stroke.
Tala
-> Duration -> Duration -> [(Tempo, Note stroke)] -> Maybe Warning
Realize.checkAlignment Tala
tala
            (Section (SequenceT sollu) -> Duration
forall a. Section a -> Duration
sectionStart Section (SequenceT sollu)
section) (Section (SequenceT sollu) -> Duration
forall a. Section a -> Duration
sectionEnd Section (SequenceT sollu)
section)
            ([Flat stroke] -> [(Tempo, Note stroke)]
forall g a. [Flat g a] -> [(Tempo, a)]
S.tempoNotes [Flat stroke]
realized)
    ([Flat stroke]
realized, [Warning]
durationWarns) <- Realized stroke -> Either Text (Realized stroke)
forall (m :: * -> *) a. Monad m => a -> m a
return (Realized stroke -> Either Text (Realized stroke))
-> Realized stroke -> Either Text (Realized stroke)
forall a b. (a -> b) -> a -> b
$ [Flat stroke] -> Realized stroke
forall stroke. [Realized stroke] -> ([Realized stroke], [Warning])
Realize.checkDuration [Flat stroke]
realized
    [Flat stroke]
startSpace <- Int -> Duration -> Either Text [Flat stroke]
forall g sollu.
Int -> Duration -> Either Text [Flat g (Note sollu)]
spaces ([Flat stroke] -> Int
forall stroke. [Flat stroke] -> Int
inferNadai [Flat stroke]
realized) (Section (SequenceT sollu) -> Duration
forall a. Section a -> Duration
sectionStart Section (SequenceT sollu)
section)
    Realized stroke -> Either Text (Realized stroke)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [Flat stroke] -> [Flat stroke]
postproc ([Flat stroke] -> [Flat stroke]) -> [Flat stroke] -> [Flat stroke]
forall a b. (a -> b) -> a -> b
$ [Flat stroke]
startSpace [Flat stroke] -> [Flat stroke] -> [Flat stroke]
forall a. [a] -> [a] -> [a]
++ [Flat stroke]
realized
        , [Warning] -> (Warning -> [Warning]) -> Maybe Warning -> [Warning]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Warning -> [Warning] -> [Warning]
forall a. a -> [a] -> [a]
:[]) Maybe Warning
alignWarn [Warning] -> [Warning] -> [Warning]
forall a. [a] -> [a] -> [a]
++ [Warning]
durationWarns
        )

allMatchedSollus :: Instrument stroke -> Korvai
    -> Set (Realize.SolluMapKey Solkattu.Sollu)
allMatchedSollus :: forall stroke.
Instrument stroke -> Korvai -> Set (SolluMapKey Sollu)
allMatchedSollus Instrument stroke
instrument Korvai
korvai = case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
    KorvaiSections Instrument stroke
IKonnakol Sections stroke
sections -> ((Maybe Tag, [Stroke Sollu]) -> SolluMapKey Sollu)
-> Set (Maybe Tag, [Stroke Sollu]) -> Set (SolluMapKey Sollu)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Maybe Tag, [Stroke Sollu]) -> SolluMapKey Sollu
forall {a} {b}. (a, [Stroke b]) -> (a, [b])
strip (Set (Maybe Tag, [Stroke Sollu]) -> Set (SolluMapKey Sollu))
-> Set (Maybe Tag, [Stroke Sollu]) -> Set (SolluMapKey Sollu)
forall a b. (a -> b) -> a -> b
$
        (Section (SequenceT (Stroke Sollu))
 -> Set (Maybe Tag, [Stroke Sollu]))
-> Sections Sollu -> Set (Maybe Tag, [Stroke Sollu])
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (ToStrokes (Stroke Sollu) stroke
-> Tala
-> Section (SequenceT (Stroke Sollu))
-> Set (Maybe Tag, [Stroke Sollu])
forall sollu stroke.
(Pretty sollu, Ord sollu) =>
ToStrokes sollu stroke
-> Tala -> Section (SequenceT sollu) -> Set (SolluMapKey sollu)
matchedSollus ToStrokes (Stroke Sollu) stroke
toStrokes (Korvai -> Tala
korvaiTala Korvai
korvai)) Sections stroke
Sections Sollu
sections
    KorvaiSections
_ -> Set (SolluMapKey Sollu)
forall a. Monoid a => a
mempty
    where
    -- For uniformity with instruments, IKonnakol also maps from
    -- (Realize.Stroke Sollu) even though I don't use emphasis.  So shim it
    -- back to plain Sollus.
    strip :: (a, [Stroke b]) -> (a, [b])
strip (a
tag, [Stroke b]
sollus) = (a
tag, (Stroke b -> b) -> [Stroke b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Stroke b -> b
forall stroke. Stroke stroke -> stroke
Realize._stroke [Stroke b]
sollus)
    toStrokes :: ToStrokes (Stroke Sollu) stroke
toStrokes = SolluMap stroke -> ToStrokes (Stroke Sollu) stroke
forall stroke. SolluMap stroke -> ToStrokes (Stroke Sollu) stroke
Realize.realizeSollu SolluMap stroke
solluMap
    solluMap :: SolluMap stroke
solluMap = (Text -> SolluMap stroke)
-> (StrokeMap stroke -> SolluMap stroke)
-> Either Text (StrokeMap stroke)
-> SolluMap stroke
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> SolluMap stroke
forall a. Monoid a => a
mempty StrokeMap stroke -> SolluMap stroke
forall stroke. StrokeMap stroke -> SolluMap stroke
Realize.smapSolluMap Either Text (StrokeMap stroke)
smap
    smap :: Either Text (StrokeMap stroke)
smap = Instrument stroke -> StrokeMaps -> Either Text (StrokeMap stroke)
forall stroke. Instrument stroke -> StrokeMaps -> StrokeMap stroke
getStrokeMap Instrument stroke
instrument (Korvai -> StrokeMaps
korvaiStrokeMaps Korvai
korvai)

matchedSollus :: (Pretty sollu, Ord sollu)
    => Realize.ToStrokes sollu stroke -> Tala.Tala -> Section (SequenceT sollu)
    -> Set (Realize.SolluMapKey sollu)
matchedSollus :: forall sollu stroke.
(Pretty sollu, Ord sollu) =>
ToStrokes sollu stroke
-> Tala -> Section (SequenceT sollu) -> Set (SolluMapKey sollu)
matchedSollus ToStrokes sollu stroke
toStrokes Tala
tala =
    (UntilFail Text (Realized stroke), Set (SolluMapKey sollu))
-> Set (SolluMapKey sollu)
forall a b. (a, b) -> b
snd ((UntilFail Text (Realized stroke), Set (SolluMapKey sollu))
 -> Set (SolluMapKey sollu))
-> (Section (SequenceT sollu)
    -> (UntilFail Text (Realized stroke), Set (SolluMapKey sollu)))
-> Section (SequenceT sollu)
-> Set (SolluMapKey sollu)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealizePattern Tempo stroke
-> ToStrokes sollu stroke
-> Tala
-> [Flat Group (Note sollu)]
-> (UntilFail Text (Realized stroke), Set (SolluMapKey sollu))
forall sollu stroke.
(Pretty sollu, Ord sollu) =>
RealizePattern Tempo stroke
-> ToStrokes sollu stroke
-> Tala
-> [Flat Group (Note sollu)]
-> (UntilFail Text (Realized stroke), Set (SolluMapKey sollu))
Realize.realize_ RealizePattern Tempo stroke
forall {a} {a} {stroke}.
a -> Pattern -> Either a [(a, Note stroke)]
dummyPattern ToStrokes sollu stroke
toStrokes Tala
tala ([Flat Group (Note sollu)]
 -> (UntilFail Text (Realized stroke), Set (SolluMapKey sollu)))
-> (Section (SequenceT sollu) -> [Flat Group (Note sollu)])
-> Section (SequenceT sollu)
-> (UntilFail Text (Realized stroke), Set (SolluMapKey sollu))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SequenceT sollu -> [Flat Group (Note sollu)]
forall g sollu. SequenceG g sollu -> [Flat g (Note sollu)]
flatten
        (SequenceT sollu -> [Flat Group (Note sollu)])
-> (Section (SequenceT sollu) -> SequenceT sollu)
-> Section (SequenceT sollu)
-> [Flat Group (Note sollu)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section (SequenceT sollu) -> SequenceT sollu
forall a. Section a -> a
sectionSequence
    where
    -- Since I'm just looking for used sollus, I can just map all patterns to
    -- rests.  I probably don't have to bother to get the duration right, but
    -- why not.
    dummyPattern :: a -> Pattern -> Either a [(a, Note stroke)]
dummyPattern a
tempo (Solkattu.PatternM Int
p) =
        [(a, Note stroke)] -> Either a [(a, Note stroke)]
forall a b. b -> Either a b
Right ([(a, Note stroke)] -> Either a [(a, Note stroke)])
-> [(a, Note stroke)] -> Either a [(a, Note stroke)]
forall a b. (a -> b) -> a -> b
$ Int -> (a, Note stroke) -> [(a, Note stroke)]
forall a. Int -> a -> [a]
replicate Int
p (a
tempo, Space -> Note stroke
forall stroke. Space -> Note stroke
Realize.Space Space
Solkattu.Rest)

inferNadai :: [Flat stroke] -> S.Nadai
inferNadai :: forall stroke. [Flat stroke] -> Int
inferNadai = Tempo -> Int
S._nadai (Tempo -> Int) -> ([Flat stroke] -> Tempo) -> [Flat stroke] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tempo
-> ((Tempo, Note stroke) -> Tempo)
-> Maybe (Tempo, Note stroke)
-> Tempo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tempo
S.defaultTempo (Tempo, Note stroke) -> Tempo
forall a b. (a, b) -> a
fst (Maybe (Tempo, Note stroke) -> Tempo)
-> ([Flat stroke] -> Maybe (Tempo, Note stroke))
-> [Flat stroke]
-> Tempo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Tempo, Note stroke)] -> Maybe (Tempo, Note stroke)
forall a. [a] -> Maybe a
Seq.head ([(Tempo, Note stroke)] -> Maybe (Tempo, Note stroke))
-> ([Flat stroke] -> [(Tempo, Note stroke)])
-> [Flat stroke]
-> Maybe (Tempo, Note stroke)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Flat stroke] -> [(Tempo, Note stroke)]
forall g a. [Flat g a] -> [(Tempo, a)]
S.tempoNotes

flatten :: SequenceG g sollu -> [S.Flat g (Solkattu.Note sollu)]
flatten :: forall g sollu. SequenceG g sollu -> [Flat g (Note sollu)]
flatten = [Flat g (Note sollu)] -> [Flat g (Note sollu)]
forall g sollu. [Flat g (Note sollu)] -> [Flat g (Note sollu)]
Solkattu.cancelKarvai ([Flat g (Note sollu)] -> [Flat g (Note sollu)])
-> (SequenceG g sollu -> [Flat g (Note sollu)])
-> SequenceG g sollu
-> [Flat g (Note sollu)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Note g (Note sollu)] -> [Flat g (Note sollu)]
forall g a. [Note g a] -> [Flat g a]
S.flatten ([Note g (Note sollu)] -> [Flat g (Note sollu)])
-> (SequenceG g sollu -> [Note g (Note sollu)])
-> SequenceG g sollu
-> [Flat g (Note sollu)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SequenceG g sollu -> [Note g (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList

-- | Generate enough 'Solkattu.Offset' spaces to align the score to the given
-- start Duration.
spaces :: S.Nadai -> S.Duration -> Either Error [S.Flat g (Realize.Note sollu)]
spaces :: forall g sollu.
Int -> Duration -> Either Text [Flat g (Note sollu)]
spaces Int
nadai Duration
dur = do
    -- Cancel out the nadai.  So dur is now in s0 matras.
    let s0_matras :: FMatra
s0_matras = Duration -> FMatra
forall a b. (Real a, Fractional b) => a -> b
realToFrac Duration
dur FMatra -> FMatra -> FMatra
forall a. Num a => a -> a -> a
* Int -> FMatra
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nadai
    [Int]
speeds <- FMatra -> Either Text [Int]
S.decomposeM FMatra
s0_matras
    [Flat g (Note sollu)] -> Either Text [Flat g (Note sollu)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Flat g (Note sollu)] -> Either Text [Flat g (Note sollu)])
-> [Flat g (Note sollu)] -> Either Text [Flat g (Note sollu)]
forall a b. (a -> b) -> a -> b
$ (Int -> Flat g (Note sollu)) -> [Int] -> [Flat g (Note sollu)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
s -> Tempo -> Note sollu -> Flat g (Note sollu)
forall g a. Tempo -> a -> Flat g a
S.FNote (Int -> Tempo
speed Int
s) Note sollu
forall {stroke}. Note stroke
space) [Int]
speeds
    where
    space :: Note stroke
space = Space -> Note stroke
forall stroke. Space -> Note stroke
Realize.Space Space
Solkattu.Offset
    speed :: Int -> Tempo
speed Int
s = Tempo
S.defaultTempo { _speed :: Int
S._speed = Int
s, _nadai :: Int
S._nadai = Int
nadai }

-- * transform

-- TODO broken by KorvaiSections, fix this
-- vary :: (Sequence -> [Sequence]) -> Korvai -> Korvai
-- vary modify korvai = korvai
--     { korvaiSections = concatMap modify (korvaiSections korvai) }

mapStrokeRest :: (Realize.Stroke a -> Maybe (Realize.Stroke b))
    -> [S.Flat g (Realize.Note a)] -> [S.Flat g (Realize.Note b)]
mapStrokeRest :: forall a b g.
(Stroke a -> Maybe (Stroke b))
-> [Flat g (Note a)] -> [Flat g (Note b)]
mapStrokeRest Stroke a -> Maybe (Stroke b)
f = (Flat g (Note a) -> Flat g (Note b))
-> [Flat g (Note a)] -> [Flat g (Note b)]
forall a b. (a -> b) -> [a] -> [b]
map Flat g (Note a) -> Flat g (Note b)
convert
    where
    convert :: Flat g (Note a) -> Flat g (Note b)
convert = \case
        S.FNote Tempo
tempo Note a
a -> Tempo -> Note b -> Flat g (Note b)
forall g a. Tempo -> a -> Flat g a
S.FNote Tempo
tempo (Note b -> Flat g (Note b)) -> Note b -> Flat g (Note b)
forall a b. (a -> b) -> a -> b
$
            Note b -> Maybe (Note b) -> Note b
forall a. a -> Maybe a -> a
fromMaybe (Space -> Note b
forall stroke. Space -> Note stroke
Realize.Space Space
Solkattu.Rest) ((Stroke a -> Maybe (Stroke b)) -> Note a -> Maybe (Note b)
forall (f :: * -> *) a b.
Applicative f =>
(Stroke a -> f (Stroke b)) -> Note a -> f (Note b)
Realize.mapStroke Stroke a -> Maybe (Stroke b)
f Note a
a)
        S.FGroup Tempo
tempo g
group [Flat g (Note a)]
notes ->
            Tempo -> g -> [Flat g (Note b)] -> Flat g (Note b)
forall g a. Tempo -> g -> [Flat g a] -> Flat g a
S.FGroup Tempo
tempo g
group ((Flat g (Note a) -> Flat g (Note b))
-> [Flat g (Note a)] -> [Flat g (Note b)]
forall a b. (a -> b) -> [a] -> [b]
map Flat g (Note a) -> Flat g (Note b)
convert [Flat g (Note a)]
notes)

-- * lint

-- | Show the shadowed strokes, except an ok set.  It's ok to shadow the
-- builtins.
lint :: Pretty stroke => Instrument stroke -> [Sequence] -> Korvai -> Text
lint :: forall stroke.
Pretty stroke =>
Instrument stroke -> [SequenceT Sollu] -> Korvai -> Text
lint Instrument stroke
inst [SequenceT Sollu]
defaultStrokes Korvai
korvai =
    (Text -> Text)
-> (StrokeMap stroke -> Text)
-> Either Text (StrokeMap stroke)
-> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Text
"stroke map: "<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")) StrokeMap stroke -> Text
lintSmap (Either Text (StrokeMap stroke) -> Text)
-> Either Text (StrokeMap stroke) -> Text
forall a b. (a -> b) -> a -> b
$
    Instrument stroke -> StrokeMaps -> Either Text (StrokeMap stroke)
forall stroke. Instrument stroke -> StrokeMaps -> StrokeMap stroke
getStrokeMap Instrument stroke
inst (StrokeMaps -> Either Text (StrokeMap stroke))
-> StrokeMaps -> Either Text (StrokeMap stroke)
forall a b. (a -> b) -> a -> b
$ Korvai -> StrokeMaps
korvaiStrokeMaps Korvai
korvai
    where
    lintSmap :: StrokeMap stroke -> Text
lintSmap StrokeMap stroke
smap = [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)
        [ if [(SolluMapKey Sollu, [Maybe (Stroke stroke)])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
shadowed then Text
""
            else Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"shadowed:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((SolluMapKey Sollu, [Maybe (Stroke stroke)]) -> Text)
-> [(SolluMapKey Sollu, [Maybe (Stroke stroke)])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SolluMapKey Sollu, [Maybe (Stroke stroke)]) -> Text
forall {sollu} {a}.
(Pretty sollu, Pretty a) =>
(SolluMapKey sollu, a) -> Text
prettyPair [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
shadowed
        , if Set (SolluMapKey Sollu) -> Bool
forall a. Set a -> Bool
Set.null Set (SolluMapKey Sollu)
unmatched then Text
""
            else Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"unmatched:"
                Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (SolluMapKey Sollu -> Text) -> [SolluMapKey Sollu] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SolluMapKey Sollu -> Text
forall sollu. Pretty sollu => SolluMapKey sollu -> Text
Realize.prettyKey (Set (SolluMapKey Sollu) -> [SolluMapKey Sollu]
forall a. Set a -> [a]
Set.toList Set (SolluMapKey Sollu)
unmatched)
        ]
        where
        shadowed :: [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
shadowed = ((SolluMapKey Sollu, [Maybe (Stroke stroke)]) -> Bool)
-> [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
-> [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SolluMapKey Sollu -> Set (SolluMapKey Sollu) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (SolluMapKey Sollu)
defaultKeys) (SolluMapKey Sollu -> Bool)
-> ((SolluMapKey Sollu, [Maybe (Stroke stroke)])
    -> SolluMapKey Sollu)
-> (SolluMapKey Sollu, [Maybe (Stroke stroke)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolluMapKey Sollu, [Maybe (Stroke stroke)]) -> SolluMapKey Sollu
forall a b. (a, b) -> a
fst) ([(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
 -> [(SolluMapKey Sollu, [Maybe (Stroke stroke)])])
-> [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
-> [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
forall a b. (a -> b) -> a -> b
$
            StrokeMap stroke -> [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
forall stroke.
StrokeMap stroke -> [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
Realize.smapSolluShadows StrokeMap stroke
smap
        prettyPair :: (SolluMapKey sollu, a) -> Text
prettyPair (SolluMapKey sollu
key, a
strokes) =
            SolluMapKey sollu -> Text
forall sollu. Pretty sollu => SolluMapKey sollu -> Text
Realize.prettyKey SolluMapKey sollu
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Pretty a => a -> Text
pretty a
strokes
        matched :: Set (SolluMapKey Sollu)
matched = Instrument stroke -> Korvai -> Set (SolluMapKey Sollu)
forall stroke.
Instrument stroke -> Korvai -> Set (SolluMapKey Sollu)
allMatchedSollus Instrument stroke
inst Korvai
korvai
        unmatched :: Set (SolluMapKey Sollu)
unmatched = StrokeMap stroke -> Set (SolluMapKey Sollu)
forall stroke. StrokeMap stroke -> Set (SolluMapKey Sollu)
Realize.smapKeys StrokeMap stroke
smap
            Set (SolluMapKey Sollu)
-> Set (SolluMapKey Sollu) -> Set (SolluMapKey Sollu)
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set (SolluMapKey Sollu)
matched
            Set (SolluMapKey Sollu)
-> Set (SolluMapKey Sollu) -> Set (SolluMapKey Sollu)
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set (SolluMapKey Sollu)
defaultKeys
    defaultKeys :: Set (SolluMapKey Sollu)
defaultKeys = [SolluMapKey Sollu] -> Set (SolluMapKey Sollu)
forall a. Ord a => [a] -> Set a
Set.fromList ([SolluMapKey Sollu] -> Set (SolluMapKey Sollu))
-> [SolluMapKey Sollu] -> Set (SolluMapKey Sollu)
forall a b. (a -> b) -> a -> b
$ ((Maybe Tag, [Maybe Sollu]) -> SolluMapKey Sollu)
-> [(Maybe Tag, [Maybe Sollu])] -> [SolluMapKey Sollu]
forall a b. (a -> b) -> [a] -> [b]
map (([Maybe Sollu] -> [Sollu])
-> (Maybe Tag, [Maybe Sollu]) -> SolluMapKey Sollu
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [Maybe Sollu] -> [Sollu]
forall a. [Maybe a] -> [a]
Maybe.catMaybes) ([(Maybe Tag, [Maybe Sollu])] -> [SolluMapKey Sollu])
-> [(Maybe Tag, [Maybe Sollu])] -> [SolluMapKey Sollu]
forall a b. (a -> b) -> a -> b
$
        [Either Text (Maybe Tag, [Maybe Sollu])]
-> [(Maybe Tag, [Maybe Sollu])]
forall a b. [Either a b] -> [b]
Either.rights ([Either Text (Maybe Tag, [Maybe Sollu])]
 -> [(Maybe Tag, [Maybe Sollu])])
-> [Either Text (Maybe Tag, [Maybe Sollu])]
-> [(Maybe Tag, [Maybe Sollu])]
forall a b. (a -> b) -> a -> b
$ ([Note Group (Note Sollu)]
 -> Either Text (Maybe Tag, [Maybe Sollu]))
-> [[Note Group (Note Sollu)]]
-> [Either Text (Maybe Tag, [Maybe Sollu])]
forall a b. (a -> b) -> [a] -> [b]
map [Note Group (Note Sollu)] -> Either Text (Maybe Tag, [Maybe Sollu])
forall g.
[Note g (Note Sollu)] -> Either Text (Maybe Tag, [Maybe Sollu])
Realize.verifySolluKey ((SequenceT Sollu -> [Note Group (Note Sollu)])
-> [SequenceT Sollu] -> [[Note Group (Note Sollu)]]
forall a b. (a -> b) -> [a] -> [b]
map SequenceT Sollu -> [Note Group (Note Sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList [SequenceT Sollu]
defaultStrokes)

-- * Metadata

-- | Attach some metadata to a Korvai.
data Metadata = Metadata {
    Metadata -> Maybe Day
_date :: !(Maybe Calendar.Day)
    , Metadata -> Tags
_tags :: !Tags.Tags
    , Metadata -> Location
_location :: !Location
    } deriving (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c== :: Metadata -> Metadata -> Bool
Eq, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metadata] -> ShowS
$cshowList :: [Metadata] -> ShowS
show :: Metadata -> String
$cshow :: Metadata -> String
showsPrec :: Int -> Metadata -> ShowS
$cshowsPrec :: Int -> Metadata -> ShowS
Show, (forall x. Metadata -> Rep Metadata x)
-> (forall x. Rep Metadata x -> Metadata) -> Generic Metadata
forall x. Rep Metadata x -> Metadata
forall x. Metadata -> Rep Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Metadata x -> Metadata
$cfrom :: forall x. Metadata -> Rep Metadata x
Generics.Generic)

-- | (module, lineNumber, variableName)
type Location = (Text, Int, Text)

instance Semigroup Metadata where
    <> :: Metadata -> Metadata -> Metadata
(<>)    (Metadata Maybe Day
date1 Tags
tags1 loc1 :: Location
loc1@(Text
mod1, Int
_, Text
_))
            (Metadata Maybe Day
date2 Tags
tags2 Location
loc2) =
        Maybe Day -> Tags -> Location -> Metadata
Metadata (Maybe Day
date1 Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Day
date2) (Tags
tags1 Tags -> Tags -> Tags
forall a. Semigroup a => a -> a -> a
<> Tags
tags2)
            (if Text -> Bool
Text.null Text
mod1 then Location
loc2 else Location
loc1)
instance Monoid Metadata where
    mempty :: Metadata
mempty = Maybe Day -> Tags -> Location -> Metadata
Metadata Maybe Day
forall a. Maybe a
Nothing Tags
forall a. Monoid a => a
mempty (Text
"", Int
0, Text
"")
    mappend :: Metadata -> Metadata -> Metadata
mappend = Metadata -> Metadata -> Metadata
forall a. Semigroup a => a -> a -> a
(<>)

instance Pretty Metadata where
    format :: Metadata -> Doc
format = Metadata -> Doc
forall a. (PrettyG (Rep a), Generic a) => a -> Doc
Pretty.formatG_

withKorvaiMetadata :: Metadata -> Korvai -> Korvai
withKorvaiMetadata :: Metadata -> Korvai -> Korvai
withKorvaiMetadata Metadata
meta Korvai
korvai =
    Korvai
korvai { korvaiMetadata :: Metadata
korvaiMetadata = Metadata
meta Metadata -> Metadata -> Metadata
forall a. Semigroup a => a -> a -> a
<> Korvai -> Metadata
korvaiMetadata Korvai
korvai }

modifyMetadata :: (Metadata -> Metadata) -> Score -> Score
modifyMetadata :: (Metadata -> Metadata) -> Score -> Score
modifyMetadata Metadata -> Metadata
modify = \case
    Single Korvai
k -> Korvai -> Score
Single (Korvai -> Score) -> Korvai -> Score
forall a b. (a -> b) -> a -> b
$ Korvai
k { korvaiMetadata :: Metadata
korvaiMetadata = Metadata -> Metadata
modify (Korvai -> Metadata
korvaiMetadata Korvai
k) }
    Tani Metadata
meta [Part Korvai]
parts -> Metadata -> [Part Korvai] -> Score
Tani (Metadata -> Metadata
modify Metadata
meta) [Part Korvai]
parts

scoreMetadata :: Score -> Metadata
scoreMetadata :: Score -> Metadata
scoreMetadata = \case
    Single Korvai
k -> Korvai -> Metadata
korvaiMetadata Korvai
k
    Tani Metadata
meta [Part Korvai]
_ -> Metadata
meta

setLocation :: Location -> Score -> Score
setLocation :: Location -> Score -> Score
setLocation Location
loc = (Metadata -> Metadata) -> Score -> Score
modifyMetadata ((Metadata -> Metadata) -> Score -> Score)
-> (Metadata -> Metadata) -> Score -> Score
forall a b. (a -> b) -> a -> b
$ \Metadata
meta -> Metadata
meta { _location :: Location
_location = Location
loc }

-- ** infer

inferMetadataS :: Score -> Score
inferMetadataS :: Score -> Score
inferMetadataS = (Korvai -> Korvai) -> Score -> Score
mapScore Korvai -> Korvai
inferMetadata

-- | This is called in "Solkattu.All", thanks to "Solkattu.ExtractKorvais".
--
-- It used to be called in the 'korvai' and 'mridangamKorvai' constructors, but
-- it was confusing how it wouldn't see modifications done after construction.
inferMetadata :: Korvai -> Korvai
inferMetadata :: Korvai -> Korvai
inferMetadata = Korvai -> Korvai
modifySections (Korvai -> Korvai) -> (Korvai -> Korvai) -> Korvai -> Korvai
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Korvai -> Korvai
inferKorvaiMetadata
    where
    modifySections :: Korvai -> Korvai
modifySections Korvai
korvai = Korvai
korvai
        { korvaiSections :: KorvaiSections
korvaiSections = case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
            KorvaiSections Instrument stroke
inst Sections stroke
sections ->
                Instrument stroke -> Sections stroke -> KorvaiSections
forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument stroke
inst (Sections stroke -> KorvaiSections)
-> Sections stroke -> KorvaiSections
forall a b. (a -> b) -> a -> b
$ (Section (SequenceT (Stroke stroke))
 -> Section (SequenceT (Stroke stroke)))
-> Sections stroke -> Sections stroke
forall a b. (a -> b) -> [a] -> [b]
map (Korvai
-> Section (SequenceT (Stroke stroke))
-> Section (SequenceT (Stroke stroke))
forall {sollu}.
Korvai -> Section (SequenceT sollu) -> Section (SequenceT sollu)
add Korvai
korvai) Sections stroke
sections
        }
    add :: Korvai -> Section (SequenceT sollu) -> Section (SequenceT sollu)
add Korvai
korvai Section (SequenceT sollu)
section = Tags -> Section (SequenceT sollu) -> Section (SequenceT sollu)
forall a. Tags -> Section a -> Section a
addSectionTags
        (Tala -> Section (SequenceT sollu) -> Tags
forall sollu. Tala -> Section (SequenceT sollu) -> Tags
inferSectionTags (Korvai -> Tala
korvaiTala Korvai
korvai) Section (SequenceT sollu)
section) Section (SequenceT sollu)
section

inferKorvaiMetadata :: Korvai -> Korvai
inferKorvaiMetadata :: Korvai -> Korvai
inferKorvaiMetadata Korvai
korvai =
    Metadata -> Korvai -> Korvai
withKorvaiMetadata (Metadata
forall a. Monoid a => a
mempty { _tags :: Tags
_tags = Korvai -> Tags
inferKorvaiTags Korvai
korvai }) Korvai
korvai

inferKorvaiTags :: Korvai -> Tags.Tags
inferKorvaiTags :: Korvai -> Tags
inferKorvaiTags Korvai
korvai = Map Text [Text] -> Tags
Tags.Tags (Map Text [Text] -> Tags) -> Map Text [Text] -> Tags
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k [a]
Maps.multimap ([(Text, Text)] -> Map Text [Text])
-> [(Text, Text)] -> Map Text [Text]
forall a b. (a -> b) -> a -> b
$ [[(Text, Text)]] -> [(Text, Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ (Text
"tala", Tala -> Text
Tala._name Tala
tala)
      , (Text
"sections", Int -> Text
forall a. Show a => a -> Text
showt Int
sections)
      , (Text
"avartanams", Int -> Text
forall a. Pretty a => a -> Text
pretty Int
avartanams)
      ]
    , (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"instrument",) [Text]
instruments
    -- Default type=korvai if not given explicitly.
    , [ (Text
Tags.type_, Text
"korvai")
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Map Text [Text] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Text
Tags.type_ (Map Text [Text] -> Bool) -> Map Text [Text] -> Bool
forall a b. (a -> b) -> a -> b
$
        Tags -> Map Text [Text]
Tags.untags (Metadata -> Tags
_tags (Korvai -> Metadata
korvaiMetadata Korvai
korvai))
      ]
    ]
    where
    tala :: Tala
tala = Korvai -> Tala
korvaiTala Korvai
korvai
    sections :: Int
sections = case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
        KorvaiSections Instrument stroke
_ Sections stroke
sections -> Sections stroke -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Sections stroke
sections
    instruments :: [Text]
instruments = (GInstrument -> Text) -> [GInstrument] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map GInstrument -> Text
ginstrumentName ([GInstrument] -> [Text]) -> [GInstrument] -> [Text]
forall a b. (a -> b) -> a -> b
$ Korvai -> [GInstrument]
korvaiInstruments Korvai
korvai
    avartanams :: Int
avartanams = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
        KorvaiSections Instrument stroke
_ Sections stroke
sections -> (Section (SequenceT (Stroke stroke)) -> Int)
-> Sections stroke -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Tala -> Section (SequenceT (Stroke stroke)) -> Int
forall sollu. Tala -> Section (SequenceT sollu) -> Int
sectionAvartanams Tala
tala) Sections stroke
sections

inferSectionTags :: Tala.Tala -> Section (SequenceT sollu) -> Tags.Tags
inferSectionTags :: forall sollu. Tala -> Section (SequenceT sollu) -> Tags
inferSectionTags Tala
tala Section (SequenceT sollu)
section = Map Text [Text] -> Tags
Tags.Tags (Map Text [Text] -> Tags) -> Map Text [Text] -> Tags
forall a b. (a -> b) -> a -> b
$ [(Text, [Text])] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, [Text])] -> Map Text [Text])
-> [(Text, [Text])] -> Map Text [Text]
forall a b. (a -> b) -> a -> b
$
    [ (Text
"avartanams", [Int -> Text
forall a. Pretty a => a -> Text
pretty (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Tala -> Section (SequenceT sollu) -> Int
forall sollu. Tala -> Section (SequenceT sollu) -> Int
sectionAvartanams Tala
tala Section (SequenceT sollu)
section])
    , (Text
"nadai", (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Pretty a => a -> Text
pretty [Int]
nadais)
    , (Text
"max_speed", [Int -> Text
forall a. Pretty a => a -> Text
pretty (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
speeds)])
    , (Text
"start", [Duration -> Text
forall a. Pretty a => a -> Text
pretty (Duration -> Text) -> Duration -> Text
forall a b. (a -> b) -> a -> b
$ Section (SequenceT sollu) -> Duration
forall a. Section a -> Duration
sectionStart Section (SequenceT sollu)
section])
    , (Text
"end", [Duration -> Text
forall a. Pretty a => a -> Text
pretty (Duration -> Text) -> Duration -> Text
forall a b. (a -> b) -> a -> b
$ Section (SequenceT sollu) -> Duration
forall a. Section a -> Duration
sectionEnd Section (SequenceT sollu)
section])
    ]
    where
    seq :: Sequence Group (Note ())
seq = (sollu -> ()) -> SequenceT sollu -> Sequence Group (Note ())
forall a b g.
(a -> b) -> Sequence g (Note a) -> Sequence g (Note b)
mapSollu (() -> sollu -> ()
forall a b. a -> b -> a
const ()) (Section (SequenceT sollu) -> SequenceT sollu
forall a. Section a -> a
sectionSequence Section (SequenceT sollu)
section)
    tempos :: [Tempo]
tempos = ((Tempo, Note ()) -> Tempo) -> [(Tempo, Note ())] -> [Tempo]
forall a b. (a -> b) -> [a] -> [b]
map (Tempo, Note ()) -> Tempo
forall a b. (a, b) -> a
fst ([(Tempo, Note ())] -> [Tempo]) -> [(Tempo, Note ())] -> [Tempo]
forall a b. (a -> b) -> a -> b
$ [Flat Group (Note ())] -> [(Tempo, Note ())]
forall g a. [Flat g a] -> [(Tempo, a)]
S.tempoNotes ([Flat Group (Note ())] -> [(Tempo, Note ())])
-> [Flat Group (Note ())] -> [(Tempo, Note ())]
forall a b. (a -> b) -> a -> b
$ Sequence Group (Note ()) -> [Flat Group (Note ())]
forall g sollu. SequenceG g sollu -> [Flat g (Note sollu)]
flatten Sequence Group (Note ())
seq
    nadais :: [Int]
nadais = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
Seq.unique_sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Tempo -> Int) -> [Tempo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Tempo -> Int
S._nadai [Tempo]
tempos
    speeds :: [Int]
speeds = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
Seq.unique_sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Tempo -> Int) -> [Tempo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Tempo -> Int
S._speed [Tempo]
tempos

sectionAvartanams :: Tala.Tala -> Section (SequenceT sollu) -> Int
sectionAvartanams :: forall sollu. Tala -> Section (SequenceT sollu) -> Int
sectionAvartanams Tala
tala Section (SequenceT sollu)
section = Duration -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Duration -> Int) -> Duration -> Int
forall a b. (a -> b) -> a -> b
$ Duration
dur Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Duration
talaAksharas
    -- Take the floor because there may be a final note as supported by
    -- Realize.checkAlignment.
    where
    talaAksharas :: Duration
talaAksharas = Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tala -> Int
Tala.tala_aksharas Tala
tala)
    seq :: Sequence Group (Note ())
seq = (sollu -> ()) -> SequenceT sollu -> Sequence Group (Note ())
forall a b g.
(a -> b) -> Sequence g (Note a) -> Sequence g (Note b)
mapSollu (() -> sollu -> ()
forall a b. a -> b -> a
const ()) (Section (SequenceT sollu) -> SequenceT sollu
forall a. Section a -> a
sectionSequence Section (SequenceT sollu)
section)
    dur :: Duration
dur = Tempo -> Sequence Group (Note ()) -> Duration
forall a. HasMatras a => Tempo -> Sequence Group a -> Duration
Solkattu.durationOf Tempo
S.defaultTempo Sequence Group (Note ())
seq


-- * types

-- | This can be a Left because it comes from one of the instrument-specific
-- 'StrokeMaps' fields, which can be Left if 'Realize.strokeMap' verification
-- failed.
type StrokeMap stroke = Either Error (Realize.StrokeMap stroke)

data StrokeMaps = StrokeMaps {
    StrokeMaps -> StrokeMap Stroke
smapMridangam :: StrokeMap Mridangam.Stroke
    , StrokeMaps -> StrokeMap Stroke
smapKendangTunggal :: StrokeMap KendangTunggal.Stroke
    , StrokeMaps -> StrokeMap Stroke
smapKendangPasang :: StrokeMap KendangPasang.Stroke
    , StrokeMaps -> StrokeMap Stroke
smapReyong :: StrokeMap Reyong.Stroke
    , StrokeMaps -> StrokeMap Stroke
smapSargam :: StrokeMap Sargam.Stroke
    } deriving (StrokeMaps -> StrokeMaps -> Bool
(StrokeMaps -> StrokeMaps -> Bool)
-> (StrokeMaps -> StrokeMaps -> Bool) -> Eq StrokeMaps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StrokeMaps -> StrokeMaps -> Bool
$c/= :: StrokeMaps -> StrokeMaps -> Bool
== :: StrokeMaps -> StrokeMaps -> Bool
$c== :: StrokeMaps -> StrokeMaps -> Bool
Eq, Int -> StrokeMaps -> ShowS
[StrokeMaps] -> ShowS
StrokeMaps -> String
(Int -> StrokeMaps -> ShowS)
-> (StrokeMaps -> String)
-> ([StrokeMaps] -> ShowS)
-> Show StrokeMaps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StrokeMaps] -> ShowS
$cshowList :: [StrokeMaps] -> ShowS
show :: StrokeMaps -> String
$cshow :: StrokeMaps -> String
showsPrec :: Int -> StrokeMaps -> ShowS
$cshowsPrec :: Int -> StrokeMaps -> ShowS
Show, (forall x. StrokeMaps -> Rep StrokeMaps x)
-> (forall x. Rep StrokeMaps x -> StrokeMaps) -> Generic StrokeMaps
forall x. Rep StrokeMaps x -> StrokeMaps
forall x. StrokeMaps -> Rep StrokeMaps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StrokeMaps x -> StrokeMaps
$cfrom :: forall x. StrokeMaps -> Rep StrokeMaps x
Generics.Generic)

instance Semigroup StrokeMaps where
    StrokeMaps StrokeMap Stroke
a1 StrokeMap Stroke
a2 StrokeMap Stroke
a3 StrokeMap Stroke
a4 StrokeMap Stroke
a5 <> :: StrokeMaps -> StrokeMaps -> StrokeMaps
<> StrokeMaps StrokeMap Stroke
b1 StrokeMap Stroke
b2 StrokeMap Stroke
b3 StrokeMap Stroke
b4 StrokeMap Stroke
b5 =
        StrokeMap Stroke
-> StrokeMap Stroke
-> StrokeMap Stroke
-> StrokeMap Stroke
-> StrokeMap Stroke
-> StrokeMaps
StrokeMaps (StrokeMap Stroke -> StrokeMap Stroke -> StrokeMap Stroke
forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Stroke
a1 StrokeMap Stroke
b1) (StrokeMap Stroke -> StrokeMap Stroke -> StrokeMap Stroke
forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Stroke
a2 StrokeMap Stroke
b2) (StrokeMap Stroke -> StrokeMap Stroke -> StrokeMap Stroke
forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Stroke
a3 StrokeMap Stroke
b3) (StrokeMap Stroke -> StrokeMap Stroke -> StrokeMap Stroke
forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Stroke
a4 StrokeMap Stroke
b4)
            (StrokeMap Stroke -> StrokeMap Stroke -> StrokeMap Stroke
forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Stroke
a5 StrokeMap Stroke
b5)
        where
        merge :: Either a b -> Either a b -> Either a b
merge (Left a
err) Either a b
_ = a -> Either a b
forall a b. a -> Either a b
Left a
err
        merge Either a b
_ (Left a
err) = a -> Either a b
forall a b. a -> Either a b
Left a
err
        merge (Right b
a) (Right b
b) = b -> Either a b
forall a b. b -> Either a b
Right (b
ab -> b -> b
forall a. Semigroup a => a -> a -> a
<>b
b)

instance Monoid StrokeMaps where
    mempty :: StrokeMaps
mempty = StrokeMap Stroke
-> StrokeMap Stroke
-> StrokeMap Stroke
-> StrokeMap Stroke
-> StrokeMap Stroke
-> StrokeMaps
StrokeMaps
        (StrokeMap Stroke -> StrokeMap Stroke
forall a b. b -> Either a b
Right StrokeMap Stroke
forall a. Monoid a => a
mempty) (StrokeMap Stroke -> StrokeMap Stroke
forall a b. b -> Either a b
Right StrokeMap Stroke
forall a. Monoid a => a
mempty) (StrokeMap Stroke -> StrokeMap Stroke
forall a b. b -> Either a b
Right StrokeMap Stroke
forall a. Monoid a => a
mempty) (StrokeMap Stroke -> StrokeMap Stroke
forall a b. b -> Either a b
Right StrokeMap Stroke
forall a. Monoid a => a
mempty)
        (StrokeMap Stroke -> StrokeMap Stroke
forall a b. b -> Either a b
Right StrokeMap Stroke
forall a. Monoid a => a
mempty)
    mappend :: StrokeMaps -> StrokeMaps -> StrokeMaps
mappend = StrokeMaps -> StrokeMaps -> StrokeMaps
forall a. Semigroup a => a -> a -> a
(<>)

instance Pretty StrokeMaps where
    format :: StrokeMaps -> Doc
format = StrokeMaps -> Doc
forall a. (PrettyG (Rep a), Generic a) => a -> Doc
Pretty.formatGCamel