-- 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

-- TODO otherwise ghc >=8.4.1 complains about extra Semigroup
-- Remove when I can drop 8.0.2 compatibility.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{- | Generic combinators for solkattu patterns.  Because these are expected to
    be called as part of the DSL, impure exceptions are allowed, via
    'Solkattu.throw'.

    This is meant to have just Sequence manipulation, without
    instrument-specific functions.
-}
module Solkattu.Dsl.Notation where
import           Prelude hiding ((^), repeat)
import qualified Data.List as List

import qualified Util.CallStack as CallStack
import qualified Util.Lists as Lists
import qualified Util.Num as Num

import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import           Solkattu.S (Duration, FMatra)
import qualified Solkattu.Solkattu as Solkattu
import           Solkattu.Solkattu (throw)
import qualified Solkattu.Tala as Tala

import           Global


-- | This is the same as 'Solkattu.Korvai.SequenceT'.
type SequenceT sollu = S.Sequence Solkattu.Group (Solkattu.Note sollu)

-- * rests

class Rest a where __ :: a
instance Rest (SequenceT sollu) where
    __ :: SequenceT sollu
__ = forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. a -> Note g a
S.Note forall a. Rest a => a
__
instance Rest (Realize.SNote sollu) where
    __ :: SNote sollu
__ = forall sollu. SNote sollu
Realize.rest
instance Rest (Solkattu.Note sollu) where
    __ :: Note sollu
__ = forall sollu. Space -> Note sollu
Solkattu.Space Space
Solkattu.Rest

-- | These are meant to suffix a sollu.  Since the sollu is considered part of
-- the duration, the number is one higher than the number of rests.  E.g.
-- @din.__3@ is a 3 count, and equivalent to @din.__.__@.  '__M' is the version
-- that doesn't do this.
__2, __3, __4, __5, __6, __7, __8, __9 :: SequenceT sollu
__2 :: forall sollu. SequenceT sollu
__2 = forall a. Rest a => a
__
__3 :: forall sollu. SequenceT sollu
__3 = forall sollu. Matra -> SequenceT sollu
__n Matra
3
__4 :: forall sollu. SequenceT sollu
__4 = forall sollu. Matra -> SequenceT sollu
__n Matra
4
__5 :: forall sollu. SequenceT sollu
__5 = forall sollu. Matra -> SequenceT sollu
__n Matra
5
__6 :: forall sollu. SequenceT sollu
__6 = forall sollu. Matra -> SequenceT sollu
__n Matra
6
__7 :: forall sollu. SequenceT sollu
__7 = forall sollu. Matra -> SequenceT sollu
__n Matra
7
__8 :: forall sollu. SequenceT sollu
__8 = forall sollu. Matra -> SequenceT sollu
__n Matra
8
__9 :: forall sollu. SequenceT sollu
__9 = forall sollu. Matra -> SequenceT sollu
__n Matra
9

__n :: S.Matra -> SequenceT sollu
__n :: forall sollu. Matra -> SequenceT sollu
__n Matra
n = forall a. Monoid a => Matra -> a -> a
repeat (Matra
nforall a. Num a => a -> a -> a
-Matra
1) forall a. Rest a => a
__

__D :: CallStack.Stack => Duration -> SequenceT sollu
__D :: forall sollu. Stack => Duration -> SequenceT sollu
__D Duration
dur = forall sollu. Matra -> SequenceT sollu
__M (Stack => Matra -> Duration -> Matra
dToM2 (Tempo -> Matra
S._nadai Tempo
S.defaultTempo) Duration
dur)

__M :: S.Matra -> SequenceT sollu
__M :: forall sollu. Matra -> SequenceT sollu
__M Matra
matras = forall a. Monoid a => Matra -> a -> a
repeat Matra
matras forall a. Rest a => a
__

sarvaM :: CallStack.Stack => SequenceT sollu -> S.Matra -> SequenceT sollu
sarvaM :: forall sollu. Stack => SequenceT sollu -> Matra -> SequenceT sollu
sarvaM SequenceT sollu
sollus Matra
matras =
    forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. g -> [Note g a] -> Note g a
S.Group (Meta -> Group
Solkattu.GMeta Meta
meta) (forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
sollus)
    where
    meta :: Meta
meta = (GroupType -> Meta
Solkattu.meta GroupType
Solkattu.GSarva) { _matras :: Maybe Matra
Solkattu._matras = forall a. a -> Maybe a
Just Matra
matras }

sarvaD :: CallStack.Stack => SequenceT sollu -> Duration -> SequenceT sollu
sarvaD :: forall sollu.
Stack =>
SequenceT sollu -> Duration -> SequenceT sollu
sarvaD SequenceT sollu
sollus Duration
dur = forall sollu. Stack => SequenceT sollu -> Matra -> SequenceT sollu
sarvaM SequenceT sollu
sollus (Stack => Matra -> Duration -> Matra
dToM2 (Tempo -> Matra
S._nadai Tempo
S.defaultTempo) Duration
dur)

sarvaM_ :: CallStack.Stack => S.Matra -> SequenceT sollu
sarvaM_ :: forall sollu. Stack => Matra -> SequenceT sollu
sarvaM_ = forall sollu. Stack => SequenceT sollu -> Matra -> SequenceT sollu
sarvaM forall a. Monoid a => a
mempty

sarvaD_ :: CallStack.Stack => Duration -> SequenceT sollu
sarvaD_ :: forall sollu. Stack => Duration -> SequenceT sollu
sarvaD_ = forall sollu.
Stack =>
SequenceT sollu -> Duration -> SequenceT sollu
sarvaD forall a. Monoid a => a
mempty

-- * by FMatra

dropM, dropM_ :: (CallStack.Stack, Pretty sollu) =>
    FMatra -> SequenceT sollu -> SequenceT sollu
dropM :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM FMatra
matras = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
splitM FMatra
matras
dropM_ :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM_ FMatra
matras = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
splitM_ FMatra
matras

takeM :: (CallStack.Stack, Pretty sollu) => FMatra -> SequenceT sollu
    -> SequenceT sollu
takeM :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
takeM FMatra
matras = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
splitM FMatra
matras

-- | Like 'splitM_', but mark the sequences as groups.  This way they remember
-- the sollus which were dropped, and realize using the complete sequence, not
-- the fragment.
--
-- TODO the class constraints are unnecessary, but if I want to verify eagerly
-- I'll need them back.
splitM :: (CallStack.Stack, Pretty sollu) => FMatra -> SequenceT sollu
    -> (SequenceT sollu, SequenceT sollu)
