-- Copyright 2017 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 CPP #-}
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
-- deriving (Real) for Duration emits this warning.
{-# OPTIONS_GHC -fno-warn-identities #-}
-- | Low level support for rhythmic sequences in a Tala.  The actual Note
-- type is polymorphic, so this is purely rhythmic.
module Solkattu.S (
    Note(..), TempoChange(..)
    , Sequence, singleton, null, fromList, toList, mapS, apply
    , Duration, FMatra, Matra, Speed, Nadai, Stride, speedFactor
    , changeSpeed
    , HasMatras(..)
    -- * transform
    , mapGroup, flattenGroups
    , simplify
    , map1
    , filterNotes
    -- * tempo
    , Tempo(..), defaultTempo
    , changeTempo
    , decompose, decomposeM
    -- * flatten
    , Flat(..)
    , filterFlat, mapGroupFlat
    , notes, flatten, flattenWith, flattenedNotes
    , flatToState
    , withDurations
    , tempoNotes
    , maxSpeed
    , tempoToState
    , Stroke(..), normalizeSpeed, flattenSpeed
    -- * State
    , State(..), statePosition, stateMatraPosition, stateAbsoluteAkshara
    , stateFrom
    , showPosition
    -- * functions
    , durationOf, noteDuration, noteFMatra, fmatraDuration, durationFMatra
    , matraFMatra
    , matraDuration
#ifdef TESTING
    , module Solkattu.S
#endif
) where
import           Prelude hiding (null)
import qualified Control.Monad.State.Strict as State
import qualified Data.List as List
import qualified Data.Ratio as Ratio

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

import qualified Solkattu.Tala as Tala

import           Global


data Note g a = Note !a
    | TempoChange !TempoChange ![Note g a]
    -- See NOTE [nested-groups] for how I arrived at this design.
    | Group !g ![Note g a]
    deriving (Note g a -> Note g a -> Bool
(Note g a -> Note g a -> Bool)
-> (Note g a -> Note g a -> Bool) -> Eq (Note g a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall g a. (Eq a, Eq g) => Note g a -> Note g a -> Bool
/= :: Note g a -> Note g a -> Bool
$c/= :: forall g a. (Eq a, Eq g) => Note g a -> Note g a -> Bool
== :: Note g a -> Note g a -> Bool
$c== :: forall g a. (Eq a, Eq g) => Note g a -> Note g a -> Bool
Eq, Eq (Note g a)
Eq (Note g a)
-> (Note g a -> Note g a -> Ordering)
-> (Note g a -> Note g a -> Bool)
-> (Note g a -> Note g a -> Bool)
-> (Note g a -> Note g a -> Bool)
-> (Note g a -> Note g a -> Bool)
-> (Note g a -> Note g a -> Note g a)
-> (Note g a -> Note g a -> Note g a)
-> Ord (Note g a)
Note g a -> Note g a -> Bool
Note g a -> Note g a -> Ordering
Note g a -> Note g a -> Note g a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {g} {a}. (Ord a, Ord g) => Eq (Note g a)
forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Bool
forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Ordering
forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Note g a
min :: Note g a -> Note g a -> Note g a
$cmin :: forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Note g a
max :: Note g a -> Note g a -> Note g a
$cmax :: forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Note g a
>= :: Note g a -> Note g a -> Bool
$c>= :: forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Bool
> :: Note g a -> Note g a -> Bool
$c> :: forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Bool
<= :: Note g a -> Note g a -> Bool
$c<= :: forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Bool
< :: Note g a -> Note g a -> Bool
$c< :: forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Bool
compare :: Note g a -> Note g a -> Ordering
$ccompare :: forall g a. (Ord a, Ord g) => Note g a -> Note g a -> Ordering
Ord, Int -> Note g a -> ShowS
[Note g a] -> ShowS
Note g a -> String
(Int -> Note g a -> ShowS)
-> (Note g a -> String) -> ([Note g a] -> ShowS) -> Show (Note g a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall g a. (Show a, Show g) => Int -> Note g a -> ShowS
forall g a. (Show a, Show g) => [Note g a] -> ShowS
forall g a. (Show a, Show g) => Note g a -> String
showList :: [Note g a] -> ShowS
$cshowList :: forall g a. (Show a, Show g) => [Note g a] -> ShowS
show :: Note g a -> String
$cshow :: forall g a. (Show a, Show g) => Note g a -> String
showsPrec :: Int -> Note g a -> ShowS
$cshowsPrec :: forall g a. (Show a, Show g) => Int -> Note g a -> ShowS
Show, (forall a b. (a -> b) -> Note g a -> Note g b)
-> (forall a b. a -> Note g b -> Note g a) -> Functor (Note g)
forall a b. a -> Note g b -> Note g a
forall a b. (a -> b) -> Note g a -> Note g b
forall g a b. a -> Note g b -> Note g a
forall g a b. (a -> b) -> Note g a -> Note g 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 -> Note g b -> Note g a
$c<$ :: forall g a b. a -> Note g b -> Note g a
fmap :: forall a b. (a -> b) -> Note g a -> Note g b
$cfmap :: forall g a b. (a -> b) -> Note g a -> Note g b
Functor, (forall m. Monoid m => Note g m -> m)
-> (forall m a. Monoid m => (a -> m) -> Note g a -> m)
-> (forall m a. Monoid m => (a -> m) -> Note g a -> m)
-> (forall a b. (a -> b -> b) -> b -> Note g a -> b)
-> (forall a b. (a -> b -> b) -> b -> Note g a -> b)
-> (forall b a. (b -> a -> b) -> b -> Note g a -> b)
-> (forall b a. (b -> a -> b) -> b -> Note g a -> b)
-> (forall a. (a -> a -> a) -> Note g a -> a)
-> (forall a. (a -> a -> a) -> Note g a -> a)
-> (forall a. Note g a -> [a])
-> (forall a. Note g a -> Bool)
-> (forall a. Note g a -> Int)
-> (forall a. Eq a => a -> Note g a -> Bool)
-> (forall a. Ord a => Note g a -> a)
-> (forall a. Ord a => Note g a -> a)
-> (forall a. Num a => Note g a -> a)
-> (forall a. Num a => Note g a -> a)
-> Foldable (Note g)
forall a. Eq a => a -> Note g a -> Bool
forall a. Num a => Note g a -> a
forall a. Ord a => Note g a -> a
forall m. Monoid m => Note g m -> m
forall a. Note g a -> Bool
forall a. Note g a -> Int
forall a. Note g a -> [a]
forall a. (a -> a -> a) -> Note g a -> a
forall g a. Eq a => a -> Note g a -> Bool
forall g a. Num a => Note g a -> a
forall g a. Ord a => Note g a -> a
forall m a. Monoid m => (a -> m) -> Note g a -> m
forall g m. Monoid m => Note g m -> m
forall g a. Note g a -> Bool
forall g a. Note g a -> Int
forall g a. Note g a -> [a]
forall b a. (b -> a -> b) -> b -> Note g a -> b
forall a b. (a -> b -> b) -> b -> Note g a -> b
forall g a. (a -> a -> a) -> Note g a -> a
forall g m a. Monoid m => (a -> m) -> Note g a -> m
forall g b a. (b -> a -> b) -> b -> Note g a -> b
forall g a b. (a -> b -> b) -> b -> Note g a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Note g a -> a
$cproduct :: forall g a. Num a => Note g a -> a
sum :: forall a. Num a => Note g a -> a
$csum :: forall g a. Num a => Note g a -> a
minimum :: forall a. Ord a => Note g a -> a
$cminimum :: forall g a. Ord a => Note g a -> a
maximum :: forall a. Ord a => Note g a -> a
$cmaximum :: forall g a. Ord a => Note g a -> a
elem :: forall a. Eq a => a -> Note g a -> Bool
$celem :: forall g a. Eq a => a -> Note g a -> Bool
length :: forall a. Note g a -> Int
$clength :: forall g a. Note g a -> Int
null :: forall a. Note g a -> Bool
$cnull :: forall g a. Note g a -> Bool
toList :: forall a. Note g a -> [a]
$ctoList :: forall g a. Note g a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Note g a -> a
$cfoldl1 :: forall g a. (a -> a -> a) -> Note g a -> a
foldr1 :: forall a. (a -> a -> a) -> Note g a -> a
$cfoldr1 :: forall g a. (a -> a -> a) -> Note g a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Note g a -> b
$cfoldl' :: forall g b a. (b -> a -> b) -> b -> Note g a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Note g a -> b
$cfoldl :: forall g b a. (b -> a -> b) -> b -> Note g a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Note g a -> b
$cfoldr' :: forall g a b. (a -> b -> b) -> b -> Note g a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Note g a -> b
$cfoldr :: forall g a b. (a -> b -> b) -> b -> Note g a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Note g a -> m
$cfoldMap' :: forall g m a. Monoid m => (a -> m) -> Note g a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Note g a -> m
$cfoldMap :: forall g m a. Monoid m => (a -> m) -> Note g a -> m
fold :: forall m. Monoid m => Note g m -> m
$cfold :: forall g m. Monoid m => Note g m -> m
Foldable, Functor (Note g)
Foldable (Note g)
Functor (Note g)
-> Foldable (Note g)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Note g a -> f (Note g b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Note g (f a) -> f (Note g a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Note g a -> m (Note g b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Note g (m a) -> m (Note g a))
-> Traversable (Note g)
forall g. Functor (Note g)
forall g. Foldable (Note g)
forall g (m :: * -> *) a. Monad m => Note g (m a) -> m (Note g a)
forall g (f :: * -> *) a.
Applicative f =>
Note g (f a) -> f (Note g a)
forall g (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Note g a -> m (Note g b)
forall g (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Note g a -> f (Note g b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Note g (m a) -> m (Note g a)
forall (f :: * -> *) a.
Applicative f =>
Note g (f a) -> f (Note g a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Note g a -> m (Note g b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Note g a -> f (Note g b)
sequence :: forall (m :: * -> *) a. Monad m => Note g (m a) -> m (Note g a)
$csequence :: forall g (m :: * -> *) a. Monad m => Note g (m a) -> m (Note g a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Note g a -> m (Note g b)
$cmapM :: forall g (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Note g a -> m (Note g b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Note g (f a) -> f (Note g a)
$csequenceA :: forall g (f :: * -> *) a.
Applicative f =>
Note g (f a) -> f (Note g a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Note g a -> f (Note g b)
$ctraverse :: forall g (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Note g a -> f (Note g b)
Traversable)

newtype Sequence g a = Sequence [Note g a]
    deriving (Sequence g a -> Sequence g a -> Bool
(Sequence g a -> Sequence g a -> Bool)
-> (Sequence g a -> Sequence g a -> Bool) -> Eq (Sequence g a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall g a. (Eq a, Eq g) => Sequence g a -> Sequence g a -> Bool
/= :: Sequence g a -> Sequence g a -> Bool
$c/= :: forall g a. (Eq a, Eq g) => Sequence g a -> Sequence g a -> Bool
== :: Sequence g a -> Sequence g a -> Bool
$c== :: forall g a. (Eq a, Eq g) => Sequence g a -> Sequence g a -> Bool
Eq, Int -> Sequence g a -> ShowS
[Sequence g a] -> ShowS
Sequence g a -> String
(Int -> Sequence g a -> ShowS)
-> (Sequence g a -> String)
-> ([Sequence g a] -> ShowS)
-> Show (Sequence g a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall g a. (Show a, Show g) => Int -> Sequence g a -> ShowS
forall g a. (Show a, Show g) => [Sequence g a] -> ShowS
forall g a. (Show a, Show g) => Sequence g a -> String
showList :: [Sequence g a] -> ShowS
$cshowList :: forall g a. (Show a, Show g) => [Sequence g a] -> ShowS
show :: Sequence g a -> String
$cshow :: forall g a. (Show a, Show g) => Sequence g a -> String
showsPrec :: Int -> Sequence g a -> ShowS
$cshowsPrec :: forall g a. (Show a, Show g) => Int -> Sequence g a -> ShowS
Show, [Sequence g a] -> Doc
Sequence g a -> Text
Sequence g a -> Doc
(Sequence g a -> Text)
-> (Sequence g a -> Doc)
-> ([Sequence g a] -> Doc)
-> Pretty (Sequence g a)
forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a
forall g a. (Pretty a, Pretty g) => [Sequence g a] -> Doc
forall g a. (Pretty a, Pretty g) => Sequence g a -> Text
forall g a. (Pretty a, Pretty g) => Sequence g a -> Doc
formatList :: [Sequence g a] -> Doc
$cformatList :: forall g a. (Pretty a, Pretty g) => [Sequence g a] -> Doc
format :: Sequence g a -> Doc
$cformat :: forall g a. (Pretty a, Pretty g) => Sequence g a -> Doc
pretty :: Sequence g a -> Text
$cpretty :: forall g a. (Pretty a, Pretty g) => Sequence g a -> Text
Pretty, (forall a b. (a -> b) -> Sequence g a -> Sequence g b)
-> (forall a b. a -> Sequence g b -> Sequence g a)
-> Functor (Sequence g)
forall a b. a -> Sequence g b -> Sequence g a
forall a b. (a -> b) -> Sequence g a -> Sequence g b
forall g a b. a -> Sequence g b -> Sequence g a
forall g a b. (a -> b) -> Sequence g a -> Sequence g 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 -> Sequence g b -> Sequence g a
$c<$ :: forall g a b. a -> Sequence g b -> Sequence g a
fmap :: forall a b. (a -> b) -> Sequence g a -> Sequence g b
$cfmap :: forall g a b. (a -> b) -> Sequence g a -> Sequence g b
Functor, NonEmpty (Sequence g a) -> Sequence g a
Sequence g a -> Sequence g a -> Sequence g a
(Sequence g a -> Sequence g a -> Sequence g a)
-> (NonEmpty (Sequence g a) -> Sequence g a)
-> (forall b. Integral b => b -> Sequence g a -> Sequence g a)
-> Semigroup (Sequence g a)
forall b. Integral b => b -> Sequence g a -> Sequence g a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall g a. NonEmpty (Sequence g a) -> Sequence g a
forall g a. Sequence g a -> Sequence g a -> Sequence g a
forall g a b. Integral b => b -> Sequence g a -> Sequence g a
stimes :: forall b. Integral b => b -> Sequence g a -> Sequence g a
$cstimes :: forall g a b. Integral b => b -> Sequence g a -> Sequence g a
sconcat :: NonEmpty (Sequence g a) -> Sequence g a
$csconcat :: forall g a. NonEmpty (Sequence g a) -> Sequence g a
<> :: Sequence g a -> Sequence g a -> Sequence g a
$c<> :: forall g a. Sequence g a -> Sequence g a -> Sequence g a
Semigroup, Semigroup (Sequence g a)
Sequence g a
Semigroup (Sequence g a)
-> Sequence g a
-> (Sequence g a -> Sequence g a -> Sequence g a)
-> ([Sequence g a] -> Sequence g a)
-> Monoid (Sequence g a)
[Sequence g a] -> Sequence g a
Sequence g a -> Sequence g a -> Sequence g a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall g a. Semigroup (Sequence g a)
forall g a. Sequence g a
forall g a. [Sequence g a] -> Sequence g a
forall g a. Sequence g a -> Sequence g a -> Sequence g a
mconcat :: [Sequence g a] -> Sequence g a
$cmconcat :: forall g a. [Sequence g a] -> Sequence g a
mappend :: Sequence g a -> Sequence g a -> Sequence g a
$cmappend :: forall g a. Sequence g a -> Sequence g a -> Sequence g a
mempty :: Sequence g a
$cmempty :: forall g a. Sequence g a
Monoid)

singleton :: Note g a -> Sequence g a
singleton :: forall g a. Note g a -> Sequence g a
singleton = [Note g a] -> Sequence g a
forall g a. [Note g a] -> Sequence g a
Sequence ([Note g a] -> Sequence g a)
-> (Note g a -> [Note g a]) -> Note g a -> Sequence g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Note g a -> [Note g a] -> [Note g a]
forall a. a -> [a] -> [a]
:[])

null :: Sequence g a -> Bool
null :: forall g a. Sequence g a -> Bool
null = [Note g a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null ([Note g a] -> Bool)
-> (Sequence g a -> [Note g a]) -> Sequence g a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence g a -> [Note g a]
forall g a. Sequence g a -> [Note g a]
toList

fromList :: [Note g a] -> Sequence g a
fromList :: forall g a. [Note g a] -> Sequence g a
fromList = [Note g a] -> Sequence g a
forall g a. [Note g a] -> Sequence g a
Sequence

toList :: Sequence g a -> [Note g a]
toList :: forall g a. Sequence g a -> [Note g a]
toList (Sequence [Note g a]
xs) = [Note g a]
xs

mapS :: (Note g1 a1 -> Note g2 a2) -> Sequence g1 a1 -> Sequence g2 a2
mapS :: forall g1 a1 g2 a2.
(Note g1 a1 -> Note g2 a2) -> Sequence g1 a1 -> Sequence g2 a2
mapS Note g1 a1 -> Note g2 a2
f (Sequence [Note g1 a1]
ns) = [Note g2 a2] -> Sequence g2 a2
forall g a. [Note g a] -> Sequence g a
Sequence ((Note g1 a1 -> Note g2 a2) -> [Note g1 a1] -> [Note g2 a2]
forall a b. (a -> b) -> [a] -> [b]
map Note g1 a1 -> Note g2 a2
f [Note g1 a1]
ns)

apply :: ([Note g1 a1] -> [Note g2 a2]) -> Sequence g1 a1 -> Sequence g2 a2
apply :: forall g1 a1 g2 a2.
([Note g1 a1] -> [Note g2 a2]) -> Sequence g1 a1 -> Sequence g2 a2
apply [Note g1 a1] -> [Note g2 a2]
f (Sequence [Note g1 a1]
ns) = [Note g2 a2] -> Sequence g2 a2
forall g a. [Note g a] -> Sequence g a
Sequence ([Note g1 a1] -> [Note g2 a2]
f [Note g1 a1]
ns)

instance (Pretty a, Pretty g) => Pretty (Note g a) where
    format :: Note g a -> Doc
format Note g a
n = case Note g a
n of
        Note a
a -> a -> Doc
forall a. Pretty a => a -> Doc
Pretty.format a
a
        TempoChange TempoChange
change [Note g a]
notes ->
            Text -> Doc
Pretty.text (TempoChange -> Text
forall a. Pretty a => a -> Text
pretty TempoChange
change) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"("
                Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
Pretty.wrapWords ((Note g a -> Doc) -> [Note g a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Note g a -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [Note g a]
notes)
                Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
        Group g
g [Note g a]
notes ->
            Text -> Doc
Pretty.text (g -> Text
forall a. Pretty a => a -> Text
pretty g
g) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"("
                Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
Pretty.wrapWords ((Note g a -> Doc) -> [Note g a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Note g a -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [Note g a]
notes)
                Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"

-- | A single Duration unit is equivalent to 1 Akshara.  Unlike 'FMatra' and
-- 'Matra', this is an absolute duration, so it doesn't depend on '_nadai' or
-- '_speed'.
newtype Duration = Duration Ratio.Rational
    deriving (Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show, Eq Duration
Eq Duration
-> (Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmax :: Duration -> Duration -> Duration
>= :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c< :: Duration -> Duration -> Bool
compare :: Duration -> Duration -> Ordering
$ccompare :: Duration -> Duration -> Ordering
Ord, Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq, Integer -> Duration
Duration -> Duration
Duration -> Duration -> Duration
(Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Integer -> Duration)
-> Num Duration
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Duration
$cfromInteger :: Integer -> Duration
signum :: Duration -> Duration
$csignum :: Duration -> Duration
abs :: Duration -> Duration
$cabs :: Duration -> Duration
negate :: Duration -> Duration
$cnegate :: Duration -> Duration
* :: Duration -> Duration -> Duration
$c* :: Duration -> Duration -> Duration
- :: Duration -> Duration -> Duration
$c- :: Duration -> Duration -> Duration
+ :: Duration -> Duration -> Duration
$c+ :: Duration -> Duration -> Duration
Num, Num Duration
Ord Duration
Num Duration
-> Ord Duration -> (Duration -> Rational) -> Real Duration
Duration -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Duration -> Rational
$ctoRational :: Duration -> Rational
Real, Num Duration
Num Duration
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Rational -> Duration)
-> Fractional Duration
Rational -> Duration
Duration -> Duration
Duration -> Duration -> Duration
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Duration
$cfromRational :: Rational -> Duration
recip :: Duration -> Duration
$crecip :: Duration -> Duration
/ :: Duration -> Duration -> Duration
$c/ :: Duration -> Duration -> Duration
Fractional, Fractional Duration
Real Duration
Real Duration
-> Fractional Duration
-> (forall b. Integral b => Duration -> (b, Duration))
-> (forall b. Integral b => Duration -> b)
-> (forall b. Integral b => Duration -> b)
-> (forall b. Integral b => Duration -> b)
-> (forall b. Integral b => Duration -> b)
-> RealFrac Duration
forall b. Integral b => Duration -> b
forall b. Integral b => Duration -> (b, Duration)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: forall b. Integral b => Duration -> b
$cfloor :: forall b. Integral b => Duration -> b
ceiling :: forall b. Integral b => Duration -> b
$cceiling :: forall b. Integral b => Duration -> b
round :: forall b. Integral b => Duration -> b
$cround :: forall b. Integral b => Duration -> b
truncate :: forall b. Integral b => Duration -> b
$ctruncate :: forall b. Integral b => Duration -> b
properFraction :: forall b. Integral b => Duration -> (b, Duration)
$cproperFraction :: forall b. Integral b => Duration -> (b, Duration)
RealFrac, [Duration] -> Doc
Duration -> Text
Duration -> Doc
(Duration -> Text)
-> (Duration -> Doc) -> ([Duration] -> Doc) -> Pretty Duration
forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a
formatList :: [Duration] -> Doc
$cformatList :: [Duration] -> Doc
format :: Duration -> Doc
$cformat :: Duration -> Doc
pretty :: Duration -> Text
$cpretty :: Duration -> Text
Pretty)

-- | A matra is an akshara divided by the nadai.  It corresponds to a single
-- sollu in first speed, which means the actual duration is dependent on Nadai
-- and Speed.
--
-- Matra being integral is important, since together with TempoChange, it
-- can encode the invariant that durations are always a power of two rational,
-- once you multiply out the nadai.
type Matra = Int

-- | This is a fractional 'Matra'.  The reason to need a fraction matra is if
-- there are speed changes below, so often this is used to mean toplevel matra,
-- which is to say duration / nadai, in which case it's relative to nadai, not
-- speed.  But not always!  Sometimes it's used to name a number of Matras
-- where it's assumed they have speed changes to accommodate the fraction.
newtype FMatra = FMatra Ratio.Rational
    deriving (Int -> FMatra -> ShowS
[FMatra] -> ShowS
FMatra -> String
(Int -> FMatra -> ShowS)
-> (FMatra -> String) -> ([FMatra] -> ShowS) -> Show FMatra
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FMatra] -> ShowS
$cshowList :: [FMatra] -> ShowS
show :: FMatra -> String
$cshow :: FMatra -> String
showsPrec :: Int -> FMatra -> ShowS
$cshowsPrec :: Int -> FMatra -> ShowS
Show, Eq FMatra
Eq FMatra
-> (FMatra -> FMatra -> Ordering)
-> (FMatra -> FMatra -> Bool)
-> (FMatra -> FMatra -> Bool)
-> (FMatra -> FMatra -> Bool)
-> (FMatra -> FMatra -> Bool)
-> (FMatra -> FMatra -> FMatra)
-> (FMatra -> FMatra -> FMatra)
-> Ord FMatra
FMatra -> FMatra -> Bool
FMatra -> FMatra -> Ordering
FMatra -> FMatra -> FMatra
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FMatra -> FMatra -> FMatra
$cmin :: FMatra -> FMatra -> FMatra
max :: FMatra -> FMatra -> FMatra
$cmax :: FMatra -> FMatra -> FMatra
>= :: FMatra -> FMatra -> Bool
$c>= :: FMatra -> FMatra -> Bool
> :: FMatra -> FMatra -> Bool
$c> :: FMatra -> FMatra -> Bool
<= :: FMatra -> FMatra -> Bool
$c<= :: FMatra -> FMatra -> Bool
< :: FMatra -> FMatra -> Bool
$c< :: FMatra -> FMatra -> Bool
compare :: FMatra -> FMatra -> Ordering
$ccompare :: FMatra -> FMatra -> Ordering
Ord, FMatra -> FMatra -> Bool
(FMatra -> FMatra -> Bool)
-> (FMatra -> FMatra -> Bool) -> Eq FMatra
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FMatra -> FMatra -> Bool
$c/= :: FMatra -> FMatra -> Bool
== :: FMatra -> FMatra -> Bool
$c== :: FMatra -> FMatra -> Bool
Eq, Integer -> FMatra
FMatra -> FMatra
FMatra -> FMatra -> FMatra
(FMatra -> FMatra -> FMatra)
-> (FMatra -> FMatra -> FMatra)
-> (FMatra -> FMatra -> FMatra)
-> (FMatra -> FMatra)
-> (FMatra -> FMatra)
-> (FMatra -> FMatra)
-> (Integer -> FMatra)
-> Num FMatra
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> FMatra
$cfromInteger :: Integer -> FMatra
signum :: FMatra -> FMatra
$csignum :: FMatra -> FMatra
abs :: FMatra -> FMatra
$cabs :: FMatra -> FMatra
negate :: FMatra -> FMatra
$cnegate :: FMatra -> FMatra
* :: FMatra -> FMatra -> FMatra
$c* :: FMatra -> FMatra -> FMatra
- :: FMatra -> FMatra -> FMatra
$c- :: FMatra -> FMatra -> FMatra
+ :: FMatra -> FMatra -> FMatra
$c+ :: FMatra -> FMatra -> FMatra
Num, Num FMatra
Ord FMatra
Num FMatra -> Ord FMatra -> (FMatra -> Rational) -> Real FMatra
FMatra -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: FMatra -> Rational
$ctoRational :: FMatra -> Rational
Real, Num FMatra
Num FMatra
-> (FMatra -> FMatra -> FMatra)
-> (FMatra -> FMatra)
-> (Rational -> FMatra)
-> Fractional FMatra
Rational -> FMatra
FMatra -> FMatra
FMatra -> FMatra -> FMatra
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> FMatra
$cfromRational :: Rational -> FMatra
recip :: FMatra -> FMatra
$crecip :: FMatra -> FMatra
/ :: FMatra -> FMatra -> FMatra
$c/ :: FMatra -> FMatra -> FMatra
Fractional, Fractional FMatra
Real FMatra
Real FMatra
-> Fractional FMatra
-> (forall b. Integral b => FMatra -> (b, FMatra))
-> (forall b. Integral b => FMatra -> b)
-> (forall b. Integral b => FMatra -> b)
-> (forall b. Integral b => FMatra -> b)
-> (forall b. Integral b => FMatra -> b)
-> RealFrac FMatra
forall b. Integral b => FMatra -> b
forall b. Integral b => FMatra -> (b, FMatra)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: forall b. Integral b => FMatra -> b
$cfloor :: forall b. Integral b => FMatra -> b
ceiling :: forall b. Integral b => FMatra -> b
$cceiling :: forall b. Integral b => FMatra -> b
round :: forall b. Integral b => FMatra -> b
$cround :: forall b. Integral b => FMatra -> b
truncate :: forall b. Integral b => FMatra -> b
$ctruncate :: forall b. Integral b => FMatra -> b
properFraction :: forall b. Integral b => FMatra -> (b, FMatra)
$cproperFraction :: forall b. Integral b => FMatra -> (b, FMatra)
RealFrac, [FMatra] -> Doc
FMatra -> Text
FMatra -> Doc
(FMatra -> Text)
-> (FMatra -> Doc) -> ([FMatra] -> Doc) -> Pretty FMatra
forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a
formatList :: [FMatra] -> Doc
$cformatList :: [FMatra] -> Doc
format :: FMatra -> Doc
$cformat :: FMatra -> Doc
pretty :: FMatra -> Text
$cpretty :: FMatra -> Text
Pretty)

-- | Relative speed change.  Each positive number doubles the number of
-- 'Matra's per akshara.  Negative numbers halve them.
data TempoChange = ChangeSpeed Speed | Nadai Nadai | Stride Stride
    deriving (TempoChange -> TempoChange -> Bool
(TempoChange -> TempoChange -> Bool)
-> (TempoChange -> TempoChange -> Bool) -> Eq TempoChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TempoChange -> TempoChange -> Bool
$c/= :: TempoChange -> TempoChange -> Bool
== :: TempoChange -> TempoChange -> Bool
$c== :: TempoChange -> TempoChange -> Bool
Eq, Eq TempoChange
Eq TempoChange
-> (TempoChange -> TempoChange -> Ordering)
-> (TempoChange -> TempoChange -> Bool)
-> (TempoChange -> TempoChange -> Bool)
-> (TempoChange -> TempoChange -> Bool)
-> (TempoChange -> TempoChange -> Bool)
-> (TempoChange -> TempoChange -> TempoChange)
-> (TempoChange -> TempoChange -> TempoChange)
-> Ord TempoChange
TempoChange -> TempoChange -> Bool
TempoChange -> TempoChange -> Ordering
TempoChange -> TempoChange -> TempoChange
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TempoChange -> TempoChange -> TempoChange
$cmin :: TempoChange -> TempoChange -> TempoChange
max :: TempoChange -> TempoChange -> TempoChange
$cmax :: TempoChange -> TempoChange -> TempoChange
>= :: TempoChange -> TempoChange -> Bool
$c>= :: TempoChange -> TempoChange -> Bool
> :: TempoChange -> TempoChange -> Bool
$c> :: TempoChange -> TempoChange -> Bool
<= :: TempoChange -> TempoChange -> Bool
$c<= :: TempoChange -> TempoChange -> Bool
< :: TempoChange -> TempoChange -> Bool
$c< :: TempoChange -> TempoChange -> Bool
compare :: TempoChange -> TempoChange -> Ordering
$ccompare :: TempoChange -> TempoChange -> Ordering
Ord, Int -> TempoChange -> ShowS
[TempoChange] -> ShowS
TempoChange -> String
(Int -> TempoChange -> ShowS)
-> (TempoChange -> String)
-> ([TempoChange] -> ShowS)
-> Show TempoChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TempoChange] -> ShowS
$cshowList :: [TempoChange] -> ShowS
show :: TempoChange -> String
$cshow :: TempoChange -> String
showsPrec :: Int -> TempoChange -> ShowS
$cshowsPrec :: Int -> TempoChange -> ShowS
Show)

instance Pretty TempoChange where
    pretty :: TempoChange -> Text
pretty (ChangeSpeed Int
s) =
        Text
"s" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Text
"+" else Text
"-") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Int -> Int
forall a. Num a => a -> a
abs Int
s)
    pretty (Nadai Int
s) = Text
"n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
s
    pretty (Stride Int
s) = Text
"t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
s

-- | 0 means nadai matras per akshara.  Positive numbers double that and
-- negative ones halve it.
type Speed = Int
type Nadai = Int
-- | This could be Duration, but it would make normalizeSpeed tricky.
type Stride = Int

speedFactor :: Speed -> Duration
speedFactor :: Int -> Duration
speedFactor Int
s
    | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Duration
2Duration -> Int -> Duration
forall a b. (Num a, Integral b) => a -> b -> a
^Int
s
    | Bool
otherwise = Duration
1 Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ (Duration
2 Duration -> Int -> Duration
forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Int
forall a. Num a => a -> a
abs Int
s)

changeSpeed :: Speed -> [Note g a] -> Note g a
changeSpeed :: forall g a. Int -> [Note g a] -> Note g a
changeSpeed = TempoChange -> [Note g a] -> Note g a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange (TempoChange -> [Note g a] -> Note g a)
-> (Int -> TempoChange) -> Int -> [Note g a] -> Note g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TempoChange
ChangeSpeed

class HasMatras a where
    matrasOf :: a -> Matra
    -- | True if this note has a duration in time.  Otherwise, it's a single
    -- stroke, which logically has zero duration.  This only affects how the
    -- note is drawn and whether it becomes a tracklang event with duration.
    hasSustain :: a -> Bool

-- * transform

mapGroup :: (g -> h) -> Note g a -> Note h a
mapGroup :: forall g h a. (g -> h) -> Note g a -> Note h a
mapGroup g -> h
f Note g a
n = case Note g a
n of
    Note a
a -> a -> Note h a
forall g a. a -> Note g a
Note a
a
    TempoChange TempoChange
change [Note g a]
ns -> TempoChange -> [Note h a] -> Note h a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
change ((Note g a -> Note h a) -> [Note g a] -> [Note h a]
forall a b. (a -> b) -> [a] -> [b]
map ((g -> h) -> Note g a -> Note h a
forall g h a. (g -> h) -> Note g a -> Note h a
mapGroup g -> h
f) [Note g a]
ns)
    Group g
g [Note g a]
ns -> h -> [Note h a] -> Note h a
forall g a. g -> [Note g a] -> Note g a
Group (g -> h
f g
g) ((Note g a -> Note h a) -> [Note g a] -> [Note h a]
forall a b. (a -> b) -> [a] -> [b]
map ((g -> h) -> Note g a -> Note h a
forall g h a. (g -> h) -> Note g a -> Note h a
mapGroup g -> h
f) [Note g a]
ns)

flattenGroups :: [Note g a] -> [Note h a]
flattenGroups :: forall g a h. [Note g a] -> [Note h a]
flattenGroups = (Note g a -> [Note h a]) -> [Note g a] -> [Note h a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Note g a -> [Note h a]) -> [Note g a] -> [Note h a])
-> (Note g a -> [Note h a]) -> [Note g a] -> [Note h a]
forall a b. (a -> b) -> a -> b
$ \Note g a
n -> case Note g a
n of
    Group g
_ [Note g a]
ns -> [Note g a] -> [Note h a]
forall g a h. [Note g a] -> [Note h a]
flattenGroups [Note g a]
ns
    Note a
a -> [a -> Note h a
forall g a. a -> Note g a
Note a
a]
    TempoChange TempoChange
change [Note g a]
ns -> [TempoChange -> [Note h a] -> Note h a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
change ([Note g a] -> [Note h a]
forall g a h. [Note g a] -> [Note h a]
flattenGroups [Note g a]
ns)]

-- | Drop empty TempoChanges, combine nested ones.  Drop empty groups.
simplify :: [Note g a] -> [Note g a]
simplify :: forall g a. [Note g a] -> [Note g a]
simplify = [Note g a] -> [Note g a]
forall g a. [Note g a] -> [Note g a]
merge ([Note g a] -> [Note g a])
-> ([Note g a] -> [Note g a]) -> [Note g a] -> [Note g a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Note g a -> [Note g a]) -> [Note g a] -> [Note g a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Note g a -> [Note g a]
forall {g} {a}. Note g a -> [Note g a]
cancel
    where
    cancel :: Note g a -> [Note g a]
cancel (Note a
a) = [a -> Note g a
forall g a. a -> Note g a
Note a
a]
    -- TODO I used to do this, but there is now such a thing as empty sarva
    -- groups, which have a duration.  I could get this back put putting in
    -- a dummy [NoSollu], but I'm not sure if that's better or worse.
    -- cancel (Group _ []) = []
    cancel (Group g
g [Note g a]
ns) = [g -> [Note g a] -> Note g a
forall g a. g -> [Note g a] -> Note g a
Group g
g [Note g a]
ns]
    cancel (TempoChange TempoChange
_ []) = []
    cancel (TempoChange (ChangeSpeed Int
s) [Note g a]
xs) | Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Note g a]
xs
    cancel (TempoChange (ChangeSpeed Int
s) [Note g a]
xs) = (Note g a -> [Note g a]) -> [Note g a] -> [Note g a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Note g a -> [Note g a]
cancelSpeed Int
s) [Note g a]
xs
    cancel (TempoChange (Nadai Int
n) [Note g a]
xs) = (Note g a -> [Note g a]) -> [Note g a] -> [Note g a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Note g a -> [Note g a]
cancelNadai Int
n) [Note g a]
xs
    cancel (TempoChange (Stride Int
s) [Note g a]
xs) =
        [TempoChange -> [Note g a] -> Note g a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange (Int -> TempoChange
Stride Int
s) ((Note g a -> [Note g a]) -> [Note g a] -> [Note g a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Note g a -> [Note g a]
cancel [Note g a]
xs)]

    cancelSpeed :: Int -> Note g a -> [Note g a]
cancelSpeed Int
s1 (TempoChange (ChangeSpeed Int
s2) [Note g a]
xs) =
        Note g a -> [Note g a]
cancel (TempoChange -> [Note g a] -> Note g a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange (Int -> TempoChange
ChangeSpeed (Int
s1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s2)) [Note g a]
xs)
    cancelSpeed Int
s1 Note g a
x = [TempoChange -> [Note g a] -> Note g a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange (Int -> TempoChange
ChangeSpeed Int
s1) [Note g a
x]]
    cancelNadai :: Int -> Note g a -> [Note g a]
cancelNadai Int
_ (TempoChange (Nadai Int
n) [Note g a]
xs) =
        Note g a -> [Note g a]
cancel (TempoChange -> [Note g a] -> Note g a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange (Int -> TempoChange
Nadai Int
n) [Note g a]
xs)
    cancelNadai Int
n Note g a
x = [TempoChange -> [Note g a] -> Note g a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange (Int -> TempoChange
Nadai Int
n) [Note g a
x]]

    -- Merge adjacent TempoChanges.
    merge :: [Note g a] -> [Note g a]
merge (TempoChange TempoChange
c [Note g a]
sub : [Note g a]
ns) =
        TempoChange -> [Note g a] -> Note g a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
c ([[Note g a]] -> [Note g a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Note g a]
sub [Note g a] -> [[Note g a]] -> [[Note g a]]
forall a. a -> [a] -> [a]
: [[Note g a]]
same)) Note g a -> [Note g a] -> [Note g a]
forall a. a -> [a] -> [a]
: [Note g a] -> [Note g a]
merge [Note g a]
rest
        where ([[Note g a]]
same, [Note g a]
rest) = (Note g a -> Maybe [Note g a])
-> [Note g a] -> ([[Note g a]], [Note g a])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
Seq.span_while (TempoChange -> Note g a -> Maybe [Note g a]
forall {g} {a}. TempoChange -> Note g a -> Maybe [Note g a]
sameChange TempoChange
c) [Note g a]
ns
    merge (Note a
a : [Note g a]
ns) = a -> Note g a
forall g a. a -> Note g a
Note a
a Note g a -> [Note g a] -> [Note g a]
forall a. a -> [a] -> [a]
: [Note g a] -> [Note g a]
merge [Note g a]
ns
    merge (Group g
g [Note g a]
a : [Note g a]
ns) = g -> [Note g a] -> Note g a
forall g a. g -> [Note g a] -> Note g a
Group g
g [Note g a]
a Note g a -> [Note g a] -> [Note g a]
forall a. a -> [a] -> [a]
: [Note g a] -> [Note g a]
merge [Note g a]
ns
    merge [] = []
    sameChange :: TempoChange -> Note g a -> Maybe [Note g a]
sameChange TempoChange
change (TempoChange TempoChange
c [Note g a]
ns) | TempoChange
change TempoChange -> TempoChange -> Bool
forall a. Eq a => a -> a -> Bool
== TempoChange
c = [Note g a] -> Maybe [Note g a]
forall a. a -> Maybe a
Just [Note g a]
ns
    sameChange TempoChange
_ Note g a
_ = Maybe [Note g a]
forall a. Maybe a
Nothing

-- | Transform only the first Note.
map1 :: (a -> a) -> Note g a -> Note g a
map1 :: forall a g. (a -> a) -> Note g a -> Note g a
map1 a -> a
f Note g a
n = case Note g a
n of
    Note a
a -> a -> Note g a
forall g a. a -> Note g a
Note (a -> a
f a
a)
    TempoChange TempoChange
change [Note g a]
ns -> TempoChange -> [Note g a] -> Note g a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
change ((Note g a -> Note g a) -> [Note g a] -> [Note g a]
forall a. (a -> a) -> [a] -> [a]
Seq.map_head ((a -> a) -> Note g a -> Note g a
forall a g. (a -> a) -> Note g a -> Note g a
map1 a -> a
f) [Note g a]
ns)
    Group g
g [Note g a]
ns -> g -> [Note g a] -> Note g a
forall g a. g -> [Note g a] -> Note g a
Group g
g ((Note g a -> Note g a) -> [Note g a] -> [Note g a]
forall a. (a -> a) -> [a] -> [a]
Seq.map_head ((a -> a) -> Note g a -> Note g a
forall a g. (a -> a) -> Note g a -> Note g a
map1 a -> a
f) [Note g a]
ns)

filterNotes :: (a -> Bool) -> Sequence g a -> Sequence g a
filterNotes :: forall a g. (a -> Bool) -> Sequence g a -> Sequence g a
filterNotes a -> Bool
f = ([Note g a] -> [Note g a]) -> Sequence g a -> Sequence g a
forall g1 a1 g2 a2.
([Note g1 a1] -> [Note g2 a2]) -> Sequence g1 a1 -> Sequence g2 a2
apply [Note g a] -> [Note g a]
forall {g}. [Note g a] -> [Note g a]
go
    where
    go :: [Note g a] -> [Note g a]
go = (Note g a -> Maybe (Note g a)) -> [Note g a] -> [Note g a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Note g a -> Maybe (Note g a)) -> [Note g a] -> [Note g a])
-> (Note g a -> Maybe (Note g a)) -> [Note g a] -> [Note g a]
forall a b. (a -> b) -> a -> b
$ \case
        note :: Note g a
note@(Note a
a) -> if a -> Bool
f a
a then Note g a -> Maybe (Note g a)
forall a. a -> Maybe a
Just Note g a
note else Maybe (Note g a)
forall a. Maybe a
Nothing
        TempoChange TempoChange
change [Note g a]
ns -> Note g a -> Maybe (Note g a)
forall a. a -> Maybe a
Just (Note g a -> Maybe (Note g a)) -> Note g a -> Maybe (Note g a)
forall a b. (a -> b) -> a -> b
$ TempoChange -> [Note g a] -> Note g a
forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
change ([Note g a] -> [Note g a]
go [Note g a]
ns)
        Group g
g [Note g a]
ns -> Note g a -> Maybe (Note g a)
forall a. a -> Maybe a
Just (Note g a -> Maybe (Note g a)) -> Note g a -> Maybe (Note g a)
forall a b. (a -> b) -> a -> b
$ g -> [Note g a] -> Note g a
forall g a. g -> [Note g a] -> Note g a
Group g
g ([Note g a] -> [Note g a]
go [Note g a]
ns)

-- * flatten

{- | This is an intermediate structure where TempoChange has been flattened
    out.  A flat list is easier to deal with, especially since I need to match
    and replace sections of notes, which may overlap tempo groups arbitrarily.

    However, 'FGroup' is actually nested, not flat.  Oops.  Originally it was
    flat too, with a count to indicate the scope, with Tempo in a Meta type.
    I still needed to express the tempo and group order, so I added a separate
    FGroup, and then it got complicated to keep the count up to date when the
    children changed size, and process things recursively and it seemed like
    recursive data would make that simpler again.  I only replace sections of
    notes within group boundaries, so it doesn't need to be flat like
    TempoChange does.

    It turns out it's still annoying to modify trees though, evidence in
    'Solkattu.Solkattu.cancelKarvai'.

    Another way to look at this, is that each FNote is one Matra.
-}
data Flat g a = FGroup !Tempo !g ![Flat g a] | FNote !Tempo !a
    deriving (Flat g a -> Flat g a -> Bool
(Flat g a -> Flat g a -> Bool)
-> (Flat g a -> Flat g a -> Bool) -> Eq (Flat g a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall g a. (Eq g, Eq a) => Flat g a -> Flat g a -> Bool
/= :: Flat g a -> Flat g a -> Bool
$c/= :: forall g a. (Eq g, Eq a) => Flat g a -> Flat g a -> Bool
== :: Flat g a -> Flat g a -> Bool
$c== :: forall g a. (Eq g, Eq a) => Flat g a -> Flat g a -> Bool
Eq, Int -> Flat g a -> ShowS
[Flat g a] -> ShowS
Flat g a -> String
(Int -> Flat g a -> ShowS)
-> (Flat g a -> String) -> ([Flat g a] -> ShowS) -> Show (Flat g a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall g a. (Show g, Show a) => Int -> Flat g a -> ShowS
forall g a. (Show g, Show a) => [Flat g a] -> ShowS
forall g a. (Show g, Show a) => Flat g a -> String
showList :: [Flat g a] -> ShowS
$cshowList :: forall g a. (Show g, Show a) => [Flat g a] -> ShowS
show :: Flat g a -> String
$cshow :: forall g a. (Show g, Show a) => Flat g a -> String
showsPrec :: Int -> Flat g a -> ShowS
$cshowsPrec :: forall g a. (Show g, Show a) => Int -> Flat g a -> ShowS
Show, (forall a b. (a -> b) -> Flat g a -> Flat g b)
-> (forall a b. a -> Flat g b -> Flat g a) -> Functor (Flat g)
forall a b. a -> Flat g b -> Flat g a
forall a b. (a -> b) -> Flat g a -> Flat g b
forall g a b. a -> Flat g b -> Flat g a
forall g a b. (a -> b) -> Flat g a -> Flat g 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 -> Flat g b -> Flat g a
$c<$ :: forall g a b. a -> Flat g b -> Flat g a
fmap :: forall a b. (a -> b) -> Flat g a -> Flat g b
$cfmap :: forall g a b. (a -> b) -> Flat g a -> Flat g b
Functor)

flatTempo :: Flat g a -> Tempo
flatTempo :: forall g a. Flat g a -> Tempo
flatTempo (FGroup Tempo
t g
_ [Flat g a]
_) = Tempo
t
flatTempo (FNote Tempo
t a
_) = Tempo
t

instance (Pretty g, Pretty a) => Pretty (Flat g a) where
    pretty :: Flat g a -> Text
pretty (FGroup Tempo
tempo g
g [Flat g a]
notes) = (Tempo, g, [Flat g a]) -> Text
forall a. Pretty a => a -> Text
pretty (Tempo
tempo, g
g, [Flat g a]
notes)
    pretty (FNote Tempo
tempo a
note) = (Tempo, a) -> Text
forall a. Pretty a => a -> Text
pretty (Tempo
tempo, a
note)

filterFlat :: (a -> Bool) -> [Flat g a] -> [Flat g a]
filterFlat :: forall a g. (a -> Bool) -> [Flat g a] -> [Flat g a]
filterFlat a -> Bool
f = [Flat g a] -> [Flat g a]
forall {g}. [Flat g a] -> [Flat g a]
go
    where
    go :: [Flat g a] -> [Flat g a]
go (Flat g a
n : [Flat g a]
ns) = case Flat g a
n of
        FGroup Tempo
tempo g
g [Flat g a]
children -> Tempo -> g -> [Flat g a] -> Flat g a
forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup Tempo
tempo g
g ([Flat g a] -> [Flat g a]
go [Flat g a]
children) Flat g a -> [Flat g a] -> [Flat g a]
forall a. a -> [a] -> [a]
: [Flat g a] -> [Flat g a]
go [Flat g a]
ns
        FNote Tempo
tempo a
n
            | a -> Bool
f a
n -> Tempo -> a -> Flat g a
forall g a. Tempo -> a -> Flat g a
FNote Tempo
tempo a
n Flat g a -> [Flat g a] -> [Flat g a]
forall a. a -> [a] -> [a]
: [Flat g a] -> [Flat g a]
go [Flat g a]
ns
            | Bool
otherwise -> [Flat g a] -> [Flat g a]
go [Flat g a]
ns
    go [] = []

mapGroupFlat :: (g -> h) -> [Flat g a] -> [Flat h a]
mapGroupFlat :: forall g h a. (g -> h) -> [Flat g a] -> [Flat h a]
mapGroupFlat g -> h
f = (Flat g a -> Flat h a) -> [Flat g a] -> [Flat h a]
forall a b. (a -> b) -> [a] -> [b]
map Flat g a -> Flat h a
forall {a}. Flat g a -> Flat h a
convert
    where
    convert :: Flat g a -> Flat h a
convert (FGroup Tempo
tempo g
g [Flat g a]
children) =
        Tempo -> h -> [Flat h a] -> Flat h a
forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup Tempo
tempo (g -> h
f g
g) ((Flat g a -> Flat h a) -> [Flat g a] -> [Flat h a]
forall a b. (a -> b) -> [a] -> [b]
map Flat g a -> Flat h a
convert [Flat g a]
children)
    convert (FNote Tempo
tempo a
a) = Tempo -> a -> Flat h a
forall g a. Tempo -> a -> Flat g a
FNote Tempo
tempo a
a

notes :: [Note g a] -> [a]
notes :: forall g a. [Note g a] -> [a]
notes = [Flat g a] -> [a]
forall g a. [Flat g a] -> [a]
flattenedNotes ([Flat g a] -> [a])
-> ([Note g a] -> [Flat g a]) -> [Note g a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Note g a] -> [Flat g a]
forall g a. [Note g a] -> [Flat g a]
flatten

flatten :: [Note g a] -> [Flat g a]
flatten :: forall g a. [Note g a] -> [Flat g a]
flatten = Tempo -> [Note g a] -> [Flat g a]
forall g a. Tempo -> [Note g a] -> [Flat g a]
flattenWith Tempo
defaultTempo

flattenWith :: Tempo -> [Note g a] -> [Flat g a]
flattenWith :: forall g a. Tempo -> [Note g a] -> [Flat g a]
flattenWith Tempo
tempo = [[Flat g a]] -> [Flat g a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Flat g a]] -> [Flat g a])
-> ([Note g a] -> [[Flat g a]]) -> [Note g a] -> [Flat g a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tempo, [[Flat g a]]) -> [[Flat g a]]
forall a b. (a, b) -> b
snd ((Tempo, [[Flat g a]]) -> [[Flat g a]])
-> ([Note g a] -> (Tempo, [[Flat g a]]))
-> [Note g a]
-> [[Flat g a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tempo -> Note g a -> (Tempo, [Flat g a]))
-> Tempo -> [Note g a] -> (Tempo, [[Flat g a]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL Tempo -> Note g a -> (Tempo, [Flat g a])
forall {g} {a}. Tempo -> Note g a -> (Tempo, [Flat g a])
go Tempo
tempo
    where
    go :: Tempo -> Note g a -> (Tempo, [Flat g a])
go Tempo
tempo Note g a
n = case Note g a
n of
        Note a
note -> (Tempo
tempo, [Tempo -> a -> Flat g a
forall g a. Tempo -> a -> Flat g a
FNote Tempo
tempo a
note])
        TempoChange TempoChange
change [Note g a]
notes ->
            (Tempo
tempo, Tempo -> [Note g a] -> [Flat g a]
forall g a. Tempo -> [Note g a] -> [Flat g a]
flattenWith (TempoChange -> Tempo -> Tempo
changeTempo TempoChange
change Tempo
tempo) [Note g a]
notes)
        Group g
g [Note g a]
notes -> (Tempo
tempo, [Tempo -> g -> [Flat g a] -> Flat g a
forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup Tempo
tempo g
g (Tempo -> [Note g a] -> [Flat g a]
forall g a. Tempo -> [Note g a] -> [Flat g a]
flattenWith Tempo
tempo [Note g a]
notes)])

flattenedNotes :: [Flat g a] -> [a]
flattenedNotes :: forall g a. [Flat g a] -> [a]
flattenedNotes = (Flat g a -> [a]) -> [Flat g a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Flat g a -> [a]) -> [Flat g a] -> [a])
-> (Flat g a -> [a]) -> [Flat g a] -> [a]
forall a b. (a -> b) -> a -> b
$ \Flat g a
n -> case Flat g a
n of
    FGroup Tempo
_ g
_ [Flat g a]
children -> [Flat g a] -> [a]
forall g a. [Flat g a] -> [a]
flattenedNotes [Flat g a]
children
    FNote Tempo
_ a
note -> [a
note]

tempoNotes :: [Flat g a] -> [(Tempo, a)]
tempoNotes :: forall g a. [Flat g a] -> [(Tempo, a)]
tempoNotes = (Flat g a -> [(Tempo, a)]) -> [Flat g a] -> [(Tempo, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Flat g a -> [(Tempo, a)]) -> [Flat g a] -> [(Tempo, a)])
-> (Flat g a -> [(Tempo, a)]) -> [Flat g a] -> [(Tempo, a)]
forall a b. (a -> b) -> a -> b
$ \Flat g a
n -> case Flat g a
n of
    FGroup Tempo
_ g
_ [Flat g a]
children  -> [Flat g a] -> [(Tempo, a)]
forall g a. [Flat g a] -> [(Tempo, a)]
tempoNotes [Flat g a]
children
    FNote Tempo
tempo a
note -> [(Tempo
tempo, a
note)]

maxSpeed :: [Flat g a] -> Speed
maxSpeed :: forall g a. [Flat g a] -> Int
maxSpeed = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Flat g a] -> [Int]) -> [Flat g a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tempo -> Int
_speed Tempo
defaultTempo :) ([Int] -> [Int]) -> ([Flat g a] -> [Int]) -> [Flat g a] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tempo -> Int) -> [Tempo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Tempo -> Int
_speed ([Tempo] -> [Int])
-> ([Flat g a] -> [Tempo]) -> [Flat g a] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Flat g a] -> [Tempo]
forall {g} {a}. [Flat g a] -> [Tempo]
tempoOf
    where
    tempoOf :: [Flat g a] -> [Tempo]
tempoOf = (Flat g a -> [Tempo]) -> [Flat g a] -> [Tempo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Flat g a -> [Tempo]) -> [Flat g a] -> [Tempo])
-> (Flat g a -> [Tempo]) -> [Flat g a] -> [Tempo]
forall a b. (a -> b) -> a -> b
$ \Flat g a
n -> case Flat g a
n of
        FNote Tempo
tempo a
_ -> [Tempo
tempo]
        FGroup Tempo
tempo g
_ [Flat g a]
children -> Tempo
tempo Tempo -> [Tempo] -> [Tempo]
forall a. a -> [a] -> [a]
: [Flat g a] -> [Tempo]
tempoOf [Flat g a]
children
    -- If I use tempoNotes, I miss the Tempos at FGroups, which turn out to be
    -- important.

-- | Convert events with Tempo into events with absolute positions in 'State'.
--
-- This is only correct when the group doesn't affect duration.  Since there's
-- no group in here, presumably it's already been stripped out, which of you
-- should only have done if it's no longer needed, which is the case post
-- realize.
tempoToState :: HasMatras a => Tala.Tala -> Duration -- ^ start time
    -> [(Tempo, a)] -> (State, [(State, a)])
tempoToState :: forall a.
HasMatras a =>
Tala -> Duration -> [(Tempo, a)] -> (State, [(State, a)])
tempoToState Tala
tala Duration
start = (State -> (Tempo, a) -> (State, (State, a)))
-> State -> [(Tempo, a)] -> (State, [(State, a)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL State -> (Tempo, a) -> (State, (State, a))
forall {b}.
HasMatras b =>
State -> (Tempo, b) -> (State, (State, b))
toState (Tala -> Duration -> State
stateFrom Tala
tala Duration
start)
    where
    toState :: State -> (Tempo, b) -> (State, (State, b))
toState State
state (Tempo
tempo, b
note) =
        ( Tala -> Duration -> State -> State
advanceStateBy Tala
tala Duration
dur State
state
        , (State
state { stateTempo :: Tempo
stateTempo = Tempo
tempo }, b
note)
        )
        where dur :: Duration
dur = Tempo -> b -> Duration
forall a. HasMatras a => Tempo -> a -> Duration
noteDuration Tempo
tempo b
note

-- | Convert events with Tempo into events with absolute positions in 'State'.
--
-- I need to look in the group to know what the actual duration is,
-- unfortunately.
flatToState :: (Flat g a -> Duration) -> Tala.Tala -> State
    -> [Flat g a] -> (State, [(State, Flat g a)])
flatToState :: forall g a.
(Flat g a -> Duration)
-> Tala -> State -> [Flat g a] -> (State, [(State, Flat g a)])
flatToState Flat g a -> Duration
flatDuration Tala
tala State
st = (State -> Flat g a -> (State, (State, Flat g a)))
-> State -> [Flat g a] -> (State, [(State, Flat g a)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL State -> Flat g a -> (State, (State, Flat g a))
toState State
st
    where
    toState :: State -> Flat g a -> (State, (State, Flat g a))
toState State
state Flat g a
flat =
        ( Tala -> Duration -> State -> State
advanceStateBy Tala
tala (Flat g a -> Duration
flatDuration Flat g a
flat) State
state
        , (State
state { stateTempo :: Tempo
stateTempo = Flat g a -> Tempo
forall g a. Flat g a -> Tempo
flatTempo Flat g a
flat }, Flat g a
flat)
        )

-- | Calculate Duration for each note.
--
-- TODO this is wrong in general because unfortunately groups can affect
-- duration, as in 'flatToState'.  I think I only call it after Koravi.realize,
-- at which point the notes do reflect the duration, but of course that's not
-- reflected in the types.  'Solkattu.Solkattu.flatDuration' has some details.
withDurations :: HasMatras a => [Flat g a] -> [Flat g (Duration, a)]
withDurations :: forall a g. HasMatras a => [Flat g a] -> [Flat g (Duration, a)]
withDurations = (Flat g a -> Flat g (Duration, a))
-> [Flat g a] -> [Flat g (Duration, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Flat g a -> Flat g (Duration, a))
 -> [Flat g a] -> [Flat g (Duration, a)])
-> (Flat g a -> Flat g (Duration, a))
-> [Flat g a]
-> [Flat g (Duration, a)]
forall a b. (a -> b) -> a -> b
$ \Flat g a
n -> case Flat g a
n of
    FGroup Tempo
tempo g
g [Flat g a]
children -> Tempo -> g -> [Flat g (Duration, a)] -> Flat g (Duration, a)
forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup Tempo
tempo g
g ([Flat g a] -> [Flat g (Duration, a)]
forall a g. HasMatras a => [Flat g a] -> [Flat g (Duration, a)]
withDurations [Flat g a]
children)
    FNote Tempo
tempo a
note -> Tempo -> (Duration, a) -> Flat g (Duration, a)
forall g a. Tempo -> a -> Flat g a
FNote Tempo
tempo (Tempo -> a -> Duration
forall a. HasMatras a => Tempo -> a -> Duration
noteDuration Tempo
tempo a
note, a
note)

data Stroke a = Attack a | Sustain a | Rest
    deriving (Int -> Stroke a -> ShowS
[Stroke a] -> ShowS
Stroke a -> String
(Int -> Stroke a -> ShowS)
-> (Stroke a -> String) -> ([Stroke a] -> ShowS) -> Show (Stroke a)
forall a. Show a => Int -> Stroke a -> ShowS
forall a. Show a => [Stroke a] -> ShowS
forall a. Show a => Stroke a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stroke a] -> ShowS
$cshowList :: forall a. Show a => [Stroke a] -> ShowS
show :: Stroke a -> String
$cshow :: forall a. Show a => Stroke a -> String
showsPrec :: Int -> Stroke a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Stroke a -> ShowS
Show, Stroke a -> Stroke a -> Bool
(Stroke a -> Stroke a -> Bool)
-> (Stroke a -> Stroke a -> Bool) -> Eq (Stroke a)
forall a. Eq a => Stroke a -> Stroke a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stroke a -> Stroke a -> Bool
$c/= :: forall a. Eq a => Stroke a -> Stroke a -> Bool
== :: Stroke a -> Stroke a -> Bool
$c== :: forall a. Eq a => Stroke a -> Stroke a -> Bool
Eq)

instance Pretty a => Pretty (Stroke a) where
    pretty :: Stroke a -> Text
pretty Stroke a
s = case Stroke a
s of
        Attack a
a -> a -> Text
forall a. Pretty a => a -> Text
pretty a
a
        Sustain a
_ -> Text
"-"
        Stroke a
Rest -> Text
"_"

-- | Normalize to the fastest speed.  Fill slower strokes in with rests.
-- Speed 0 always gets at least one Stroke, even if it's not the slowest.
--
-- This normalizes speed, not nadai, because Realize.format lays out notation
-- by nadai, not in absolute time.
normalizeSpeed :: HasMatras a => Speed -> Tala.Tala
    -> [Flat g a] -> [Flat g (State, (Stroke a))]
normalizeSpeed :: forall a g.
HasMatras a =>
Int -> Tala -> [Flat g a] -> [Flat g (State, Stroke a)]
normalizeSpeed Int
toSpeed Tala
tala [Flat g a]
flattened = ([Flat g (State, Stroke a)], State) -> [Flat g (State, Stroke a)]
forall a b. (a, b) -> a
fst (([Flat g (State, Stroke a)], State) -> [Flat g (State, Stroke a)])
-> ([Flat g (State, Stroke a)], State)
-> [Flat g (State, Stroke a)]
forall a b. (a -> b) -> a -> b
$
    State State [Flat g (State, Stroke a)]
-> State -> ([Flat g (State, Stroke a)], State)
forall s a. State s a -> s -> (a, s)
State.runState ((Flat g (Stroke a)
 -> StateT State Identity (Flat g (State, Stroke a)))
-> [Flat g (Stroke a)] -> State State [Flat g (State, Stroke a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Flat g (Stroke a)
-> StateT State Identity (Flat g (State, Stroke a))
forall {m :: * -> *} {g} {b}.
MonadState State m =>
Flat g b -> m (Flat g (State, b))
addState ((Flat g a -> [Flat g (Stroke a)])
-> [Flat g a] -> [Flat g (Stroke a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flat g a -> [Flat g (Stroke a)]
forall {a} {g}. HasMatras a => Flat g a -> [Flat g (Stroke a)]
expand [Flat g a]
flattened)) State
initialState
    where
    addState :: Flat g b -> m (Flat g (State, b))
addState (FNote Tempo
tempo b
stroke) = do
        State
state <- m State
forall s (m :: * -> *). MonadState s m => m s
State.get
        (State -> State) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ Tala -> Duration -> State -> State
advanceStateBy Tala
tala (Tempo -> Duration
matraDuration Tempo
tempo)
        Flat g (State, b) -> m (Flat g (State, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Flat g (State, b) -> m (Flat g (State, b)))
-> Flat g (State, b) -> m (Flat g (State, b))
forall a b. (a -> b) -> a -> b
$ Tempo -> (State, b) -> Flat g (State, b)
forall g a. Tempo -> a -> Flat g a
FNote Tempo
tempo (State
state { stateTempo :: Tempo
stateTempo = Tempo
tempo }, b
stroke)
    addState (FGroup Tempo
tempo g
g [Flat g b]
children) =
        Tempo -> g -> [Flat g (State, b)] -> Flat g (State, b)
forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup Tempo
tempo g
g ([Flat g (State, b)] -> Flat g (State, b))
-> m [Flat g (State, b)] -> m (Flat g (State, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Flat g b -> m (Flat g (State, b)))
-> [Flat g b] -> m [Flat g (State, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Flat g b -> m (Flat g (State, b))
addState [Flat g b]
children
    expand :: Flat g a -> [Flat g (Stroke a)]
expand (FGroup Tempo
tempo g
g [Flat g a]
children) =
        [Tempo -> g -> [Flat g (Stroke a)] -> Flat g (Stroke a)
forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup (Tempo
tempo { _speed :: Int
_speed = Int
toSpeed }) g
g ((Flat g a -> [Flat g (Stroke a)])
-> [Flat g a] -> [Flat g (Stroke a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flat g a -> [Flat g (Stroke a)]
expand [Flat g a]
children)]
    expand (FNote Tempo
tempo a
note) =
        (Stroke a -> Flat g (Stroke a))
-> [Stroke a] -> [Flat g (Stroke a)]
forall a b. (a -> b) -> [a] -> [b]
map (Tempo -> Stroke a -> Flat g (Stroke a)
forall g a. Tempo -> a -> Flat g a
FNote (Tempo
tempo { _speed :: Int
_speed = Int
toSpeed })) ([Stroke a] -> [Flat g (Stroke a)])
-> [Stroke a] -> [Flat g (Stroke a)]
forall a b. (a -> b) -> a -> b
$
            a -> Stroke a
forall a. a -> Stroke a
Attack a
note Stroke a -> [Stroke a] -> [Stroke a]
forall a. a -> [a] -> [a]
: Int -> Stroke a -> [Stroke a]
forall a. Int -> a -> [a]
replicate (Int
spaces Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                (if a -> Bool
forall a. HasMatras a => a -> Bool
hasSustain a
note then a -> Stroke a
forall a. a -> Stroke a
Sustain a
note else Stroke a
forall a. Stroke a
Rest)
        where
        spaces :: Int
spaces = Tempo -> Int
_stride Tempo
tempo Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. HasMatras a => a -> Int
matrasOf a
note Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
exp
        exp :: Int
exp | Int
toSpeed Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tempo -> Int
_speed Tempo
tempo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
                String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"tried to normalize to speed " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
toSpeed
                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but there is " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Tempo -> String
forall a. Pretty a => a -> String
prettys Tempo
tempo
            | Bool
otherwise = Int
toSpeed Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tempo -> Int
_speed Tempo
tempo

-- | This is similar to 'normalizeSpeed', but working on 'Note's instead of
-- 'Flat's.  Expand speed to the given toSpeed, or error if there's a speed
-- above it, or if I run into a nadai change.  This will eliminate all
-- 'TempoChange's.
flattenSpeed :: HasMatras a => Speed -> [Note g a]
    -> Either Text [Note g (Stroke a)]
flattenSpeed :: forall a g.
HasMatras a =>
Int -> [Note g a] -> Either Text [Note g (Stroke a)]
flattenSpeed Int
toSpeed = Tempo -> [Note g a] -> Either Text [Note g (Stroke a)]
forall {a} {g}.
HasMatras a =>
Tempo -> [Note g a] -> Either Text [Note g (Stroke a)]
normalize Tempo
defaultTempo
    where
    normalize :: Tempo -> [Note g a] -> Either Text [Note g (Stroke a)]
normalize Tempo
tempo = (Note g a -> Either Text [Note g (Stroke a)])
-> [Note g a] -> Either Text [Note g (Stroke a)]
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
concatMapM (Tempo -> Note g a -> Either Text [Note g (Stroke a)]
go Tempo
tempo)
    go :: Tempo -> Note g a -> Either Text [Note g (Stroke a)]
go Tempo
tempo = \case
        Note a
a -> [Note g (Stroke a)] -> Either Text [Note g (Stroke a)]
forall a b. b -> Either a b
Right ([Note g (Stroke a)] -> Either Text [Note g (Stroke a)])
-> [Note g (Stroke a)] -> Either Text [Note g (Stroke a)]
forall a b. (a -> b) -> a -> b
$ (Stroke a -> Note g (Stroke a))
-> [Stroke a] -> [Note g (Stroke a)]
forall a b. (a -> b) -> [a] -> [b]
map Stroke a -> Note g (Stroke a)
forall g a. a -> Note g a
Note ([Stroke a] -> [Note g (Stroke a)])
-> [Stroke a] -> [Note g (Stroke a)]
forall a b. (a -> b) -> a -> b
$ a -> Stroke a
forall a. a -> Stroke a
Attack a
a Stroke a -> [Stroke a] -> [Stroke a]
forall a. a -> [a] -> [a]
: Int -> Stroke a -> [Stroke a]
forall a. Int -> a -> [a]
replicate (Int
spacesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Stroke a
sustain
            where
            sustain :: Stroke a
sustain = if a -> Bool
forall a. HasMatras a => a -> Bool
hasSustain a
a then a -> Stroke a
forall a. a -> Stroke a
Sustain a
a else Stroke a
forall a. Stroke a
Rest
            spaces :: Int
spaces = Tempo -> Int
_stride Tempo
tempo Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. HasMatras a => a -> Int
matrasOf a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
toSpeed Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tempo -> Int
_speed Tempo
tempo)
        TempoChange TempoChange
change [Note g a]
subs -> case TempoChange
change of
            Nadai Int
_ -> Text -> Either Text [Note g (Stroke a)]
forall a b. a -> Either a b
Left (Text -> Either Text [Note g (Stroke a)])
-> Text -> Either Text [Note g (Stroke a)]
forall a b. (a -> b) -> a -> b
$ Text
"unsupported nadai change: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TempoChange -> Text
forall a. Pretty a => a -> Text
pretty TempoChange
change
            ChangeSpeed Int
s | Int
speed Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
toSpeed ->
                Text -> Either Text [Note g (Stroke a)]
forall a b. a -> Either a b
Left (Text -> Either Text [Note g (Stroke a)])
-> Text -> Either Text [Note g (Stroke a)]
forall a b. (a -> b) -> a -> b
$ Text
"speed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (Int
speedInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" > toSpeed "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
toSpeed
            TempoChange
_ -> Tempo -> [Note g a] -> Either Text [Note g (Stroke a)]
normalize (TempoChange -> Tempo -> Tempo
changeTempo TempoChange
change Tempo
tempo) [Note g a]
subs
        Group g
g [Note g a]
subs -> (Note g (Stroke a) -> [Note g (Stroke a)] -> [Note g (Stroke a)]
forall a. a -> [a] -> [a]
:[]) (Note g (Stroke a) -> [Note g (Stroke a)])
-> ([Note g (Stroke a)] -> Note g (Stroke a))
-> [Note g (Stroke a)]
-> [Note g (Stroke a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> [Note g (Stroke a)] -> Note g (Stroke a)
forall g a. g -> [Note g a] -> Note g a
Group g
g ([Note g (Stroke a)] -> [Note g (Stroke a)])
-> Either Text [Note g (Stroke a)]
-> Either Text [Note g (Stroke a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tempo -> [Note g a] -> Either Text [Note g (Stroke a)]
normalize Tempo
tempo [Note g a]
subs
        where
        speed :: Int
speed = Tempo -> Int
_speed Tempo
tempo

-- ** Tempo

data Tempo = Tempo { Tempo -> Int
_speed :: !Speed, Tempo -> Int
_nadai :: !Nadai, Tempo -> Int
_stride :: !Stride }
    deriving (Tempo -> Tempo -> Bool
(Tempo -> Tempo -> Bool) -> (Tempo -> Tempo -> Bool) -> Eq Tempo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tempo -> Tempo -> Bool
$c/= :: Tempo -> Tempo -> Bool
== :: Tempo -> Tempo -> Bool
$c== :: Tempo -> Tempo -> Bool
Eq, Int -> Tempo -> ShowS
[Tempo] -> ShowS
Tempo -> String
(Int -> Tempo -> ShowS)
-> (Tempo -> String) -> ([Tempo] -> ShowS) -> Show Tempo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tempo] -> ShowS
$cshowList :: [Tempo] -> ShowS
show :: Tempo -> String
$cshow :: Tempo -> String
showsPrec :: Int -> Tempo -> ShowS
$cshowsPrec :: Int -> Tempo -> ShowS
Show)

instance Pretty Tempo where
    pretty :: Tempo -> Text
pretty (Tempo Int
speed Int
nadai Int
stride) =
        Text
"s" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Pretty a => a -> Text
pretty Int
speed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Pretty a => a -> Text
pretty Int
nadai
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Int
stride Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Pretty a => a -> Text
pretty Int
stride)

defaultTempo :: Tempo
defaultTempo :: Tempo
defaultTempo = Tempo { _speed :: Int
_speed = Int
0, _nadai :: Int
_nadai = Int
defaultNadai, _stride :: Int
_stride = Int
1 }

defaultNadai :: Nadai
defaultNadai :: Int
defaultNadai = Int
4

changeTempo :: TempoChange -> Tempo -> Tempo
changeTempo :: TempoChange -> Tempo -> Tempo
changeTempo (ChangeSpeed Int
s) Tempo
tempo = Tempo
tempo { _speed :: Int
_speed = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tempo -> Int
_speed Tempo
tempo }
changeTempo (Nadai Int
n) Tempo
tempo = Tempo
tempo { _nadai :: Int
_nadai = Int
n }
changeTempo (Stride Int
s) Tempo
tempo = Tempo
tempo { _stride :: Int
_stride = Int
s }

-- | Given a duration, return the speeds of 1 duration notes needed to add up
-- to that duration.  Error if the speed went past 4, which means the duration
-- probably isn't binary.
decompose :: Duration -> Either Text [Speed]
decompose :: Duration -> Either Text [Int]
decompose Duration
dur = Int -> Duration -> Either Text [Int]
go (- Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Duration -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Duration
dur))) Duration
dur
    where
    go :: Int -> Duration -> Either Text [Int]
go Int
speed Duration
left
        | Duration
left Duration -> Duration -> Bool
forall a. Eq a => a -> a -> Bool
== Duration
0 = [Int] -> Either Text [Int]
forall a b. b -> Either a b
Right []
        | Int
speed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 = Text -> Either Text [Int]
forall a b. a -> Either a b
Left (Text -> Either Text [Int]) -> Text -> Either Text [Int]
forall a b. (a -> b) -> a -> b
$ Text
"not a binary multiple: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Duration -> Text
forall a. Pretty a => a -> Text
pretty Duration
dur
        | Duration
matra Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
<= Duration
left = (Int
speed:) ([Int] -> [Int]) -> Either Text [Int] -> Either Text [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Duration -> Either Text [Int]
go (Int
speedInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Duration
left Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
matra)
        | Bool
otherwise = Int -> Duration -> Either Text [Int]
go (Int
speedInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Duration
left
        where matra :: Duration
matra = Duration
1 Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Int -> Duration
speedFactor Int
speed

decomposeM :: FMatra -> Either Text [Speed]
decomposeM :: FMatra -> Either Text [Int]
decomposeM (FMatra Rational
m) = Duration -> Either Text [Int]
decompose (Rational -> Duration
Duration Rational
m)

-- ** State

-- | Keep track of timing and tala position.
data State = State {
    State -> Int
stateAvartanam :: !Int
    , State -> Int
stateAkshara :: !Tala.Akshara
    -- | Time through this akshara, so this is always < 1.
    -- TODO actually this is not matras, but fraction of the way through the
    -- akshara.  Is there a better term?
    , State -> Duration
stateMatra :: !Duration
    -- | The tempo at the time of the State.  This is not needed internally,
    -- but it's easier to record this explicitly than try to figure it out
    -- based on the difference between this state and the next.
    --
    -- TODO this is a bit error prone, because while the rest of the fields are
    -- about the current state, this is about the next time step.  That means
    -- 'advanceStateBy' is too late to set it, and it has to be set by whoever
    -- calls advanceStateBy.  Ugh.
    , State -> Tempo
stateTempo :: !Tempo
    } deriving (Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)

instance Pretty State where
    format :: State -> Doc
format (State Int
avartanam Int
akshara Duration
matra Tempo
tempo) =
        Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"State"
            [ (Text
"avartanam", Int -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Int
avartanam)
            , (Text
"akshara", Int -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Int
akshara)
            , (Text
"matra", Duration -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Duration
matra)
            , (Text
"tempo", Tempo -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Tempo
tempo)
            ]

stateFrom :: Tala.Tala -> Duration -> State
stateFrom :: Tala -> Duration -> State
stateFrom Tala
tala Duration
dur = Tala -> Duration -> State -> State
advanceStateBy Tala
tala Duration
dur State
initialState

initialState :: State
initialState :: State
initialState = State
    { stateAvartanam :: Int
stateAvartanam = Int
0
    , stateAkshara :: Int
stateAkshara = Int
0
    , stateMatra :: Duration
stateMatra = Duration
0
    , stateTempo :: Tempo
stateTempo = Tempo
defaultTempo
    }

statePosition :: State -> (Int, Tala.Akshara, Duration)
statePosition :: State -> (Int, Int, Duration)
statePosition State
state =
    (State -> Int
stateAvartanam State
state, State -> Int
stateAkshara State
state, State -> Duration
stateMatra State
state)

-- | Number of aksharas relative to the avartanam.
stateMatraPosition :: State -> Duration
stateMatraPosition :: State -> Duration
stateMatraPosition State
state = Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral (State -> Int
stateAkshara State
state) Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
+ State -> Duration
stateMatra State
state

-- | Absolute number of aksharas from the beginning of the sequence.
stateAbsoluteAkshara :: Tala.Tala -> State -> Duration
stateAbsoluteAkshara :: Tala -> State -> Duration
stateAbsoluteAkshara Tala
tala State
state =
    Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral (State -> Int
stateAvartanam State
state Int -> Int -> Int
forall a. Num a => a -> a -> a
* Tala -> Int
Tala.tala_aksharas Tala
tala)
        Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
+ State -> Duration
stateMatraPosition State
state

-- | Show avartanam, akshara, and matra as avartanam:akshara+n/d.
showPosition :: State -> Text
showPosition :: State -> Text
showPosition State
state = Int -> Text
forall a. Show a => a -> Text
showt (State -> Int
stateAvartanam State
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Duration -> Text
forall a. Pretty a => a -> Text
pretty (State -> Duration
stateMatraPosition State
state)

-- * functions

-- | Flatten the note and return its Duration.
durationOf :: HasMatras a => Tempo -> Note g a -> Duration
durationOf :: forall a g. HasMatras a => Tempo -> Note g a -> Duration
durationOf Tempo
tempo Note g a
n = case Note g a
n of
    TempoChange TempoChange
change [Note g a]
notes ->
        [Duration] -> Duration
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Duration] -> Duration) -> [Duration] -> Duration
forall a b. (a -> b) -> a -> b
$ (Note g a -> Duration) -> [Note g a] -> [Duration]
forall a b. (a -> b) -> [a] -> [b]
map (Tempo -> Note g a -> Duration
forall a g. HasMatras a => Tempo -> Note g a -> Duration
durationOf (TempoChange -> Tempo -> Tempo
changeTempo TempoChange
change Tempo
tempo)) [Note g a]
notes
    Note a
n -> Tempo -> a -> Duration
forall a. HasMatras a => Tempo -> a -> Duration
noteDuration Tempo
tempo a
n
    Group g
_ [Note g a]
notes -> [Duration] -> Duration
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Duration] -> Duration) -> [Duration] -> Duration
forall a b. (a -> b) -> a -> b
$ (Note g a -> Duration) -> [Note g a] -> [Duration]
forall a b. (a -> b) -> [a] -> [b]
map (Tempo -> Note g a -> Duration
forall a g. HasMatras a => Tempo -> Note g a -> Duration
durationOf Tempo
tempo) [Note g a]
notes

noteDuration :: HasMatras a => Tempo -> a -> Duration
noteDuration :: forall a. HasMatras a => Tempo -> a -> Duration
noteDuration Tempo
tempo a
n = Tempo -> Duration
matraDuration Tempo
tempo Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. HasMatras a => a -> Int
matrasOf a
n)
    Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tempo -> Int
_stride Tempo
tempo)

noteFMatra :: HasMatras a => Tempo -> Note g a -> FMatra
noteFMatra :: forall a g. HasMatras a => Tempo -> Note g a -> FMatra
noteFMatra Tempo
tempo Note g a
n =
    Duration -> FMatra
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Duration -> FMatra) -> Duration -> FMatra
forall a b. (a -> b) -> a -> b
$ Tempo -> Note g a -> Duration
forall a g. HasMatras a => Tempo -> Note g a -> Duration
durationOf Tempo
tempo Note g a
n Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tempo -> Int
_nadai Tempo
tempo)

fmatraDuration :: Tempo -> FMatra -> Duration
fmatraDuration :: Tempo -> FMatra -> Duration
fmatraDuration Tempo
tempo (FMatra Rational
matra) = Rational -> Duration
Duration Rational
matra Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Tempo -> Duration
matraDuration Tempo
tempo

durationFMatra :: Tempo -> Duration -> FMatra
durationFMatra :: Tempo -> Duration -> FMatra
durationFMatra Tempo
tempo Duration
dur = Duration -> FMatra
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Duration -> FMatra) -> Duration -> FMatra
forall a b. (a -> b) -> a -> b
$ Duration
dur Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tempo -> Int
_nadai Tempo
tempo)

-- | Convert a tempo-relative Matra to a toplevel FMatra, which should only
-- be nadai-relative.
matraFMatra :: Tempo -> Matra -> FMatra
matraFMatra :: Tempo -> Int -> FMatra
matraFMatra Tempo
tempo Int
matra =
    Int -> FMatra
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
matra FMatra -> FMatra -> FMatra
forall a. Num a => a -> a -> a
* (FMatra
1 FMatra -> FMatra -> FMatra
forall a. Fractional a => a -> a -> a
/ Duration -> FMatra
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int -> Duration
speedFactor (Tempo -> Int
_speed Tempo
tempo)))

-- normalizeFMatra :: Tempo -> FMatra -> FMatra
-- normalizeFMatra tempo = (/ realToFrac (speedFactor (_speed tempo)))

-- | Duration of one matra in the given tempo.  This doesn't include '_stride',
-- because stride adds matras to the note duration, it doesn't change the
-- duration of a matra itself.
matraDuration :: Tempo -> Duration
matraDuration :: Tempo -> Duration
matraDuration Tempo
tempo =
    Duration
1 Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Int -> Duration
speedFactor (Tempo -> Int
_speed Tempo
tempo) Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tempo -> Int
_nadai Tempo
tempo)

advanceStateBy :: Tala.Tala -> Duration -> State -> State
advanceStateBy :: Tala -> Duration -> State -> State
advanceStateBy Tala
tala Duration
duration State
state = State
    { stateAvartanam :: Int
stateAvartanam = State -> Int
stateAvartanam State
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
aksharaCarry
    , stateAkshara :: Int
stateAkshara = Int
akshara
    , stateMatra :: Duration
stateMatra = Duration
dur
    -- This will probably have to be updated by the caller.
    , stateTempo :: Tempo
stateTempo = State -> Tempo
stateTempo State
state
    }
    where
    (Int
durCarry, Duration
dur) = Duration -> (Int, Duration)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Duration -> (Int, Duration)) -> Duration -> (Int, Duration)
forall a b. (a -> b) -> a -> b
$ State -> Duration
stateMatra State
state Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
+ Duration
duration
    (Int
aksharaCarry, Int
akshara)
        | Int
avartanam Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
0, State -> Int
stateAkshara State
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
durCarry)
        | Bool
otherwise = (State -> Int
stateAkshara State
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
durCarry) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
avartanam
        where avartanam :: Int
avartanam = Tala -> Int
Tala.tala_aksharas Tala
tala