-- Copyright 2014 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 RankNTypes #-}
-- | Evaluate tracklang expressions.
module Derive.Eval (
    -- * eval / apply
    eval_toplevel, eval_quoted, eval_quoted_normalized, eval_expr_val
    -- ** generator
    , apply_generator
    -- ** transformer
    , eval_transformers, eval_transform_expr
    , apply_transformer, apply_transformers
    , eval_quoted_transformers
    -- ** val calls
    , eval, apply
    , get_val_call

    -- * lookup call
    , get_generator, get_transformer, get_track_call
    , unknown_symbol, call_to_block_id, block_id_to_call
    -- ** relative calls
    , is_relative, make_relative, parse_relative_id

    -- * util
    , eval_one, eval_one_call, eval_one_at
    , eval_event, reapply_generator, reapply_generator_normalized
    , reapply, reapply_call, eval_pitch, eval_note, apply_pitch
    , eval_expr
) where
import qualified Data.Char as Char
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text

import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Deriver.Internal as Internal
import qualified Derive.Expr as Expr
import qualified Derive.PSignal as PSignal
import qualified Derive.Parse as Parse
import qualified Derive.ShowVal as ShowVal
import qualified Derive.Stream as Stream
import qualified Derive.Typecheck as Typecheck

import qualified Perform.Pitch as Pitch
import qualified Ui.Event as Event
import qualified Ui.Id as Id
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig

import           Global
import           Types


-- * eval / apply

-- | Apply a toplevel expression.
{-# SCC eval_toplevel #-}
eval_toplevel :: Derive.CallableExpr d => Derive.Context d
    -> DeriveT.Expr -> Derive.Deriver (Stream.Stream d)
eval_toplevel :: forall d. CallableExpr d => Context d -> Expr -> Deriver (Stream d)
eval_toplevel Context d
ctx Expr
expr =
    Context d -> [Call] -> Deriver (Stream d) -> Deriver (Stream d)
forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> [Call] -> Deriver (Stream d) -> Deriver (Stream d)
eval_transformers Context d
ctx [Call]
transform_calls (Context d -> Call -> Deriver (Stream d)
forall d.
(Callable (Generator d), Taggable d) =>
Context d -> Call -> Deriver (Stream d)
eval_generator Context d
ctx Call
generator_call)
    where ([Call]
transform_calls, Call
generator_call) = Expr -> ([Call], Call)
forall val. Expr val -> ([Call val], Call val)
Expr.split Expr
expr

eval_quoted :: Derive.CallableExpr d => Derive.Context d -> DeriveT.Quoted
    -> Derive.Deriver (Stream.Stream d)
eval_quoted :: forall d.
CallableExpr d =>
Context d -> Quoted -> Deriver (Stream d)
eval_quoted Context d
ctx (DeriveT.Quoted Expr
expr) = Context d -> Expr -> Deriver (Stream d)
forall d. CallableExpr d => Context d -> Expr -> Deriver (Stream d)
eval_toplevel Context d
ctx Expr
expr

-- | This is like 'eval_quoted', except that the 'Derive.ctx_event' is set to
-- (0, 1) normalized time.  This is important if you want to place the
-- resulting deriver.  Otherwise, you can use eval_quoted and the event's
-- position will fall through to the callee.
--
-- TODO this awkwardness is because events evaluate in track time, not in
-- normalized time.  Details in "Derive.EvalTrack".
eval_quoted_normalized :: Derive.CallableExpr d => Derive.Context d
    -> DeriveT.Quoted -> Derive.Deriver (Stream.Stream d)
eval_quoted_normalized :: forall d.
CallableExpr d =>
Context d -> Quoted -> Deriver (Stream d)
eval_quoted_normalized = Context d -> Quoted -> Deriver (Stream d)
forall d.
CallableExpr d =>
Context d -> Quoted -> Deriver (Stream d)
eval_quoted (Context d -> Quoted -> Deriver (Stream d))
-> (Context d -> Context d)
-> Context d
-> Quoted
-> Deriver (Stream d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context d -> Context d
forall val. Context val -> Context val
normalize_event

normalize_event :: Derive.Context val -> Derive.Context val
normalize_event :: forall val. Context val -> Context val
normalize_event Context val
ctx = Context val
ctx
    { ctx_event :: Event
Derive.ctx_event = ScoreTime -> ScoreTime -> Event -> Event
Event.place ScoreTime
0 ScoreTime
1 (Context val -> Event
forall val. Context val -> Event
Derive.ctx_event Context val
ctx)
    , ctx_prev_events :: [Event]
Derive.ctx_prev_events = []
    , ctx_next_events :: [Event]
Derive.ctx_next_events = []
    }

-- | Eval a Expr MiniVal, which is produced by 'Expr.ToExpr'.
eval_expr_val :: Derive.CallableExpr d => Derive.Context d
    -> Expr.Expr Expr.MiniVal -> Derive.Deriver (Stream.Stream d)
eval_expr_val :: forall d.
CallableExpr d =>
Context d -> Expr MiniVal -> Deriver (Stream d)
eval_expr_val Context d
ctx Expr MiniVal
expr = Context d -> Expr -> Deriver (Stream d)
forall d. CallableExpr d => Context d -> Expr -> Deriver (Stream d)
eval_toplevel Context d
ctx (Expr MiniVal -> Expr
convert_minival Expr MiniVal
expr)

-- TODO find a better place for this, or get rid of MiniVal
convert_minival :: Expr.Expr Expr.MiniVal -> DeriveT.Expr
convert_minival :: Expr MiniVal -> Expr
convert_minival = (Call MiniVal -> Call) -> Expr MiniVal -> Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Call MiniVal -> Call) -> Expr MiniVal -> Expr)
-> (Call MiniVal -> Call) -> Expr MiniVal -> Expr
forall a b. (a -> b) -> a -> b
$ (MiniVal -> Val) -> Call MiniVal -> Call
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MiniVal -> Val) -> Call MiniVal -> Call)
-> (MiniVal -> Val) -> Call MiniVal -> Call
forall a b. (a -> b) -> a -> b
$ \case
    Expr.VNum Typed Y
