{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
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.Lists as Lists
import qualified Util.Maps as Maps
import qualified Util.Num as Num
import qualified Util.Pretty as Pretty
import qualified Util.Styled as Styled
import qualified Derive.Expr as Expr
import qualified Solkattu.Bol as Bol
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.Tabla as Tabla
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 qualified Solkattu.Talas as Talas
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 = forall g1 a1 g2 a2.
(Note g1 a1 -> Note g2 a2) -> Sequence g1 a1 -> Sequence g2 a2
S.mapS forall a b. (a -> b) -> a -> b
$ \case
S.Note Note a
note -> forall g a. a -> Note g a
S.Note (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Note a
note)
S.TempoChange TempoChange
change [Note g (Note a)]
notes -> 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 -> 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 = forall g a. Sequence g a -> [Note g a]
S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b g.
(a -> b) -> Sequence g (Note a) -> Sequence g (Note b)
mapSollu a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. [Note g a] -> Sequence g a
S.fromList
data Score = Single !Korvai | Tani !Metadata ![Part Korvai]
deriving (Int -> Score -> ShowS
[Score] -> ShowS
Score -> String
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 | !Text
deriving (Int -> Part k -> ShowS
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 -> 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)
tani :: [Part Korvai] -> Score
tani :: [Part Korvai] -> Score
tani = Metadata -> [Part Korvai] -> Score
Tani (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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Part Korvai]
parts forall a b. (a -> b) -> a -> b
$ \case
K Korvai
korvai -> Korvai -> IO ()
realize Korvai
korvai
Comment Text
comment -> Styled -> IO ()
Styled.printLn forall a b. (a -> b) -> a -> b
$ forall a. ToStyled a => a -> Styled
Styled.bold Text
comment
data Korvai = Korvai {
Korvai -> KorvaiSections
korvaiSections :: !KorvaiSections
, Korvai -> StrokeMaps
korvaiStrokeMaps :: !StrokeMaps
, Korvai -> Tala
korvaiTala :: !Talas.Tala
, Korvai -> Metadata
korvaiMetadata :: !Metadata
} deriving (Int -> Korvai -> ShowS
[Korvai] -> ShowS
Korvai -> String
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. 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 = 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 = forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument Sollu
IKonnakol
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall stroke. stroke -> Stroke stroke
Realize.stroke))) [Section (SequenceT Sollu)]
sections)
, korvaiStrokeMaps :: StrokeMaps
korvaiStrokeMaps = StrokeMaps
strokeMaps
, korvaiTala :: Tala
korvaiTala = Tala -> Tala
Talas.Carnatic Tala
tala
, korvaiMetadata :: Metadata
korvaiMetadata = forall a. Monoid a => a
mempty
}
korvaiInstruments :: Korvai -> [GInstrument]
korvaiInstruments :: Korvai -> [GInstrument]
korvaiInstruments Korvai
korvai = forall a. (a -> Bool) -> [a] -> [a]
filter GInstrument -> Bool
hasInstrument [GInstrument]
instruments
where
hasInstrument :: GInstrument -> Bool
hasInstrument (GInstrument Instrument stroke
inst) =
case 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 (forall stroke. Instrument stroke -> Bool
isEmpty Instrument stroke
inst)
KorvaiSections
_ -> Bool
False
isEmpty :: Instrument stroke -> Bool
isEmpty :: forall stroke. Instrument stroke -> Bool
isEmpty Instrument stroke
inst = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) forall sollu stroke. StrokeMap sollu stroke -> Bool
Realize.isInstrumentEmpty forall a b. (a -> b) -> a -> b
$
forall stroke.
Instrument stroke -> StrokeMaps -> StrokeMap Sollu 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 = 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 = 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 = forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument stroke
inst [Section (SequenceT (Stroke stroke))]
sections
, korvaiStrokeMaps :: StrokeMaps
korvaiStrokeMaps =
forall stroke.
Instrument stroke -> StrokeMap Sollu stroke -> StrokeMaps
setStrokeMap Instrument stroke
inst forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { smapPatternMap :: PatternMap stroke
Realize.smapPatternMap = PatternMap stroke
pmap }
, korvaiTala :: Tala
korvaiTala = Tala -> Tala
Talas.Carnatic Tala
tala
, korvaiMetadata :: Metadata
korvaiMetadata = forall a. Monoid a => a
mempty
}
tablaKorvai :: Talas.Tal
-> [Section (SequenceT (Realize.Stroke Bol.Bol))] -> Korvai
tablaKorvai :: Tal -> [Section (SequenceT (Stroke Bol))] -> Korvai
tablaKorvai Tal
tala [Section (SequenceT (Stroke Bol))]
sections = Korvai
{ korvaiSections :: KorvaiSections
korvaiSections = forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument Bol
IBol [Section (SequenceT (Stroke Bol))]
sections
, korvaiStrokeMaps :: StrokeMaps
korvaiStrokeMaps = forall a. Monoid a => a
mempty
, korvaiTala :: Tala
korvaiTala = Tal -> Tala
Talas.Hindustani Tal
tala
, korvaiMetadata :: Metadata
korvaiMetadata = forall a. Monoid a => a
mempty
}
index :: Int -> Korvai -> Korvai
index :: Int -> Korvai -> Korvai
index Int
i = Int -> Int -> Korvai -> Korvai
slice Int
i (Int
iforall 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 = forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument stroke
inst forall a b. (a -> b) -> a -> b
$
forall a. Int -> [a] -> [a]
get (if Int
end forall a. Ord a => a -> a -> Bool
< Int
0 then forall (t :: * -> *) a. Foldable t => t a -> Int
length Sections stroke
sections 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
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> a -> Bool
Num.inRange Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Num a => a -> a -> a
+ Int
1)) [Int
start, Int
end] =
forall a. Int -> [a] -> [a]
take (Int
end forall a. Num a => a -> a -> a
- Int
start) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
start [a]
xs
| Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(start, end) " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Int
start, Int
end)
forall a. Semigroup a => a -> a -> a
<> String
" out of range 0--" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)
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 forall a b. (a -> b) -> a -> b
$ forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
inst
instance Pretty KorvaiSections where
pretty :: KorvaiSections -> Text
pretty (KorvaiSections Instrument stroke
inst Sections stroke
_) = forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
inst
type Sections stroke = [Section (SequenceT (Realize.Stroke stroke))]
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) -> forall a. a -> Maybe a
Just Sections stroke
sections
(Instrument stroke
IMridangam, KorvaiSections Instrument stroke
IMridangam Sections stroke
sections) -> forall a. a -> Maybe a
Just Sections stroke
sections
(Instrument stroke
IKendangTunggal, KorvaiSections Instrument stroke
IKendangTunggal Sections stroke
sections) -> forall a. a -> Maybe a
Just Sections stroke
sections
(Instrument stroke
IKendangPasang, KorvaiSections Instrument stroke
IKendangPasang Sections stroke
sections) -> forall a. a -> Maybe a
Just Sections stroke
sections
(Instrument stroke
IReyong, KorvaiSections Instrument stroke
IReyong Sections stroke
sections) -> forall a. a -> Maybe a
Just Sections stroke
sections
(Instrument stroke
ISargam, KorvaiSections Instrument stroke
ISargam Sections stroke
sections) -> forall a. a -> Maybe a
Just Sections stroke
sections
(Instrument stroke
IBol, KorvaiSections Instrument stroke
IBol Sections stroke
sections) -> forall a. a -> Maybe a
Just Sections stroke
sections
(Instrument stroke
ITabla, KorvaiSections Instrument stroke
ITabla Sections stroke
sections) -> forall a. a -> Maybe a
Just Sections stroke
sections
(Instrument stroke, KorvaiSections)
_ -> 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 =
[ forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Sollu
IKonnakol
, forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Bol
IBol
, forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Stroke
IMridangam
, forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Stroke
IKendangTunggal
, forall stroke.
(Notation stroke, Ord stroke, ToExpr (Stroke stroke)) =>
Instrument stroke -> GInstrument
GInstrument Instrument Stroke
IReyong
, 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) = forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
inst
data Section a = Section {
forall a. Section a -> a
sectionSequence :: a
, forall a. Section a -> Duration
sectionStart :: !S.Duration
, forall a. Section a -> Duration
sectionEnd :: !S.Duration
, forall a. Section a -> Tags
sectionTags :: Tags.Tags
} deriving (Section a -> Section a -> Bool
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
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 -> 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 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 = 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 -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Part Korvai]
parts 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 -> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 ->
forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument stroke
inst forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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 = 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 (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 = 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 forall a. [a] -> Maybe ([a], a)
Lists.unsnoc (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Section a
section [SequenceT sollu]
seqs) of
Just ([Section (SequenceT sollu)]
inits, Section (SequenceT sollu)
last) ->
forall a b. (a -> b) -> [a] -> [b]
map (forall a. Tags -> Section a -> Section a
addSectionTags (Text -> Tags
Tags.withType Text
Tags.development)) [Section (SequenceT sollu)]
inits
forall a. [a] -> [a] -> [a]
++ [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 -> []
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
IBol :: Instrument Bol.Bol
ITabla :: Instrument Tabla.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"
Instrument stroke
IBol -> Text
"bol"
Instrument stroke
ITabla -> Text
"tabla"
getStrokeMap :: Instrument stroke -> StrokeMaps
-> StrokeMap Solkattu.Sollu stroke
getStrokeMap :: forall stroke.
Instrument stroke -> StrokeMaps -> StrokeMap Sollu stroke
getStrokeMap Instrument stroke
inst StrokeMaps
smap = case Instrument stroke
inst of
Instrument stroke
IKonnakol -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
{ smapPatternMap :: PatternMap Sollu
Realize.smapPatternMap = PatternMap Sollu
Konnakol.defaultPatterns }
Instrument stroke
IMridangam -> StrokeMaps -> StrokeMap Sollu Stroke
smapMridangam StrokeMaps
smap
Instrument stroke
IKendangTunggal -> StrokeMaps -> StrokeMap Sollu Stroke
smapKendangTunggal StrokeMaps
smap
Instrument stroke
IKendangPasang -> StrokeMaps -> StrokeMap Sollu Stroke
smapKendangPasang StrokeMaps
smap
Instrument stroke
IReyong -> StrokeMaps -> StrokeMap Sollu Stroke
smapReyong StrokeMaps
smap
Instrument stroke
ISargam -> StrokeMaps -> StrokeMap Sollu Stroke
smapSargam StrokeMaps
smap
Instrument stroke
IBol -> forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty
Instrument stroke
ITabla -> forall a b. a -> Either a b
Left Text
"tabla should have had a hardcoded stroke map"
setStrokeMap :: Instrument stroke -> StrokeMap Solkattu.Sollu stroke
-> StrokeMaps
setStrokeMap :: forall stroke.
Instrument stroke -> StrokeMap Sollu stroke -> StrokeMaps
setStrokeMap Instrument stroke
inst StrokeMap Sollu stroke
smap = case Instrument stroke
inst of
Instrument stroke
IKonnakol -> forall a. Monoid a => a
mempty
Instrument stroke
IMridangam -> forall a. Monoid a => a
mempty { smapMridangam :: StrokeMap Sollu Stroke
smapMridangam = StrokeMap Sollu stroke
smap }
Instrument stroke
IKendangTunggal -> forall a. Monoid a => a
mempty { smapKendangTunggal :: StrokeMap Sollu Stroke
smapKendangTunggal = StrokeMap Sollu stroke
smap }
Instrument stroke
IKendangPasang -> forall a. Monoid a => a
mempty { smapKendangPasang :: StrokeMap Sollu Stroke
smapKendangPasang = StrokeMap Sollu stroke
smap }
Instrument stroke
IReyong -> forall a. Monoid a => a
mempty { smapReyong :: StrokeMap Sollu Stroke
smapReyong = StrokeMap Sollu stroke
smap }
Instrument stroke
ISargam -> forall a. Monoid a => a
mempty { smapSargam :: StrokeMap Sollu Stroke
smapSargam = StrokeMap Sollu stroke
smap }
Instrument stroke
IBol -> forall a. Monoid a => a
mempty
Instrument stroke
ITabla -> forall a. Monoid a => a
mempty
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]
Mridangam.postprocess
Instrument 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
Sargam.toScore
Instrument stroke
_ -> forall stroke. ToExpr (Stroke stroke) => ToScore stroke
ToScore.toScore
type Flat stroke =
S.Flat (Realize.Group (Realize.Stroke stroke)) (Realize.Note stroke)
type Realized stroke = ([Flat stroke], [Realize.Warning])
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 forall stroke.
Instrument stroke -> StrokeMaps -> StrokeMap Sollu stroke
getStrokeMap Instrument stroke
inst (Korvai -> StrokeMaps
korvaiStrokeMaps Korvai
korvai) of
Left Text
err -> [forall a b. a -> Either a b
Left Text
err]
Right StrokeMap Sollu stroke
smap -> case forall stroke.
Instrument stroke -> KorvaiSections -> Maybe (Sections stroke)
getSections Instrument stroke
inst (Korvai -> KorvaiSections
korvaiSections Korvai
korvai) of
Just Sections stroke
sections ->
forall a b. (a -> b) -> [a] -> [b]
map (forall sollu stroke.
(Ord sollu, Pretty sollu, Notation stroke) =>
Tala
-> ToStrokes sollu stroke
-> StrokeMap Sollu stroke
-> ([Flat stroke] -> [Flat stroke])
-> Section (SequenceT sollu)
-> Either Text (Realized stroke)
realizeSection Tala
tala forall stroke. ToStrokes (Stroke stroke) stroke
Realize.realizeStroke StrokeMap Sollu stroke
smap [Flat stroke] -> [Flat stroke]
postproc)
Sections stroke
sections
Maybe (Sections stroke)
Nothing -> case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
KorvaiSections Instrument stroke
IKonnakol Sections stroke
sections ->
forall a b. (a -> b) -> [a] -> [b]
map (forall sollu stroke.
(Ord sollu, Pretty sollu, Notation stroke) =>
Tala
-> ToStrokes sollu stroke
-> StrokeMap Sollu stroke
-> ([Flat stroke] -> [Flat stroke])
-> Section (SequenceT sollu)
-> Either Text (Realized stroke)
realizeSection Tala
tala ToStrokes (Stroke Sollu) stroke
toStrokes StrokeMap Sollu stroke
smap [Flat stroke] -> [Flat stroke]
postproc) Sections stroke
sections
where
toStrokes :: ToStrokes (Stroke Sollu) stroke
toStrokes = forall sollu stroke.
Ord sollu =>
SolluMap sollu stroke -> ToStrokes (Stroke sollu) stroke
Realize.realizeSollu (forall sollu stroke.
StrokeMap sollu stroke -> SolluMap sollu stroke
Realize.smapSolluMap StrokeMap Sollu stroke
smap)
KorvaiSections Instrument stroke
kinst Sections stroke
_ -> (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"can't realize "
forall a. Semigroup a => a -> a -> a
<> forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
kinst forall a. Semigroup a => a -> a -> a
<> Text
" as " forall a. Semigroup a => a -> a -> a
<> forall stroke. Instrument stroke -> Text
instrumentName Instrument stroke
inst
where
tala :: Tala
tala = Korvai -> Tala
korvaiTala Korvai
korvai
postproc :: [Flat stroke] -> [Flat stroke]
postproc = forall stroke. Instrument stroke -> [Flat stroke] -> [Flat stroke]
instPostprocess Instrument stroke
inst
realizeSection :: (Ord sollu, Pretty sollu, Solkattu.Notation stroke)
=> Talas.Tala
-> Realize.ToStrokes sollu stroke
-> Realize.StrokeMap Solkattu.Sollu 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 Sollu stroke
-> ([Flat stroke] -> [Flat stroke])
-> Section (SequenceT sollu)
-> Either Text (Realized stroke)
realizeSection Tala
tala ToStrokes sollu stroke
toStrokes StrokeMap Sollu stroke
smap [Flat stroke] -> [Flat stroke]
postproc Section (SequenceT sollu)
section = do
[Flat stroke]
realized <- forall a g.
Notation a =>
UntilFail Text (Flat g a) -> Either Text [Flat g a]
Realize.formatError forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
forall sollu stroke.
(Pretty sollu, Ord sollu) =>
StrokeMap Sollu stroke
-> ToStrokes sollu stroke
-> Int
-> [Flat Group (Note sollu)]
-> (UntilFail Text (Realized stroke), Set (SolluMapKey sollu))
Realize.realize StrokeMap Sollu stroke
smap ToStrokes sollu stroke
toStrokes (Tala -> Int
Talas.aksharas Tala
tala) forall a b. (a -> b) -> a -> b
$ forall g sollu. SequenceG g sollu -> [Flat g (Note sollu)]
flatten forall a b. (a -> b) -> a -> b
$
forall a. Section a -> a
sectionSequence Section (SequenceT sollu)
section
let alignWarn :: Maybe Warning
alignWarn = [Flat stroke] -> Maybe Warning
checkAlignment [Flat stroke]
realized
([Flat stroke]
realized, [Warning]
durationWarns) <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall stroke. [Realized stroke] -> ([Realized stroke], [Warning])
Realize.checkDuration [Flat stroke]
realized
[Flat stroke]
startSpace <- forall g sollu.
Int -> Duration -> Either Text [Flat g (Note sollu)]
spaces (forall stroke. [Flat stroke] -> Int
inferNadai [Flat stroke]
realized) (forall a. Section a -> Duration
sectionStart Section (SequenceT sollu)
section)
forall (m :: * -> *) a. Monad m => a -> m a
return
( [Flat stroke] -> [Flat stroke]
postproc forall a b. (a -> b) -> a -> b
$ [Flat stroke]
startSpace forall a. [a] -> [a] -> [a]
++ [Flat stroke]
realized
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
:[]) Maybe Warning
alignWarn forall a. [a] -> [a] -> [a]
++ [Warning]
durationWarns
)
where
checkAlignment :: [Flat stroke] -> Maybe Warning
checkAlignment [Flat stroke]
realized
| Tala
tala forall a. Eq a => a -> a -> Bool
== Tala -> Tala
Talas.Carnatic Tala
Tala.any_beats = forall a. Maybe a
Nothing
| Bool
otherwise = forall stroke.
Int
-> Duration -> Duration -> [(Tempo, Note stroke)] -> Maybe Warning
Realize.checkAlignment
(Tala -> Int
Talas.aksharas Tala
tala)
(forall a. Section a -> Duration
sectionStart Section (SequenceT sollu)
section) (forall a. Section a -> Duration
sectionEnd Section (SequenceT sollu)
section)
(forall g a. [Flat g a] -> [(Tempo, a)]
S.tempoNotes [Flat stroke]
realized)
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 -> forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall {a} {b}. (a, [Stroke b]) -> (a, [b])
strip forall a b. (a -> b) -> a -> b
$
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (forall sollu stroke.
(Pretty sollu, Ord sollu) =>
ToStrokes sollu stroke
-> Int -> Section (SequenceT sollu) -> Set (SolluMapKey sollu)
matchedSollus ToStrokes (Stroke Sollu) stroke
toStrokes Int
talaAksharas) Sections stroke
sections
KorvaiSections
_ -> forall a. Monoid a => a
mempty
where
talaAksharas :: Int
talaAksharas = Tala -> Int
Talas.aksharas (Korvai -> Tala
korvaiTala Korvai
korvai)
strip :: (a, [Stroke b]) -> (a, [b])
strip (a
tag, [Stroke b]
sollus) = (a
tag, forall a b. (a -> b) -> [a] -> [b]
map forall stroke. Stroke stroke -> stroke
Realize._stroke [Stroke b]
sollus)
toStrokes :: ToStrokes (Stroke Sollu) stroke
toStrokes = forall sollu stroke.
Ord sollu =>
SolluMap sollu stroke -> ToStrokes (Stroke sollu) stroke
Realize.realizeSollu SolluMap Sollu stroke
solluMap
solluMap :: SolluMap Sollu stroke
solluMap = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Monoid a => a
mempty forall sollu stroke.
StrokeMap sollu stroke -> SolluMap sollu stroke
Realize.smapSolluMap StrokeMap Sollu stroke
smap
smap :: StrokeMap Sollu stroke
smap = forall stroke.
Instrument stroke -> StrokeMaps -> StrokeMap Sollu stroke
getStrokeMap Instrument stroke
instrument (Korvai -> StrokeMaps
korvaiStrokeMaps Korvai
korvai)
matchedSollus :: (Pretty sollu, Ord sollu) => Realize.ToStrokes sollu stroke
-> Tala.Akshara -> Section (SequenceT sollu)
-> Set (Realize.SolluMapKey sollu)
matchedSollus :: forall sollu stroke.
(Pretty sollu, Ord sollu) =>
ToStrokes sollu stroke
-> Int -> Section (SequenceT sollu) -> Set (SolluMapKey sollu)
matchedSollus ToStrokes sollu stroke
toStrokes Int
talaAksharas =
forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sollu stroke.
(Pretty sollu, Ord sollu) =>
RealizePattern Tempo stroke
-> ToStrokes sollu stroke
-> Int
-> [Flat Group (Note sollu)]
-> (UntilFail Text (Realized stroke), Set (SolluMapKey sollu))
Realize.realize_ forall {a} {a} {stroke}.
a -> Pattern -> Either a [(a, Note stroke)]
dummyPattern ToStrokes sollu stroke
toStrokes Int
talaAksharas forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g sollu. SequenceG g sollu -> [Flat g (Note sollu)]
flatten
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Section a -> a
sectionSequence
where
dummyPattern :: a -> Pattern -> Either a [(a, Note stroke)]
dummyPattern a
tempo (Solkattu.PatternM Int
p) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
p (a
tempo, 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tempo
S.defaultTempo forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
Lists.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall g sollu. [Flat g (Note sollu)] -> [Flat g (Note sollu)]
Solkattu.cancelKarvai forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. [Note g a] -> [Flat g a]
S.flatten forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. Sequence g a -> [Note g a]
S.toList
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
let s0_matras :: FMatra
s0_matras = forall a b. (Real a, Fractional b) => a -> b
realToFrac Duration
dur forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nadai
[Int]
speeds <- FMatra -> Either Text [Int]
S.decomposeM FMatra
s0_matras
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
s -> forall g a. Tempo -> a -> Flat g a
S.FNote (Int -> Tempo
speed Int
s) forall {stroke}. Note stroke
space) [Int]
speeds
where
space :: Note stroke
space = 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 }
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 = 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 -> forall g a. Tempo -> a -> Flat g a
S.FNote Tempo
tempo forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
fromMaybe (forall stroke. Space -> Note stroke
Realize.Space Space
Solkattu.Rest) (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 ->
forall g a. Tempo -> g -> [Flat g a] -> Flat g a
S.FGroup Tempo
tempo g
group (forall a b. (a -> b) -> [a] -> [b]
map Flat g (Note a) -> Flat g (Note b)
convert [Flat g (Note a)]
notes)
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 =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Text
"stroke map: "<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<>Text
"\n")) StrokeMap Sollu stroke -> Text
lintSmap forall a b. (a -> b) -> a -> b
$
forall stroke.
Instrument stroke -> StrokeMaps -> StrokeMap Sollu stroke
getStrokeMap Instrument stroke
inst forall a b. (a -> b) -> a -> b
$ Korvai -> StrokeMaps
korvaiStrokeMaps Korvai
korvai
where
lintSmap :: StrokeMap Sollu stroke -> Text
lintSmap StrokeMap Sollu stroke
smap = [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)
[ if 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" forall a b. (a -> b) -> a -> b
$ Text
"shadowed:" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {sollu} {a}.
(Pretty sollu, Pretty a) =>
(SolluMapKey sollu, a) -> Text
prettyPair [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
shadowed
, if forall a. Set a -> Bool
Set.null Set (SolluMapKey Sollu)
unmatched then Text
""
else Text -> [Text] -> Text
Text.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ Text
"unmatched:"
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall sollu. Pretty sollu => SolluMapKey sollu -> Text
Realize.prettyKey (forall a. Set a -> [a]
Set.toList Set (SolluMapKey Sollu)
unmatched)
]
where
shadowed :: [(SolluMapKey Sollu, [Maybe (Stroke stroke)])]
shadowed = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (SolluMapKey Sollu)
defaultKeys) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
forall sollu stroke.
StrokeMap sollu stroke
-> [(SolluMapKey sollu, [Maybe (Stroke stroke)])]
Realize.smapSolluShadows StrokeMap Sollu stroke
smap
prettyPair :: (SolluMapKey sollu, a) -> Text
prettyPair (SolluMapKey sollu
key, a
strokes) =
forall sollu. Pretty sollu => SolluMapKey sollu -> Text
Realize.prettyKey SolluMapKey sollu
key forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty a
strokes
matched :: Set (SolluMapKey Sollu)
matched = forall stroke.
Instrument stroke -> Korvai -> Set (SolluMapKey Sollu)
allMatchedSollus Instrument stroke
inst Korvai
korvai
unmatched :: Set (SolluMapKey Sollu)
unmatched = forall sollu stroke.
StrokeMap sollu stroke -> Set (SolluMapKey sollu)
Realize.smapKeys StrokeMap Sollu stroke
smap
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set (SolluMapKey Sollu)
matched
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set (SolluMapKey Sollu)
defaultKeys
defaultKeys :: Set (SolluMapKey Sollu)
defaultKeys = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. [Maybe a] -> [a]
Maybe.catMaybes) forall a b. (a -> b) -> a -> b
$
forall a b. [Either a b] -> [b]
Either.rights forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall sollu g.
Pretty sollu =>
[Note g (Note sollu)] -> Either Text (SolluMapKey (Maybe sollu))
Realize.verifySolluKey (forall a b. (a -> b) -> [a] -> [b]
map forall g a. Sequence g a -> [Note g a]
S.toList [SequenceT Sollu]
defaultStrokes)
data Metadata = Metadata {
Metadata -> Maybe Day
_date :: !(Maybe Calendar.Day)
, Metadata -> Tags
_tags :: !Tags.Tags
, Metadata -> Location
_location :: !Location
} deriving (Metadata -> Metadata -> Bool
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
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. 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)
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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Day
date2) (Tags
tags1 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 forall a. Maybe a
Nothing forall a. Monoid a => a
mempty (Text
"", Int
0, Text
"")
mappend :: Metadata -> Metadata -> Metadata
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Pretty Metadata where
format :: Metadata -> Doc
format = 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 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 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 forall a b. (a -> b) -> a -> b
$ \Metadata
meta -> Metadata
meta { _location :: Location
_location = Location
loc }
inferMetadataS :: Score -> Score
inferMetadataS :: Score -> Score
inferMetadataS = (Korvai -> Korvai) -> Score -> Score
mapScore Korvai -> Korvai
inferMetadata
inferMetadata :: Korvai -> Korvai
inferMetadata :: Korvai -> Korvai
inferMetadata = Korvai -> Korvai
modifySections 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 ->
forall stroke.
Instrument stroke -> Sections stroke -> KorvaiSections
KorvaiSections Instrument stroke
inst forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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 = forall a. Tags -> Section a -> Section a
addSectionTags
(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 (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 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k [a]
Maps.multimap forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ (Text
"tala", Tala -> Text
Talas.name Tala
tala)
, (Text
"sections", forall a. Show a => a -> Text
showt Int
sections)
, (Text
"avartanams", forall a. Pretty a => a -> Text
pretty Int
avartanams)
]
, forall a b. (a -> b) -> [a] -> [b]
map (Text
"instrument",) [Text]
instruments
, [ (Text
Tags.type_, Text
"korvai")
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Bool
Map.member Text
Tags.type_ 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 -> forall (t :: * -> *) a. Foldable t => t a -> Int
length Sections stroke
sections
instruments :: [Text]
instruments = forall a b. (a -> b) -> [a] -> [b]
map GInstrument -> Text
ginstrumentName forall a b. (a -> b) -> a -> b
$ Korvai -> [GInstrument]
korvaiInstruments Korvai
korvai
avartanams :: Int
avartanams = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum forall a b. (a -> b) -> a -> b
$ case Korvai -> KorvaiSections
korvaiSections Korvai
korvai of
KorvaiSections Instrument stroke
_ Sections stroke
sections -> forall a b. (a -> b) -> [a] -> [b]
map (forall sollu. Tala -> Section (SequenceT sollu) -> Int
sectionAvartanams Tala
tala) Sections stroke
sections
inferSectionTags :: Talas.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 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
[ (Text
"avartanams", [forall a. Pretty a => a -> Text
pretty forall a b. (a -> b) -> a -> b
$ forall sollu. Tala -> Section (SequenceT sollu) -> Int
sectionAvartanams Tala
tala Section (SequenceT sollu)
section])
, (Text
"nadai", forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Text
pretty [Int]
nadais)
, (Text
"max_speed", [forall a. Pretty a => a -> Text
pretty forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 forall a. a -> [a] -> [a]
: [Int]
speeds)])
, (Text
"start", [forall a. Pretty a => a -> Text
pretty forall a b. (a -> b) -> a -> b
$ forall a. Section a -> Duration
sectionStart Section (SequenceT sollu)
section])
, (Text
"end", [forall a. Pretty a => a -> Text
pretty forall a b. (a -> b) -> a -> b
$ forall a. Section a -> Duration
sectionEnd Section (SequenceT sollu)
section])
]
where
seq :: Sequence Group (Note ())
seq = forall a b g.
(a -> b) -> Sequence g (Note a) -> Sequence g (Note b)
mapSollu (forall a b. a -> b -> a
const ()) (forall a. Section a -> a
sectionSequence Section (SequenceT sollu)
section)
tempos :: [Tempo]
tempos = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall g a. [Flat g a] -> [(Tempo, a)]
S.tempoNotes forall a b. (a -> b) -> a -> b
$ forall g sollu. SequenceG g sollu -> [Flat g (Note sollu)]
flatten Sequence Group (Note ())
seq
nadais :: [Int]
nadais = forall a. Ord a => [a] -> [a]
Lists.uniqueSort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Tempo -> Int
S._nadai [Tempo]
tempos
speeds :: [Int]
speeds = forall a. Ord a => [a] -> [a]
Lists.uniqueSort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Tempo -> Int
S._speed [Tempo]
tempos
sectionAvartanams :: Talas.Tala -> Section (SequenceT sollu) -> Int
sectionAvartanams :: forall sollu. Tala -> Section (SequenceT sollu) -> Int
sectionAvartanams Tala
tala Section (SequenceT sollu)
section = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Duration
dur forall a. Fractional a => a -> a -> a
/ Duration
talaAksharas
where
talaAksharas :: Duration
talaAksharas = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tala -> Int
Talas.aksharas Tala
tala)
seq :: Sequence Group (Note ())
seq = forall a b g.
(a -> b) -> Sequence g (Note a) -> Sequence g (Note b)
mapSollu (forall a b. a -> b -> a
const ()) (forall a. Section a -> a
sectionSequence Section (SequenceT sollu)
section)
dur :: Duration
dur = forall a. HasMatras a => Tempo -> Sequence Group a -> Duration
Solkattu.durationOf Tempo
S.defaultTempo Sequence Group (Note ())
seq
type StrokeMap sollu stroke = Either Error (Realize.StrokeMap sollu stroke)
data StrokeMaps = StrokeMaps {
StrokeMaps -> StrokeMap Sollu Stroke
smapMridangam :: StrokeMap Solkattu.Sollu Mridangam.Stroke
, StrokeMaps -> StrokeMap Sollu Stroke
smapKendangTunggal :: StrokeMap Solkattu.Sollu KendangTunggal.Stroke
, StrokeMaps -> StrokeMap Sollu Stroke
smapKendangPasang :: StrokeMap Solkattu.Sollu KendangPasang.Stroke
, StrokeMaps -> StrokeMap Sollu Stroke
smapReyong :: StrokeMap Solkattu.Sollu Reyong.Stroke
, StrokeMaps -> StrokeMap Sollu Stroke
smapSargam :: StrokeMap Solkattu.Sollu Sargam.Stroke
} deriving (StrokeMaps -> StrokeMaps -> Bool
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
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. 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 Sollu Stroke
a1 StrokeMap Sollu Stroke
a2 StrokeMap Sollu Stroke
a3 StrokeMap Sollu Stroke
a4 StrokeMap Sollu Stroke
a5 <> :: StrokeMaps -> StrokeMaps -> StrokeMaps
<> StrokeMaps StrokeMap Sollu Stroke
b1 StrokeMap Sollu Stroke
b2 StrokeMap Sollu Stroke
b3 StrokeMap Sollu Stroke
b4 StrokeMap Sollu Stroke
b5 =
StrokeMap Sollu Stroke
-> StrokeMap Sollu Stroke
-> StrokeMap Sollu Stroke
-> StrokeMap Sollu Stroke
-> StrokeMap Sollu Stroke
-> StrokeMaps
StrokeMaps (forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Sollu Stroke
a1 StrokeMap Sollu Stroke
b1) (forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Sollu Stroke
a2 StrokeMap Sollu Stroke
b2) (forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Sollu Stroke
a3 StrokeMap Sollu Stroke
b3) (forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Sollu Stroke
a4 StrokeMap Sollu Stroke
b4)
(forall {b} {a}.
Semigroup b =>
Either a b -> Either a b -> Either a b
merge StrokeMap Sollu Stroke
a5 StrokeMap Sollu Stroke
b5)
where
merge :: Either a b -> Either a b -> Either a b
merge (Left a
err) Either a b
_ = forall a b. a -> Either a b
Left a
err
merge Either a b
_ (Left a
err) = forall a b. a -> Either a b
Left a
err
merge (Right b
a) (Right b
b) = forall a b. b -> Either a b
Right (b
aforall a. Semigroup a => a -> a -> a
<>b
b)
instance Monoid StrokeMaps where
mempty :: StrokeMaps
mempty = StrokeMap Sollu Stroke
-> StrokeMap Sollu Stroke
-> StrokeMap Sollu Stroke
-> StrokeMap Sollu Stroke
-> StrokeMap Sollu Stroke
-> StrokeMaps
StrokeMaps
(forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty) (forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty) (forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty) (forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty)
(forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty)
mappend :: StrokeMaps -> StrokeMaps -> StrokeMaps
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Pretty StrokeMaps where
format :: StrokeMaps -> Doc
format = forall a. (PrettyG (Rep a), Generic a) => a -> Doc
Pretty.formatGCamel