splitM :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
splitM FMatra
matras SequenceT sollu
seq =
    ( forall sollu. FMatra -> Side -> SequenceT sollu -> SequenceT sollu
reduction FMatra
matras Side
Solkattu.After SequenceT sollu
seq
    , forall sollu. FMatra -> Side -> SequenceT sollu -> SequenceT sollu
reduction FMatra
matras Side
Solkattu.Before SequenceT sollu
seq
    )

-- | Split the sequence at the given FMatra.  Unlike 'splitM', this directly
-- splits the sequence, it doesn't create a group.
splitM_ :: (CallStack.Stack, Pretty sollu) => FMatra -> SequenceT sollu
    -> (SequenceT sollu, SequenceT sollu)
splitM_ :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
splitM_ FMatra
matras = forall a. Stack => Either Error a -> a
Solkattu.check forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sollu.
Pretty sollu =>
FMatra
-> SequenceT sollu
-> Either Error (SequenceT sollu, SequenceT sollu)
splitM_either FMatra
matras

splitM_either :: Pretty sollu => FMatra -> SequenceT sollu
    -> Either Text (SequenceT sollu, SequenceT sollu)
splitM_either :: forall sollu.
Pretty sollu =>
FMatra
-> SequenceT sollu
-> Either Error (SequenceT sollu, SequenceT sollu)
splitM_either FMatra
matras =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall {g} {a}. [Note g a] -> Sequence g a
toSequence forall {g} {a}. [Note g a] -> Sequence g a
toSequence 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 {sollu}.
Pretty sollu =>
Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
go Tempo
S.defaultTempo FMatra
matras
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. Sequence g a -> [Note g a]
S.toList
    where
    toSequence :: [Note g a] -> Sequence g a
toSequence = forall {g} {a}. [Note g a] -> Sequence g a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. [Note g a] -> [Note g a]
S.simplify
    -- Return (matrasLeft, (pre, post)).  matrasLeft is so that a recursive
    -- split in a S.TempoChange or S.Group can report how many matras it
    -- consumed.
    go :: Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
go Tempo
_ FMatra
_ [] = forall a b. b -> Either a b
Right (FMatra
0, ([], []))
    go Tempo
tempo FMatra
matras (Note Group (Note sollu)
n:[Note Group (Note sollu)]
ns)
        | FMatra
matras forall a. Ord a => a -> a -> Bool
<= FMatra
0 = forall a b. b -> Either a b
Right (FMatra
0, ([], Note Group (Note sollu)
nforall a. a -> [a] -> [a]
:[Note Group (Note sollu)]
ns))
        | FMatra
noteMatras forall a. Ord a => a -> a -> Bool
<= FMatra
matras =
            forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Note Group (Note sollu)
n:)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
go Tempo
tempo (FMatra
matras forall a. Num a => a -> a -> a
- FMatra
noteMatras) [Note Group (Note sollu)]
ns
        | Bool
otherwise = case Note Group (Note sollu)
n of
            S.TempoChange TempoChange
change [Note Group (Note sollu)]
children ->
                ([Note Group (Note sollu)] -> Note Group (Note sollu))
-> Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
group (forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange TempoChange
change) (TempoChange -> Tempo -> Tempo
S.changeTempo TempoChange
change Tempo
tempo)
                    FMatra
matras [Note Group (Note sollu)]
children [Note Group (Note sollu)]
ns
            S.Group (Solkattu.GReduction Reduction
r) [Note Group (Note sollu)]
children -> do
                -- The group is destroyed if it gets split.
                (SequenceT sollu
pre, SequenceT sollu
post) <- forall sollu.
Pretty sollu =>
FMatra
-> SequenceT sollu
-> Either Error (SequenceT sollu, SequenceT sollu)
splitM_either (Reduction -> FMatra
Solkattu._split Reduction
r)
                    (forall {g} {a}. [Note g a] -> Sequence g a
S.fromList [Note Group (Note sollu)]
children)
                case Reduction -> Side
Solkattu._side Reduction
r of
                    Side
Solkattu.Before -> Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
go Tempo
tempo FMatra
matras (forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
post forall a. [a] -> [a] -> [a]
++ [Note Group (Note sollu)]
ns)
                    Side
Solkattu.After -> Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
go Tempo
tempo FMatra
matras (forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
pre forall a. [a] -> [a] -> [a]
++ [Note Group (Note sollu)]
ns)
            S.Group (Solkattu.GMeta
                        meta :: Meta
meta@(Solkattu.Meta (Just Matra
sMatras) Maybe Error
_ GroupType
Solkattu.GSarva))
                    [Note Group (Note sollu)]
children
                | Just Matra
imatras <- forall frac int. (RealFrac frac, Integral int) => frac -> Maybe int
Num.asIntegral FMatra
matras -> forall (m :: * -> *) a. Monad m => a -> m a
return
                    (FMatra
0, ([Matra -> Note Group (Note sollu)
make Matra
imatras], Matra -> Note Group (Note sollu)
make (Matra
sMatras forall a. Num a => a -> a -> a
- Matra
imatras) forall a. a -> [a] -> [a]
: [Note Group (Note sollu)]
ns))
                | Bool
otherwise ->
                    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Error
"can't split sarva of non-integral matras: "
                        forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Error
pretty FMatra
matras
                    where
                    make :: Matra -> Note Group (Note sollu)
make Matra
m = forall g a. g -> [Note g a] -> Note g a
S.Group
                        (Meta -> Group
Solkattu.GMeta (Meta
meta { _matras :: Maybe Matra
Solkattu._matras = forall a. a -> Maybe a
Just Matra
m }))
                        [Note Group (Note sollu)]
children
            S.Group (Solkattu.GMeta (Solkattu.Meta Maybe Matra
Nothing Maybe Error
Nothing GroupType
gtype))
                    [Note Group (Note sollu)]
children ->
                ([Note Group (Note sollu)] -> Note Group (Note sollu))
-> Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
group forall {a}. [Note Group a] -> Note Group a
makeGroup Tempo
tempo FMatra
matras [Note Group (Note sollu)]
children [Note Group (Note sollu)]
ns
                where
                makeGroup :: [Note Group a] -> Note Group a
makeGroup = forall g a. g -> [Note g a] -> Note g a
S.Group forall a b. (a -> b) -> a -> b
$ Meta -> Group
Solkattu.GMeta forall a b. (a -> b) -> a -> b
$
                    Maybe Matra -> Maybe Error -> GroupType -> Meta
Solkattu.Meta forall a. Maybe a
Nothing forall a. Maybe a
Nothing GroupType
gtype
            S.Note (Solkattu.Space Space
space) -> do
                [Note Group (Note sollu)]
pre <- forall {g} {sollu}.
Tempo -> Space -> FMatra -> Either Error [Note g (Note sollu)]
spaces Tempo
tempo Space
space FMatra
matras
                [Note Group (Note sollu)]