v -> Typed Y -> Val
DeriveT.VNum Typed Y
v
    Expr.VStr Str
v -> Str -> Val
DeriveT.VStr Str
v

-- ** generator

{-# SCC eval_generator #-}
eval_generator :: (Derive.Callable (Derive.Generator d), Derive.Taggable d)
    => Derive.Context d -> DeriveT.Call -> Derive.Deriver (Stream.Stream d)
eval_generator :: forall d.
(Callable (Generator d), Taggable d) =>
Context d -> Call -> Deriver (Stream d)
eval_generator Context d
ctx (Expr.Call Symbol
sym [Term Val]
args) = do
    [Val]
vals <- (Term Val -> Deriver State Error Val)
-> [Term Val] -> Deriver State Error [Val]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Context d -> Term Val -> Deriver State Error Val
forall a.
Taggable a =>
Context a -> Term Val -> Deriver State Error Val
eval Context d
ctx) [Term Val]
args
    Generator d
call <- Symbol -> Deriver (Generator d)
forall d. Callable (Generator d) => Symbol -> Deriver (Generator d)
get_generator Symbol
sym
    Context d -> Generator d -> [Val] -> Deriver (Stream d)
forall d. Context d -> Generator d -> [Val] -> Deriver (Stream d)
apply_generator Context d
ctx Generator d
call [Val]
vals

