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

module Derive.C.Post.Map (library) where
import qualified Derive.Args as Args
import qualified Derive.Call.Module as Module
import qualified Derive.Call.Post as Post
import qualified Derive.Call.Tags as Tags
import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Eval as Eval
import qualified Derive.LEvent as LEvent
import qualified Derive.Library as Library
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
import qualified Derive.Sig as Sig
import qualified Derive.Stream as Stream

import           Global


library :: Library.Library
library :: Library
library = forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
Library.transformers
    [ (Symbol
"mapc", Transformer Note
c_mapc)
    ]

c_mapc :: Derive.Transformer Derive.Note
c_mapc :: Transformer Note
c_mapc = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
Module.prelude CallName
"mapc" Tags
Tags.postproc
    Doc
"Apply a signal transformer to the pitch or control signals of each event."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d)
Sig.callt ((,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => ArgName -> Doc -> Parser a
Sig.required ArgName
"control" Doc
"Apply to this control. Pitch signals start\
        \ with `#`."
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Typecheck a => ArgName -> Doc -> Parser a
Sig.required ArgName
"transformer" Doc
"Transformer to apply."
    ) forall a b. (a -> b) -> a -> b
$ \(Either Control PControl
control, Quoted
transformer) PassedArgs Note
args Deriver (Stream Note)
deriver -> do
        let mapper :: Note -> Deriver [Note]
mapper = case Either Control PControl
control of
                Left Control
control -> Context Control -> Control -> Quoted -> Note -> Deriver [Note]
map_control
                    (forall a b. Context a -> Context b
Derive.coerce_context (forall a. PassedArgs a -> Context a
Args.context PassedArgs Note
args)) Control
control
                    Quoted
transformer
                Right PControl
pcontrol -> Context Pitch -> PControl -> Quoted -> Note -> Deriver [Note]
map_pcontrol
                    (forall a b. Context a -> Context b
Derive.coerce_context (forall a. PassedArgs a -> Context a
Args.context PassedArgs Note
args)) PControl
pcontrol
                    Quoted
transformer
        forall a b.
(a -> Note) -> (a -> Deriver [b]) -> Stream a -> Deriver (Stream b)
Post.emap_m_ forall a. a -> a
id Note -> Deriver [Note]
mapper forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Deriver (Stream Note)
deriver

map_control :: Derive.Context Derive.Control -> ScoreT.Control
    -> DeriveT.Quoted -> Score.Event -> Derive.Deriver [Score.Event]
map_control :: Context Control -> Control -> Quoted -> Note -> Deriver [Note]
map_control Context Control
ctx Control
control Quoted
transformer Note
event = do
    let ScoreT.Typed Type
typ Control
sig = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
            Control -> Note -> Maybe (Typed Control)
Score.event_control Control
control Note
event
    Control
sig <- (forall (m :: * -> *) a. LogMonad m => (a, [Msg]) -> m a
LEvent.write_snd =<<) forall a b. (a -> b) -> a -> b
$ forall sig.
Monoid sig =>
Deriver (Stream sig) -> Deriver (sig, [Msg])
Post.derive_signal forall a b. (a -> b) -> a -> b
$
        forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> Quoted -> Deriver (Stream d) -> Deriver (Stream d)
Eval.eval_quoted_transformers Context Control
ctx Quoted
transformer forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Stream a
Stream.from_event Control
sig
    forall (m :: * -> *) a. Monad m => a -> m a
return [Control -> Typed Control -> Note -> Note
Score.set_control Control
control (forall a. Type -> a -> Typed a
ScoreT.Typed Type
typ Control
sig) Note
event]

map_pcontrol :: Derive.Context Derive.Pitch -> ScoreT.PControl
    -> DeriveT.Quoted -> Score.Event -> Derive.Deriver [Score.Event]
map_pcontrol :: Context Pitch -> PControl -> Quoted -> Note -> Deriver [Note]
map_pcontrol Context Pitch
ctx PControl
control Quoted
transformer Note
event = do
    let sig :: Pitch
sig = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ PControl -> Note -> Maybe Pitch
Score.event_named_pitch PControl
control Note
event
    Pitch
sig <- (forall (m :: * -> *) a. LogMonad m => (a, [Msg]) -> m a
LEvent.write_snd =<<) forall a b. (a -> b) -> a -> b
$ forall sig.
Monoid sig =>
Deriver (Stream sig) -> Deriver (sig, [Msg])
Post.derive_signal forall a b. (a -> b) -> a -> b
$
        forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> Quoted -> Deriver (Stream d) -> Deriver (Stream d)
Eval.eval_quoted_transformers Context Pitch
ctx Quoted
transformer forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Stream a
Stream.from_event Pitch
sig
    forall (m :: * -> *) a. Monad m => a -> m a
return [PControl -> Pitch -> Note -> Note
Score.set_named_pitch PControl
control Pitch
sig Note
event]