post <- forall {g} {sollu}.
Tempo -> Space -> FMatra -> Either Error [Note g (Note sollu)]
spaces Tempo
tempo Space
space (FMatra
noteMatras forall a. Num a => a -> a -> a
- FMatra
matras)
                forall (m :: * -> *) a. Monad m => a -> m a
return (FMatra
0, ([Note Group (Note sollu)]
pre, [Note Group (Note sollu)]
post forall a. Semigroup a => a -> a -> a
<> [Note Group (Note sollu)]
ns))
            Note Group (Note sollu)
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Error
"can't split a note: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Error
pretty FMatra
matras
                forall a. Semigroup a => a -> a -> a
<> Error
" of " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Error
pretty FMatra
noteMatras forall a. Semigroup a => a -> a -> a
<> Error
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Error
pretty Note Group (Note sollu)
n
        where
        noteMatras :: FMatra
noteMatras = forall a. HasMatras a => Tempo -> Sequence Group a -> FMatra
Solkattu.matrasOf Tempo
tempo (forall g a. Note g a -> Sequence g a
S.singleton Note Group (Note sollu)
n)
    group :: ([Note Group (Note sollu)] -> Note Group (Note sollu))
-> Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
group [Note Group (Note sollu)] -> Note Group (Note sollu)
makeGroup Tempo
tempo FMatra
matras [Note Group (Note sollu)]
children [Note Group (Note sollu)]
remaining = do
        (FMatra
left, ([Note Group (Note sollu)]
pre, [Note Group (Note sollu)]
post)) <- Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
go Tempo
tempo FMatra
matras [Note Group (Note sollu)]
children
        if FMatra
left forall a. Ord a => a -> a -> Bool
<= FMatra
0
            then forall a b. b -> Either a b
Right (FMatra
0, ([Note Group (Note sollu)] -> [Note Group (Note sollu)]
make [Note Group (Note sollu)]
pre, [Note Group (Note sollu)] -> [Note Group (Note sollu)]
make [Note Group (Note sollu)]
post forall a. [a] -> [a] -> [a]
++ [Note Group (Note sollu)]
remaining))
            else forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Note Group (Note sollu)] -> [Note Group (Note sollu)]
make [Note Group (Note sollu)]
children ++)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
go Tempo
tempo FMatra
left [Note Group (Note sollu)]
remaining
        where
        make :: [Note Group (Note sollu)] -> [Note Group (Note sollu)]
make [] = []
        make [Note Group (Note sollu)]
ns = [[Note Group (Note sollu)] -> Note Group (Note sollu)
makeGroup [Note Group (Note sollu)]
ns]

    spaces :: Tempo -> Space -> FMatra -> Either Error [Note g (Note sollu)]
spaces Tempo
tempo Space
space FMatra
matras = do
        [Matra]
speeds <- FMatra -> Either Error [Matra]
S.decomposeM FMatra
matras
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall g a. Sequence g a -> [Note g a]
S.toList forall a b. (a -> b) -> a -> b
$ forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap forall {g} {sollu}. Matra -> Sequence g (Note sollu)
make [Matra]
speeds
        where
        make :: Matra -> Sequence g (Note sollu)
make Matra
s = forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed (Matra
s forall a. Num a => a -> a -> a
- Tempo -> Matra
S._speed Tempo
tempo) forall a b. (a -> b) -> a -> b
$
            forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. a -> Note g a
S.Note (forall sollu. Space -> Note sollu
Solkattu.Space Space
space)

rdropM, rdropM_ :: (CallStack.Stack, Pretty sollu) =>
    FMatra -> SequenceT sollu -> SequenceT sollu
rdropM :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
rdropM FMatra
matras SequenceT sollu
seq = forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
takeM (forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
seq forall a. Num a => a -> a -> a
- FMatra
matras) SequenceT sollu
seq
rdropM_ :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
rdropM_ FMatra
matras SequenceT sollu
seq = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
splitM_ (forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
seq forall a. Num a => a -> a -> a
- FMatra
matras) SequenceT sollu
seq

rtakeM :: (CallStack.Stack, Pretty sollu) => FMatra -> SequenceT sollu
    -> SequenceT sollu
rtakeM :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
rtakeM FMatra
dur SequenceT sollu
seq = forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM (forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
seq forall a. Num a => a -> a -> a
- FMatra
dur) SequenceT sollu
seq

spaceM :: CallStack.Stack => Solkattu.Space -> FMatra -> SequenceT sollu
spaceM :: forall sollu. Stack => Space -> FMatra -> SequenceT sollu
spaceM Space
space FMatra
matras = forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap forall {g} {sollu}. Matra -> Sequence g (Note sollu)
make forall a b. (a -> b) -> a -> b
$ forall a. Stack => Either Error a -> a
Solkattu.check forall a b. (a -> b) -> a -> b
$ FMatra -> Either Error [Matra]
S.decomposeM FMatra
matras
    where make :: Matra -> Sequence g (Note sollu)
make Matra
s = forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed Matra
s forall a b. (a -> b) -> a -> b
$ forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. a -> Note g a
S.Note (forall sollu. Space -> Note sollu
Solkattu.Space Space
space)

-- * by Duration

restD :: CallStack.Stack => Duration -> SequenceT sollu
restD :: forall sollu. Stack => Duration -> SequenceT sollu
restD = forall sollu.
Stack =>
Space -> Tempo -> Duration -> SequenceT sollu
spaceD Space
Solkattu.Rest Tempo
S.defaultTempo

spaceD :: CallStack.Stack => Solkattu.Space -> S.Tempo -> Duration
    -> SequenceT sollu
spaceD :: forall sollu.
Stack =>
Space -> Tempo -> Duration -> SequenceT sollu
spaceD Space
space Tempo
tempo Duration
dur =
    forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap forall {g} {sollu}. Matra -> Sequence g (Note sollu)
make forall a b. (a -> b) -> a -> b
$ forall a. Stack => Either Error a -> a
Solkattu.check forall a b. (a -> b) -> a -> b
$ Duration -> Either Error [Matra]
S.decompose Duration
s0_matras
    where
    make :: Matra -> Sequence g (Note sollu)
make Matra
s = forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed (Matra
s forall a. Num a => a -> a -> a
- Tempo -> Matra
S._speed Tempo
tempo) forall a b. (a -> b) -> a -> b
$
        forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. a -> Note g a
S.Note (forall sollu. Space -> Note sollu
Solkattu.Space Space
space)
    -- Cancel out the nadai.  So d is now in s0 matras.
    s0_matras :: Duration
s0_matras = Duration
dur forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tempo -> Matra
S._nadai Tempo
tempo)