-- | Like 'eval_generator', but for when the args are already parsed and
-- evaluated.  This is useful when one generator wants to dispatch to another.
{-# SCC apply_generator #-}
apply_generator :: Derive.Context d -> Derive.Generator d -> [DeriveT.Val]
    -> Derive.Deriver (Stream.Stream d)
apply_generator :: forall d. Context d -> Generator d -> [Val] -> Deriver (Stream d)
apply_generator Context d
ctx Generator d
call [Val]
args = do
    let passed :: PassedArgs d
passed = Derive.PassedArgs
            { passed_vals :: [Val]
Derive.passed_vals = [Val]
args
            , passed_call_name :: CallName
Derive.passed_call_name = Generator d -> CallName
forall func. Call func -> CallName
Derive.call_name Generator d
call
            , passed_ctx :: Context d
Derive.passed_ctx = Context d
ctx
            }
    Mode
mode <- Deriver Mode
Derive.get_mode
    CallName -> Deriver (Stream d) -> Deriver (Stream d)
forall a. CallName -> Deriver a -> Deriver a
Internal.with_stack_call (Generator d -> CallName
forall func. Call func -> CallName
Derive.call_name Generator d
call) (Deriver (Stream d) -> Deriver (Stream d))
-> Deriver (Stream d) -> Deriver (Stream d)
forall a b. (a -> b) -> a -> b
$ case Mode
mode of
        Mode
Derive.ScoreDurationQuery -> do
            CallDuration ScoreTime
dur <- GeneratorFunc d -> PassedArgs d -> Deriver (CallDuration ScoreTime)
forall d.
GeneratorFunc d -> PassedArgs d -> Deriver (CallDuration ScoreTime)
Derive.gfunc_score_duration (Generator d -> GeneratorFunc d
forall func. Call func -> func
Derive.call_func Generator d
call) PassedArgs d
passed
            CallDuration ScoreTime -> Deriver ()
set_score_duration CallDuration ScoreTime
dur
            Stream d -> Deriver (Stream d)
forall (m :: * -> *) a. Monad m => a -> m a
return Stream d
forall a. Stream a
Stream.empty
        Mode
Derive.RealDurationQuery -> do
            CallDuration RealTime
dur <- GeneratorFunc d -> PassedArgs d -> Deriver (CallDuration RealTime)
forall d.
GeneratorFunc d -> PassedArgs d -> Deriver (CallDuration RealTime)
Derive.gfunc_real_duration (Generator d -> GeneratorFunc d
forall func. Call func -> func
Derive.call_func Generator d
call) PassedArgs d
passed
            CallDuration RealTime -> Deriver ()
set_real_duration CallDuration RealTime
dur
            Stream d -> Deriver (Stream d)
forall (m :: * -> *) a. Monad m => a -> m a
return Stream d
forall a. Stream a
Stream.empty
        Mode
_ -> do
            -- Ensure a unique serial number for each generator call, as
            -- documneted in 'Stack.Serial'.
            Serial
serial <- (State -> Serial) -> Deriver State Error Serial
forall st a err. (st -> a) -> Deriver st err a
Derive.gets ((State -> Serial) -> Deriver State Error Serial)
-> (State -> Serial) -> Deriver State Error Serial
forall a b. (a -> b) -> a -> b
$
                Threaded -> Serial
Derive.state_event_serial (Threaded -> Serial) -> (State -> Threaded) -> State -> Serial
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Threaded
Derive.state_threaded
            Serial -> Deriver (Stream d) -> Deriver (Stream d)
forall a. Serial -> Deriver a -> Deriver a
Internal.with_stack_serial Serial
serial (Deriver (Stream d) -> Deriver (Stream d))
-> Deriver (Stream d) -> Deriver (Stream d)
forall a b. (a -> b) -> a -> b
$
                GeneratorFunc d -> GeneratorF d
forall d. GeneratorFunc d -> GeneratorF d
Derive.gfunc_f (Generator d -> GeneratorFunc d
forall func. Call func -> func
Derive.call_func Generator d
call) PassedArgs d
passed

-- | See 'Derive.CallDuration' for details.
set_score_duration :: Derive.CallDuration ScoreTime -> Derive.Deriver ()
set_score_duration :: CallDuration ScoreTime -> Deriver ()
set_score_duration CallDuration ScoreTime
dur = (Collect -> Collect) -> Deriver ()
Internal.modify_collect ((Collect -> Collect) -> Deriver ())
-> (Collect -> Collect) -> Deriver ()
forall a b. (a -> b) -> a -> b
$ \Collect
collect ->
    Collect
collect { collect_score_duration :: CallDuration ScoreTime
Derive.collect_score_duration = CallDuration ScoreTime
dur }

set_real_duration :: Derive.CallDuration RealTime -> Derive.Deriver ()
set_real_duration :: CallDuration RealTime -> Deriver ()
set_real_duration CallDuration RealTime
dur = (Collect -> Collect) -> Deriver ()
Internal.modify_collect ((Collect -> Collect) -> Deriver ())
-> (Collect -> Collect) -> Deriver ()
forall a b. (a -> b) -> a -> b
$ \Collect
collect ->
    Collect
collect { collect_real_duration :: CallDuration RealTime
Derive.collect_real_duration = CallDuration RealTime
dur }

-- ** transformer

{-# SCC eval_transformers #-}
eval_transformers :: (Derive.Callable (Derive.Transformer d), Derive.Taggable d)
    => Derive.Context d -> [DeriveT.Call] -> Derive.Deriver (Stream.Stream d)
    -> Derive.Deriver (Stream.Stream d)
eval_transformers :: forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> [Call] -> Deriver (Stream d) -> Deriver (Stream d)
eval_transformers Context d
ctx [Call]
calls Deriver (Stream d)
deriver = [Call] -> Deriver (Stream d)
go [Call]
calls
    where
    go :: [Call] -> Deriver (Stream d)
go [] = Deriver (Stream d)
deriver
    go (Expr.Call Symbol
sym [Term Val]
args : [Call]
calls) = do
        [Val]
vals <- (Term Val -> Deriver State Error Val)
-> [Term Val] -> Deriver State Error [Val]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Context d -> Term Val -> Deriver State Error Val
forall a.
Taggable a =>
Context a -> Term Val -> Deriver State Error Val
eval Context d
ctx) [Term Val]
args
        Transformer d
call <- Symbol -> Deriver (Transformer d)
forall d.
Callable (Transformer d) =>
Symbol -> Deriver (Transformer d)
get_transformer Symbol
sym
        Context d
-> Transformer d
-> [Val]
-> Deriver (Stream d)
-> Deriver (Stream d)
forall d.
Context d
-> Transformer d
-> [Val]
-> Deriver (Stream d)
-> Deriver (Stream d)
apply_transformer Context d
ctx Transformer d
call [Val]
vals ([Call] -> Deriver (Stream d)
go [Call]
calls)

-- | Parse and apply a transformer expression.
eval_transform_expr ::
    (Derive.Callable (Derive.Transformer d), Derive.Taggable d)
    => Text -> Text -> Derive.Deriver (Stream.Stream d)
    -> Derive.Deriver (Stream.Stream d)
eval_transform_expr :: forall d.
(Callable (Transformer d), Taggable d) =>
Text -> Text -> Deriver (Stream d) -> Deriver (Stream d)
eval_transform_expr Text
name Text
expr_str Deriver (Stream d)
deriver
    | (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
Char.isSpace Text
expr_str = Deriver (Stream d)
deriver
    | Bool
otherwise = do
        Expr
expr <- case Text -> Either Text Expr
Parse.parse_expr Text
expr_str of
            Left Text
err -> Text -> Deriver State Error Expr
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver State Error Expr)
-> Text -> Deriver State Error Expr
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
            Right Expr
expr -> Expr -> Deriver State Error Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
expr
        let ctx :: Context a
ctx = ScoreTime -> ScoreTime -> Text -> Context a
forall a. ScoreTime -> ScoreTime -> Text -> Context a
Derive.dummy_context ScoreTime
0 ScoreTime
1 Text
name
        Context d -> [Call] -> Deriver (Stream d) -> Deriver (Stream d)
forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> [Call] -> Deriver (Stream d) -> Deriver (Stream d)
eval_transformers Context d
forall {a}. Context a
ctx (Expr -> [Call]
forall a. NonEmpty a -> [a]
NonEmpty.toList Expr
expr) Deriver (Stream d)
deriver

-- | The same as 'eval_transformers', but get them out of a Quoted.
eval_quoted_transformers ::
    (Derive.Callable (Derive.Transformer d), Derive.Taggable d)
    => Derive.Context d -> DeriveT.Quoted -> Derive.Deriver (Stream.Stream d)
    -> Derive.Deriver (Stream.Stream d)
eval_quoted_transformers :: forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> Quoted -> Deriver (Stream d) -> Deriver (Stream d)
eval_quoted_transformers Context d
ctx (DeriveT.Quoted Expr
expr) =
    Context d -> [Call] -> Deriver (Stream d) -> Deriver (Stream d)
forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> [Call] -> Deriver (Stream d) -> Deriver (Stream d)
eval_transformers Context d
ctx (Expr -> [Call]
forall a. NonEmpty a -> [a]
NonEmpty.toList Expr
expr)

-- | The transformer version of 'apply_generator'.  Like 'eval_transformers',
-- but apply only one, and apply to already evaluated 'DeriveT.Val's.  This
-- is useful when you want to re-apply an already parsed set of vals.
{-# SCC apply_transformer #-}
apply_transformer :: Derive.Context d -> Derive.Transformer d -> [DeriveT.Val]
    -> Derive.Deriver (Stream.Stream d) -> Derive.Deriver (Stream.Stream d)
apply_transformer :: forall d.
Context d
-> Transformer d
-> [Val]
-> Deriver (Stream d)
-> Deriver (Stream d)
apply_transformer Context d
ctx Transformer d
call [Val]
args Deriver (Stream d)
deriver =
    CallName -> Deriver (Stream d) -> Deriver (Stream d)
forall a. CallName -> Deriver a -> Deriver a
Internal.with_stack_call (Transformer d -> CallName
forall func. Call func -> CallName
Derive.call_name Transformer d
call) (Deriver (Stream d) -> Deriver (Stream d))
-> Deriver (Stream d) -> Deriver (Stream d)
forall a b. (a -> b) -> a -> b
$
        Transformer d
-> PassedArgs d -> Deriver (Stream d) -> Deriver (Stream d)
forall func. Call func -> func
Derive.call_func Transformer d
call PassedArgs d
passed Deriver (Stream d)
deriver
    where
    passed :: PassedArgs d
passed = Derive.PassedArgs
        { passed_vals :: [Val]
passed_vals = [Val]
args
        , passed_call_name :: CallName
passed_call_name = Transformer d -> CallName
forall func. Call func -> CallName
Derive.call_name Transformer d
call
        , passed_ctx :: Context d
passed_ctx = Context d
ctx
        }

-- | A list version of 'apply_transformer'.
apply_transformers :: Derive.Context d
    -> [(Derive.Transformer d, [DeriveT.Val])]
    -> Derive.Deriver (Stream.Stream d) -> Derive.Deriver (Stream.Stream d)
apply_transformers :: forall d.
Context d
-> [(Transformer d, [Val])]
-> Deriver (Stream d)
-> Deriver (Stream d)
apply_transformers Context d
ctx [(Transformer d, [Val])]
calls Deriver (Stream d)
deriver = ((Transformer d, [Val])
 -> Deriver (Stream d) -> Deriver (Stream d))
-> Deriver (Stream d)
-> [(Transformer d, [Val])]
-> Deriver (Stream d)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Transformer d, [Val]) -> Deriver (Stream d) -> Deriver (Stream d)
apply Deriver (Stream d)
deriver [(Transformer d, [Val])]
calls
    where apply :: (Transformer d, [Val]) -> Deriver (Stream d) -> Deriver (Stream d)
apply (Transformer d
sym, [Val]
args) = Context d
-> Transformer d
-> [Val]
-> Deriver (Stream d)
-> Deriver (Stream d)
forall d.
Context d
-> Transformer d
-> [Val]
-> Deriver (Stream d)
-> Deriver (Stream d)
apply_transformer Context d
ctx Transformer d
sym [Val]
args

-- ** val call

{-# SCC eval #-}
eval :: Derive.Taggable a => Derive.Context a -> DeriveT.Term
    -> Derive.Deriver DeriveT.Val
eval :: forall a.
Taggable a =>
Context a -> Term Val -> Deriver State Error Val
eval Context a
_ (Expr.Literal Val
val) = Val -> Deriver State Error Val
forall (m :: * -> *) a. Monad m => a -> m a
return Val
val
eval Context a
ctx (Expr.ValCall (Expr.Call Symbol
sym [Term Val]
terms)) = do
    ValCall
call <- Symbol -> Deriver ValCall
get_val_call Symbol
sym
    Context Tagged -> ValCall -> [Term Val] -> Deriver State Error Val
apply (Context a -> Context Tagged
forall a. Taggable a => Context a -> Context Tagged
Derive.tag_context Context a
ctx) ValCall
call [Term Val]
terms

{-# SCC apply #-}
apply :: Derive.Context Derive.Tagged -> Derive.ValCall
    -> [DeriveT.Term] -> Derive.Deriver DeriveT.Val
apply :: Context Tagged -> ValCall -> [Term Val] -> Deriver State Error Val
apply Context Tagged
ctx ValCall
call [Term Val]
args = do
    [Val]
vals <- (Term Val -> Deriver State Error Val)
-> [Term Val] -> Deriver State Error [Val]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Context Tagged -> Term Val -> Deriver State Error Val
forall a.
Taggable a =>
Context a -> Term Val -> Deriver State Error Val
eval Context Tagged
ctx) [Term Val]
args
    let passed :: PassedArgs Tagged
passed = Derive.PassedArgs
            { passed_vals :: [Val]
passed_vals = [Val]
vals
            , passed_call_name :: CallName
passed_call_name = ValCall -> CallName
Derive.vcall_name ValCall
call
            , passed_ctx :: Context Tagged
passed_ctx = Context Tagged
ctx
            }
    CallName -> Deriver State Error Val -> Deriver State Error Val
forall a. CallName -> Deriver a -> Deriver a
Internal.with_stack_call (ValCall -> CallName
Derive.vcall_name ValCall
call) (Deriver State Error Val -> Deriver State Error Val)
-> Deriver State Error Val -> Deriver State Error Val
forall a b. (a -> b) -> a -> b
$
        ValCall -> PassedArgs Tagged -> Deriver State Error Val
Derive.vcall_call ValCall
call PassedArgs Tagged
passed

-- * lookup call

get_val_call :: Expr.Symbol -> Derive.Deriver Derive.ValCall
get_val_call :: Symbol -> Deriver ValCall
get_val_call Symbol
sym = Bool -> Symbol -> Text -> Maybe ValCall -> Deriver ValCall
forall a. Bool -> Symbol -> Text -> Maybe a -> Deriver a
require_call Bool
False Symbol
sym Text
name (Maybe ValCall -> Deriver ValCall)
-> Deriver State Error (Maybe ValCall) -> Deriver ValCall
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Symbol -> Deriver State Error (Maybe ValCall)
forall call. Callable call => Symbol -> Deriver (Maybe call)
Derive.lookup_call Symbol
sym
    where name :: Text
name = Proxy ValCall -> Text
forall call. Callable call => Proxy call -> Text
Derive.callable_name (Proxy ValCall
forall {k} (t :: k). Proxy t
Proxy :: Proxy Derive.ValCall)

get_generator :: forall d. Derive.Callable (Derive.Generator d) =>
    Expr.Symbol -> Derive.Deriver (Derive.Generator d)
get_generator :: forall d. Callable (Generator d) => Symbol -> Deriver (Generator d)
get_generator Symbol
sym = Bool
-> Symbol -> Text -> Maybe (Generator d) -> Deriver (Generator d)
forall a. Bool -> Symbol -> Text -> Maybe a -> Deriver a
require_call Bool
True Symbol
sym Text
name (Maybe (Generator d) -> Deriver (Generator d))
-> Deriver State Error (Maybe (Generator d))
-> Deriver (Generator d)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Symbol -> Deriver State Error (Maybe (Generator d))
forall call. Callable call => Symbol -> Deriver (Maybe call)
Derive.lookup_call Symbol
sym
    where name :: Text
name = Proxy (Generator d) -> Text
forall call. Callable call => Proxy call -> Text
Derive.callable_name (Proxy (Generator d)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Derive.Generator d))

get_transformer :: forall d. Derive.Callable (Derive.Transformer d) =>
    Expr.Symbol -> Derive.Deriver (Derive.Transformer d)
get_transformer :: forall d.
Callable (Transformer d) =>
Symbol -> Deriver (Transformer d)
get_transformer Symbol
sym =
    Bool
-> Symbol
-> Text
-> Maybe (Transformer d)
-> Deriver (Transformer d)
forall a. Bool -> Symbol -> Text -> Maybe a -> Deriver a
require_call Bool
False Symbol
sym Text
name (Maybe (Transformer d) -> Deriver (Transformer d))
-> Deriver State Error (Maybe (Transformer d))
-> Deriver (Transformer d)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Symbol -> Deriver State Error (Maybe (Transformer d))
forall call. Callable call => Symbol -> Deriver (Maybe call)
Derive.lookup_call Symbol
sym
    where name :: Text
name = Proxy (Transformer d) -> Text
forall call. Callable call => Proxy call -> Text
Derive.callable_name (Proxy (Transformer d)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Derive.Transformer d))

