-- 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.Num as Num
import qualified Util.Seq as Seq

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
__ = Note Group (Note sollu) -> SequenceT sollu
forall g a. Note g a -> Sequence g a
S.singleton (Note Group (Note sollu) -> SequenceT sollu)
-> Note Group (Note sollu) -> SequenceT sollu
forall a b. (a -> b) -> a -> b
$ Note sollu -> Note Group (Note sollu)
forall g a. a -> Note g a
S.Note Note sollu
forall a. Rest a => a
__
instance Rest (Realize.SNote sollu) where
    __ :: SNote sollu
__ = SNote sollu
forall sollu. SNote sollu
Realize.rest
instance Rest (Solkattu.Note sollu) where
    __ :: Note sollu
__ = Space -> 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 = SequenceT sollu
forall a. Rest a => a
__
__3 :: forall sollu. SequenceT sollu
__3 = Matra -> SequenceT sollu
forall sollu. Matra -> SequenceT sollu
__n Matra
3
__4 :: forall sollu. SequenceT sollu
__4 = Matra -> SequenceT sollu
forall sollu. Matra -> SequenceT sollu
__n Matra
4
__5 :: forall sollu. SequenceT sollu
__5 = Matra -> SequenceT sollu
forall sollu. Matra -> SequenceT sollu
__n Matra
5
__6 :: forall sollu. SequenceT sollu
__6 = Matra -> SequenceT sollu
forall sollu. Matra -> SequenceT sollu
__n Matra
6
__7 :: forall sollu. SequenceT sollu
__7 = Matra -> SequenceT sollu
forall sollu. Matra -> SequenceT sollu
__n Matra
7
__8 :: forall sollu. SequenceT sollu
__8 = Matra -> SequenceT sollu
forall sollu. Matra -> SequenceT sollu
__n Matra
8
__9 :: forall sollu. SequenceT sollu
__9 = Matra -> SequenceT sollu
forall sollu. Matra -> SequenceT sollu
__n Matra
9

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

__D :: CallStack.Stack => Duration -> SequenceT sollu
__D :: forall sollu. Stack => Duration -> SequenceT sollu
__D Duration
dur = Matra -> SequenceT sollu
forall sollu. Matra -> SequenceT sollu
__M (Stack => Matra -> Duration -> Matra
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 = Matra -> SequenceT sollu -> SequenceT sollu
forall a. Monoid a => Matra -> a -> a
repeat Matra
matras SequenceT sollu
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 =
    Note Group (Note sollu) -> SequenceT sollu
forall g a. Note g a -> Sequence g a
S.singleton (Note Group (Note sollu) -> SequenceT sollu)
-> Note Group (Note sollu) -> SequenceT sollu
forall a b. (a -> b) -> a -> b
$ Group -> [Note Group (Note sollu)] -> Note Group (Note sollu)
forall g a. g -> [Note g a] -> Note g a
S.Group (Meta -> Group
Solkattu.GMeta Meta
meta) (SequenceT sollu -> [Note Group (Note sollu)]
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 = Matra -> Maybe Matra
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 = SequenceT sollu -> Matra -> SequenceT sollu
forall sollu. Stack => SequenceT sollu -> Matra -> SequenceT sollu
sarvaM SequenceT sollu
sollus (Stack => Matra -> Duration -> Matra
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_ = SequenceT sollu -> Matra -> SequenceT sollu
forall sollu. Stack => SequenceT sollu -> Matra -> SequenceT sollu
sarvaM SequenceT sollu
forall a. Monoid a => a
mempty

sarvaD_ :: CallStack.Stack => Duration -> SequenceT sollu
sarvaD_ :: forall sollu. Stack => Duration -> SequenceT sollu
sarvaD_ = SequenceT sollu -> Duration -> SequenceT sollu
forall sollu.
Stack =>
SequenceT sollu -> Duration -> SequenceT sollu
sarvaD SequenceT sollu
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 = (SequenceT sollu, SequenceT sollu) -> SequenceT sollu
forall a b. (a, b) -> b
snd ((SequenceT sollu, SequenceT sollu) -> SequenceT sollu)
-> (SequenceT sollu -> (SequenceT sollu, SequenceT sollu))
-> SequenceT sollu
-> SequenceT sollu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
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 = (SequenceT sollu, SequenceT sollu) -> SequenceT sollu
forall a b. (a, b) -> b
snd ((SequenceT sollu, SequenceT sollu) -> SequenceT sollu)
-> (SequenceT sollu -> (SequenceT sollu, SequenceT sollu))
-> SequenceT sollu
-> SequenceT sollu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
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 = (SequenceT sollu, SequenceT sollu) -> SequenceT sollu
forall a b. (a, b) -> a
fst ((SequenceT sollu, SequenceT sollu) -> SequenceT sollu)
-> (SequenceT sollu -> (SequenceT sollu, SequenceT sollu))
-> SequenceT sollu
-> SequenceT sollu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
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 =
    ( FMatra -> Side -> SequenceT sollu -> SequenceT sollu
forall sollu. FMatra -> Side -> SequenceT sollu -> SequenceT sollu
reduction FMatra
matras Side
Solkattu.After SequenceT sollu
seq
    , FMatra -> Side -> SequenceT sollu -> SequenceT sollu
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 = Either Error (SequenceT sollu, SequenceT sollu)
-> (SequenceT sollu, SequenceT sollu)
forall a. Stack => Either Error a -> a
Solkattu.check (Either Error (SequenceT sollu, SequenceT sollu)
 -> (SequenceT sollu, SequenceT sollu))
-> (SequenceT sollu
    -> Either Error (SequenceT sollu, SequenceT sollu))
-> SequenceT sollu
-> (SequenceT sollu, SequenceT sollu)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMatra
-> SequenceT sollu
-> Either Error (SequenceT sollu, SequenceT sollu)
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 =
    ((FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
 -> (SequenceT sollu, SequenceT sollu))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> Either Error (SequenceT sollu, SequenceT sollu)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Note Group (Note sollu)] -> SequenceT sollu)
-> ([Note Group (Note sollu)] -> SequenceT sollu)
-> ([Note Group (Note sollu)], [Note Group (Note sollu)])
-> (SequenceT sollu, SequenceT sollu)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Note Group (Note sollu)] -> SequenceT sollu
forall {g} {a}. [Note g a] -> Sequence g a
toSequence [Note Group (Note sollu)] -> SequenceT sollu
forall {g} {a}. [Note g a] -> Sequence g a
toSequence (([Note Group (Note sollu)], [Note Group (Note sollu)])
 -> (SequenceT sollu, SequenceT sollu))
-> ((FMatra,
     ([Note Group (Note sollu)], [Note Group (Note sollu)]))
    -> ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> (SequenceT sollu, SequenceT sollu)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> ([Note Group (Note sollu)], [Note Group (Note sollu)])
forall a b. (a, b) -> b
snd) (Either
   Error
   (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
 -> Either Error (SequenceT sollu, SequenceT sollu))
-> (SequenceT sollu
    -> Either
         Error
         (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)])))