-- | Duration-using variants of the matra functions.  These are only valid
-- at the top level, in 'S.defaultTempo'.  TODO require Tempo arg?
dropD, rdropD, takeD, rtakeD :: (CallStack.Stack, Pretty sollu) =>
    Duration -> SequenceT sollu -> SequenceT sollu
dropD :: forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
dropD = forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> FMatra
dToM
rdropD :: forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
rdropD = forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
rdropM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> FMatra
dToM
takeD :: forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
takeD = forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
takeM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> FMatra
dToM
rtakeD :: forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
rtakeD = forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
rtakeM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> FMatra
dToM

-- * structures

-- | Drop sollus equal in length to some others.  This is intenedd for
-- repeated sequences that get elided away, e.g. @tri p7 . sandi p7 (p7.p6.p5)@.
--
-- I considered an annotation that automatically drops stuff from before which
-- matches stuff afterwards, but it seemed more complicated and less reliable
-- than just dropping explicitly.
sandi :: (CallStack.Stack, Pretty sollu) => SequenceT sollu -> SequenceT sollu
    -> SequenceT sollu
sandi :: forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
sandi SequenceT sollu
dropped = forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM_ (forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
dropped)
    -- dropM_ means don't create a group.  At the moment, making a group means
    -- it gets highlighted, which I definitely don't want.  It seems like if
    -- I sandi away part of a sequence I may no longer match strokes, or match
    -- different ones, but at least so far no one does that.
    -- TODO I probably want a non-highlighting group.

-- | Repeat thrice, with no karvai.
tri :: SequenceT sollu -> SequenceT sollu
tri :: forall sollu. SequenceT sollu -> SequenceT sollu
tri = forall sollu. SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri_ forall a. Monoid a => a
mempty

-- | Repeat thrice, with the given separator.  The _nomid variant doesn't
-- add the 'mid' tag, which is useful for nested calls.
tri_, tri_nomid :: SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri_ :: forall sollu. SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri_ SequenceT sollu
sep SequenceT sollu
a = SequenceT sollu
a forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
a forall a. Semigroup a => a -> a -> a
<> forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
trySetTag Tag
mid SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
a
tri_nomid :: forall sollu. SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri_nomid SequenceT sollu
sep SequenceT sollu
a = SequenceT sollu
a forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
a forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
a

tri123 :: SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri123 :: forall sollu. SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri123 SequenceT sollu
sep SequenceT sollu
a = SequenceT sollu
a forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
aforall a. Semigroup a => a -> a -> a
<>SequenceT sollu
a forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
aforall a. Semigroup a => a -> a -> a
<>SequenceT sollu
aforall a. Semigroup a => a -> a -> a
<>SequenceT sollu
a

-- | Three different patterns with the same separator.
trin :: SequenceT sollu -> SequenceT sollu -> SequenceT sollu
    -> SequenceT sollu -> SequenceT sollu
trin :: forall sollu.
SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
-> SequenceT sollu
trin SequenceT sollu
sep SequenceT sollu
a SequenceT sollu
b SequenceT sollu
c = SequenceT sollu
a forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
b forall a. Semigroup a => a -> a -> a
<> forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
trySetTag Tag
mid SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
c

-- | Tirmanams with a variant final repeat.
tri2 :: SequenceT sollu -> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri2 :: forall sollu.
SequenceT sollu
-> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri2 SequenceT sollu
sep SequenceT sollu
ab SequenceT sollu
c = SequenceT sollu
ab forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
ab forall a. Semigroup a => a -> a -> a
<> forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
trySetTag Tag
mid SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
c

tri2g :: SequenceT sollu -> SequenceT sollu -> SequenceT sollu
    -> SequenceT sollu
tri2g :: forall sollu.
SequenceT sollu
-> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri2g SequenceT sollu
sep SequenceT sollu
ab SequenceT sollu
c = forall sollu. SequenceT sollu -> SequenceT sollu
group SequenceT sollu
ab forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> forall sollu. SequenceT sollu -> SequenceT sollu
group SequenceT sollu
ab forall a. Semigroup a => a -> a -> a
<> forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
trySetTag Tag
mid SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> forall sollu. SequenceT sollu -> SequenceT sollu
group SequenceT sollu
c

-- | 'tri_' with variable separators.
tsep :: SequenceT sollu -> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tsep :: forall sollu.
SequenceT sollu
-> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tsep SequenceT sollu
seq SequenceT sollu
sep1 SequenceT sollu
sep2 = SequenceT sollu
seq forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep1 forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
seq forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep2 forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
seq

-- * sequences

-- | replicate + mconcat.
repeat :: Monoid a => Int -> a -> a
repeat :: forall a. Monoid a => Matra -> a -> a
repeat Matra
n a
p = forall a. Monoid a => [a] -> a
mconcat (forall a. Matra -> a -> [a]
replicate Matra
n a
p)

r2, r3, r4, r5, r6, r7, r8 :: Monoid a => a -> a
r2 :: forall a. Monoid a => a -> a
r2 = forall a. Monoid a => Matra -> a -> a
repeat Matra
2
r3 :: forall a. Monoid a => a -> a
r3 = forall a. Monoid a => Matra -> a -> a
repeat Matra
3
r4 :: forall a. Monoid a => a -> a
r4 = forall a. Monoid a => Matra -> a -> a
repeat Matra
4
r5 :: forall a. Monoid a => a -> a
r5 = forall a. Monoid a => Matra -> a -> a
repeat Matra
5
r6 :: forall a. Monoid a => a -> a
r6 = forall a. Monoid a => Matra -> a -> a
repeat Matra
6
r7 :: forall a. Monoid a => a -> a
r7 = forall a. Monoid a => Matra -> a -> a
repeat Matra
7
r8 :: forall a. Monoid a => a -> a
r8 = forall a. Monoid a => Matra -> a -> a
repeat Matra
8