get_track_call :: forall d. Derive.Callable (Derive.TrackCall d) =>
    Expr.Symbol -> Derive.Deriver (Derive.TrackCall d)
get_track_call :: forall d. Callable (TrackCall d) => Symbol -> Deriver (TrackCall d)
get_track_call Symbol
sym =
    Bool
-> Symbol -> Text -> Maybe (TrackCall d) -> Deriver (TrackCall d)
forall a. Bool -> Symbol -> Text -> Maybe a -> Deriver a
require_call Bool
False Symbol
sym Text
name (Maybe (TrackCall d) -> Deriver (TrackCall d))
-> Deriver State Error (Maybe (TrackCall d))
-> Deriver (TrackCall d)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Symbol -> Deriver State Error (Maybe (TrackCall d))
forall call. Callable call => Symbol -> Deriver (Maybe call)
Derive.lookup_call Symbol
sym
    where name :: Text
name = Proxy (TrackCall d) -> Text
forall call. Callable call => Proxy call -> Text
Derive.callable_name (Proxy (TrackCall d)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Derive.TrackCall d))

require_call :: Bool -> Expr.Symbol -> Text -> Maybe a -> Derive.Deriver a
require_call :: forall a. Bool -> Symbol -> Text -> Maybe a -> Deriver a
require_call Bool
_ Symbol
_ Text
_ (Just a
a) = a -> Deriver State Error a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
require_call Bool
is_generator Symbol
sym Text
name Maybe a
Nothing = do
    -- If the call wasn't found, it can be seen as a block call whose block
    -- doesn't exist yet.  If it is created later, I have to know that this
    -- block depends on it, otherwise it won't be rederived and hence won't
    -- realize that the bad call is now valid.
    Bool -> Deriver () -> Deriver ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
