-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE FlexibleContexts #-}
-- | This is like "Derive.Call", but higher level.  It has templates for
-- creating calls.
module Derive.Call.Make where
import qualified Util.Doc as Doc
import qualified Util.Texts as Texts
import qualified Derive.Attrs as Attrs
import qualified Derive.Call as Call
import qualified Derive.Call.Module as Module
import qualified Derive.Call.Post as Post
import qualified Derive.Call.Sub as Sub
import qualified Derive.Call.Tags as Tags
import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Env as Env
import qualified Derive.Flags as Flags
import qualified Derive.Library as Library
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal
import qualified Derive.Sig as Sig
import qualified Derive.Typecheck as Typecheck

import qualified Perform.Signal as Signal


-- | This is a specialization of 'transform_notes' that adds Attributes.
attributed_note :: Module.Module -> Attrs.Attributes
    -> Library.Calls Derive.Note
attributed_note :: Module -> Attributes -> Calls Event
attributed_note Module
module_ Attributes
attrs = Module
-> CallName
-> Tags
-> Doc
-> Parser ()
-> (() -> NoteDeriver -> NoteDeriver)
-> Calls Event
forall a.
Module
-> CallName
-> Tags
-> Doc
-> Parser a
-> (a -> NoteDeriver -> NoteDeriver)
-> Calls Event
transform_notes Module
module_
    (Text -> CallName
Derive.CallName (Text -> CallName) -> Text -> CallName
forall a b. (a -> b) -> a -> b
$ Text
"note with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Attributes -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Attributes
attrs) Tags
Tags.attr
    Doc
"Add attributes to the notes." Parser ()
Sig.no_args
    (\() -> Attributes -> NoteDeriver -> NoteDeriver
forall d. Attributes -> Deriver d -> Deriver d
Call.add_attributes Attributes
attrs)

-- | This is a specialization of 'transform_notes' that sets an environ value.
environ_note :: Typecheck.ToVal a => Module.Module -> Derive.CallName
    -> Tags.Tags -> Doc.Doc -> Env.Key -> a -> Library.Calls Derive.Note
environ_note :: forall a.
ToVal a =>
Module -> CallName -> Tags -> Doc -> Text -> a -> Calls Event
environ_note Module
module_ CallName
name Tags
tags Doc
doc Text
key a
val =
    Module
-> CallName
-> Tags
-> Doc
-> Parser ()
-> (() -> NoteDeriver -> NoteDeriver)
-> Calls Event
forall a.
Module
-> CallName
-> Tags
-> Doc
-> Parser a
-> (a -> NoteDeriver -> NoteDeriver)
-> Calls Event
transform_notes Module
module_ CallName
name Tags
tags Doc
doc Parser ()
Sig.no_args ((() -> NoteDeriver -> NoteDeriver) -> Calls Event)
-> (() -> NoteDeriver -> NoteDeriver) -> Calls Event
forall a b. (a -> b) -> a -> b
$
        \() -> Text -> a -> NoteDeriver -> NoteDeriver
forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
key a
val

-- | This is a specialization of 'transform_notes' that sets a control.
control_note :: Module.Module -> Derive.CallName -> ScoreT.Control -> Signal.Y
    -> Library.Calls Derive.Note
control_note :: Module -> CallName -> Control -> Y -> Calls Event
control_note Module
module_ CallName
name Control
control Y
val = Module
-> CallName
-> Tags
-> Doc
-> Parser ()
-> (() -> NoteDeriver -> NoteDeriver)
-> Calls Event
forall a.
Module
-> CallName
-> Tags
-> Doc
-> Parser a
-> (a -> NoteDeriver -> NoteDeriver)
-> Calls Event
transform_notes Module
module_ CallName
name Tags
forall a. Monoid a => a
mempty
    (Doc
"Note with " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
Doc.literal (Control -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Control
control Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Y -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Y
val) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
".")
    Parser ()
Sig.no_args ((() -> NoteDeriver -> NoteDeriver) -> Calls Event)
-> (() -> NoteDeriver -> NoteDeriver) -> Calls Event
forall a b. (a -> b) -> a -> b
$ \() -> Control -> Y -> NoteDeriver -> NoteDeriver
forall a. Control -> Y -> Deriver a -> Deriver a
Derive.with_constant_control Control
control Y
val