join :: SequenceT sollu -> [SequenceT sollu] -> SequenceT sollu
join :: forall sollu.
SequenceT sollu -> [SequenceT sollu] -> SequenceT sollu
join SequenceT sollu
sep = forall {g} {a}. [Note g a] -> Sequence g a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
List.intercalate (forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
sep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall g a. Sequence g a -> [Note g a]
S.toList

-- | Intersperse between each stroke.  TODO won't look inside a group
inter :: SequenceT sollu -> SequenceT sollu -> SequenceT sollu
inter :: forall sollu. SequenceT sollu -> SequenceT sollu -> SequenceT sollu
inter SequenceT sollu
sep = [Note Group (Note sollu)] -> SequenceT sollu
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. Sequence g a -> [Note g a]
S.toList
    where
    go :: [Note Group (Note sollu)] -> SequenceT sollu
go [] = forall a. Monoid a => a
mempty
    go (Note Group (Note sollu)
x:[Note Group (Note sollu)]
xs) = forall g a. Note g a -> Sequence g a
S.singleton Note Group (Note sollu)
x forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep forall a. Semigroup a => a -> a -> a
<> [Note Group (Note sollu)] -> SequenceT sollu
go [Note Group (Note sollu)]
xs

spread :: S.Matra -> SequenceT sollu -> SequenceT sollu
spread :: forall sollu. Matra -> SequenceT sollu -> SequenceT sollu
spread Matra
n = forall sollu. SequenceT sollu -> SequenceT sollu -> SequenceT sollu
inter (forall sollu. Matra -> SequenceT sollu
__n Matra
n)

cmap :: Monoid b => (a -> b) -> [a] -> b
cmap :: forall b a. Monoid b => (a -> b) -> [a] -> b
cmap = forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap

for :: [a] -> (a -> b) -> [b]
for :: forall a b. [a] -> (a -> b) -> [b]
for = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map

cfor :: Monoid b => [a] -> (a -> b) -> b
cfor :: forall b a. Monoid b => [a] -> (a -> b) -> b
cfor [a]
xs a -> b
f = forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap a -> b
f [a]
xs

-- | Multiple prefixes on a single suffix.
prefixes :: (Semigroup a, Monoid a) => [a] -> a -> a
prefixes :: forall a. (Semigroup a, Monoid a) => [a] -> a -> a
prefixes [a]
prefs a
suffix = forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (forall a. Semigroup a => a -> a -> a
<>a
suffix) [a]
prefs

suffixes :: (Semigroup a, Monoid a) => a -> [a] -> a
suffixes :: forall a. (Semigroup a, Monoid a) => a -> [a] -> a
suffixes a
prefix [a]
sufs = forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (a
prefix<>) [a]
sufs

circum :: (Semigroup a, Monoid a) => a -> [a] -> a -> a
circum :: forall a. (Semigroup a, Monoid a) => a -> [a] -> a -> a
circum a
prefix [a]
mids a
suffix = forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (\a
m -> a
prefix forall a. Semigroup a => a -> a -> a
<> a
m forall a. Semigroup a => a -> a -> a
<> a
suffix) [a]
mids

suffix :: (Semigroup a, Monoid a) => [a] -> a -> a
suffix :: forall a. (Semigroup a, Monoid a) => [a] -> a -> a
suffix [a]
seqs a
suf = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Semigroup a => a -> a -> a
<>a
suf) [a]
seqs

prefix :: (Semigroup a, Monoid a) => a -> [a] -> a
prefix :: forall a. (Semigroup a, Monoid a) => a -> [a] -> a
prefix a
pref [a]
seqs = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (a
pref<>) [a]
seqs

-- | Succesively accumulate suffixes.
accumulate :: Monoid a => [a] -> [a]
accumulate :: forall a. Monoid a => [a] -> [a]
accumulate = forall a b. (a -> b) -> [a] -> [b]
map forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Matra -> [a] -> [a]
drop Matra
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
List.inits

-- * combinators

-- | Reduce three times, with a separator.
reduce3 :: Pretty sollu => FMatra -> SequenceT sollu -> SequenceT sollu
    -> SequenceT sollu
reduce3 :: forall sollu.
Pretty sollu =>
FMatra -> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
reduce3 FMatra
dur SequenceT sollu
sep = forall sollu.
SequenceT sollu -> [SequenceT sollu] -> SequenceT sollu
join SequenceT sollu
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Matra -> [a] -> [a]
take Matra
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sollu.
(Stack, Pretty sollu) =>
FMatra -> FMatra -> SequenceT sollu -> [SequenceT sollu]
reduceToL FMatra
dur FMatra
dur

reduceBy :: Pretty sollu => [FMatra] -> SequenceT sollu -> SequenceT sollu
    -> SequenceT sollu
reduceBy :: forall sollu.
Pretty sollu =>
[FMatra] -> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
reduceBy [FMatra]
durs SequenceT sollu
sep SequenceT sollu
seq = forall sollu.
SequenceT sollu -> [SequenceT sollu] -> SequenceT sollu
join SequenceT sollu
sep [forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM FMatra
d SequenceT sollu
seq | FMatra
d <- [FMatra]
durs]

-- | 'reduceToL', except mconcat the result.
reduceTo :: (CallStack.Stack, Pretty sollu) => FMatra -> FMatra
    -> SequenceT sollu -> SequenceT sollu
reduceTo :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> FMatra -> SequenceT sollu -> SequenceT sollu
reduceTo FMatra
to FMatra
by = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sollu.
(Stack, Pretty sollu) =>
FMatra -> FMatra -> SequenceT sollu -> [SequenceT sollu]
reduceToL FMatra
to FMatra
by

-- | Reduce by a duration until a final duration.
reduceToL :: (CallStack.Stack, Pretty sollu) => FMatra -> FMatra
    -> SequenceT sollu -> [SequenceT sollu]
reduceToL :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> FMatra -> SequenceT sollu -> [SequenceT sollu]
reduceToL FMatra
to FMatra
by SequenceT sollu
seq = [forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM FMatra
m SequenceT sollu
seq | FMatra
m <- forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range FMatra
0 (FMatra
matras forall a. Num a => a -> a -> a
- FMatra
to) FMatra
by]
    where matras :: FMatra
matras = forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
seq

-- | Like 'reduceToL', but drop from the end instead of the front.
reduceToR :: (CallStack.Stack, Pretty sollu) => FMatra -> FMatra
    -> SequenceT sollu -> [SequenceT sollu]
reduceToR :: forall sollu.
(Stack, Pretty sollu) =>
FMatra -> FMatra -> SequenceT sollu -> [SequenceT sollu]
reduceToR FMatra
to FMatra
by SequenceT sollu
seq = [forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
takeM FMatra
m SequenceT sollu
seq | FMatra
m <- forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range FMatra
matras FMatra
to (-FMatra
by)]
    where matras :: FMatra
matras = forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
seq

-- | Start fully reduced, and expand n times by the given duration.
expand :: (CallStack.Stack, Pretty sollu) => Int -> FMatra
    -> SequenceT sollu -> [SequenceT sollu]
expand :: forall sollu.
(Stack, Pretty sollu) =>
Matra -> FMatra -> SequenceT sollu -> [SequenceT sollu]
expand Matra
times FMatra
dur = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Matra -> [a] -> [a]
take Matra
times forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sollu.
(Stack, Pretty sollu) =>
FMatra -> FMatra -> SequenceT sollu -> [SequenceT sollu]
reduceToL FMatra
dur FMatra
dur