is_generator (Deriver () -> Deriver ()) -> Deriver () -> Deriver ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe BlockId
caller <- Deriver (Maybe BlockId)
Internal.lookup_current_block_id
        Namespace
ns <- (State -> Namespace) -> Deriver Namespace
forall a. (State -> a) -> Deriver a
Derive.get_ui_state ((State -> Namespace) -> Deriver Namespace)
-> (State -> Namespace) -> Deriver Namespace
forall a b. (a -> b) -> a -> b
$ Config -> Namespace
UiConfig.config_namespace (Config -> Namespace) -> (State -> Config) -> State -> Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Config
Ui.state_config
        Maybe BlockId -> (BlockId -> Deriver ()) -> Deriver ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Namespace -> Maybe BlockId -> Symbol -> Maybe BlockId
call_to_block_id Namespace
ns Maybe BlockId
caller Symbol
sym) BlockId -> Deriver ()
Internal.add_block_dep
    Text -> Deriver State Error a
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver State Error a) -> Text -> Deriver State Error a
forall a b. (a -> b) -> a -> b
$ Text -> Symbol -> Text
unknown_symbol Text
name Symbol
sym

unknown_symbol :: Text -> Expr.Symbol -> Text
unknown_symbol :: Text -> Symbol -> Text
unknown_symbol Text
name Symbol
sym = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Symbol -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Symbol
sym

-- | Given a Symbol, try to come up with the BlockId of the block it could be
-- a call for.
call_to_block_id :: Id.Namespace -> Maybe BlockId
    -- ^ If the symbol starts with -, this block is prepended to it.
    -> Expr.Symbol -> Maybe BlockId
call_to_block_id :: Namespace -> Maybe BlockId -> Symbol -> Maybe BlockId
call_to_block_id Namespace
ns Maybe BlockId
maybe_caller Symbol
sym
    | Symbol
sym Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
"" = Maybe BlockId
forall a. Maybe a
Nothing
    | Bool
otherwise = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just (BlockId -> Maybe BlockId) -> BlockId -> Maybe BlockId
forall a b. (a -> b) -> a -> b
$ Id -> BlockId
Id.BlockId (Id -> BlockId) -> Id -> BlockId
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Id
Id.read_short Namespace
ns Text
relative
    where
    relative :: Text