-- | 'transform_notes_args' without the PassedArgs.
transform_notes :: Module.Module -> Derive.CallName -> Tags.Tags -> Doc.Doc
    -> Sig.Parser a -> (a -> Derive.NoteDeriver -> Derive.NoteDeriver)
    -> Library.Calls Derive.Note
transform_notes :: forall a.
Module
-> CallName
-> Tags
-> Doc
-> Parser a
-> (a -> NoteDeriver -> NoteDeriver)
-> Calls Event
transform_notes Module
module_ CallName
name Tags
tags Doc
transform_doc Parser a
sig a -> NoteDeriver -> NoteDeriver
transform =
    Module
-> CallName
-> Tags
-> Doc
-> Parser a
-> (a -> PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> Calls Event
forall a.
Module
-> CallName
-> Tags
-> Doc
-> Parser a
-> (a -> PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> Calls Event
transform_notes_args Module
module_ CallName
name Tags
tags Doc
transform_doc Parser a
sig
        (\a
params PassedArgs Event
_args NoteDeriver
deriver -> a -> NoteDeriver -> NoteDeriver
transform a
params NoteDeriver
deriver)

-- | The generator either derives subs or derives a new Call.note if there are
-- no subs, and then applies the transform.  The transformer call just applies
-- the transform.
transform_notes_args :: Module.Module -> Derive.CallName -> Tags.Tags
    -> Doc.Doc -> Sig.Parser a
    -> (a -> Derive.PassedArgs Score.Event -> Derive.NoteDeriver
        -> Derive.NoteDeriver)
    -> Library.Calls Derive.Note
transform_notes_args :: forall a.
Module
-> CallName
-> Tags
-> Doc
-> Parser a
-> (a -> PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> Calls Event
transform_notes_args Module
module_ CallName
name Tags
tags Doc
transform_doc Parser a
sig a -> PassedArgs Event -> NoteDeriver -> NoteDeriver
transform =
    Generator Event -> Transformer Event -> Calls Event
forall d. Generator d -> Transformer d -> Calls d
Library.Calls Generator Event
generator Transformer Event
transformer
    where
    generator :: Generator Event
generator = Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF Event)
-> Generator Event
forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
module_ CallName
name (Tags
tags Tags -> Tags -> Tags
forall a. Semigroup a => a -> a -> a
<> Tags
Tags.subs)
        (Doc
transform_doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\n" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
generator_doc) (WithArgDoc (GeneratorF Event) -> Generator Event)
-> WithArgDoc (GeneratorF Event) -> Generator Event
forall a b. (a -> b) -> a -> b
$
        Parser a
-> (a -> GeneratorF Event) -> WithArgDoc (GeneratorF Event)
forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call Parser a
sig ((a -> GeneratorF Event) -> WithArgDoc (GeneratorF Event))
-> (a -> GeneratorF Event) -> WithArgDoc (GeneratorF Event)
forall a b. (a -> b) -> a -> b
$ \a
params PassedArgs Event
args -> PassedArgs Event -> Deriver [[Event]]
forall d. PassedArgs d -> Deriver [[Event]]
Sub.sub_events PassedArgs Event
args Deriver [[Event]] -> ([[Event]] -> NoteDeriver) -> NoteDeriver
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            [] -> a -> PassedArgs Event -> NoteDeriver -> NoteDeriver
transform a
params PassedArgs Event
args (NoteDeriver -> NoteDeriver) -> NoteDeriver -> NoteDeriver
forall a b. (a -> b) -> a -> b
$ GeneratorF Event -> GeneratorF Event
forall d.
(PassedArgs d -> NoteDeriver) -> PassedArgs d -> NoteDeriver
Sub.inverting GeneratorF Event
forall d. PassedArgs d -> NoteDeriver
Call.placed_note PassedArgs Event
args
            [[Event]]
subs -> [NoteDeriver] -> NoteDeriver
forall a. Monoid a => [a] -> a
mconcat ([NoteDeriver] -> NoteDeriver) -> [NoteDeriver] -> NoteDeriver
forall a b. (a -> b) -> a -> b
$ ([Event] -> NoteDeriver) -> [[Event]] -> [NoteDeriver]
forall a b. (a -> b) -> [a] -> [b]
map (a -> PassedArgs Event -> NoteDeriver -> NoteDeriver
transform a
params PassedArgs Event
args (NoteDeriver -> NoteDeriver)
-> ([Event] -> NoteDeriver) -> [Event] -> NoteDeriver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> NoteDeriver
Sub.derive) [[Event]]
subs
    generator_doc :: Doc
generator_doc = Doc
"If there are notes in child tracks, apply the\
        \ transformation to them. Otherwise apply the transformation to the\
        \ null note call."
    transformer :: Transformer Event
transformer = Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> Transformer Event
forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
module_ CallName
name Tags
tags Doc
transform_doc (WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
 -> Transformer Event)
-> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> Transformer Event
forall a b. (a -> b) -> a -> b
$
        Parser a
-> (a -> PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
forall y a d.
Taggable y =>
Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d)
Sig.callt Parser a
sig ((a -> PassedArgs Event -> NoteDeriver -> NoteDeriver)
 -> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver))
-> (a -> PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
forall a b. (a -> b) -> a -> b
$ \a
params PassedArgs Event
args NoteDeriver
deriver -> a -> PassedArgs Event -> NoteDeriver -> NoteDeriver
transform a
params PassedArgs Event
args NoteDeriver
deriver

-- | Create a transformer that just sets an environ value.  This is higher
-- level and more concise than using the @=@ transformer.
environ :: (Typecheck.ToVal val, Derive.Taggable d) =>
    Module.Module -> Env.Key -> Doc.Doc -> Sig.Parser a
    -> (a -> val) -> Derive.Transformer d
environ :: forall val d a.
(ToVal val, Taggable d) =>
Module -> Text -> Doc -> Parser a -> (a -> val) -> Transformer d
environ Module
module_ Text
key Doc
key_doc Parser a
sig a -> val
extract =
    Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
module_ (Text -> CallName
Derive.CallName Text
key) Tags
forall a. Monoid a => a
mempty
        (Doc
"Set the " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
key_doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" environ variable.")
    (WithArgDoc (TransformerF d) -> Transformer d)
-> WithArgDoc (TransformerF d) -> Transformer d
forall a b. (a -> b) -> a -> b
$ Parser a -> (a -> TransformerF d) -> WithArgDoc (TransformerF d)
forall y a d.
Taggable y =>
Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d)
Sig.callt Parser a
sig ((a -> TransformerF d) -> WithArgDoc (TransformerF d))
-> (a -> TransformerF d) -> WithArgDoc (TransformerF d)
forall a b. (a -> b) -> a -> b
$ \a
val PassedArgs d
_args ->
        Text -> val -> Deriver (Stream d) -> Deriver (Stream d)
forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
key (a -> val
extract a
val)

-- | Make a call that sets an environ key to a specific value.
environ_val :: (ShowVal.ShowVal a, Typecheck.ToVal a, Derive.Taggable d) =>
    Module.Module -> Derive.CallName -> Env.Key -> a -> Doc.Doc
    -> Derive.Transformer d
environ_val :: forall a d.
(ShowVal a, ToVal a, Taggable d) =>
Module -> CallName -> Text -> a -> Doc -> Transformer d
environ_val Module
module_ CallName
name Text
key a
val Doc
extra_doc =
    Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
module_ CallName
name Tags
forall a. Monoid a => a
mempty (Doc -> Doc -> Doc
forall a. Textlike a => a -> a -> a
Texts.unwords2 Doc
doc Doc
extra_doc) (WithArgDoc (TransformerF d) -> Transformer d)
-> WithArgDoc (TransformerF d) -> Transformer d
forall a b. (a -> b) -> a -> b
$
        TransformerF d -> WithArgDoc (TransformerF d)
forall y d.
Taggable y =>
Transformer y d -> WithArgDoc (Transformer y d)
Sig.call0t (TransformerF d -> WithArgDoc (TransformerF d))
-> TransformerF d -> WithArgDoc (TransformerF d)
forall a b. (a -> b) -> a -> b
$ \PassedArgs d
_args -> Text -> a -> Deriver (Stream d) -> Deriver (Stream d)
forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
key a
val
    where
    doc :: Doc
doc = Text -> Doc
Doc.literal (Text -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val a
val)
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"."

-- | Make a call that adds a flag.
add_flag :: Module.Module -> Derive.CallName -> Doc.Doc -> Flags.Flags
    -> Derive.Transformer Score.Event
add_flag :: Module -> CallName -> Doc -> Flags -> Transformer Event
add_flag Module
module_ CallName
name Doc
doc Flags
flags =
    Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> Transformer Event
forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
module_ CallName
name Tags
Tags.postproc Doc
doc (WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
 -> Transformer Event)
-> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> Transformer Event
forall a b. (a -> b) -> a -> b
$
    (PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
forall y d.
Taggable y =>
Transformer y d -> WithArgDoc (Transformer y d)
Sig.call0t ((PassedArgs Event -> NoteDeriver -> NoteDeriver)
 -> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver))
-> (PassedArgs Event -> NoteDeriver -> NoteDeriver)
-> WithArgDoc (PassedArgs Event -> NoteDeriver -> NoteDeriver)
forall a b. (a -> b) -> a -> b
$ \PassedArgs Event
_args -> (Stream Event -> Stream Event) -> NoteDeriver -> NoteDeriver
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Stream Event -> Stream Event) -> NoteDeriver -> NoteDeriver)
-> (Stream Event -> Stream Event) -> NoteDeriver -> NoteDeriver
forall a b. (a -> b) -> a -> b
$ (Event -> Event) -> Stream Event -> Stream Event
forall a b. (a -> b) -> Stream a -> Stream b
Post.emap1_ ((Event -> Event) -> Stream Event -> Stream Event)
-> (Event -> Event) -> Stream Event -> Stream Event
forall a b. (a -> b) -> a -> b
$ Flags -> Event -> Event
Score.add_flags Flags
flags