-- | Unlike most other functions that drop from a sequence, this one doesn't
-- make a group.  Since these are used to construct a new sequence, it seems
-- more confusing than helpful.
--
-- As with (<==) and (==>), this is higher precedence than (.), so paretheses
-- are needed: @(a.b) `replaceStart` xyz@.
replaceStart, replaceEnd :: (CallStack.Stack, Pretty sollu) => SequenceT sollu
    -> SequenceT sollu -> SequenceT sollu
replaceStart :: forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
replaceStart SequenceT sollu
prefix SequenceT sollu
seq = SequenceT sollu
prefix forall a. Semigroup a => a -> a -> a
<> forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM_ (forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
prefix) SequenceT sollu
seq
replaceEnd :: forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
replaceEnd SequenceT sollu
seq SequenceT sollu
suffix = forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
rdropM_ (forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
suffix) SequenceT sollu
seq forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
suffix

-- | Operators to embed a sequence at the beginning or end of sarvalaghu.
--
-- The precedence is such that sequences must be parenthesized:
-- @(a.b) <== 8@.  If it's lower than (.), then @a.b <== 4 . c.d <== 4@ is
-- still wrong.  Since sometimes I want (.) to be tighter and sometimes looser,
-- I go for always looser and require parentheses, just like function calls.
-- But by being at 8, at least I can be below (^) and (§).
(<==) :: Pretty sollu => SequenceT sollu -> Duration -> SequenceT sollu
SequenceT sollu
seq <== :: forall sollu.
Pretty sollu =>
SequenceT sollu -> Duration -> SequenceT sollu
<== Duration
dur = SequenceT sollu
seq forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
`replaceStart` forall sollu. Stack => Duration -> SequenceT sollu
sarvaD_ Duration
dur
(==>) :: Pretty sollu => Duration -> SequenceT sollu -> SequenceT sollu
Duration
dur ==> :: forall sollu.
Pretty sollu =>
Duration -> SequenceT sollu -> SequenceT sollu
==> SequenceT sollu
seq = forall sollu. Stack => Duration -> SequenceT sollu
sarvaD_ Duration
dur forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
`replaceEnd` SequenceT sollu
seq
infixl 8 <==
infixl 8 ==>

-- * measurement

matrasOf :: SequenceT sollu -> FMatra
matrasOf :: forall sollu. SequenceT sollu -> FMatra
matrasOf = forall a. HasMatras a => Tempo -> Sequence Group a -> FMatra
Solkattu.matrasOf Tempo
S.defaultTempo

-- | Like 'matrasOf', but throw an error if it's not integral.
matrasOfI :: CallStack.Stack => SequenceT sollu -> S.Matra
matrasOfI :: forall sollu. Stack => SequenceT sollu -> Matra
matrasOfI SequenceT sollu
seq
    | FMatra
frac forall a. Eq a => a -> a -> Bool
== FMatra
0 = Matra
matras
    | Bool
otherwise = forall a. Stack => Error -> a
throw forall a b. (a -> b) -> a -> b
$ Error
"non-integral matras: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Error
pretty FMatra
fmatras
    where
    (Matra
matras, FMatra
frac) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction FMatra
fmatras
    fmatras :: FMatra
fmatras = forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
seq

-- | I think defaultTempo is ok because these functions are used on fragments.
matraDuration :: S.Duration
matraDuration :: Duration
matraDuration = Tempo -> Duration
S.matraDuration Tempo
S.defaultTempo

dToM :: Duration -> FMatra
dToM :: Duration -> FMatra
dToM Duration
d = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ Duration
d forall a. Fractional a => a -> a -> a
/ Tempo -> Duration
S.matraDuration Tempo
S.defaultTempo

dToM2 :: CallStack.Stack => S.Nadai -> Duration -> S.Matra
dToM2 :: Stack => Matra -> Duration -> Matra
dToM2 Matra
nadai Duration
dur
    | Duration
frac forall a. Eq a => a -> a -> Bool
== Duration
0 = Matra
matra
    | Bool
otherwise = forall a. Stack => Error -> a
throw forall a b. (a -> b) -> a -> b
$ Error
"duration not divisible by nadai: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Error
pretty Duration
dur
    where
    (Matra
matra, Duration
frac) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction 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 Matra
nadai

-- * generic notation

-- | Set relative speed.
speed :: S.Speed -> S.Sequence g sollu -> S.Sequence g sollu
speed :: forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed Matra
change Sequence g sollu
seq
    | forall g a. Sequence g a -> Bool
S.null Sequence g sollu
seq Bool -> Bool -> Bool
|| Matra
change forall a. Eq a => a -> a -> Bool
== Matra
0 = Sequence g sollu
seq
    | Bool
otherwise = forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$
        forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange (Matra -> TempoChange
S.ChangeSpeed Matra
change) (forall g a. Sequence g a -> [Note g a]
S.toList Sequence g sollu
seq)

-- | Mnemonic: speed up, slow down.
su, sd :: S.Sequence g sollu -> S.Sequence g sollu
su :: forall g sollu. Sequence g sollu -> Sequence g sollu
su = forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed Matra
1
sd :: forall g sollu. Sequence g sollu -> Sequence g sollu
sd = forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed (-Matra
1)

su2, sd2 :: S.Sequence g sollu -> S.Sequence g sollu
su2 :: forall g sollu. Sequence g sollu -> Sequence g sollu
su2 = forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed Matra
2
sd2 :: forall g sollu. Sequence g sollu -> Sequence g sollu
sd2 = forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed (-Matra
2)

nadai :: S.Matra -> S.Sequence g sollu -> S.Sequence g sollu
nadai :: forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
nadai Matra
n Sequence g sollu
seq
    | forall g a. Sequence g a -> Bool
S.null Sequence g sollu
seq = forall a. Monoid a => a
mempty
    | Bool
otherwise = forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange (Matra -> TempoChange
S.Nadai Matra
n) (forall g a. Sequence g a -> [Note g a]
S.toList Sequence g sollu
seq)

stride :: S.Stride -> S.Sequence g sollu -> S.Sequence g sollu
stride :: forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
stride Matra
n Sequence g sollu
seq
    | forall g a. Sequence g a -> Bool
S.null Sequence g sollu
seq = forall a. Monoid a => a
mempty
    | Bool
otherwise = forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange (Matra -> TempoChange
S.Stride Matra
n) (forall g a. Sequence g a -> [Note g a]
S.toList Sequence g sollu
seq)

-- * groups

-- | Mark a theme group.
group :: SequenceT sollu -> SequenceT sollu
group :: forall sollu. SequenceT sollu -> SequenceT sollu
group = forall sollu. Meta -> SequenceT sollu -> SequenceT sollu
_groupWith (GroupType -> Meta
Solkattu.meta GroupType
Solkattu.GGroup)

g :: SequenceT sollu -> SequenceT sollu
g :: forall sollu. SequenceT sollu -> SequenceT sollu
g = forall sollu. SequenceT sollu -> SequenceT sollu
group

