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

-- | Functions to write performance postprocess functions.
module Solkattu.Technique where
import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import qualified Solkattu.Solkattu as Solkattu

import           Global


-- | A realized note with associated S.Meta.
type Flat stroke =
    S.Flat (Realize.Group (Realize.Stroke stroke)) (Realize.Note stroke)

-- | A Technique is a wrapper around postprocess to write functions which
-- modify strokes during a reduction.
--
-- TODO: it turns out this doesn't really happen very much, so far only the
-- [k]tk -> kk transformation seems common.  There are some other
-- transformations but they aren't universal.  Perhaps instead this should
-- be a per-Korvai thing.
type Technique stroke = [stroke] -- ^ Dropped strokes.  These are in original
    -- order, which means if you want to see the previous strokes, you have to
    -- use Lists.takeEnd.
    -> stroke -- ^ current
    -> [stroke] -- ^ next
    -> Maybe stroke -- ^ Nothing to not modify

postprocess :: Technique (Realize.Stroke stroke)
    -> [Flat stroke] -> [Flat stroke]
postprocess :: forall stroke.
Technique (Stroke stroke) -> [Flat stroke] -> [Flat stroke]
postprocess Technique (Stroke stroke)
technique = forall a b. (a -> b) -> [a] -> [b]
map Flat (Group (Stroke stroke)) (Note stroke)
-> Flat (Group (Stroke stroke)) (Note stroke)
process
    where
    -- TODO I just pick the innermost group, but maybe I should try for each
    -- nested group.
    process :: Flat (Group (Stroke stroke)) (Note stroke)
-> Flat (Group (Stroke stroke)) (Note stroke)
process (S.FGroup Tempo
gtempo Group (Stroke stroke)
meta [Flat (Group (Stroke stroke)) (Note stroke)]
children)
        | Just [Stroke stroke]
prevs <- forall {stroke}. Group stroke -> Maybe [stroke]
dropped Group (Stroke stroke)
meta, S.FNote Tempo
ntempo Note stroke
note : [Flat (Group (Stroke stroke)) (Note stroke)]
notes <- [Flat (Group (Stroke stroke)) (Note stroke)]
children
                , Just Note stroke
newNote <- forall {g}.
[Stroke stroke]
-> Note stroke -> [Flat g (Note stroke)] -> Maybe (Note stroke)
group [Stroke stroke]
prevs Note stroke
note [Flat (Group (Stroke stroke)) (Note stroke)]
notes =
            forall g a. Tempo -> g -> [Flat g a] -> Flat g a
S.FGroup Tempo
gtempo Group (Stroke stroke)
meta (forall g a. Tempo -> a -> Flat g a
S.FNote Tempo
ntempo Note stroke
newNote forall a. a -> [a] -> [a]
: [Flat (Group (Stroke stroke)) (Note stroke)]
notes)
        | Bool
otherwise = forall g a. Tempo -> g -> [Flat g a] -> Flat g a
S.FGroup Tempo
gtempo Group (Stroke stroke)
meta (forall a b. (a -> b) -> [a] -> [b]
map Flat (Group (Stroke stroke)) (Note stroke)
-> Flat (Group (Stroke stroke)) (Note stroke)
process [Flat (Group (Stroke stroke)) (Note stroke)]
children)
    process note :: Flat (Group (Stroke stroke)) (Note stroke)
note@(S.FNote {}) = Flat (Group (Stroke stroke)) (Note stroke)
note
    -- Only transform when we are dropping from the front of the group.
    dropped :: Group stroke -> Maybe [stroke]
dropped (Realize.GReduction (Realize.Reduction [stroke]
prevs Side
Solkattu.Before)) =
        forall a. a -> Maybe a
Just [stroke]
prevs
    dropped Group stroke
_ = forall a. Maybe a
Nothing
    group :: [Stroke stroke]
-> Note stroke -> [Flat g (Note stroke)] -> Maybe (Note stroke)
group [Stroke stroke]
prevs Note stroke
note [Flat g (Note stroke)]
notes = do
        Stroke stroke
stroke <- forall a. Note a -> Maybe (Stroke a)
Realize.noteOf Note stroke
note
        let nexts :: [Stroke stroke]
nexts = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Note a -> Maybe (Stroke a)
Realize.noteOf (forall g a. [Flat g a] -> [a]
S.flattenedNotes [Flat g (Note stroke)]
notes)
        forall stroke. Stroke stroke -> Note stroke
Realize.Note forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Technique (Stroke stroke)
technique [Stroke stroke]
prevs Stroke stroke
stroke [Stroke stroke]
nexts

-- | Techinque that ignores Realize.Stroke details.
plain :: Technique stroke -> Technique (Realize.Stroke stroke)
plain :: forall stroke. Technique stroke -> Technique (Stroke stroke)
plain Technique stroke
technique [Stroke stroke]
prevs Stroke stroke
cur [Stroke stroke]
nexts = do
    stroke
s <- Technique stroke
technique (forall a b. (a -> b) -> [a] -> [b]
map forall stroke. Stroke stroke -> stroke
Realize._stroke [Stroke stroke]
prevs) (forall stroke. Stroke stroke -> stroke
Realize._stroke Stroke stroke
cur)
        (forall a b. (a -> b) -> [a] -> [b]
map forall stroke. Stroke stroke -> stroke
Realize._stroke [Stroke stroke]
nexts)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Stroke stroke
cur { _stroke :: stroke
Realize._stroke = stroke
s }