-> SequenceT sollu
-> Either Error (SequenceT sollu, SequenceT sollu)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tempo
-> FMatra
-> [Note Group (Note sollu)]
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
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
        ([Note Group (Note sollu)]
 -> Either
      Error
      (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)])))
-> (SequenceT sollu -> [Note Group (Note sollu)])
-> SequenceT sollu
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SequenceT sollu -> [Note Group (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList
    where
    toSequence :: [Note g a] -> Sequence g a
toSequence = [Note g a] -> Sequence g a
forall {g} {a}. [Note g a] -> Sequence g a
S.fromList ([Note g a] -> Sequence g a)
-> ([Note g a] -> [Note g a]) -> [Note g a] -> Sequence g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Note g a] -> [Note g a]
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
_ [] = (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
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 FMatra -> FMatra -> Bool
forall a. Ord a => a -> a -> Bool
<= FMatra
0 = (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
forall a b. b -> Either a b
Right (FMatra
0, ([], Note Group (Note sollu)
nNote Group (Note sollu)
-> [Note Group (Note sollu)] -> [Note Group (Note sollu)]
forall a. a -> [a] -> [a]
:[Note Group (Note sollu)]
ns))
        | FMatra
noteMatras FMatra -> FMatra -> Bool
forall a. Ord a => a -> a -> Bool
<= FMatra
matras =
            (([Note Group (Note sollu)], [Note Group (Note sollu)])
 -> ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([Note Group (Note sollu)] -> [Note Group (Note sollu)])
-> ([Note Group (Note sollu)], [Note Group (Note sollu)])
-> ([Note Group (Note sollu)], [Note Group (Note sollu)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Note Group (Note sollu)
n:)) ((FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
 -> (FMatra,
     ([Note Group (Note sollu)], [Note Group (Note sollu)])))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
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 FMatra -> FMatra -> FMatra
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 (TempoChange -> [Note Group (Note sollu)] -> Note Group (Note sollu)
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) <- FMatra
-> SequenceT sollu
-> Either Error (SequenceT sollu, SequenceT sollu)
forall sollu.
Pretty sollu =>
FMatra
-> SequenceT sollu
-> Either Error (SequenceT sollu, SequenceT sollu)
splitM_either (Reduction -> FMatra
Solkattu._split Reduction
r)
                    ([Note Group (Note sollu)] -> SequenceT sollu
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 (SequenceT sollu -> [Note Group (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
post [Note Group (Note sollu)]
-> [Note Group (Note sollu)] -> [Note Group (Note sollu)]
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 (SequenceT sollu -> [Note Group (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
pre [Note Group (Note sollu)]
-> [Note Group (Note sollu)] -> [Note Group (Note sollu)]
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 <- FMatra -> Maybe Matra
forall frac int. (RealFrac frac, Integral int) => frac -> Maybe int
Num.asIntegral FMatra
matras -> (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
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 Matra -> Matra -> Matra
forall a. Num a => a -> a -> a
- Matra
imatras) Note Group (Note sollu)
-> [Note Group (Note sollu)] -> [Note Group (Note sollu)]
forall a. a -> [a] -> [a]
: [Note Group (Note sollu)]
ns))
                | Bool
otherwise ->
                    Error
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
forall a b. a -> Either a b
Left (Error
 -> Either
      Error
      (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)])))
-> Error
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
forall a b. (a -> b) -> a -> b
$ Error
"can't split sarva of non-integral matras: "
                        Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> FMatra -> Error
forall a. Pretty a => a -> Error
pretty FMatra
matras
                    where
                    make :: Matra -> Note Group (Note sollu)
make Matra
m = Group -> [Note Group (Note sollu)] -> Note Group (Note sollu)
forall g a. g -> [Note g a] -> Note g a
S.Group
                        (Meta -> Group
Solkattu.GMeta (Meta
meta { _matras :: Maybe Matra
Solkattu._matras = Matra -> Maybe Matra
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 [Note Group (Note sollu)] -> Note Group (Note sollu)
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 = Group -> [Note Group a] -> Note Group a
forall g a. g -> [Note g a] -> Note g a
S.Group (Group -> [Note Group a] -> Note Group a)
-> Group -> [Note Group a] -> Note Group a
forall a b. (a -> b) -> a -> b
$ Meta -> Group
Solkattu.GMeta (Meta -> Group) -> Meta -> Group
forall a b. (a -> b) -> a -> b
$
                    Maybe Matra -> Maybe Error -> GroupType -> Meta
Solkattu.Meta Maybe Matra
forall a. Maybe a
Nothing Maybe Error
forall a. Maybe a
Nothing GroupType
gtype
            S.Note (Solkattu.Space Space
space) -> do
                [Note Group (Note sollu)]
pre <- Tempo -> Space -> FMatra -> Either Error [Note Group (Note sollu)]
forall {g} {sollu}.
Tempo -> Space -> FMatra -> Either Error [Note g (Note sollu)]
spaces Tempo
tempo Space
space FMatra
matras
                [Note Group (Note sollu)]
post <- Tempo -> Space -> FMatra -> Either Error [Note Group (Note sollu)]
forall {g} {sollu}.
Tempo -> Space -> FMatra -> Either Error [Note g (Note sollu)]
spaces Tempo
tempo Space
space (FMatra
noteMatras FMatra -> FMatra -> FMatra
forall a. Num a => a -> a -> a
- FMatra
matras)
                (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
forall (m :: * -> *) a. Monad m => a -> m a
return (FMatra
0, ([Note Group (Note sollu)]
pre, [Note Group (Note sollu)]
post [Note Group (Note sollu)]
-> [Note Group (Note sollu)] -> [Note Group (Note sollu)]
forall a. Semigroup a => a -> a -> a
<> [Note Group (Note sollu)]
ns))
            Note Group (Note sollu)
_ -> Error
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
forall a b. a -> Either a b
Left (Error
 -> Either
      Error
      (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)])))
-> Error
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
forall a b. (a -> b) -> a -> b
$ Error
"can't split a note: " Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> FMatra -> Error
forall a. Pretty a => a -> Error
pretty FMatra
matras
                Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Error
" of " Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> FMatra -> Error
forall a. Pretty a => a -> Error
pretty FMatra
noteMatras Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Error
": " Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Note Group (Note sollu) -> Error
forall a. Pretty a => a -> Error
pretty Note Group (Note sollu)
n
        where
        noteMatras :: FMatra
noteMatras = Tempo -> SequenceT sollu -> FMatra
forall a. HasMatras a => Tempo -> Sequence Group a -> FMatra
Solkattu.matrasOf Tempo
tempo (Note Group (Note sollu) -> SequenceT sollu
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 FMatra -> FMatra -> Bool
forall a. Ord a => a -> a -> Bool
<= FMatra
0
            then (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
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 [Note Group (Note sollu)]
-> [Note Group (Note sollu)] -> [Note Group (Note sollu)]
forall a. [a] -> [a] -> [a]
++ [Note Group (Note sollu)]
remaining))
            else (([Note Group (Note sollu)], [Note Group (Note sollu)])
 -> ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([Note Group (Note sollu)] -> [Note Group (Note sollu)])
-> ([Note Group (Note sollu)], [Note Group (Note sollu)])
-> ([Note Group (Note sollu)], [Note Group (Note sollu)])
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 ++)) ((FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
 -> (FMatra,
     ([Note Group (Note sollu)], [Note Group (Note sollu)])))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
-> Either
     Error
     (FMatra, ([Note Group (Note sollu)], [Note Group (Note sollu)]))
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
        [Note g (Note sollu)] -> Either Error [Note g (Note sollu)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Note g (Note sollu)] -> Either Error [Note g (Note sollu)])
-> [Note g (Note sollu)] -> Either Error [Note g (Note sollu)]
forall a b. (a -> b) -> a -> b
$ Sequence g (Note sollu) -> [Note g (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList (Sequence g (Note sollu) -> [Note g (Note sollu)])
-> Sequence g (Note sollu) -> [Note g (Note sollu)]
forall a b. (a -> b) -> a -> b
$ (Matra -> Sequence g (Note sollu))
-> [Matra] -> Sequence g (Note sollu)
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap Matra -> Sequence g (Note sollu)
forall {g} {sollu}. Matra -> Sequence g (Note sollu)
make [Matra]
speeds
        where
        make :: Matra -> Sequence g (Note sollu)
make Matra
s = Matra -> Sequence g (Note sollu) -> Sequence g (Note sollu)
forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed (Matra
s Matra -> Matra -> Matra
forall a. Num a => a -> a -> a
- Tempo -> Matra
S._speed Tempo
tempo) (Sequence g (Note sollu) -> Sequence g (Note sollu))
-> Sequence g (Note sollu) -> Sequence g (Note sollu)
forall a b. (a -> b) -> a -> b
$
            Note g (Note sollu) -> Sequence g (Note sollu)
forall g a. Note g a -> Sequence g a
S.singleton (Note g (Note sollu) -> Sequence g (Note sollu))
-> Note g (Note sollu) -> Sequence g (Note sollu)
forall a b. (a -> b) -> a -> b
$ Note sollu -> Note g (Note sollu)
forall g a. a -> Note g a
S.Note (Space -> Note sollu
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 = FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
takeM (SequenceT sollu -> FMatra
forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
seq FMatra -> FMatra -> FMatra
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 = (SequenceT sollu, SequenceT sollu) -> SequenceT sollu
forall a b. (a, b) -> a
fst ((SequenceT sollu, SequenceT sollu) -> SequenceT sollu)
-> (SequenceT sollu, SequenceT sollu) -> SequenceT sollu
forall a b. (a -> b) -> a -> b
$ FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> (SequenceT sollu, SequenceT sollu)
splitM_ (SequenceT sollu -> FMatra
forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
seq FMatra -> FMatra -> FMatra
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 = FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM (SequenceT sollu -> FMatra
forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
seq FMatra -> FMatra -> FMatra
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 = (Matra -> SequenceT sollu) -> [Matra] -> SequenceT sollu
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap Matra -> SequenceT sollu
forall {g} {sollu}. Matra -> Sequence g (Note sollu)
make ([Matra] -> SequenceT sollu) -> [Matra] -> SequenceT sollu
forall a b. (a -> b) -> a -> b
$ Either Error [Matra] -> [Matra]
forall a. Stack => Either Error a -> a
Solkattu.check (Either Error [Matra] -> [Matra])
-> Either Error [Matra] -> [Matra]
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 = Matra -> Sequence g (Note sollu) -> Sequence g (Note sollu)
forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed Matra
s (Sequence g (Note sollu) -> Sequence g (Note sollu))
-> Sequence g (Note sollu) -> Sequence g (Note sollu)
forall a b. (a -> b) -> a -> b
$ Note g (Note sollu) -> Sequence g (Note sollu)
forall g a. Note g a -> Sequence g a
S.singleton (Note g (Note sollu) -> Sequence g (Note sollu))
-> Note g (Note sollu) -> Sequence g (Note sollu)
forall a b. (a -> b) -> a -> b
$ Note sollu -> Note g (Note sollu)
forall g a. a -> Note g a
S.Note (Space -> Note sollu
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 = Space -> Tempo -> Duration -> SequenceT sollu
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 =
    (Matra -> SequenceT sollu) -> [Matra] -> SequenceT sollu
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap Matra -> SequenceT sollu
forall {g} {sollu}. Matra -> Sequence g (Note sollu)
make ([Matra] -> SequenceT sollu) -> [Matra] -> SequenceT sollu
forall a b. (a -> b) -> a -> b
$ Either Error [Matra] -> [Matra]
forall a. Stack => Either Error a -> a
Solkattu.check (Either Error [Matra] -> [Matra])
-> Either Error [Matra] -> [Matra]
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 = Matra -> Sequence g (Note sollu) -> Sequence g (Note sollu)
forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed (Matra
s Matra -> Matra -> Matra
forall a. Num a => a -> a -> a
- Tempo -> Matra
S._speed Tempo
tempo) (Sequence g (Note sollu) -> Sequence g (Note sollu))
-> Sequence g (Note sollu) -> Sequence g (Note sollu)
forall a b. (a -> b) -> a -> b
$
        Note g (Note sollu) -> Sequence g (Note sollu)
forall g a. Note g a -> Sequence g a
S.singleton (Note g (Note sollu) -> Sequence g (Note sollu))
-> Note g (Note sollu) -> Sequence g (Note sollu)
forall a b. (a -> b) -> a -> b
$ Note sollu -> Note g (Note sollu)
forall g a. a -> Note g a
S.Note (Space -> Note sollu
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 Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Matra -> Duration
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 = FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM (FMatra -> SequenceT sollu -> SequenceT sollu)
-> (Duration -> FMatra)
-> Duration
-> SequenceT sollu
-> SequenceT sollu
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 = FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
rdropM (FMatra -> SequenceT sollu -> SequenceT sollu)
-> (Duration -> FMatra)
-> Duration
-> SequenceT sollu
-> SequenceT sollu
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 = FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
takeM (FMatra -> SequenceT sollu -> SequenceT sollu)
-> (Duration -> FMatra)
-> Duration
-> SequenceT sollu
-> SequenceT sollu
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 = FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
rtakeM (FMatra -> SequenceT sollu -> SequenceT sollu)
-> (Duration -> FMatra)
-> Duration
-> SequenceT sollu
-> SequenceT sollu
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 = FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM_ (SequenceT sollu -> FMatra
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 = SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall sollu. SequenceT sollu -> SequenceT sollu -> SequenceT sollu
tri_ SequenceT sollu
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 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
a SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> Tag -> SequenceT sollu -> SequenceT sollu
forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
trySetTag Tag
mid SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
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 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
a SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
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 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
aSequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<>SequenceT sollu
a SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
aSequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<>SequenceT sollu
aSequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall 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 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
b SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> Tag -> SequenceT sollu -> SequenceT sollu
forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
trySetTag Tag
mid SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
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 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
ab SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> Tag -> SequenceT sollu -> SequenceT sollu
forall sollu. Tag -> SequenceT sollu -> SequenceT sollu
trySetTag Tag
mid SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> 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 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep1 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
seq SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep2 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
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 = [a] -> a
forall a. Monoid a => [a] -> a
mconcat (Matra -> a -> [a]
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 = Matra -> a -> a
forall a. Monoid a => Matra -> a -> a
repeat Matra
2
r3 :: forall a. Monoid a => a -> a
r3 = Matra -> a -> a
forall a. Monoid a => Matra -> a -> a
repeat Matra
3
r4 :: forall a. Monoid a => a -> a
r4 = Matra -> a -> a
forall a. Monoid a => Matra -> a -> a
repeat Matra
4
r5 :: forall a. Monoid a => a -> a
r5 = Matra -> a -> a
forall a. Monoid a => Matra -> a -> a
repeat Matra
5
r6 :: forall a. Monoid a => a -> a
r6 = Matra -> a -> a
forall a. Monoid a => Matra -> a -> a
repeat Matra
6
r7 :: forall a. Monoid a => a -> a
r7 = Matra -> a -> a
forall a. Monoid a => Matra -> a -> a
repeat Matra
7
r8 :: forall a. Monoid a => a -> a
r8 = Matra -> a -> a
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 = [Note Group (Note sollu)] -> SequenceT sollu
forall {g} {a}. [Note g a] -> Sequence g a
S.fromList ([Note Group (Note sollu)] -> SequenceT sollu)
-> ([SequenceT sollu] -> [Note Group (Note sollu)])
-> [SequenceT sollu]
-> SequenceT sollu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Note Group (Note sollu)]
-> [[Note Group (Note sollu)]] -> [Note Group (Note sollu)]
forall a. [a] -> [[a]] -> [a]
List.intercalate (SequenceT sollu -> [Note Group (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
sep) ([[Note Group (Note sollu)]] -> [Note Group (Note sollu)])
-> ([SequenceT sollu] -> [[Note Group (Note sollu)]])
-> [SequenceT sollu]
-> [Note Group (Note sollu)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SequenceT sollu -> [Note Group (Note sollu)])
-> [SequenceT sollu] -> [[Note Group (Note sollu)]]
forall a b. (a -> b) -> [a] -> [b]
map SequenceT sollu -> [Note Group (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList

-- | Intersperse between each stroke.
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 ([Note Group (Note sollu)] -> SequenceT sollu)
-> (SequenceT sollu -> [Note Group (Note sollu)])
-> SequenceT sollu
-> SequenceT sollu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SequenceT sollu -> [Note Group (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList
    where
    go :: [Note Group (Note sollu)] -> SequenceT sollu
go [] = SequenceT sollu
forall a. Monoid a => a
mempty
    go (Note Group (Note sollu)
x:[Note Group (Note sollu)]
xs) = Note Group (Note sollu) -> SequenceT sollu
forall g a. Note g a -> Sequence g a
S.singleton Note Group (Note sollu)
x SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> SequenceT sollu
sep SequenceT sollu -> SequenceT sollu -> SequenceT sollu
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 = SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall sollu. SequenceT sollu -> SequenceT sollu -> SequenceT sollu
inter (Matra -> SequenceT sollu
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 = (a -> b) -> [a] -> b
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap

for :: [a] -> (a -> b) -> [b]
for :: forall a b. [a] -> (a -> b) -> [b]
for = ((a -> b) -> [a] -> [b]) -> [a] -> (a -> b) -> [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> [a] -> [b]
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 = (a -> b) -> [a] -> b
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 = (a -> a) -> [a] -> a
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (a -> a -> a
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 = (a -> a) -> [a] -> a
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 = (a -> a) -> [a] -> a
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (\a
m -> a
prefix a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
m a -> a -> a
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 = [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
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 = [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
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 = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matra -> [[a]] -> [[a]]
forall a. Matra -> [a] -> [a]
drop Matra
1 ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
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 = SequenceT sollu -> [SequenceT sollu] -> SequenceT sollu
forall sollu.
SequenceT sollu -> [SequenceT sollu] -> SequenceT sollu
join SequenceT sollu
sep ([SequenceT sollu] -> SequenceT sollu)
-> (SequenceT sollu -> [SequenceT sollu])
-> SequenceT sollu
-> SequenceT sollu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matra -> [SequenceT sollu] -> [SequenceT sollu]
forall a. Matra -> [a] -> [a]
take Matra
3 ([SequenceT sollu] -> [SequenceT sollu])
-> (SequenceT sollu -> [SequenceT sollu])
-> SequenceT sollu
-> [SequenceT sollu]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMatra -> FMatra -> SequenceT sollu -> [SequenceT sollu]
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 = SequenceT sollu -> [SequenceT sollu] -> SequenceT sollu
forall sollu.
SequenceT sollu -> [SequenceT sollu] -> SequenceT sollu
join SequenceT sollu
sep [FMatra -> SequenceT sollu -> SequenceT sollu
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 = [SequenceT sollu] -> SequenceT sollu
forall a. Monoid a => [a] -> a
mconcat ([SequenceT sollu] -> SequenceT sollu)
-> (SequenceT sollu -> [SequenceT sollu])
-> SequenceT sollu
-> SequenceT sollu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMatra -> FMatra -> SequenceT sollu -> [SequenceT sollu]
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 = [FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM FMatra
m SequenceT sollu
seq | FMatra
m <- FMatra -> FMatra -> FMatra -> [FMatra]
forall a. (Num a, Ord a) => a -> a -> a -> [a]
Seq.range FMatra
0 (FMatra
matras FMatra -> FMatra -> FMatra
forall a. Num a => a -> a -> a
- FMatra
to) FMatra
by]
    where matras :: FMatra
matras = SequenceT sollu -> FMatra
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 = [FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
takeM FMatra
m SequenceT sollu
seq | FMatra
m <- FMatra -> FMatra -> FMatra -> [FMatra]
forall a. (Num a, Ord a) => a -> a -> a -> [a]
Seq.range FMatra
matras FMatra
to (-FMatra
by)]
    where matras :: FMatra
matras = SequenceT sollu -> FMatra
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 = [SequenceT sollu] -> [SequenceT sollu]
forall a. [a] -> [a]
reverse ([SequenceT sollu] -> [SequenceT sollu])
-> (SequenceT sollu -> [SequenceT sollu])
-> SequenceT sollu
-> [SequenceT sollu]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matra -> [SequenceT sollu] -> [SequenceT sollu]
forall a. Matra -> [a] -> [a]
take Matra
times ([SequenceT sollu] -> [SequenceT sollu])
-> (SequenceT sollu -> [SequenceT sollu])
-> SequenceT sollu
-> [SequenceT sollu]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMatra -> FMatra -> SequenceT sollu -> [SequenceT sollu]
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 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall a. Semigroup a => a -> a -> a
<> FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
dropM_ (SequenceT sollu -> FMatra
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 = FMatra -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
FMatra -> SequenceT sollu -> SequenceT sollu
rdropM_ (SequenceT sollu -> FMatra
forall sollu. SequenceT sollu -> FMatra
matrasOf SequenceT sollu
suffix) SequenceT sollu
seq SequenceT sollu -> SequenceT sollu -> SequenceT sollu
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 SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
`replaceStart` Duration -> SequenceT sollu
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 = Duration -> SequenceT sollu
forall sollu. Stack => Duration -> SequenceT sollu
sarvaD_ Duration
dur SequenceT sollu -> SequenceT sollu -> SequenceT sollu
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 = Tempo -> Sequence Group (Note sollu) -> FMatra
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 FMatra -> FMatra -> Bool
forall a. Eq a => a -> a -> Bool
== FMatra
0 = Matra
matras
    | Bool
otherwise = Error -> Matra
forall a. Stack => Error -> a
throw (Error -> Matra) -> Error -> Matra
forall a b. (a -> b) -> a -> b
$ Error
"non-integral matras: " Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> FMatra -> Error
forall a. Pretty a => a -> Error
pretty FMatra
fmatras
    where
    (Matra
matras, FMatra
frac) = FMatra -> (Matra, FMatra)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction FMatra
fmatras
    fmatras :: FMatra
fmatras = SequenceT sollu -> FMatra
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 = Duration -> FMatra
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Duration -> FMatra) -> Duration -> FMatra
forall a b. (a -> b) -> a -> b
$ Duration
d Duration -> Duration -> Duration
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 Duration -> Duration -> Bool
forall a. Eq a => a -> a -> Bool
== Duration
0 = Matra
matra
    | Bool
otherwise = Error -> Matra
forall a. Stack => Error -> a
throw (Error -> Matra) -> Error -> Matra
forall a b. (a -> b) -> a -> b
$ Error
"duration not divisible by nadai: " Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Duration -> Error
forall a. Pretty a => a -> Error
pretty Duration
dur
    where
    (Matra
matra, Duration
frac) = Duration -> (Matra, Duration)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Duration -> (Matra, Duration)) -> Duration -> (Matra, Duration)
forall a b. (a -> b) -> a -> b
$ Duration
dur Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Matra -> Duration
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
    | Sequence g sollu -> Bool
forall g a. Sequence g a -> Bool
S.null Sequence g sollu
seq Bool -> Bool -> Bool
|| Matra
change Matra -> Matra -> Bool
forall a. Eq a => a -> a -> Bool
== Matra
0 = Sequence g sollu
seq
    | Bool
otherwise = Note g sollu -> Sequence g sollu
forall g a. Note g a -> Sequence g a
S.singleton (Note g sollu -> Sequence g sollu)
-> Note g sollu -> Sequence g sollu
forall a b. (a -> b) -> a -> b
$
        TempoChange -> [Note g sollu] -> Note g sollu
forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange (Matra -> TempoChange
S.ChangeSpeed Matra
change) (Sequence g sollu -> [Note g sollu]
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 = Matra -> Sequence g sollu -> Sequence g sollu
forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed Matra
1
sd :: forall g sollu. Sequence g sollu -> Sequence g sollu
sd = Matra -> Sequence g sollu -> Sequence g sollu
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 = Matra -> Sequence g sollu -> Sequence g sollu
forall g sollu. Matra -> Sequence g sollu -> Sequence g sollu
speed Matra
2
sd2 :: forall g sollu. Sequence g sollu -> Sequence g sollu
sd2 = Matra -> Sequence g sollu -> Sequence g sollu
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
    | Sequence g sollu -> Bool
forall g a. Sequence g a -> Bool
S.null Sequence g sollu
seq = Sequence g sollu
forall a. Monoid a => a
mempty
    | Bool
otherwise = Note g sollu -> Sequence g sollu
forall g a. Note g a -> Sequence g a
S.singleton (Note g sollu -> Sequence g sollu)
-> Note g sollu -> Sequence g sollu
forall a b. (a -> b) -> a -> b
$ TempoChange -> [Note g sollu] -> Note g sollu
forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange (Matra -> TempoChange
S.Nadai Matra
n) (Sequence g sollu -> [Note g sollu]
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
    | Sequence g sollu -> Bool
forall g a. Sequence g a -> Bool
S.null Sequence g sollu
seq = Sequence g sollu
forall a. Monoid a => a
mempty
    | Bool
otherwise = Note g sollu -> Sequence g sollu
forall g a. Note g a -> Sequence g a
S.singleton (Note g sollu -> Sequence g sollu)
-> Note g sollu -> Sequence g sollu
forall a b. (a -> b) -> a -> b
$ TempoChange -> [Note g sollu] -> Note g sollu
forall g a. TempoChange -> [Note g a] -> Note g a
S.TempoChange (Matra -> TempoChange
S.Stride Matra
n) (Sequence g sollu -> [Note g sollu]
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 = Meta -> SequenceT sollu -> SequenceT sollu
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 = SequenceT sollu -> SequenceT sollu
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 = Meta -> SequenceT sollu -> SequenceT sollu
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 = Note Group (Note sollu) -> Sequence Group (Note sollu)
forall g a. Note g a -> Sequence g a
S.singleton (Note Group (Note sollu) -> Sequence Group (Note sollu))
-> (Sequence Group (Note sollu) -> Note Group (Note sollu))
-> Sequence Group (Note sollu)
-> Sequence Group (Note sollu)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group -> [Note Group (Note sollu)] -> Note Group (Note sollu)
forall g a. g -> [Note g a] -> Note g a
S.Group Group
group ([Note Group (Note sollu)] -> Note Group (Note sollu))
-> (Sequence Group (Note sollu) -> [Note Group (Note sollu)])
-> Sequence Group (Note sollu)
-> Note Group (Note sollu)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence Group (Note sollu) -> [Note Group (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList
    where
    group :: Group
group = Reduction -> Group
Solkattu.GReduction (Reduction -> Group) -> Reduction -> Group
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 = GroupType -> Error -> SequenceT sollu -> SequenceT sollu
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 =
    Meta -> SequenceT sollu -> SequenceT sollu
forall sollu. Meta -> SequenceT sollu -> SequenceT sollu
_groupWith (Meta -> SequenceT sollu -> SequenceT sollu)
-> Meta -> SequenceT sollu -> SequenceT sollu
forall a b. (a -> b) -> a -> b
$ (GroupType -> Meta
Solkattu.meta GroupType
gtype) { _name :: Maybe Error
Solkattu._name = Error -> Maybe Error
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 = Meta -> SequenceT sollu -> SequenceT sollu
forall sollu. Meta -> SequenceT sollu -> SequenceT sollu
_groupWith (Meta -> SequenceT sollu -> SequenceT sollu)
-> Meta -> SequenceT sollu -> SequenceT sollu
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 = Note Group (Note sollu) -> Sequence Group (Note sollu)
forall g a. Note g a -> Sequence g a
S.singleton (Note Group (Note sollu) -> Sequence Group (Note sollu))
-> (Sequence Group (Note sollu) -> Note Group (Note sollu))
-> Sequence Group (Note sollu)
-> Sequence Group (Note sollu)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group -> [Note Group (Note sollu)] -> Note Group (Note sollu)
forall g a. g -> [Note g a] -> Note g a
S.Group (Meta -> Group
Solkattu.GMeta Meta
meta) ([Note Group (Note sollu)] -> Note Group (Note sollu))
-> (Sequence Group (Note sollu) -> [Note Group (Note sollu)])
-> Sequence Group (Note sollu)
-> Note Group (Note sollu)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence Group (Note sollu) -> [Note Group (Note sollu)]
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
(^) = 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 = (Note sollu -> Note sollu)
-> Sequence Group (Note sollu) -> Sequence Group (Note sollu)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Note sollu -> Note sollu)
 -> Sequence Group (Note sollu) -> Sequence Group (Note sollu))
-> (Note sollu -> Note sollu)
-> Sequence Group (Note sollu)
-> Sequence Group (Note sollu)
forall a b. (a -> b) -> a -> b
$ (NoteT sollu -> NoteT sollu) -> Note sollu -> Note sollu
forall a b. (NoteT a -> NoteT b) -> Note a -> Note b
Solkattu.modifyNote ((NoteT sollu -> NoteT sollu) -> Note sollu -> Note sollu)
-> (NoteT sollu -> NoteT sollu) -> Note sollu -> Note sollu
forall a b. (a -> b) -> a -> b
$
    \NoteT sollu
note -> NoteT sollu
note { _tag :: Maybe Tag
Solkattu._tag = Tag -> Maybe 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 = (Note sollu -> Note sollu)
-> Sequence Group (Note sollu) -> Sequence Group (Note sollu)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Note sollu -> Note sollu)
 -> Sequence Group (Note sollu) -> Sequence Group (Note sollu))
-> (Note sollu -> Note sollu)
-> Sequence Group (Note sollu)
-> Sequence Group (Note sollu)
forall a b. (a -> b) -> a -> b
$ (NoteT sollu -> NoteT sollu) -> Note sollu -> Note sollu
forall a b. (NoteT a -> NoteT b) -> Note a -> Note b
Solkattu.modifyNote ((NoteT sollu -> NoteT sollu) -> Note sollu -> Note sollu)
-> (NoteT sollu -> NoteT sollu) -> Note sollu -> Note sollu
forall a b. (a -> b) -> a -> b
$
    \NoteT sollu
note -> if NoteT sollu -> Maybe Tag
forall sollu. NoteT sollu -> Maybe Tag
Solkattu._tag NoteT sollu
note Maybe Tag -> Maybe Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Tag
forall a. Maybe a
Nothing
        then NoteT sollu
note { _tag :: Maybe Tag
Solkattu._tag = Tag -> Maybe 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 = Duration -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
__a (Tala -> SequenceT sollu -> Duration
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 = Matra -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Matra -> Duration) -> Matra -> Duration
forall a b. (a -> b) -> a -> b
$ Matra -> Duration -> Matra
forall factor a. (Integral factor, Real a) => factor -> a -> factor
Num.roundUp Matra
aksharas Duration
dur
    where
    dur :: Duration
dur = Tempo -> SequenceT sollu -> Duration
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 = SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
replaceEnd (Duration -> SequenceT sollu
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 = Duration -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
Duration -> SequenceT sollu -> SequenceT sollu
sarvaA_ (Tala -> SequenceT sollu -> Duration
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 = SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> SequenceT sollu -> SequenceT sollu
replaceEnd (SequenceT sollu -> Duration -> SequenceT sollu
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_ = SequenceT sollu -> Duration -> SequenceT sollu -> SequenceT sollu
forall sollu.
(Stack, Pretty sollu) =>
SequenceT sollu -> Duration -> SequenceT sollu -> SequenceT sollu
sarvaA SequenceT sollu
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 = Matra -> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
forall sollu.
Matra -> SequenceT sollu -> SequenceT sollu -> SequenceT sollu
appendEach Matra
2 SequenceT sollu
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 = (Matra -> Note sollu -> (Matra, [Note Group (Note sollu)]))
-> Matra -> SequenceT sollu -> SequenceT sollu
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
perMatra -> Matra -> Matra
forall 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 Matra -> Matra -> Bool
forall a. Ord a => a -> a -> Bool
<= Matra
0 = (Matra
perMatra -> Matra -> Matra
forall a. Num a => a -> a -> a
-Matra
1, Note sollu -> Note Group (Note sollu)
forall g a. a -> Note g a
S.Note Note sollu
n Note Group (Note sollu)
-> [Note Group (Note sollu)] -> [Note Group (Note sollu)]
forall a. a -> [a] -> [a]
: SequenceT sollu -> [Note Group (Note sollu)]
forall g a. Sequence g a -> [Note g a]
S.toList SequenceT sollu
sep)
        | Bool
otherwise = (Matra
atMatra -> Matra -> Matra
forall a. Num a => a -> a -> a
-Matra
1, [Note sollu -> Note Group (Note sollu)
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 = [Note g a] -> Sequence g a
forall {g} {a}. [Note g a] -> Sequence g a
S.fromList ([Note g a] -> Sequence g a)
-> (Sequence g a -> [Note g a]) -> Sequence g a -> Sequence g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. state -> [Note g a] -> [Note g a]
go state
state ([Note g a] -> [Note g a])
-> (Sequence g a -> [Note g a]) -> Sequence g a -> [Note g a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence g a -> [Note g a]
forall g a. Sequence g a -> [Note g a]
S.toList
    where
    go :: state -> [Note g a] -> [Note g a]
go state
state = \case
        [S.TempoChange TempoChange
change [Note g a]
ns] -> [TempoChange -> [Note g a] -> Note g a
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] -> [g -> [Note g a] -> Note g a
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 -> (state, [Note g a]) -> [Note g a]
forall a b. (a, b) -> b
snd ((state, [Note g a]) -> [Note g a])
-> (state, [Note g a]) -> [Note g a]
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 [Note g a] -> Maybe [Either (g, [Note g a]) [a]]
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 -> Error -> (state, [Note g a])
forall a. Stack => Error -> a
throw Error
"can't transform multiple tempo changes"
        Just [Either (g, [Note g a]) [a]]
groups -> ([[Note g a]] -> [Note g a])
-> (state, [[Note g a]]) -> (state, [Note g a])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [[Note g a]] -> [Note g a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((state, [[Note g a]]) -> (state, [Note g a]))
-> (state, [[Note g a]]) -> (state, [Note g a])
forall a b. (a -> b) -> a -> b
$ (state -> Either (g, [Note g a]) [a] -> (state, [Note g a]))
-> state -> [Either (g, [Note g a]) [a]] -> (state, [[Note g a]])
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) = [[Note g a]] -> [Note g a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Note g a]] -> [Note g a])
-> (state, [[Note g a]]) -> (state, [Note g a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (state -> a -> (state, [Note g a]))
-> state -> [a] -> (state, [[Note g a]])
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)) =
        (Note g a -> [Note g a] -> [Note g a]
forall a. a -> [a] -> [a]
:[]) (Note g a -> [Note g a])
-> ([Note g a] -> Note g a) -> [Note g a] -> [Note g a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> [Note g a] -> Note g a
forall g a. g -> [Note g a] -> Note g a
S.Group g
g ([Note g a] -> [Note g a])
-> (state, [Note g a]) -> (state, [Note g a])
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 [] = [Either (g, [Note g a]) [a]] -> Maybe [Either (g, [Note g a]) [a]]
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 -> ((g, [Note g a]) -> Either (g, [Note g a]) [a]
forall a b. a -> Either a b
Left (g
g, [Note g a]
ns) :) ([Either (g, [Note g a]) [a]] -> [Either (g, [Note g a]) [a]])
-> Maybe [Either (g, [Note g a]) [a]]
-> Maybe [Either (g, [Note g a]) [a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Note g a] -> Maybe [Either (g, [Note g a]) [a]]
forall g a. [Note g a] -> Maybe [Either (g, [Note g a]) [a]]
byGroup [Note g a]
ns
    S.TempoChange {} -> Maybe [Either (g, [Note g a]) [a]]
forall a. Maybe a
Nothing
    S.Note a
n -> ([a] -> Either (g, [Note g a]) [a]
forall a b. b -> Either a b
Right (a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
notes) :) ([Either (g, [Note g a]) [a]] -> [Either (g, [Note g a]) [a]])
-> Maybe [Either (g, [Note g a]) [a]]
-> Maybe [Either (g, [Note g a]) [a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Note g a] -> Maybe [Either (g, [Note g a]) [a]]
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) = (Note g a -> Maybe a) -> [Note g a] -> ([a], [Note g a])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
Seq.span_while Note g a -> Maybe a
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) = a -> Maybe a
forall a. a -> Maybe a
Just a
n
    noteOf Note g a
_ = Maybe a
forall a. Maybe a
Nothing