-- * modify

-- | Make a modified version of an existing call.  Args are the same.
modify_generator :: Module.Module -> Derive.CallName -> Doc.Doc
    -> Derive.TransformerF a -> Derive.Generator a -> Derive.Generator a
modify_generator :: forall a.
Module
-> CallName -> Doc -> TransformerF a -> Generator a -> Generator a
modify_generator Module
module_ CallName
name Doc
doc TransformerF a
transform =
    Module
-> CallName
-> Doc
-> (GeneratorFunc a -> GeneratorFunc a)
-> Call (GeneratorFunc a)
-> Call (GeneratorFunc a)
forall a b.
Module -> CallName -> Doc -> (a -> b) -> Call a -> Call b
modify_call Module
module_ CallName
name Doc
doc ((GeneratorFunc a -> GeneratorFunc a)
 -> Call (GeneratorFunc a) -> Call (GeneratorFunc a))
-> (GeneratorFunc a -> GeneratorFunc a)
-> Call (GeneratorFunc a)
-> Call (GeneratorFunc a)
forall a b. (a -> b) -> a -> b
$ \GeneratorFunc a
gfunc -> GeneratorFunc a
gfunc
        { gfunc_f :: GeneratorF a
Derive.gfunc_f = \PassedArgs a
args -> TransformerF a
transform PassedArgs a
args (GeneratorFunc a -> GeneratorF a
forall d. GeneratorFunc d -> GeneratorF d
Derive.gfunc_f GeneratorFunc a
gfunc PassedArgs a
args)
        }