-- | Mark a pattern group.  These are like patterns, except with a specific
-- realization.
pattern :: SequenceT sollu -> SequenceT sollu
pattern :: forall sollu. SequenceT sollu -> SequenceT sollu
pattern = forall sollu. Meta -> SequenceT sollu -> SequenceT sollu
_groupWith (GroupType -> Meta
Solkattu.meta GroupType
Solkattu.GExplicitPattern)

reduction :: FMatra -> Solkattu.Side -> SequenceT sollu -> SequenceT sollu
reduction :: forall sollu. FMatra -> Side -> SequenceT sollu -> SequenceT sollu
reduction FMatra
split Side
side SequenceT sollu
sols = case forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
sols of
    -- If it's a "plain" group, replace the group.  This means
    -- dropM 1 (g xyz) won't be a nested group and won't confuse technique
    -- postprocess.
    -- TODO maybe _groupWith should do this to make it universal
    -- TODO also I could combine reductions so dropM 1 . dropM 2 = dropM 3.
    -- But I won't unless I have a reason to want that.
    [S.Group Group
g [Note Group (Note sollu)]
sols]
        | Group
g forall a. Eq a => a -> a -> Bool
== Meta -> Group
Solkattu.GMeta (GroupType -> Meta
Solkattu.meta GroupType
Solkattu.GGroup) ->
            forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. g -> [Note g a] -> Note g a
S.Group Group
group [Note Group (Note sollu)]
sols
    [Note Group (Note sollu)]
sols -> forall g a. Note g a -> Sequence g a
S.singleton forall a b. (a -> b) -> a -> b
$ forall g a. g -> [Note g a] -> Note g a
S.Group Group
group [Note Group (Note sollu)]
sols
    where
    group :: Group
group = Reduction -> Group
Solkattu.GReduction forall a b. (a -> b) -> a -> b
$ Solkattu.Reduction
        { _split :: FMatra
_split = FMatra
split
        , _side :: Side
_side = Side
side
        }

-- | Make a named group.
named :: Text -> SequenceT sollu -> SequenceT sollu
named :: forall sollu. Error -> SequenceT sollu -> SequenceT sollu
named = forall sollu.
GroupType -> Error -> SequenceT sollu -> SequenceT sollu
namedT GroupType
Solkattu.GGroup

namedT :: Solkattu.GroupType -> Text -> SequenceT sollu -> SequenceT sollu
namedT :: forall sollu.
GroupType -> Error -> SequenceT sollu -> SequenceT sollu
namedT GroupType
gtype Error
name =
    forall sollu. Meta -> SequenceT sollu -> SequenceT sollu
_groupWith forall a b. (a -> b) -> a -> b
$ (GroupType -> Meta
Solkattu.meta GroupType
gtype) { _name :: Maybe Error
Solkattu._name = forall a. a -> Maybe a
Just Error
name }

checkD :: S.Duration -> SequenceT sollu -> SequenceT sollu
checkD :: forall sollu. Duration -> SequenceT sollu -> SequenceT sollu
checkD Duration
dur = forall sollu. Meta -> SequenceT sollu -> SequenceT sollu
_groupWith forall a b. (a -> b) -> a -> b
$ GroupType -> Meta
Solkattu.meta (Duration -> GroupType
Solkattu.GCheckDuration Duration
dur)