relative
        | Just BlockId
caller <- Maybe BlockId
maybe_caller, Symbol -> Bool
is_relative Symbol
sym =
            BlockId -> Text
forall a. Ident a => a -> Text
Id.ident_text BlockId
caller Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Symbol -> Text
Expr.unsym Symbol
sym
        | Bool
otherwise = Symbol -> Text
Expr.unsym Symbol
sym

-- | Create the symbol to call a given block.
block_id_to_call :: Bool -> BlockId -> BlockId -> Text
block_id_to_call :: Bool -> BlockId -> BlockId -> Text
block_id_to_call Bool
relative BlockId
parent BlockId
child
    | BlockId -> Namespace
forall a. Ident a => a -> Namespace
Id.ident_namespace BlockId
parent Namespace -> Namespace -> Bool
forall a. Eq a => a -> a -> Bool
/= BlockId -> Namespace
forall a. Ident a => a -> Namespace
Id.ident_namespace BlockId
child =
        Id -> Text
Id.show_id (BlockId -> Id
forall a. Ident a => a -> Id
Id.unpack_id BlockId
child)
    | Bool
relative, Just Text
suffix <- Text -> Text -> Maybe Text
Text.stripPrefix
            (Text
parent_name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
relative_separator) Text
child_name =
        Text
relative_separator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
    | Bool
otherwise = Text
child_name
    where
    child_name :: Text
child_name = BlockId -> Text
forall a. Ident a => a -> Text
Id.ident_name BlockId
child
    parent_name :: Text
parent_name = BlockId -> Text
forall a. Ident a => a -> Text
Id.ident_name BlockId
parent

-- | True if this is a relative block call.
is_relative :: Expr.Symbol -> Bool
is_relative :: Symbol -> Bool
is_relative = (Text
relative_separator `Text.isPrefixOf`) (Text -> Bool) -> (Symbol -> Text) -> Symbol -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Text
Expr.unsym

-- | Make a block name relative to a parent block.
make_relative :: BlockId -> Text -> Text
make_relative :: BlockId -> Text -> Text
make_relative BlockId
block_id Text
name =
    BlockId -> Text
forall a. Ident a => a -> Text
Id.ident_name BlockId
block_id Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
relative_separator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

-- | If it's a relative BlockId, return the parent and relative call.
parse_relative_id :: BlockId -> Maybe (BlockId, Id.Id)
parse_relative_id :: BlockId -> Maybe (BlockId, Id)
parse_relative_id BlockId
block_id
    | Text -> Bool
Text.null Text
post = Maybe (BlockId, Id)
forall a. Maybe a
Nothing
    | Bool
otherwise = (BlockId, Id) -> Maybe (BlockId, Id)
forall a. a -> Maybe a
Just
        ( Id -> BlockId
Id.BlockId (Id -> BlockId) -> Id -> BlockId
forall a b. (a -> b) -> a -> b
$ Text -> Id -> Id
Id.set_name Text
pre (BlockId -> Id
forall a. Ident a => a -> Id
Id.unpack_id BlockId
block_id)
        , Namespace -> Text -> Id
Id.id (BlockId -> Namespace
forall a. Ident a => a -> Namespace
Id.ident_namespace BlockId
block_id) (Serial -> Text -> Text
Text.drop Serial
1 Text
post)
        )
    where (Text
pre, Text
post) = Text -> Text -> (Text, Text)
Text.breakOn Text
relative_separator (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ BlockId -> Text
forall a. Ident a => a -> Text
Id.ident_name BlockId
block_id

relative_separator :: Text
relative_separator :: Text
relative_separator = Text
"-"

-- * util

-- | Evaluate a single note as a generator.  Fake up an event with no prev or
-- next lists.
eval_one :: Derive.CallableExpr d => Bool -> DeriveT.Expr
    -> Derive.Deriver (Stream.Stream d)
eval_one :: forall d. CallableExpr d => Bool -> Expr -> Deriver (Stream d)
eval_one Bool
collect = Bool -> ScoreTime -> ScoreTime -> Expr -> Deriver (Stream d)
forall d.
CallableExpr d =>
Bool -> ScoreTime -> ScoreTime -> Expr -> Deriver (Stream d)
eval_one_at Bool
collect ScoreTime
0 ScoreTime
1

eval_one_call :: Derive.CallableExpr d => Bool -> DeriveT.Call
    -> Derive.Deriver (Stream.Stream d)
eval_one_call :: forall d. CallableExpr d => Bool -> Call -> Deriver (Stream d)
eval_one_call Bool
collect = Bool -> Expr -> Deriver (Stream d)
forall d. CallableExpr d => Bool -> Expr -> Deriver (Stream d)
eval_one Bool
collect (Expr -> Deriver (Stream d))
-> (Call -> Expr) -> Call -> Deriver (Stream d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Call -> [Call] -> Expr
forall a. a -> [a] -> NonEmpty a
:| [])

eval_one_at :: Derive.CallableExpr d => Bool -> ScoreTime -> ScoreTime
    -> DeriveT.Expr -> Derive.Deriver (Stream.Stream d)
eval_one_at :: forall d.
CallableExpr d =>
Bool -> ScoreTime -> ScoreTime -> Expr -> Deriver (Stream d)
eval_one_at Bool
collect ScoreTime
start ScoreTime
dur Expr
expr = Bool -> Context d -> Expr -> Deriver (Stream d)
forall d.
CallableExpr d =>
Bool -> Context d -> Expr -> Deriver (Stream d)
eval_expr Bool
collect Context d
forall {a}. Context a
ctx Expr
expr
    where
    -- Set the event start and duration instead of using Derive.place since
    -- this way I can have zero duration events.
    ctx :: Context a
ctx = ScoreTime -> ScoreTime -> Text -> Context a
forall a. ScoreTime -> ScoreTime -> Text -> Context a
Derive.dummy_context ScoreTime
start ScoreTime
dur (Text -> Context a) -> Text -> Context a
forall a b. (a -> b) -> a -> b
$ Expr -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Expr
expr

-- | Like 'Derive.EvalTrack.derive_event' but evaluate the event outside of its
-- track context.  This is useful if you want to evaluate things out of order,
-- i.e. evaluate the /next/ pitch.
eval_event :: Derive.CallableExpr d => Event.Event
    -> Derive.Deriver (Either Text (Stream.Stream d))
eval_event :: forall d.
CallableExpr d =>
Event -> Deriver (Either Text (Stream d))
eval_event Event
event = case Text -> Either Text Expr
Parse.parse_expr (Event -> Text
Event.text Event
event) of
    Left Text
err -> Either Text (Stream d) -> Deriver (Either Text (Stream d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Stream d) -> Deriver (Either Text (Stream d)))
-> Either Text (Stream d) -> Deriver (Either Text (Stream d))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Stream d)
forall a b. a -> Either a b
Left Text
err
    Right Expr