-- | Like 'modify_generator', but inherit metadata from the original call.
modify_generator_ :: Doc.Doc
    -> Derive.TransformerF a -> Derive.Generator a -> Derive.Generator a
modify_generator_ :: forall a. Doc -> TransformerF a -> Generator a -> Generator a
modify_generator_ Doc
doc_prefix TransformerF a
transform Generator a
call =
    Module
-> CallName -> Doc -> TransformerF a -> Generator a -> Generator a
forall a.
Module
-> CallName -> Doc -> TransformerF a -> Generator a -> Generator a
modify_generator (CallDoc -> Module
Derive.cdoc_module CallDoc
cdoc) (Generator a -> CallName
forall func. Call func -> CallName
Derive.call_name Generator a
call)
        (Doc -> Doc -> Doc
forall a. Textlike a => a -> a -> a
Texts.unlines2 Doc
doc_prefix (CallDoc -> Doc
Derive.cdoc_doc CallDoc
cdoc))
        TransformerF a
transform Generator a
call
    where cdoc :: CallDoc
cdoc = Generator a -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Generator a
call

-- | Make a modified version of an existing call.  Args are the same.
modify_transformer :: Module.Module -> Derive.CallName -> Doc.Doc
    -> Derive.TransformerF a -> Derive.Transformer a -> Derive.Transformer a
