-- 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, replace
    , Duration, FMatra, Matra, Speed, Nadai, Stride, speedFactor
    , changeSpeed
    , HasMatras(..)
    -- * transform
    , mapGroup, flattenGroups
    , simplify
    , map1
    , filterNotes
    , dropEndWhile
    -- * 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.Lists as Lists
import qualified Util.Num as Num
import qualified Util.Pretty as Pretty

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
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, Note g a -> Note g a -> Bool
Note g a -> Note g a -> Ordering
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
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 -> 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 a. Note g a -> Bool
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 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, 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 (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
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
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
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 -> 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
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, 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 = forall g a. [Note g a] -> Sequence g a
Sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])

null :: Sequence g a -> Bool
null :: forall g a. Sequence g a -> Bool
null = forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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) = forall g a. [Note g a] -> Sequence g a
Sequence (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) = forall g a. [Note g a] -> Sequence g a
Sequence ([Note g1 a1] -> [Note g2 a2]
f [Note g1 a1]
ns)

replace :: (Eq g, Eq a) => Sequence g a -> Sequence g a -> Sequence g a
    -> Sequence g a
replace :: forall g a.
(Eq g, Eq a) =>
Sequence g a -> Sequence g a -> Sequence g a -> Sequence g a
replace (Sequence [Note g a]
from) (Sequence [Note g a]
to) (Sequence [Note g a]
ns) =
    forall g a. [Note g a] -> Sequence g a
Sequence forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a] -> [a]
Lists.replace [Note g a]
from [Note g a]
to [Note g a]
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 -> forall a. Pretty a => a -> Doc
Pretty.format a
a
        TempoChange TempoChange
change [Note g a]
notes ->
            Text -> Doc
Pretty.text (forall a. Pretty a => a -> Text
pretty TempoChange
change) forall a. Semigroup a => a -> a -> a
<> Doc
"("
                forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
Pretty.wrapWords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
Pretty.format [Note g a]
notes)
                forall a. Semigroup a => a -> a -> a
<> Doc
")"
        Group g
g [Note g a]
notes ->
            Text -> Doc
Pretty.text (forall a. Pretty a => a -> Text
pretty g
g) forall a. Semigroup a => a -> a -> a
<> Doc
"("
                forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
Pretty.wrapWords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
Pretty.format [Note g a]
notes)
                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
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
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
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
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
Duration -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Duration -> Rational
$ctoRational :: Duration -> Rational
Real, Num 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
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
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
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
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
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
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
FMatra -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: FMatra -> Rational
$ctoRational :: FMatra -> Rational
Real, Num 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
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
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
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
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
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" forall a. Semigroup a => a -> a -> a
<> (if Int
s forall a. Ord a => a -> a -> Bool
> Int
0 then Text
"+" else Text
"-") forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall a. Num a => a -> a
abs Int
s)
    pretty (Nadai Int
s) = Text
"n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Int
s
    pretty (Stride Int
s) = Text
"t" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Ord a => a -> a -> Bool
> Int
0 = Duration
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
s
    | Bool