expr -> Stream d -> Either Text (Stream d)
forall a b. b -> Either a b
Right (Stream d -> Either Text (Stream d))
-> Deriver State Error (Stream d)
-> Deriver (Either Text (Stream d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        -- TODO eval it separately to catch any exception?
        Bool
-> ScoreTime -> ScoreTime -> Expr -> Deriver State Error (Stream d)
forall d.
CallableExpr d =>
Bool -> ScoreTime -> ScoreTime -> Expr -> Deriver (Stream d)
eval_one_at Bool
False (Event -> ScoreTime
Event.start Event
event) (Event -> ScoreTime
Event.duration Event
event) Expr
expr

-- | Evaluate a generator, reusing the passed args but replacing the Symbol.
-- Generators can use this to delegate to other generators.
reapply_generator :: Derive.Callable (Derive.Generator d)
    => Derive.PassedArgs d -> Expr.Symbol -> Derive.Deriver (Stream.Stream d)
reapply_generator :: forall d.
Callable (Generator d) =>
PassedArgs d -> Symbol -> Deriver (Stream d)
reapply_generator PassedArgs d
args Symbol
sym = do
    let ctx :: Context d
ctx = PassedArgs d -> Context d
forall val. PassedArgs val -> Context val
Derive.passed_ctx PassedArgs d
args
    Generator d
call <- Symbol -> Deriver (Generator d)
forall d. Callable (Generator d) => Symbol -> Deriver (Generator d)
get_generator Symbol
sym
    Context d -> Generator d -> [Val] -> Deriver (Stream d)
forall d. Context d -> Generator d -> [Val] -> Deriver (Stream d)
apply_generator Context d
ctx Generator d
call (PassedArgs d -> [Val]
forall val. PassedArgs val -> [Val]
Derive.passed_vals PassedArgs d
args)

-- | Like 'reapply_generator', but the note is given normalized time, 0--1,
-- instead of inheriting the start and duration from the args.  This is
-- essential if you want to shift or stretch the note.
reapply_generator_normalized :: Derive.Callable (Derive.Generator d)
    => Derive.PassedArgs d -> Expr.Symbol -> Derive.Deriver (Stream.Stream d)
reapply_generator_normalized :: forall d.
Callable (Generator d) =>
PassedArgs d -> Symbol -> Deriver (Stream d)
reapply_generator_normalized PassedArgs d
args = PassedArgs d -> Symbol -> Deriver (Stream d)
forall d.
Callable (Generator d) =>
PassedArgs d -> Symbol -> Deriver (Stream d)
reapply_generator (PassedArgs d -> Symbol -> Deriver (Stream d))
-> PassedArgs d -> Symbol -> Deriver (Stream d)
forall a b. (a -> b) -> a -> b
$ PassedArgs d
args
    { passed_ctx :: Context d
Derive.passed_ctx = Context d
ctx
        { ctx_event :: Event
Derive.ctx_event = ScoreTime -> ScoreTime -> Event -> Event
Event.place ScoreTime
0 ScoreTime
1 (Context d -> Event
forall val. Context val -> Event
Derive.ctx_event Context d
ctx)
        , ctx_event_end :: ScoreTime
Derive.ctx_event_end = ScoreTime
1
        }
    }
    where ctx :: Context d
ctx = PassedArgs d -> Context d
forall val. PassedArgs val -> Context val
Derive.passed_ctx PassedArgs d
args

-- | Apply an expr with an explicit Context.  You can use this to reuse the
-- current call's Context, but be careful because it will also inherit the
-- 'Derive.ctx_sub_tracks', which means if inversion hasn't happened yet, which
-- may be what you want or may be surprising.  For instance, it will likely
-- override any pitch you try to set.
reapply :: Derive.CallableExpr d => Derive.Context d -> DeriveT.Expr
    -> Derive.Deriver (Stream.Stream d)
reapply :: forall d. CallableExpr d => Context d -> Expr -> Deriver (Stream d)
reapply = Bool -> Context d -> Expr -> Deriver (Stream d)
forall d.
CallableExpr d =>
Bool -> Context d -> Expr -> Deriver (Stream d)
eval_expr Bool
True

reapply_call :: Derive.CallableExpr d => Derive.Context d -> Expr.Symbol
    -> [DeriveT.Term] -> Derive.Deriver (Stream.Stream d)
reapply_call :: forall d.
CallableExpr d =>
Context d -> Symbol -> [Term Val] -> Deriver (Stream d)
reapply_call Context d
ctx Symbol
sym [Term Val]
call_args =
    Context d -> Expr -> Deriver (Stream d)
forall d. CallableExpr d => Context d -> Expr -> Deriver (Stream d)
reapply Context d
ctx (Call -> Expr
forall val. Call val -> Expr val
Expr.generator (Call -> Expr) -> Call -> Expr
forall a b. (a -> b) -> a -> b
$ Symbol -> [Term Val] -> Call
forall val. Symbol -> [Term val] -> Call val
Expr.Call Symbol
sym [Term Val]
call_args)

-- | A version of 'eval' specialized to evaluate pitch calls.  It's unknown if
-- this pitch has been transposed or not.
eval_pitch :: ScoreTime -> DeriveT.PitchCall
    -> Derive.Deriver (PSignal.RawPitch a)
eval_pitch :: forall a. ScoreTime -> Call -> Deriver (RawPitch a)
eval_pitch ScoreTime
pos Call
call = do
    Pitch
pitch <- Text -> ScoreTime -> Val -> Deriver Pitch
forall a. Typecheck a => Text -> ScoreTime -> Val -> Deriver a
Typecheck.typecheck (Text
"eval pitch " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Call -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Call
call) ScoreTime
pos
        (Val -> Deriver Pitch) -> Deriver State Error Val -> Deriver Pitch
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context Pitch -> Term Val -> Deriver State Error Val
forall a.
Taggable a =>
Context a -> Term Val -> Deriver State Error Val
eval Context Pitch
ctx (Call -> Term Val
forall val. Call val -> Term val
Expr.ValCall Call
call)
    RawPitch a -> Deriver (RawPitch a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawPitch a -> Deriver (RawPitch a))
-> RawPitch a -> Deriver (RawPitch a)
forall a b. (a -> b) -> a -> b
$ Pitch -> RawPitch a
forall a b. RawPitch a -> RawPitch b
PSignal.coerce (Pitch
pitch :: PSignal.Pitch)
    where
    ctx :: Derive.Context Derive.Pitch
    ctx :: Context Pitch
ctx = ScoreTime -> ScoreTime -> Text -> Context Pitch
forall a. ScoreTime -> ScoreTime -> Text -> Context a
Derive.dummy_context ScoreTime
pos ScoreTime
0 Text
"<eval_pitch>"

-- | Get a Pitch from in a given scale.  Like 'eval_pitch', it's unknown if
-- this pitch has been transposed or not.
eval_note :: Derive.Scale -> Pitch.Note -> Derive.Deriver (PSignal.RawPitch a)
eval_note :: forall a. Scale -> Note -> Deriver (RawPitch a)
eval_note Scale
scale Note
note = case Scale -> Note -> Maybe ValCall
Derive.scale_note_to_call Scale
scale Note
note of
    Maybe ValCall
Nothing -> Text -> Deriver (RawPitch a)
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver (RawPitch a)) -> Text -> Deriver (RawPitch a)
forall a b. (a -> b) -> a -> b
$ Scale -> Text
forall a. Pretty a => a -> Text
pretty Scale
scale Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has no note " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Note -> Text
forall a. Pretty a => a -> Text
pretty Note
note
    Just ValCall
vcall -> ScoreTime -> ValCall -> Deriver (RawPitch a)
forall a. ScoreTime -> ValCall -> Deriver (RawPitch a)
apply_pitch ScoreTime
0 ValCall
vcall

-- | This is like 'eval_pitch' when you already know the call, presumably
-- because you asked 'Derive.scale_note_to_call'.
apply_pitch :: ScoreTime -> Derive.ValCall
    -> Derive.Deriver (PSignal.RawPitch a)
apply_pitch :: forall a. ScoreTime -> ValCall -> Deriver (RawPitch a)
apply_pitch ScoreTime
pos ValCall
call = do
    Pitch
pitch <- Text -> ScoreTime -> Val -> Deriver Pitch
forall a. Typecheck a => Text -> ScoreTime -> Val -> Deriver a
Typecheck.typecheck Text
msg ScoreTime
pos (Val -> Deriver Pitch) -> Deriver State Error Val -> Deriver Pitch
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context Tagged -> ValCall -> [Term Val] -> Deriver State Error Val
apply Context Tagged
forall {a}. Context a
ctx ValCall
call []
    RawPitch a -> Deriver (RawPitch a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawPitch a -> Deriver (RawPitch a))
-> RawPitch a -> Deriver (RawPitch a)
forall a b. (a -> b) -> a -> b
$ Pitch -> RawPitch a
forall a b. RawPitch a -> RawPitch b
PSignal.coerce (Pitch
pitch :: PSignal.Pitch)
    where
    msg :: Text
msg = Text
"apply pitch: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CallName -> Text
forall a. Show a => a -> Text
showt (ValCall -> CallName
Derive.vcall_name ValCall
call)
    ctx :: Context a
ctx = ScoreTime -> ScoreTime -> Text -> Context a
forall a. ScoreTime -> ScoreTime -> Text -> Context a
Derive.dummy_context ScoreTime
pos ScoreTime
0 Text
"<apply_pitch>"

-- | Evaluate a single expression, catching an exception if it throws.
eval_expr :: Derive.CallableExpr d => Bool -- ^ See 'Derive.catch'.  This
    -- should be True for evals that generate notes for eventual output.
    -> Derive.Context d -> DeriveT.Expr -> Derive.Deriver (Stream.Stream d)
eval_expr :: forall d.
CallableExpr d =>
Bool -> Context d -> Expr -> Deriver (Stream d)
eval_expr Bool
collect Context d
ctx Expr
expr =
    Stream d -> Maybe (Stream d) -> Stream d
forall a. a -> Maybe a -> a
fromMaybe Stream d
forall a. Stream a
Stream.empty (Maybe (Stream d) -> Stream d)
-> Deriver State Error (Maybe (Stream d))
-> Deriver State Error (Stream d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Deriver State Error (Stream d)
-> Deriver State Error (Maybe (Stream d))
forall a. Bool -> Deriver a -> Deriver (Maybe a)
Derive.catch Bool
collect (Context d -> Expr -> Deriver State Error (Stream d)
forall d. CallableExpr d => Context d -> Expr -> Deriver (Stream d)
eval_toplevel Context d
ctx Expr
expr)