modify_transformer :: forall a.
Module
-> CallName
-> Doc
-> TransformerF a
-> Transformer a
-> Transformer a
modify_transformer Module
module_ CallName
name Doc
doc TransformerF a
transform =
    Module
-> CallName
-> Doc
-> (TransformerF a -> TransformerF a)
-> Call (TransformerF a)
-> Call (TransformerF a)
forall a b.
Module -> CallName -> Doc -> (a -> b) -> Call a -> Call b
modify_call Module
module_ CallName
name Doc
doc ((TransformerF a -> TransformerF a)
 -> Call (TransformerF a) -> Call (TransformerF a))
-> (TransformerF a -> TransformerF a)
-> Call (TransformerF a)
-> Call (TransformerF a)
forall a b. (a -> b) -> a -> b
$ \TransformerF a
tfunc PassedArgs a
args -> TransformerF a
transform PassedArgs a
args (Deriver (Stream a) -> Deriver (Stream a))
-> (Deriver (Stream a) -> Deriver (Stream a))
-> Deriver (Stream a)
-> Deriver (Stream a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransformerF a
tfunc PassedArgs a
args

modify_transformer_ :: Doc.Doc
    -> Derive.TransformerF a -> Derive.Transformer a -> Derive.Transformer a
modify_transformer_ :: forall a. Doc -> TransformerF a -> Transformer a -> Transformer a
modify_transformer_ Doc
doc_prefix TransformerF a
transform Transformer a
call =
    Module
-> CallName
-> Doc
-> TransformerF a
-> Transformer a
-> Transformer a
forall a.
Module
-> CallName
-> Doc
-> TransformerF a
-> Transformer a
-> Transformer a
modify_transformer (CallDoc -> Module
Derive.cdoc_module CallDoc
cdoc) (Transformer a -> CallName
forall func. Call func -> CallName
Derive.call_name Transformer a
call)
        (Doc -> Doc -> Doc
forall a. Textlike a => a -> a -> a
Texts.unlines2 Doc
doc_prefix (CallDoc -> Doc
Derive.cdoc_doc CallDoc
cdoc))
        TransformerF a
transform Transformer a
call
    where cdoc :: CallDoc
cdoc = Transformer a -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Transformer a
call

-- | Modify a generator transformer pair, inheriting metadata.
modify_calls_ :: Doc.Doc
    -> Derive.TransformerF a
    -> Library.Calls a -> Library.Calls a
modify_calls_ :: forall a. Doc -> TransformerF a -> Calls a -> Calls a
modify_calls_ Doc
doc_prefix TransformerF a
transform (Library.Calls Generator a
gen Transformer a
trans) = Library.Calls
    { generator :: Generator a
generator = Doc -> TransformerF a -> Generator a -> Generator a
forall a. Doc -> TransformerF a -> Generator a -> Generator a
modify_generator_ Doc
doc_prefix TransformerF a
transform Generator a
gen
    , transformer :: Transformer a
transformer = Doc -> TransformerF a -> Transformer a -> Transformer a
forall a. Doc -> TransformerF a -> Transformer a -> Transformer a
modify_transformer_ Doc
doc_prefix TransformerF a
transform Transformer a
trans
    }

modify_call :: Module.Module -> Derive.CallName -> Doc.Doc
    -> (a -> b) -> Derive.Call a -> Derive.Call b
modify_call :: forall a b.
Module -> CallName -> Doc -> (a -> b) -> Call a -> Call b
modify_call Module
module_ CallName
name Doc
doc a -> b
modify Call a
call = Derive.Call
    { call_name :: CallName
call_name = CallName
name
    , call_doc :: CallDoc
call_doc = Derive.CallDoc
        { cdoc_tags :: Tags
cdoc_tags = CallDoc -> Tags
Derive.cdoc_tags (Call a -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Call a
call)
        , cdoc_module :: Module
cdoc_module = Module
module_
        , cdoc_doc :: Doc
cdoc_doc = Doc
doc
        , cdoc_args :: [ArgDoc]
cdoc_args = CallDoc -> [ArgDoc]
Derive.cdoc_args (Call a -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Call a
call)
        }
    , call_func :: b
call_func = a -> b
modify (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Call a -> a
forall func. Call func -> func
Derive.call_func Call a
call
    }

-- * val calls

constant_val :: (Typecheck.ToVal a, ShowVal.ShowVal a) =>
    Module.Module -> Derive.CallName -> Doc.Doc -> a -> Derive.ValCall
constant_val :: forall a.
(ToVal a, ShowVal a) =>
Module -> CallName -> Doc -> a -> ValCall
constant_val Module
module_ CallName
name Doc
doc a
val = Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (PassedArgs Tagged -> Deriver a)
-> ValCall
forall a.
ToVal a =>
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (PassedArgs Tagged -> Deriver a)
-> ValCall
Derive.val_call Module
module_  CallName
name Tags
forall a. Monoid a => a
mempty
    (Doc -> Doc -> Doc
forall a. Textlike a => a -> a -> a
Texts.unlines2 Doc
doc (Doc
"Constant: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. ShowVal a => a -> Doc
ShowVal.doc a
val)) (WithArgDoc (PassedArgs Tagged -> Deriver a) -> ValCall)
-> WithArgDoc (PassedArgs Tagged -> Deriver a) -> ValCall
forall a b. (a -> b) -> a -> b
$
    (PassedArgs Tagged -> Deriver a)
-> WithArgDoc (PassedArgs Tagged -> Deriver a)
forall y d.
Taggable y =>
Generator y d -> WithArgDoc (Generator y d)
Sig.call0 ((PassedArgs Tagged -> Deriver a)
 -> WithArgDoc (PassedArgs Tagged -> Deriver a))
-> (PassedArgs Tagged -> Deriver a)
-> WithArgDoc (PassedArgs Tagged -> Deriver a)
forall a b. (a -> b) -> a -> b
$ \PassedArgs Tagged
_args -> a -> Deriver a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val

-- | Make a new ValCall from an existing one, by mapping over its output.
modify_vcall :: Derive.ValCall -> Module.Module -> Derive.CallName -> Doc.Doc
    -> (DeriveT.Val -> DeriveT.Val) -> Derive.ValCall
modify_vcall :: ValCall -> Module -> CallName -> Doc -> (Val -> Val) -> ValCall
modify_vcall ValCall
vcall Module
module_ CallName
name Doc
doc Val -> Val
f = Derive.ValCall
    { vcall_name :: CallName
vcall_name = CallName
name
    , vcall_doc :: CallDoc
vcall_doc = Derive.CallDoc
        { cdoc_tags :: Tags
cdoc_tags = CallDoc -> Tags
Derive.cdoc_tags (ValCall -> CallDoc
Derive.vcall_doc ValCall
vcall)
        , cdoc_module :: Module
cdoc_module = Module
module_
        , cdoc_doc :: Doc
cdoc_doc = Doc
doc
        , cdoc_args :: [ArgDoc]
cdoc_args = CallDoc -> [ArgDoc]
Derive.cdoc_args (ValCall -> CallDoc
Derive.vcall_doc ValCall
vcall)
        }
    , vcall_call :: PassedArgs Tagged -> Deriver Val
vcall_call = (Val -> Val) -> Deriver Val -> Deriver Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Val -> Val
f (Deriver Val -> Deriver Val)
-> (PassedArgs Tagged -> Deriver Val)
-> PassedArgs Tagged
-> Deriver Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValCall -> PassedArgs Tagged -> Deriver Val
Derive.vcall_call ValCall
vcall
    }