_groupWith :: Solkattu.Meta -> SequenceT sollu -> SequenceT sollu
_groupWith :: forall sollu. Meta -> SequenceT sollu -> SequenceT sollu
_groupWith Meta
meta = forall g a. Note g a -> Sequence g a
S.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. g -> [Note g a] -> Note g a
S.Group (Meta -> Group
Solkattu.GMeta Meta
meta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. Sequence g a -> [Note g a]
S.toList

-- ** tags

-- | Infix operator to 'Solkattu.Tag' all of the sollus it applies to.
(^) :: Solkattu.Tag -> SequenceT sollu -> SequenceT sollu
^ :: forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
(^) = forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
setTag
infix 9 ^

-- | 'Solkattu.Middle'.
mid :: Solkattu.Tag
mid :: Tag
mid = Tag
Solkattu.Middle

setTag :: Solkattu.Tag -> SequenceT sollu -> SequenceT sollu
setTag :: forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
setTag Tag
tag = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b. (NoteT a -> NoteT b) -> Note a -> Note b
Solkattu.modifyNote forall a b. (a -> b) -> a -> b
$
    \NoteT sollu
note -> NoteT sollu
note { _tag :: Maybe Tag
Solkattu._tag = forall a. a -> Maybe a
Just Tag
tag }

-- | Set if not already set.
trySetTag :: Solkattu.Tag -> SequenceT sollu -> SequenceT sollu
trySetTag :: forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
trySetTag Tag
tag = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b. (NoteT a -> NoteT b) -> Note a -> Note b
Solkattu.modifyNote forall a b. (a -> b) -> a -> b
$
    \NoteT sollu
note -> if forall sollu. NoteT sollu -> Maybe Tag
Solkattu._tag NoteT sollu
note forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing
        then NoteT sollu
note { _tag :: Maybe Tag
Solkattu._tag = forall a. a -> Maybe a
Just Tag
tag }
        else NoteT sollu
note

-- * align

-- | Align to the end of the avartanam, with rests.
--
-- This should only be used at the top level, since it gets the timing wrong
-- under a tempo change.
__sam :: (CallStack.Stack, Pretty sollu) =>
    Tala.Tala -> SequenceT sollu -> SequenceT sollu
__sam :: forall sollu.
(Stack, Pretty sollu) =>
Tala -> SequenceT sollu -> SequenceT sollu
__sam Tala
tala SequenceT sollu
seq = forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
__a (forall sollu. Tala -> SequenceT sollu -> Duration
nextSam Tala
tala SequenceT sollu
seq) SequenceT sollu
seq

nextSam :: Tala.Tala -> SequenceT sollu -> S.Duration
nextSam :: forall sollu. Tala -> SequenceT sollu -> Duration
nextSam Tala
tala SequenceT sollu
seq = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall factor a. (Integral factor, Real a) => factor -> a -> factor
Num.roundUp Matra
aksharas Duration
dur
    where
    dur :: Duration
dur = forall a. HasMatras a => Tempo -> Sequence Group a -> Duration
Solkattu.durationOf Tempo
S.defaultTempo SequenceT sollu
seq
    aksharas :: Matra
aksharas = Tala -> Matra
Tala.tala_aksharas Tala
tala

-- | Align to the end of the given number of aksharams.
__a :: (CallStack.Stack, Pretty sollu) =>
    S.Duration -> SequenceT sollu -> SequenceT sollu
__a :: forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
__a Duration
dur SequenceT sollu
seq = forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
replaceEnd (forall sollu. Stack => Duration -> SequenceT sollu
restD Duration
dur) SequenceT sollu
seq

sarvaSam :: (CallStack.Stack, Pretty sollu) =>
    Tala.Tala -> SequenceT sollu -> SequenceT sollu
sarvaSam :: forall sollu.
(Stack, Pretty sollu) =>
Tala -> SequenceT sollu -> SequenceT sollu
sarvaSam Tala
tala SequenceT sollu
seq = forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
sarvaA_ (forall sollu. Tala -> SequenceT sollu -> Duration
nextSam Tala
tala SequenceT sollu
seq) SequenceT sollu
seq

sarvaA :: (CallStack.Stack, Pretty sollu) =>
    SequenceT sollu -> S.Duration -> SequenceT sollu -> SequenceT sollu
sarvaA :: forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> Duration -> SequenceT sollu -> SequenceT sollu
sarvaA SequenceT sollu
sarva Duration
dur SequenceT sollu
seq = forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
replaceEnd (forall sollu.
Stack =>
SequenceT sollu -> Duration -> SequenceT sollu
sarvaD SequenceT sollu
sarva Duration
dur) SequenceT sollu
seq

sarvaA_ :: (CallStack.Stack, Pretty sollu) =>
    S.Duration -> SequenceT sollu -> SequenceT sollu
sarvaA_ :: forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
sarvaA_ = forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> Duration -> SequenceT sollu -> SequenceT sollu
sarvaA forall a. Monoid a => a
mempty

-- * complex transformation

-- | ktknkook -> kt_kn_ko_ok
in3 :: SequenceT sollu -> SequenceT sollu
in3 :: forall sollu. SequenceT sollu -> SequenceT sollu
in3 = forall sollu.
Matra -> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
appendEach Matra
2 forall a. Rest a => a
__

-- | Append a sequence after a number of syllables.  This works across groups,
-- but not tempo changes.
appendEach :: Int -> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
appendEach :: forall sollu.
Matra -> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
appendEach Matra
per SequenceT sollu
sep = forall state g a.
(state -> a -> (state, [Note g a]))
-> state -> Sequence g a -> Sequence g a
mapGroup Matra -> Note sollu -> (Matra, [Note Group (Note sollu)])
add (Matra
perforall a. Num a => a -> a -> a
-Matra
1)
    where
    add :: Matra -> Note sollu -> (Matra, [Note Group (Note sollu)])
add Matra
at Note sollu
n
        | Matra
at forall a. Ord a => a -> a -> Bool
<= Matra
0 = (Matra
perforall a. Num a => a -> a -> a
-Matra
1, forall g a. a -> Note g a
S.Note Note sollu
n forall a. a -> [a] -> [a]
: forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
sep)
        | Bool
otherwise = (Matra
atforall a. Num a => a -> a -> a
-Matra
1, [forall g a. a -> Note g a
S.Note Note sollu
n])

-- | Apply a stateful transformation within groups.  Since the transformation
-- is allowed to add or remove notes, this will throw if there is a TempoChange
-- in there, since now we are changing an unknown amount of time.
mapGroup :: forall state g a. (state -> a -> (state, [S.Note g a])) -> state
    -> S.Sequence g a -> S.Sequence g a
mapGroup :: forall state g a.
(state -> a -> (state, [Note g a]))
-> state -> Sequence g a -> Sequence g a
mapGroup state -> a -> (state, [Note g a])
f state
state = forall {g} {a}. [Note g a] -> Sequence g a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. state -> [Note g a] -> [Note g a]
go state
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. Sequence g a -> [Note g a]
S.toList
    where
    go :: state -> [Note g a] -> [Note g a]
go state
state = \case
        [S.TempoChange TempoChange
change [Note g a]
ns] -> [forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange TempoChange
change (state -> [Note g a] -> [Note g a]
go state
state [Note g a]
ns)]
        [S.Group g
g [Note g a]
ns] -> [forall g a. g -> [Note g a] -> Note g a
S.Group g
g (state -> [Note g a] -> [Note g a]
go state
state [Note g a]
ns)]
        [Note g a]
seq -> forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ state -> [Note g a] -> (state, [Note g a])
transform state
state [Note g a]
seq
    transform :: state -> [Note g a] -> (state, [Note g a])
transform state
state [Note g a]
seq = case forall g a. [Note g a] -> Maybe [Either (g, [Note g a]) [a]]
byGroup [Note g a]
seq of
        Maybe [Either (g, [Note g a]) [a]]
Nothing -> forall a. Stack => Error -> a
throw Error
"can't transform multiple tempo changes"
        Just [Either (g, [Note g a]) [a]]
groups -> forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL state -> Either (g, [Note g a]) [a] -> (state, [Note g a])
transform1 state
state [Either (g, [Note g a]) [a]]
groups
    transform1 :: state -> Either (g, [S.Note g a]) [a] -> (state, [S.Note g a])
    transform1 :: state -> Either (g, [Note g a]) [a] -> (state, [Note g a])
transform1 state
state (Right [a]
ns) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL state -> a -> (state, [Note g a])
f state
state [a]
ns
    transform1 state
state (Left (g
g, [Note g a]
ns)) =
        (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
S.Group g
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> state -> [Note g a] -> (state, [Note g a])
transform state
state [Note g a]
ns

-- | Return groups, or runs of Notes.  Nothing if there's a TempoChange in
-- there.
byGroup :: [S.Note g a] -> Maybe [Either (g, [S.Note g a]) [a]]
byGroup :: forall g a. [Note g a] -> Maybe [Either (g, [Note g a]) [a]]
byGroup [] = forall a. a -> Maybe a
Just []
byGroup (Note g a
n : [Note g a]
ns) = case Note g a
n of
    S.Group g
g [Note g a]
ns -> (forall a b. a -> Either a b
Left (g
g, [Note g a]
ns) :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall g a. [Note g a] -> Maybe [Either (g, [Note g a]) [a]]
byGroup [Note g a]
ns
    S.TempoChange {} -> forall a. Maybe a
Nothing
    S.Note a
n -> (forall a b. b -> Either a b
Right (a
nforall a. a -> [a] -> [a]
:[a]
notes) :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall g a. [Note g a] -> Maybe [Either (g, [Note g a]) [a]]
byGroup [Note g a]
rest
        where ([a]
notes, [Note g a]
rest) = forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
Lists.spanWhile forall {g} {a}. Note g a -> Maybe a
noteOf [Note g a]
ns
    where
    noteOf :: Note g a -> Maybe a
noteOf (S.Note a
n) = forall a. a -> Maybe a
Just a
n
    noteOf Note g a
_ = forall a. Maybe a
Nothing