otherwise = Duration
1 forall a. Fractional a => a -> a -> a
/ (Duration
2 forall a b. (Num a, Integral b) => a -> b -> a
^ 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 = forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange 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 -> forall g a. a -> Note g a
Note a
a
    TempoChange TempoChange
change [Note g a]
ns -> forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
change (forall a b. (a -> b) -> [a] -> [b]
map (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 -> forall g a. g -> [Note g a] -> Note g a
Group (g -> h
f g
g) (forall a b. (a -> b) -> [a] -> [b]
map (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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a -> b) -> a -> b
$ \Note g a
n -> case Note g a
n of
    Group g
_ [Note g a]
ns -> forall g a h. [Note g a] -> [Note h a]
flattenGroups [Note g a]
ns
    Note a
a -> [forall g a. a -> Note g a
Note a
a]
    TempoChange TempoChange
change [Note g a]
ns -> [forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
change (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 = forall g a. [Note g a] -> [Note g a]
merge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {g} {a}. Note g a -> [Note g a]
cancel
    where
    cancel :: Note g a -> [Note g a]
cancel (Note a
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) = [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 forall a. Eq a => a -> a -> Bool
== Int
0 = [Note g a]
xs
    cancel (TempoChange (ChangeSpeed Int
s) [Note g a]
xs) = 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) = 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) =
        [forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange (Int -> TempoChange
Stride Int
s) (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 (forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange (Int -> TempoChange
ChangeSpeed (Int
s1forall a. Num a => a -> a -> a
+Int
s2)) [Note g a]
xs)
    cancelSpeed Int
s1 Note g a
x = [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 (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 = [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) =
        forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
c (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Note g a]
sub forall a. a -> [a] -> [a]
: [[Note g a]]
same)) 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) = forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
Lists.spanWhile (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) = forall g a. a -> Note g a
Note a
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) = forall g a. g -> [Note g a] -> Note g a
Group g
g [Note g a]
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 forall a. Eq a => a -> a -> Bool
== TempoChange
c = forall a. a -> Maybe a
Just [Note g a]
ns
    sameChange TempoChange
_ 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 -> forall g a. a -> Note g a
Note (a -> a
f a
a)
    TempoChange TempoChange
change [Note g a]
ns -> forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
change (forall a. (a -> a) -> [a] -> [a]
Lists.mapHead (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 -> forall g a. g -> [Note g a] -> Note g a
Group g
g (forall a. (a -> a) -> [a] -> [a]
Lists.mapHead (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 = forall g1 a1 g2 a2.
([Note g1 a1] -> [Note g2 a2]) -> Sequence g1 a1 -> Sequence g2 a2
apply forall {g}. [Note g a] -> [Note g a]
go
    where
    go :: [Note g a] -> [Note g a]
go = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a -> b) -> a -> b
$ \case
        note :: Note g a
note@(Note a
a) -> if a -> Bool
f a
a then forall a. a -> Maybe a
Just Note g a
note else forall a. Maybe a
Nothing
        TempoChange TempoChange
change [Note g a]
ns -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall g a. g -> [Note g a] -> Note g a
Group g
g ([Note g a] -> [Note g a]
go [Note g a]
ns)

-- TODO I didn't wind up using this, but maybe it'll still be useful?
dropEndWhile :: (a -> Bool) -> Sequence g a -> Sequence g a
dropEndWhile :: forall a g. (a -> Bool) -> Sequence g a -> Sequence g a
dropEndWhile a -> Bool
f = forall g1 a1 g2 a2.
([Note g1 a1] -> [Note g2 a2]) -> Sequence g1 a1 -> Sequence g2 a2
apply forall {g}. [Note g a] -> [Note g a]
go
    where
    go :: [Note g a] -> [Note g a]
go = forall a. [a] -> [a]
List.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Note g a] -> [Note g a]
strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
List.reverse
    strip :: [Note g a] -> [Note g a]
strip [] = []
    strip (Note g a
n : [Note g a]
ns) = case Note g a
n of
        Note a
a
            | a -> Bool
f a
a -> [Note g a] -> [Note g a]
strip [Note g a]
ns
            | Bool
otherwise -> Note g a
n forall a. a -> [a] -> [a]
: [Note g a]
ns
        Group g
g [Note g a]
gs -> case [Note g a] -> [Note g a]
go [Note g a]
gs of
            [] -> [Note g a] -> [Note g a]
strip [Note g a]
ns
            [Note g a]
gs -> forall g a. g -> [Note g a] -> Note g a
Group g
g [Note g a]
gs forall a. a -> [a] -> [a]
: [Note g a]
ns
        TempoChange TempoChange
t [Note g a]
gs -> case [Note g a] -> [Note g a]
go [Note g a]
gs of
            [] -> [Note g a] -> [Note g a]
strip [Note g a]
ns
            [Note g a]
gs -> forall g a. TempoChange -> [Note g a] -> Note g a
TempoChange TempoChange
t [Note g a]
gs forall a. a -> [a] -> [a]
: [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
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
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 -> 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) = forall a. Pretty a => a -> Text
pretty (Tempo
tempo, g
g, [Flat g a]
notes)
    pretty (FNote Tempo
tempo a
note) = 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 = 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 -> 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) 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 -> forall g a. Tempo -> a -> Flat g a
FNote Tempo
tempo a
n 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 = forall a b. (a -> b) -> [a] -> [b]
map 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) =
        forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup Tempo
tempo (g -> h
f g
g) (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) = 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 = forall g a. [Flat g a] -> [a]
flattenedNotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL 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, [forall g a. Tempo -> a -> Flat g a
FNote Tempo
tempo a
note])
        TempoChange TempoChange
change [Note g a]
notes ->
            (Tempo
tempo, 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, [forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup Tempo
tempo g
g (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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a -> b) -> a -> b
$ \Flat g a
n -> case Flat g a
n of
    FGroup Tempo
_ g
_ [Flat g a]
children -> 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a -> b) -> a -> b
$ \Flat g a
n -> case Flat g a
n of
    FGroup Tempo
_ g
_ [Flat g a]
children  -> 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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tempo -> Int
_speed Tempo
defaultTempo :) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Tempo -> Int
_speed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {g} {a}. [Flat g a] -> [Tempo]
tempoOf
    where
    tempoOf :: [Flat g a] -> [Tempo]
tempoOf = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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 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.Akshara -> Duration -- ^ start time
    -> [(Tempo, a)] -> (State, [(State, a)])
tempoToState :: forall a.
HasMatras a =>
Int -> Duration -> [(Tempo, a)] -> (State, [(State, a)])
tempoToState Int
talaAksharas Duration
start =
    forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL forall {b}.
HasMatras b =>
State -> (Tempo, b) -> (State, (State, b))
toState (Int -> Duration -> State
stateFrom Int
talaAksharas Duration
start)
    where
    toState :: State -> (Tempo, b) -> (State, (State, b))
toState State
state (Tempo
tempo, b
note) =
        ( Int -> Duration -> State -> State
advanceStateBy Int
talaAksharas Duration
dur State
state
        , (State
state { stateTempo :: Tempo
stateTempo = Tempo
tempo }, b
note)
        )
        where dur :: Duration
dur = 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.Akshara -> State
    -> [Flat g a] -> (State, [(State, Flat g a)])
flatToState :: forall g a.
(Flat g a -> Duration)
-> Int -> State -> [Flat g a] -> (State, [(State, Flat g a)])
flatToState Flat g a -> Duration
flatDuration Int
talaAksharas State
st = 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 =
        ( Int -> Duration -> State -> State
advanceStateBy Int
talaAksharas (Flat g a -> Duration
flatDuration Flat g a
flat) State
state
        , (State
state { stateTempo :: Tempo
stateTempo = 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 = forall a b. (a -> b) -> [a] -> [b]
map 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 -> forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup Tempo
tempo g
g (forall a g. HasMatras a => [Flat g a] -> [Flat g (Duration, a)]
withDurations [Flat g a]
children)
    FNote Tempo
tempo a
note -> forall g a. Tempo -> a -> Flat g a
FNote Tempo
tempo (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
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
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 -> 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.Akshara
    -> [Flat g a] -> [Flat g (State, (Stroke a))]
normalizeSpeed :: forall a g.
HasMatras a =>
Int -> Int -> [Flat g a] -> [Flat g (State, Stroke a)]
normalizeSpeed Int
toSpeed Int
talaAksharas [Flat g a]
flattened = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
    forall s a. State s a -> s -> (a, s)
State.runState (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *} {g} {b}.
MonadState State m =>
Flat g b -> m (Flat g (State, b))
addState (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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 <- forall s (m :: * -> *). MonadState s m => m s
State.get
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' forall a b. (a -> b) -> a -> b
$ Int -> Duration -> State -> State
advanceStateBy Int
talaAksharas (Tempo -> Duration
matraDuration Tempo
tempo)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> 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) =
        forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup Tempo
tempo g
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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) =
        [forall g a. Tempo -> g -> [Flat g a] -> Flat g a
FGroup (Tempo
tempo { _speed :: Int
_speed = Int
toSpeed }) g
g (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) =
        forall a b. (a -> b) -> [a] -> [b]
map (forall g a. Tempo -> a -> Flat g a
FNote (Tempo
tempo { _speed :: Int
_speed = Int
toSpeed })) forall a b. (a -> b) -> a -> b
$
            forall a. a -> Stroke a
Attack a
note forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
spaces forall a. Num a => a -> a -> a
- Int
1)
                (if forall a. HasMatras a => a -> Bool
hasSustain a
note then forall a. a -> Stroke a
Sustain a
note else forall a. Stroke a
Rest)
        where
        spaces :: Int
spaces = Tempo -> Int
_stride Tempo
tempo forall a. Num a => a -> a -> a
* forall a. HasMatras a => a -> Int
matrasOf a
note forall a. Num a => a -> a -> a
* Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
exp
        exp :: Int
exp | Int
toSpeed forall a. Num a => a -> a -> a
- Tempo -> Int
_speed Tempo
tempo forall a. Ord a => a -> a -> Bool
< Int
0 =
                forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"tried to normalize to speed " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
toSpeed
                    forall a. Semigroup a => a -> a -> a
<> String
" but there is " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> String
prettys Tempo
tempo
            | Bool
otherwise = Int
toSpeed 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 = 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 = 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 -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall g a. a -> Note g a
Note forall a b. (a -> b) -> a -> b
$ forall a. a -> Stroke a
Attack a
a forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
spacesforall a. Num a => a -> a -> a
-Int
1) Stroke a
sustain
            where
            sustain :: Stroke a
sustain = if forall a. HasMatras a => a -> Bool
hasSustain a
a then forall a. a -> Stroke a
Sustain a
a else forall a. Stroke a
Rest
            spaces :: Int
spaces = Tempo -> Int
_stride Tempo
tempo forall a. Num a => a -> a -> a
* forall a. HasMatras a => a -> Int
matrasOf a
a forall a. Num a => a -> a -> a
* Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
toSpeed 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
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"unsupported nadai change: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty TempoChange
change
            ChangeSpeed Int
s | Int
speed forall a. Num a => a -> a -> a
+ Int
s forall a. Ord a => a -> a -> Bool
> Int
toSpeed ->
                forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"speed " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (Int
speedforall a. Num a => a -> a -> a
+Int
s) forall a. Semigroup a => a -> a -> a
<> Text
" > toSpeed "
                    forall a. Semigroup a => a -> a -> a
<> 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 -> (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. g -> [Note g a] -> Note g a
Group g
g 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
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
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" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Int
speed forall a. Semigroup a => a -> a -> a
<> Text
"n" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Int
nadai
        forall a. Semigroup a => a -> a -> a
<> (if Int
stride forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"t" forall a. Semigroup a => a -> a -> a
<> 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 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 (- forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Floating a => a -> a -> a
logBase Double
2 (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 forall a. Eq a => a -> a -> Bool
== Duration
0 = forall a b. b -> Either a b
Right []
        | Int
speed forall a. Ord a => a -> a -> Bool
> Int
4 = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"not a binary multiple: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Duration
dur
        | Duration
matra forall a. Ord a => a -> a -> Bool
<= Duration
left = (Int
speed:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Duration -> Either Text [Int]
go (Int
speedforall a. Num a => a -> a -> a
+Int
1) (Duration
left forall a. Num a => a -> a -> a
- Duration
matra)
        | Bool
otherwise = Int -> Duration -> Either Text [Int]
go (Int
speedforall a. Num a => a -> a -> a
+Int
1) Duration
left
        where matra :: Duration
matra = Duration
1 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
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", forall a. Pretty a => a -> Doc
Pretty.format Int
avartanam)
            , (Text
"akshara", forall a. Pretty a => a -> Doc
Pretty.format Int
akshara)
            , (Text
"matra", forall a. Pretty a => a -> Doc
Pretty.format Duration
matra)
            , (Text
"tempo", forall a. Pretty a => a -> Doc
Pretty.format Tempo
tempo)
            ]

stateFrom :: Tala.Akshara -> Duration -> State
stateFrom :: Int -> Duration -> State
stateFrom Int
talaAksharas Duration
dur = Int -> Duration -> State -> State
advanceStateBy Int
talaAksharas 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (State -> Int
stateAkshara State
state) forall a. Num a => a -> a -> a
+ State -> Duration
stateMatra State
state

-- | Absolute number of aksharas from the beginning of the sequence.
stateAbsoluteAkshara :: Tala.Akshara -> State -> Duration
stateAbsoluteAkshara :: Int -> State -> Duration
stateAbsoluteAkshara Int
talaAksharas State
state =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral (State -> Int
stateAvartanam State
state forall a. Num a => a -> a -> a
* Int
talaAksharas)
        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 = forall a. Show a => a -> Text
showt (State -> Int
stateAvartanam State
state forall a. Num a => a -> a -> a
+ Int
1)
    forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> 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 ->
        forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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 -> forall a. HasMatras a => Tempo -> a -> Duration
noteDuration Tempo
tempo a
n
    Group g
_ [Note g a]
notes -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. HasMatras a => a -> Int
matrasOf a
n)
    forall a. Num a => a -> a -> a
* 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 =
    forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ forall a g. HasMatras a => Tempo -> Note g a -> Duration
durationOf Tempo
tempo Note g a
n forall a. Num a => a -> a -> a
* 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 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 = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ Duration
dur forall a. Num a => a -> a -> a
* 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 =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
matra forall a. Num a => a -> a -> a
* (FMatra
1 forall a. Fractional a => a -> a -> a
/ 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 forall a. Fractional a => a -> a -> a
/ Int -> Duration
speedFactor (Tempo -> Int
_speed Tempo
tempo) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tempo -> Int
_nadai Tempo
tempo)

advanceStateBy :: Tala.Akshara -> Duration -> State -> State
advanceStateBy :: Int -> Duration -> State -> State
advanceStateBy Int
talaAksharas Duration
duration State
state = State
    { stateAvartanam :: Int
stateAvartanam = State -> Int
stateAvartanam State
state 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) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction forall a b. (a -> b) -> a -> b
$ State -> Duration
stateMatra State
state forall a. Num a => a -> a -> a
+ Duration
duration
    (Int
aksharaCarry, Int
akshara)
        | Int
talaAksharas forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
0, State -> Int
stateAkshara State
state forall a. Num a => a -> a -> a
+ Int
durCarry)
        | Bool
otherwise = (State -> Int
stateAkshara State
state forall a. Num a => a -> a -> a
+ Int
durCarry) forall a. Integral a => a -> a -> (a, a)
`divMod` Int
talaAksharas