Safe Haskell | Safe-Inferred |
---|
Implementation for the Deriver monad.
This module should contain only Deriver
and the definitions needed to
implement it. Unfortunately that winds up being quite a lot. Deriver
carries a State
, which is depended upon directly by all derivation, so
it's just as complicated as derivation itself, which is to say, very.
Since State only really requires data types, the majority of this module is data declarations, with the exception of a few constructors which are intimately concerned with the type they are constructing. The library of functions to manipulate these types are split into Derive.Deriver.Lib.
This module is way too big. Unfortunately it's hard to split up because of circular imports. Anyone who directly or indirectly needs Deriver (e.g. calls) needs to import Derive. However, anything directly or indirectly used by State must be imported by Derive. Since State is the central type that must hold anything that persists beyond the evaluation of a single note, that winds up being a lot. At one point I tried to reign in the madness with hs-boot files, but I decided that hs-boot was worse.
Synopsis
- type Deriver = DeriveM.Deriver State Error
- type RunResult a = DeriveM.RunResult State Error a
- modify :: (st -> st) -> DeriveM.Deriver st err ()
- get :: DeriveM.Deriver st err st
- gets :: (st -> a) -> DeriveM.Deriver st err a
- put :: st -> DeriveM.Deriver st err ()
- run :: st -> DeriveM.Deriver st err a -> DeriveM.RunResult st err a
- initialize_log_msg :: Log.Msg -> Deriver Log.Msg
- data Error = Error !CallStack !Stack.Stack !ErrorVal
- data ErrorVal
- data CallError
- data TypeErrorT = TypeErrorT {
- error_place :: !ErrorPlace
- error_source :: !EvalSource
- error_arg_name :: !ArgName
- error_expected :: !ValType.Type
- error_received :: !(Maybe DeriveT.Val)
- error_derive :: !(Maybe Error)
- data ErrorPlace
- data EvalSource
- throw :: HasCallStack => Text -> Deriver a
- throw_arg_error :: HasCallStack => Text -> Deriver a
- throw_error :: HasCallStack => ErrorVal -> Deriver a
- annotate :: (Error -> Error) -> Deriver a -> Deriver a
- require :: HasCallStack => Text -> Maybe a -> Deriver a
- require_right :: HasCallStack => (err -> Text) -> Either err a -> Deriver a
- class Callable call
- callable_name :: Callable call => Proxy call -> Text
- data Tagged
- class (Show a, Pretty.Pretty a) => Taggable a where
- to_tagged :: a -> Tagged
- from_tagged :: Tagged -> Maybe a
- type CallableExpr d = (Callable (Generator d), Callable (Transformer d), Callable (TrackCall d), Taggable d)
- type Note = Score.Event
- type NoteDeriver = Deriver (Stream.Stream Score.Event)
- type NoteArgs = PassedArgs Score.Event
- type Control = Signal.Control
- type ControlDeriver = Deriver (Stream.Stream Signal.Control)
- type ControlArgs = PassedArgs Control
- type Pitch = DeriveT.PSignal
- type PitchDeriver = Deriver (Stream.Stream DeriveT.PSignal)
- type PitchArgs = PassedArgs Pitch
- lookup_call :: Callable call => Expr.Symbol -> Deriver (Maybe call)
- data State = State {}
- initial_state :: Constant -> Dynamic -> State
- data Threaded = Threaded {
- state_prev_val :: !(Map (BlockId, TrackId) Tagged)
- state_event_serial :: !Stack.Serial
- initial_threaded :: Threaded
- data Dynamic = Dynamic {
- state_control_merge_defaults :: !(Map ScoreT.Control Merger)
- state_pitch :: !DeriveT.PSignal
- state_environ :: !DeriveT.Environ
- state_warp :: !Warp.Warp
- state_scopes :: !Scopes
- state_instrument_aliases :: !InstrumentAliases
- state_control_damage :: !ControlDamage
- state_under_invert :: !(NoteDeriver -> NoteDeriver)
- state_inversion :: !Inversion
- state_pitch_map :: !(Maybe (Maybe DeriveT.PSignal, [Log.Msg]))
- state_note_track :: !(Maybe (BlockId, TrackId))
- state_stack :: !Stack.Stack
- state_mode :: !Mode
- type InstrumentAliases = Map ScoreT.Instrument ScoreT.Instrument
- data Inversion
- initial_dynamic :: DeriveT.Environ -> Dynamic
- strip_dynamic :: Dynamic -> Dynamic
- initial_environ :: DeriveT.Environ
- initial_controls :: ScoreT.ControlMap
- initial_control_vals :: Map ScoreT.Control Signal.Y
- default_dynamic :: Signal.Y
- type Builtins = ScopesT (MkScopeCallMaps (Generator Note) (Generator Control) (Generator Pitch)) (MkScopeCallMaps (Transformer Note) (Transformer Control) (Transformer Pitch)) (MkScopeCallMaps (TrackCall Note) (TrackCall Control) (TrackCall Pitch)) (ModuleMap ValCall)
- data CallMap call = CallMap {
- call_map :: Map Expr.Symbol call
- call_patterns :: [PatternCall call]
- single_call :: Expr.Symbol -> call -> CallMap call
- type Scopes = ScopesT (Scope (ScopePriority (Generator Note)) (ScopePriority (Generator Control)) (ScopePriority (Generator Pitch))) (Scope (ScopePriority (Transformer Note)) (ScopePriority (Transformer Control)) (ScopePriority (Transformer Pitch))) (Scope (ScopePriority (TrackCall Note)) (ScopePriority (TrackCall Control)) (ScopePriority (TrackCall Pitch))) (ScopePriority ValCall)
- data ScopesT gen trans track val = Scopes {
- scopes_generator :: !gen
- scopes_transformer :: !trans
- scopes_track :: !track
- scopes_val :: !val
- s_generator :: ScopesT gen trans track val :-> gen
- s_transformer :: ScopesT gen trans track val :-> trans
- s_track :: ScopesT gen trans track val :-> track
- s_val :: ScopesT gen trans track val :-> val
- data Scope note control pitch = Scope {
- scope_note :: !note
- scope_control :: !control
- scope_pitch :: !pitch
- s_note :: Scope note control pitch :-> note
- s_control :: Scope note control pitch :-> control
- s_pitch :: Scope note control pitch :-> pitch
- newtype ScopePriority call = ScopePriority (Map CallPriority (CallMap call))
- data CallPriority
- scope_priority :: [(CallPriority, CallMap call)] -> ScopePriority call
- lookup_priority :: CallPriority -> ScopePriority call -> CallMap call
- add_priority :: CallPriority -> CallMap call -> ScopePriority call -> ScopePriority call
- replace_priority :: CallPriority -> CallMap call -> ScopePriority call -> ScopePriority call
- data DocumentedCall = DocumentedCall !CallName !CallDoc
- data PatternCall call = PatternCall {
- pat_description :: !Text
- pat_doc :: !DocumentedCall
- pat_function :: !(Expr.Symbol -> Deriver (Maybe call))
- pat_call_doc :: PatternCall call -> CallDoc
- extract_doc :: Call d -> DocumentedCall
- extract_val_doc :: ValCall -> DocumentedCall
- extract_track_doc :: TrackCall d -> DocumentedCall
- data TrackCall d = TrackCall {
- tcall_name :: !CallName
- tcall_doc :: !CallDoc
- tcall_func :: !(TrackCallFunc d)
- track_call :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> TrackCallFunc d -> TrackCall d
- data Constant = Constant {}
- initial_constant :: Ui.State -> Builtins -> LookupScale -> Map CallName ScaleCall -> (ScoreT.Instrument -> Either Text Instrument) -> Cache -> ScoreDamage -> Constant
- data Mode
- mergers :: Map Expr.Symbol Merger
- merge_add :: Merger
- merge_sub :: Merger
- merge_mul :: Merger
- merge_scale :: Merger
- data Instrument = Instrument {}
- type InstrumentCalls = ScopesT (CallMap (Generator Note)) (CallMap (Transformer Note)) (CallMap (TrackCall Note)) (CallMap ValCall)
- data Merge
- = DefaultMerge
- | Merge !Merger
- data Merger
- = Merger !Text !(Signal.Control -> Signal.Control -> Signal.Control) !Signal.Y
- | Set
- | Unset
- data Collect = Collect {
- collect_warp_map :: !TrackWarp.WarpMap
- collect_track_signals :: !Track.TrackSignals
- collect_signal_fragments :: !SignalFragments
- collect_track_dynamic :: !TrackDynamic
- collect_track_dynamic_inverted :: !TrackDynamic
- collect_block_deps :: !BlockDeps
- collect_cache :: !Cache
- collect_cache_stats :: !CacheStats
- collect_integrated :: ![Integrated]
- collect_control_mods :: ![ControlMod]
- collect_score_duration :: !(CallDuration ScoreTime)
- collect_real_duration :: !(CallDuration RealTime)
- data CacheStats = CacheStats {}
- type SignalFragments = Map (BlockId, TrackId) (Map TrackTime Signal.Control)
- data ControlMod = ControlMod !ScoreT.Control !Signal.Control !Merger
- data Integrated = Integrated {}
- type TrackDynamic = Map (BlockId, TrackId) Dynamic
- data CallDuration a
- = Unknown
- | CallDuration !a
- data Context val = Context {
- ctx_prev_val :: !(Maybe val)
- ctx_event :: !Event.Event
- ctx_prev_events :: ![Event.Event]
- ctx_next_events :: ![Event.Event]
- ctx_event_end :: !ScoreTime
- ctx_track_shifted :: !TrackTime
- ctx_sub_tracks :: !TrackTree.EventsTree
- ctx_sub_events :: !(Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]])
- ctx_track_type :: !(Maybe ParseTitle.Type)
- ctx_track_range :: Context a -> (TrackTime, TrackTime)
- coerce_context :: Context a -> Context b
- dummy_context :: ScoreTime -> ScoreTime -> Text -> Context a
- tag_context :: Taggable a => Context a -> Context Tagged
- untag_context :: Taggable a => Context Tagged -> Context a
- data Call func = Call {}
- make_call :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc func -> Call func
- newtype CallName = CallName Text
- newtype ArgName = ArgName Text
- sym_to_call_name :: Expr.Symbol -> CallName
- str_to_call_name :: Expr.Str -> CallName
- str_to_arg_name :: Expr.Str -> ArgName
- data CallDoc = CallDoc {
- cdoc_module :: !Module.Module
- cdoc_tags :: !Tags.Tags
- cdoc_doc :: !Doc.Doc
- cdoc_args :: ![ArgDoc]
- data ArgDoc = ArgDoc {}
- data ArgParser
- data EnvironDefault
- = None
- | Prefixed
- | Unprefixed
- | Both
- type WithArgDoc f = (f, [ArgDoc])
- data PassedArgs val = PassedArgs {
- passed_vals :: ![DeriveT.Val]
- passed_call_name :: !CallName
- passed_ctx :: !(Context val)
- type Generator d = Call (GeneratorFunc d)
- data GeneratorFunc d = GeneratorFunc {
- gfunc_f :: !(GeneratorF d)
- gfunc_score_duration :: !(PassedArgs d -> Deriver (CallDuration ScoreTime))
- gfunc_real_duration :: !(PassedArgs d -> Deriver (CallDuration RealTime))
- type GeneratorF d = PassedArgs d -> Deriver (Stream.Stream d)
- generator_func :: (PassedArgs d -> Deriver (Stream.Stream d)) -> GeneratorFunc d
- generator :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (GeneratorF d) -> Generator d
- generator_events :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (PassedArgs d -> Deriver [d]) -> Generator d
- generator1 :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (PassedArgs d -> Deriver d) -> Generator d
- with_score_duration :: (PassedArgs d -> Deriver (CallDuration ScoreTime)) -> Generator d -> Generator d
- with_real_duration :: (PassedArgs d -> Deriver (CallDuration RealTime)) -> Generator d -> Generator d
- type Transformer d = Call (TransformerF d)
- type TransformerF d = PassedArgs d -> Deriver (Stream.Stream d) -> Deriver (Stream.Stream d)
- transformer :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (TransformerF d) -> Transformer d
- data ValCall = ValCall {
- vcall_name :: !CallName
- vcall_doc :: !CallDoc
- vcall_call :: PassedArgs Tagged -> Deriver DeriveT.Val
- make_val_call :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (PassedArgs Tagged -> Deriver DeriveT.Val) -> ValCall
- newtype Cache = Cache (Map CacheKey Cached)
- newtype CacheKey = CacheKey {}
- data Cached
- = Cached !CacheEntry
- | Invalid
- cache_size :: Cache -> Int
- data CacheEntry
- data CallType d = CallType !Collect !(Stream.Stream d)
- newtype BlockDeps = BlockDeps (Set BlockId)
- data ScoreDamage = ScoreDamage {
- sdamage_tracks :: !(Map TrackId (Ranges.Ranges ScoreTime))
- sdamage_track_blocks :: !(Set BlockId)
- sdamage_blocks :: !(Set BlockId)
- newtype ControlDamage = ControlDamage (Ranges.Ranges ScoreTime)
- score_to_real :: ScoreTime -> Deriver RealTime
- real_to_score :: RealTime -> Deriver ScoreTime
- data ScaleCall = ScaleCall {
- scall_name :: CallName
- scall_doc :: !CallDoc
- scall_call :: ScaleF
- type ScaleF = [DeriveT.Val] -> Deriver Scale
- scale_call :: CallName -> Doc.Doc -> (ScaleF, [ArgDoc]) -> ScaleCall
- data Scale = Scale {
- scale_id :: !Pitch.ScaleId
- scale_pattern :: !Text
- scale_symbols :: ![Symbol.Symbol]
- scale_transposers :: !(Set ScoreT.Control)
- scale_read :: DeriveT.Environ -> Pitch.Note -> Either DeriveT.PitchError Pitch.Pitch
- scale_show :: DeriveT.Environ -> Pitch.Pitch -> Either DeriveT.PitchError Pitch.Note
- scale_bottom :: !Pitch.Pitch
- scale_layout :: !Layout
- scale_transpose :: !Transpose
- scale_enharmonics :: !Enharmonics
- scale_note_to_call :: !(Pitch.Note -> Maybe ValCall)
- scale_input_to_note :: !(DeriveT.Environ -> Pitch.Input -> Either DeriveT.PitchError Pitch.Note)
- scale_input_to_nn :: !(ScoreTime -> Pitch.Input -> Deriver (Either DeriveT.PitchError Pitch.NoteNumber))
- scale_call_doc :: !DocumentedCall
- newtype LookupScale = LookupScale (DeriveT.Environ -> Pitch.ScaleId -> Maybe (Either DeriveT.PitchError Scale))
- type Transpose = Transposition -> DeriveT.Environ -> Pitch.Step -> Pitch.Pitch -> Either DeriveT.PitchError Pitch.Pitch
- data Transposition
- type Enharmonics = DeriveT.Environ -> Pitch.Note -> Either DeriveT.PitchError [Pitch.Note]
- type Layout = Vector.Vector Pitch.Semi
- error_to_warn :: Error -> Log.Msg
- merge_logs :: Either Error (Stream.Stream a) -> [Log.Msg] -> Stream.Stream a
- invalidate_damaged :: ScoreDamage -> Cache -> Cache
Deriver
modify :: (st -> st) -> DeriveM.Deriver st err () Source #
get :: DeriveM.Deriver st err st Source #
gets :: (st -> a) -> DeriveM.Deriver st err a Source #
put :: st -> DeriveM.Deriver st err () Source #
run :: st -> DeriveM.Deriver st err a -> DeriveM.RunResult st err a Source #
error
Instances
TypeError !TypeErrorT | Error typechecking an argument. |
CallNotFound !Expr.Symbol | Couldn't even call the thing because the name was not found. |
ArgError !Text | Calling error that doesn't fit into the above categories. |
data TypeErrorT Source #
TypeErrorT | |
|
Instances
Show TypeErrorT Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> TypeErrorT -> ShowS # show :: TypeErrorT -> String.String # showList :: [TypeErrorT] -> ShowS # | |
Pretty.Pretty TypeErrorT Source # | |
Defined in Derive.Deriver.Monad pretty :: TypeErrorT -> Text Source # format :: TypeErrorT -> Doc Source # formatList :: [TypeErrorT] -> Doc Source # |
data ErrorPlace Source #
Where a type error came from. The arg number starts at 0.
Instances
Show ErrorPlace Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> ErrorPlace -> ShowS # show :: ErrorPlace -> String.String # showList :: [ErrorPlace] -> ShowS # | |
Eq ErrorPlace Source # | |
Defined in Derive.Deriver.Monad (==) :: ErrorPlace -> ErrorPlace -> Bool # (/=) :: ErrorPlace -> ErrorPlace -> Bool # | |
Pretty.Pretty ErrorPlace Source # | |
Defined in Derive.Deriver.Monad pretty :: ErrorPlace -> Text Source # format :: ErrorPlace -> Doc Source # formatList :: [ErrorPlace] -> Doc Source # |
data EvalSource Source #
Literal | The value in error came from a literal expression. |
Quoted !DeriveT.Quoted | The value in error came from a |
SubTrack !(Either Text TrackId) | The error came from a SubT.Track. The value is either a track index
into |
Instances
Show EvalSource Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> EvalSource -> ShowS # show :: EvalSource -> String.String # showList :: [EvalSource] -> ShowS # |
throw_arg_error :: HasCallStack => Text -> Deriver a Source #
throw_error :: HasCallStack => ErrorVal -> Deriver a Source #
annotate :: (Error -> Error) -> Deriver a -> Deriver a Source #
Catch and rethrow an error, presumably to annotate it with more information.
require_right :: HasCallStack => (err -> Text) -> Either err a -> Deriver a Source #
derived types
Each kind of deriver looks a different scope for its calls. By making this a class method, I can figure out which scope to look in just from the type.
This is essentially a translation from dynamically typed ScopesT
and
Scopes
to statically typed Generator Note
etc. The class itself should
be closed, and correspond exactly to the fields of ScopesT * Scopes.
Surely there is some more direct way to express this, but I haven't figured
it out yet. TODO what would this look like in idris?
get_builtins_scope, get_scopes_scope, callable_name
Instances
callable_name :: Callable call => Proxy call -> Text Source #
What to call this call, for error msgs when lookup fails.
This is for ctx_prev_val
. Normally the previous value is available
in all its untagged glory based on the type of the call, but ValCalls can
occur with all the different types, so they need a tagged ctx_prev_val
.
class (Show a, Pretty.Pretty a) => Taggable a where Source #
type CallableExpr d = (Callable (Generator d), Callable (Transformer d), Callable (TrackCall d), Taggable d) Source #
Context for Callable on both Generator and Transformer. It has this name because top-level expression calls have this context.
type Note = Score.Event Source #
type NoteDeriver = Deriver (Stream.Stream Score.Event) Source #
type NoteArgs = PassedArgs Score.Event Source #
type Control = Signal.Control Source #
type ControlDeriver = Deriver (Stream.Stream Signal.Control) Source #
type ControlArgs = PassedArgs Control Source #
type Pitch = DeriveT.PSignal Source #
type PitchDeriver = Deriver (Stream.Stream DeriveT.PSignal) Source #
type PitchArgs = PassedArgs Pitch Source #
lookup_call
lookup_call :: Callable call => Expr.Symbol -> Deriver (Maybe call) Source #
state
All the state available during derivation.
State | |
|
Instances
State which is threaded linearly. This destroys the ability to parallelize derivation, so it's not so great. However, the only threaded state is state_prev_val, which is only needed within a track, so sibling tracks can still be parallelized.
Threaded | |
|
This is a dynamically scoped environment that applies to generated events inside its scope.
Dynamic | |
|
type InstrumentAliases = Map ScoreT.Instrument ScoreT.Instrument Source #
Instrument aliases as (alias, destination) pairs. Map through this before
looking in state_lookup_instrument
. The alias destination is always the
final instrument, not another alias, so you never have to look up multiple
times.
When a note call inverts, it stashes its actual note-generating code so it can re-invoke track evaluation on the control tracks below it. It's kind of like saving a continuation.
Previously I did it by copying the text of the inverting call to the
generated track. The problem was that I therefore had to keep the
evaluated expression around in the call Context
, and if I forgot to clear
it in the right places things would be very confusing when a later
inversion executed unexpected code. under_invert
transforms are now also stored as code rather than data, in
state_under_invert
.
NotInverted | Pre-inversion. |
InversionInProgress !NoteDeriver | After inversion, but not yet at the bottom. The inverted generator is captured here. |
strip_dynamic :: Dynamic -> Dynamic Source #
Strip out fields that I don't need to remember in a TrackDynamic.
If I don't do this, I get a memory leak. Presumably the cause is that
state_pitch_map
has an unevaluated pitch derivation, which in turn
somehow retains the previous derivation, and then the previous, and so on.
This makes each derivation leak more space.
initial_controls :: ScoreT.ControlMap Source #
Initial control environment.
default_dynamic :: Signal.Y Source #
A default dynamic that's not 0 is useful because otherwise you have to add dyn to everything. Since control tracks multiply by default, 1 is the most convenient value.
scope
type Builtins = ScopesT (MkScopeCallMaps (Generator Note) (Generator Control) (Generator Pitch)) (MkScopeCallMaps (Transformer Note) (Transformer Control) (Transformer Pitch)) (MkScopeCallMaps (TrackCall Note) (TrackCall Control) (TrackCall Pitch)) (ModuleMap ValCall) Source #
This is the library of built-in calls, indexed by Module. On import, the
imported CallMap
s are inserted into Scopes
at PrioBuiltin
.
The map takes priority over the patterns.
CallMap | |
|
Instances
Show Builtins Source # | |
Show InstrumentCalls Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> InstrumentCalls -> ShowS # show :: InstrumentCalls -> String.String # showList :: [InstrumentCalls] -> ShowS # | |
Monoid (CallMap call) Source # | |
Semigroup (CallMap call) Source # | |
Pretty.Pretty (CallMap call) Source # | |
single_call :: Expr.Symbol -> call -> CallMap call Source #
type Scopes = ScopesT (Scope (ScopePriority (Generator Note)) (ScopePriority (Generator Control)) (ScopePriority (Generator Pitch))) (Scope (ScopePriority (Transformer Note)) (ScopePriority (Transformer Control)) (ScopePriority (Transformer Pitch))) (Scope (ScopePriority (TrackCall Note)) (ScopePriority (TrackCall Control)) (ScopePriority (TrackCall Pitch))) (ScopePriority ValCall) Source #
This represents all calls in scope. Different types of calls are in scope depending on the track type, except ValCalls, which are in scope everywhere. This is dynamic scope, not lexical scope.
Perhaps this should be called Namespaces, but Id.Namespace is already taken and Scopes is shorter.
data ScopesT gen trans track val Source #
TODO this could probably now do with a more general name
maybe CallType for this, and CallKind for Scope
?
This is arg type, Scope
is return type, or maybe TrackType.
Calls are in scope by expression position (generator, transformer, track,
val) and then by track type (note, control, pitch). Expression position
also determines the the argument type (generator: nothing, transformer:
deriver, track: TrackTree.EventsTree
), while track type determines the
return type (Deriver Note
, Deriver Control
, Deriver Pitch
).
Val calls are special in that they always have the same type (Args -> Val), and are in scope in val call exrpession position for all track types.
names: EScope, TScope for ExpressionScope and TrackScope? ExprScope, TrackScope? I'd want to update the names in CallDoc too.
Scopes | |
|
Instances
Show Builtins Source # | |
Show InstrumentCalls Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> InstrumentCalls -> ShowS # show :: InstrumentCalls -> String.String # showList :: [InstrumentCalls] -> ShowS # | |
Show Library Source # | |
(Monoid gen, Monoid trans, Monoid track, Monoid val) => Monoid (ScopesT gen trans track val) Source # | |
(Semigroup gen, Semigroup trans, Semigroup track, Semigroup val) => Semigroup (ScopesT gen trans track val) Source # | |
Defined in Derive.Deriver.Monad | |
(Pretty.Pretty gen, Pretty.Pretty trans, Pretty.Pretty track, Pretty.Pretty val) => Pretty.Pretty (ScopesT gen trans track val) Source # | |
s_generator :: ScopesT gen trans track val :-> gen Source #
s_transformer :: ScopesT gen trans track val :-> trans Source #
data Scope note control pitch Source #
Scope | |
|
Instances
Show Builtins Source # | |
Show Library Source # | |
(Monoid note, Monoid control, Monoid pitch) => Monoid (Scope note control pitch) Source # | |
(Semigroup note, Semigroup control, Semigroup pitch) => Semigroup (Scope note control pitch) Source # | |
DeepSeq.NFData (Scope a b c) Source # | |
Defined in Derive.Deriver.Monad | |
(Pretty.Pretty note, Pretty.Pretty control, Pretty.Pretty pitch) => Pretty.Pretty (Scope note control pitch) Source # | |
newtype ScopePriority call Source #
An instrument or scale may put calls into scope. If that instrument or scale is replaced with another, the old calls must be replaced with the new ones.
Priority is determined by get_scopes
, which returns them in the fields'
declaration order.
The reason this can't be accomplished just by arranging imports in the right order is that when an instrument or scale comes into scope, it needs to replace existing instrument or scale calls. To do that, I need to keep each category separate. Also, this way I can import the ky file once at the toplevel, and it will still override PrioBuiltin calls.
ScopePriority (Map CallPriority (CallMap call)) |
Instances
Monoid (ScopePriority call) Source # | |
Defined in Derive.Deriver.Monad mempty :: ScopePriority call # mappend :: ScopePriority call -> ScopePriority call -> ScopePriority call # mconcat :: [ScopePriority call] -> ScopePriority call # | |
Semigroup (ScopePriority call) Source # | |
Defined in Derive.Deriver.Monad (<>) :: ScopePriority call -> ScopePriority call -> ScopePriority call # sconcat :: NonEmpty (ScopePriority call) -> ScopePriority call # stimes :: Integral b => b -> ScopePriority call -> ScopePriority call # | |
Pretty.Pretty (ScopePriority call) Source # | |
Defined in Derive.Deriver.Monad pretty :: ScopePriority call -> Text Source # format :: ScopePriority call -> Doc Source # formatList :: [ScopePriority call] -> Doc Source # |
data CallPriority Source #
PrioOverride | Override calls shadow all others. They're useful when you want to prevent instruments from overriding calls, which the lilypond deriver needs to do. |
PrioInstrument | These are instrument-specific calls implicitly imported by note tracks. |
PrioBlock | Block calls are local definitions, so they should override builtin calls, but are still below instrument calls. Otherwise, it's easy to define a block that shadows a drum stroke and get confused. TODO there could be a mechanism to set PrioOverride in case I actually do want to shadow an instrument call. |
PrioScale | This is for value calls introduced by a scale. They are implicitly imported by pitch tracks. |
PrioBuiltin | Calls imported from the |
Instances
Show CallPriority Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> CallPriority -> ShowS # show :: CallPriority -> String.String # showList :: [CallPriority] -> ShowS # | |
Eq CallPriority Source # | |
Defined in Derive.Deriver.Monad (==) :: CallPriority -> CallPriority -> Bool # (/=) :: CallPriority -> CallPriority -> Bool # | |
Ord CallPriority Source # | |
Defined in Derive.Deriver.Monad compare :: CallPriority -> CallPriority -> Ordering # (<) :: CallPriority -> CallPriority -> Bool # (<=) :: CallPriority -> CallPriority -> Bool # (>) :: CallPriority -> CallPriority -> Bool # (>=) :: CallPriority -> CallPriority -> Bool # max :: CallPriority -> CallPriority -> CallPriority # min :: CallPriority -> CallPriority -> CallPriority # | |
Pretty.Pretty CallPriority Source # | |
Defined in Derive.Deriver.Monad pretty :: CallPriority -> Text Source # format :: CallPriority -> Doc Source # formatList :: [CallPriority] -> Doc Source # |
scope_priority :: [(CallPriority, CallMap call)] -> ScopePriority call Source #
lookup_priority :: CallPriority -> ScopePriority call -> CallMap call Source #
add_priority :: CallPriority -> CallMap call -> ScopePriority call -> ScopePriority call Source #
Add this call at this level of priority. It will shadow existing calls with the same name.
replace_priority :: CallPriority -> CallMap call -> ScopePriority call -> ScopePriority call Source #
Replace all calls at this level of priority.
data DocumentedCall Source #
This is like Call
, but with only documentation. (name, CallDoc)
data PatternCall call Source #
PatternCall | |
|
Instances
Pretty.Pretty (PatternCall call) Source # | |
Defined in Derive.Deriver.Monad pretty :: PatternCall call -> Text Source # format :: PatternCall call -> Doc Source # formatList :: [PatternCall call] -> Doc Source # |
pat_call_doc :: PatternCall call -> CallDoc Source #
extract_doc :: Call d -> DocumentedCall Source #
extract_track_doc :: TrackCall d -> DocumentedCall Source #
TrackCall
TrackCall | |
|
Instances
track_call :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> TrackCallFunc d -> TrackCall d Source #
constant
Values that don't change during one derive run.
Constant | |
|
initial_constant :: Ui.State -> Builtins -> LookupScale -> Map CallName ScaleCall -> (ScoreT.Instrument -> Either Text Instrument) -> Cache -> ScoreDamage -> Constant Source #
Derivation can run in a few distinct modes.
Normal | Standard derivation. |
ScoreDurationQuery | This indicates that I'm running the deriver just to find out its
duration. There's a hack in Derive.Eval that will fill in
|
RealDurationQuery | |
Lilypond !Lilypond.Types.Config | Emit events intended for the lilypond backend. Calls that have corresponding staff notation (e.g. trills) emit special events with attached lilypond code in this mode. |
merge_scale :: Merger Source #
Unlike the rest, this one is not associative.
instrument
data Instrument Source #
Mostly the deriver just deals with instruments as strings, and doesn't understand anything else about them. However, it does need a few other things, which are expressed here to avoid excessive dependencies between the systems.
Instrument | |
|
Instances
Show Instrument Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> Instrument -> ShowS # show :: Instrument -> String.String # showList :: [Instrument] -> ShowS # |
type InstrumentCalls = ScopesT (CallMap (Generator Note)) (CallMap (Transformer Note)) (CallMap (TrackCall Note)) (CallMap ValCall) Source #
Some ornaments only apply to a particular instrument, so each instrument
can bring a set of note calls and val calls into scope, via the Scope
type. This is like Builtins
, but without the Module map, since they're
all implicitly in PrioInstrument
.
control
How to merge a control into Dynamic
.
DefaultMerge | Apply the default merge for this control. |
Merge !Merger | Merge with a specific operator. |
Instances
Show Merge Source # | |
DeepSeq.NFData Merge Source # | |
Defined in Derive.Deriver.Monad | |
Pretty.Pretty Merge Source # | |
Combine two signals. The element should be an identity, like mempty.
ControlMod uses it to avoid affecting signal outside of the modified range.
The merge function is not obliged to be associative, so this isn't actually
a monoid. TODO it's all the fault of merge_scale
... do I lose something
important with associativity?
Merger !Text !(Signal.Control -> Signal.Control -> Signal.Control) !Signal.Y | name merge identity |
Set | Replace the existing signal. |
Unset | Replace only if there is no existing signal. TODO I thought I'd need this but I don't. If it turns out to never be useful I can delete it. |
Instances
collect
These are things that collect throughout derivation, and are cached in
addition to the derived values. Effectively they are extra return values,
which are combined with mappend. So this is the WriterT part of State
.
Collect | |
|
data CacheStats Source #
Instances
Monoid CacheStats Source # | |
Defined in Derive.Deriver.Monad mempty :: CacheStats # mappend :: CacheStats -> CacheStats -> CacheStats # mconcat :: [CacheStats] -> CacheStats # | |
Semigroup CacheStats Source # | |
Defined in Derive.Deriver.Monad (<>) :: CacheStats -> CacheStats -> CacheStats # sconcat :: NonEmpty CacheStats -> CacheStats # stimes :: Integral b => b -> CacheStats -> CacheStats # | |
Show CacheStats Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> CacheStats -> ShowS # show :: CacheStats -> String.String # showList :: [CacheStats] -> ShowS # | |
Eq CacheStats Source # | |
Defined in Derive.Deriver.Monad (==) :: CacheStats -> CacheStats -> Bool # (/=) :: CacheStats -> CacheStats -> Bool # | |
Pretty.Pretty CacheStats Source # | |
Defined in Derive.Deriver.Monad pretty :: CacheStats -> Text Source # format :: CacheStats -> Doc Source # formatList :: [CacheStats] -> Doc Source # |
type SignalFragments = Map (BlockId, TrackId) (Map TrackTime Signal.Control) Source #
These are fragments of a signal, which will be later collected into
collect_track_signals
. This is part of a complicated mechanism to
evaluate TrackSignals only once. When the sliced fragments of a track are
evaluated, they collect signal fragments. When the track is fully
evaluated, they are sorted and merged into collect_track_signals
.
If the track is then evaluated again, the monoid instance will discard the
duplicate.
The signal fragments are indexed by the slice position. Since
merge
makes the earlier signals win in case of overlaps, this
ensures a trimmed earlier fragment won't replace a more complete later one.
data ControlMod Source #
This is a hack so a call on a control track can modify other controls. The motivating case is pitch ornaments that also want to affect the dynamics. The modifications are a secondary return value from control and pitch calls. The track deriver will extract them and merge them into the dynamic environment. [NOTE control-modification]
Instances
Show ControlMod Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> ControlMod -> ShowS # show :: ControlMod -> String.String # showList :: [ControlMod] -> ShowS # | |
Pretty.Pretty ControlMod Source # | |
Defined in Derive.Deriver.Monad pretty :: ControlMod -> Text Source # format :: ControlMod -> Doc Source # formatList :: [ControlMod] -> Doc Source # |
data Integrated Source #
Instances
Show Integrated Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> Integrated -> ShowS # show :: Integrated -> String.String # showList :: [Integrated] -> ShowS # | |
DeepSeq.NFData Integrated Source # | |
Defined in Derive.Deriver.Monad rnf :: Integrated -> () # | |
Pretty.Pretty Integrated Source # | |
Defined in Derive.Deriver.Monad pretty :: Integrated -> Text Source # format :: Integrated -> Doc Source # formatList :: [Integrated] -> Doc Source # |
type TrackDynamic = Map (BlockId, TrackId) Dynamic Source #
Snapshots of the environ at each track. This is used by the Cmd layer to figure out what the scale and instrument are for a given track.
Originally this was a map from Stacks to Environ (and only the changed parts). The idea was that I could walk up the stack to find the Environ value in scope at a given point, and given Stack.Region, could even get e.g. per event instruments. Unfortunately, while it's easy to do that on the Derive side, it seems really complicated and somewhat expensive to try to retrace a complete stack on every cmd. Since this implementation doesn't store the entire stack, a track with a different instrument at different times will wind up with the last one.
This is a much simpler solution which will hopefully work well enough in practice.
NOTE [record-track-dynamics] One complication is that when I get controls from sliced tracks, the controls are also sliced. But I need the environ from the inverted version of the track so the common case of [>i, *scale] gets the correct scale. So I record TrackDynamic for both inverted and non inverted tracks and prefer the inverted tracks, but take controls from the non-inverted versions.
data CallDuration a Source #
This is the logical duration of a call. This may be different from its actual duration (which is to say, the end time of the last event it emits). Also, while most calls adjust their duration to the duration of the event they are called from, some of them have their own intrinsic duration. For example, a block call may stretch to its calling event's duration, but it also has its own duration that is used to align the block's end, or to sequence blocks.
Since the call duration is sometimes used to place the call in the first
place (e.g. to align its end), I want to evaluate the minimum amount
necessary to find the duration. The implementation is that each generator
call has a gfunc_score_duration
field. When Derive.Eval is evaluating
a generator call, if it sees that state_mode
is ScoreDurationQuery
,
instead of calling gfunc_f
, it will call gfunc_score_duration and return
the result via collect_score_duration
. You shouldn't stick your fingers
into this machinery, but instead use Derive.get_call_duration
to do the
gefingerpoken for you.
I'm not very happy with this implementation, but I tried several approaches and this is the only one that worked. Historical details are in NOTE [call-duration].
Instances
calls
Additional data for a call. This part is invariant for all calls on an event.
The events are not used for transform calls.
TODO make separate types so the irrelevent data need not be passed?
Context | |
|
Instances
Functor Context Source # | |
Pretty.Pretty val => Pretty.Pretty (Context val) Source # | |
coerce_context :: Context a -> Context b Source #
dummy_context :: ScoreTime -> ScoreTime -> Text -> Context a Source #
Transformer calls don't necessarily apply to any particular event, and neither do generators for that matter.
tag_context :: Taggable a => Context a -> Context Tagged Source #
Taggable the polymorphic part of the Context so it can be given to
a ValCall
. Otherwise, ValCall would have to be polymorphic too,
which means it would hard to write generic ones.
A Call will be called as either a generator or a transformer, depending on
its position. A call at the end of a compose pipeline will be called as
a generator while ones composed with it will be called as transformers, so
in a | b
, a
is a transformer and b
is a generator.
More details on this strange setup are in the Derive.Call haddock.
Instances
make_call :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc func -> Call func Source #
Each call has an intrinsic name. Since call IDs may be rebound
dynamically, each call has its own name so that error msgs are unambiguous.
It's also used along with ArgName
for argument defaulting, so if you want
that to work it should be short and parseable by
p_unquoted_str
. The name is not necessarily unique, and in
fact may be intentionally non-unique to share defaults with another.
The documentation for all calls that differ only in name are grouped together, so it's easier to read if small modifications are reflected in the name only. If you put invalid identifiers in the name, it can't be used to set default arguments.
Instances
String.IsString CallName Source # | |
Defined in Derive.Deriver.Monad fromString :: String.String -> CallName # | |
Show CallName Source # | |
Eq CallName Source # | |
Ord CallName Source # | |
Defined in Derive.Deriver.Monad | |
Pretty.Pretty CallName Source # | |
Each call argument has its own name, which is used for documentation as well as argument defaulting, as documented in Derive.Sig.
Instances
String.IsString ArgName Source # | |
Defined in Derive.Deriver.Monad fromString :: String.String -> ArgName # | |
Show ArgName Source # | |
Eq ArgName Source # | |
Ord ArgName Source # | |
Pretty.Pretty ArgName Source # | |
str_to_call_name :: Expr.Str -> CallName Source #
str_to_arg_name :: Expr.Str -> ArgName Source #
Documentation for a call. The documentation is in markdown format, except that a single newline will be replaced with two, so a single n is enough to start a new paragraph. Also, single quotes are turned into links as per Util.Texts.haddockUrl.
CallDoc | |
|
ArgDoc | |
|
These enumerate the different ways an argumnt can be parsed, and correspond to parsers in Derive.Sig.
data EnvironDefault Source #
This configures how an argument looks for a default in the environ.
None | Don't default from environ at all. |
Prefixed | Look for |
Unprefixed | Look for |
Both | First look for a prefixed key, then for an unprefixed one. |
Instances
Show EnvironDefault Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> EnvironDefault -> ShowS # show :: EnvironDefault -> String.String # showList :: [EnvironDefault] -> ShowS # | |
Eq EnvironDefault Source # | |
Defined in Derive.Deriver.Monad (==) :: EnvironDefault -> EnvironDefault -> Bool # (/=) :: EnvironDefault -> EnvironDefault -> Bool # | |
Ord EnvironDefault Source # | |
Defined in Derive.Deriver.Monad compare :: EnvironDefault -> EnvironDefault -> Ordering # (<) :: EnvironDefault -> EnvironDefault -> Bool # (<=) :: EnvironDefault -> EnvironDefault -> Bool # (>) :: EnvironDefault -> EnvironDefault -> Bool # (>=) :: EnvironDefault -> EnvironDefault -> Bool # max :: EnvironDefault -> EnvironDefault -> EnvironDefault # min :: EnvironDefault -> EnvironDefault -> EnvironDefault # | |
Pretty.Pretty EnvironDefault Source # | |
Defined in Derive.Deriver.Monad pretty :: EnvironDefault -> Text Source # format :: EnvironDefault -> Doc Source # formatList :: [EnvironDefault] -> Doc Source # |
type WithArgDoc f = (f, [ArgDoc]) Source #
A value annotated with argument docs. This is returned by the functions in Derive.Sig, and accepted by the Call constructors here.
data PassedArgs val Source #
Data passed to a Call
.
PassedArgs | |
|
Instances
generator
type Generator d = Call (GeneratorFunc d) Source #
data GeneratorFunc d Source #
GeneratorFunc | |
|
Instances
type GeneratorF d = PassedArgs d -> Deriver (Stream.Stream d) Source #
generator_func :: (PassedArgs d -> Deriver (Stream.Stream d)) -> GeneratorFunc d Source #
generator :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (GeneratorF d) -> Generator d Source #
Create a generator that expects a list of derived values (e.g. Score.Event or Signal.Control), with no logs mixed in. The result is wrapped in LEvent.Event.
generator_events :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (PassedArgs d -> Deriver [d]) -> Generator d Source #
Make a generator from a function which returns events in sorted order. TODO this just trusts that the events will be sorted. Is there a safer way?
generator1 :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (PassedArgs d -> Deriver d) -> Generator d Source #
Since Signals themselves are collections, there's little reason for a signal generator to return a Stream of events. So wrap the generator result in a Stream singleton.
TODO call this signal_generator?
with_score_duration :: (PassedArgs d -> Deriver (CallDuration ScoreTime)) -> Generator d -> Generator d Source #
Set the gfunc_score_duration
field to get ScoreTime CallDuration.
with_real_duration :: (PassedArgs d -> Deriver (CallDuration RealTime)) -> Generator d -> Generator d Source #
transformer
type Transformer d = Call (TransformerF d) Source #
type TransformerF d = PassedArgs d -> Deriver (Stream.Stream d) -> Deriver (Stream.Stream d) Source #
args -> deriver -> deriver
transformer :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (TransformerF d) -> Transformer d Source #
Just make_call
with a more specific signature.
val
ValCall | |
|
Instances
Show Builtins Source # | |
Show InstrumentCalls Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> InstrumentCalls -> ShowS # show :: InstrumentCalls -> String.String # showList :: [InstrumentCalls] -> ShowS # | |
Show ValCall Source # | |
Show Library Source # | |
Callable ValCall Source # | |
Defined in Derive.Deriver.Monad get_builtins_scope :: Builtins -> ModuleMap ValCall | |
ToLibrary ValCall Source # | |
Defined in Derive.Library to_library :: [Entry ValCall] -> Library -> Library |
make_val_call :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (PassedArgs Tagged -> Deriver DeriveT.Val) -> ValCall Source #
cache types
The cache types are nominally exported from Derive.Cache, but must be defined here to avoid circular dependencies.
Ideally, the cache would be keyed by all data that can affect derivation,
which would mean all of Dynamic
and Threaded
. Effectively a deriver is
a function that takes State
as its input, and this would be memoizing
that function. But in practice, there's too much junk in there, so I have
to do an approximation.
The first approximation is the stack, which is a proxy for the things that
are likely to affect derivation. Different calls in the stack are likely
to result in a different environment, or a different Stack.Region
likely
means a different warp. Stack.Frame
attempts to ensure that multiple
generators within a single event also have unique stacks.
When cache entries are invalidated by ScoreDamage, a marker is left in their place. This is just for a nicer log msg that can tell the difference between never evaluated and damaged.
cache_size :: Cache -> Int Source #
data CacheEntry Source #
Since an entire track is one type but will have many different calls of different types, the deriver type division goes above the call type division.
CachedEvents !(CallType Score.Event) | |
CachedControl !(CallType Signal.Control) | |
CachedPitch !(CallType DeriveT.PSignal) |
Instances
DeepSeq.NFData CacheEntry Source # | |
Defined in Derive.Deriver.Monad rnf :: CacheEntry -> () # | |
Pretty.Pretty CacheEntry Source # | |
Defined in Derive.Deriver.Monad pretty :: CacheEntry -> Text Source # format :: CacheEntry -> Doc Source # formatList :: [CacheEntry] -> Doc Source # |
The type here should match the type of the stack it's associated with, but I'm not quite up to those type gymnastics yet.
CallType !Collect !(Stream.Stream d) |
Instances
DeepSeq.NFData d => DeepSeq.NFData (CallType d) Source # | |
Defined in Derive.Deriver.Monad |
damage
data ScoreDamage Source #
Modified ranges in the score.
ScoreDamage | |
|
Instances
Monoid ScoreDamage Source # | |
Defined in Derive.Deriver.Monad mempty :: ScoreDamage # mappend :: ScoreDamage -> ScoreDamage -> ScoreDamage # mconcat :: [ScoreDamage] -> ScoreDamage # | |
Semigroup ScoreDamage Source # | |
Defined in Derive.Deriver.Monad (<>) :: ScoreDamage -> ScoreDamage -> ScoreDamage # sconcat :: NonEmpty ScoreDamage -> ScoreDamage # stimes :: Integral b => b -> ScoreDamage -> ScoreDamage # | |
Show ScoreDamage Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> ScoreDamage -> ShowS # show :: ScoreDamage -> String.String # showList :: [ScoreDamage] -> ShowS # | |
DeepSeq.NFData ScoreDamage Source # | |
Defined in Derive.Deriver.Monad rnf :: ScoreDamage -> () # | |
Eq ScoreDamage Source # | |
Defined in Derive.Deriver.Monad (==) :: ScoreDamage -> ScoreDamage -> Bool # (/=) :: ScoreDamage -> ScoreDamage -> Bool # | |
Pretty.Pretty ScoreDamage Source # | |
Defined in Derive.Deriver.Monad pretty :: ScoreDamage -> Text Source # format :: ScoreDamage -> Doc Source # formatList :: [ScoreDamage] -> Doc Source # |
newtype ControlDamage Source #
Control damage indicates that a section of control signal has been modified. It's dynamically scoped over the same range as the control itself, so that events that depend on it can be rederived.
Instances
util
scale
Like ValCall, but specialized to return Scale, which is not a first class Val.
ScaleCall | |
|
Scale | |
|
newtype LookupScale Source #
A scale can configure itself by looking in the environment and by looking up other scales.
Instances
Show LookupScale Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> LookupScale -> ShowS # show :: LookupScale -> String.String # showList :: [LookupScale] -> ShowS # |
type Transpose = Transposition -> DeriveT.Environ -> Pitch.Step -> Pitch.Pitch -> Either DeriveT.PitchError Pitch.Pitch Source #
Scales may ignore Transposition if they don't support it.
Transposition could almost always succeed, and leaving the error reporting
to scale_show
. But for some scales it has to parse the Pitch.Key
from
the environ, which can fail. Parsing the key is pretty unfortunate, since
it winds up getting repeated for scale_read
and scale_show
, but I don't
want to make the Key type concrete, since each scale has a different one.
TODO could make the key an existential type and export scale_parse_key?
data Transposition Source #
Instances
Show Transposition Source # | |
Defined in Derive.Deriver.Monad showsPrec :: Int -> Transposition -> ShowS # show :: Transposition -> String.String # showList :: [Transposition] -> ShowS # |
type Enharmonics = DeriveT.Environ -> Pitch.Note -> Either DeriveT.PitchError [Pitch.Note] Source #
Get the enharmonics of the note. The given note is omitted, and the enharmonics are in ascending order until they wrap around, so if you always take the head of the list you will cycle through all of the enharmonics.
type Layout = Vector.Vector Pitch.Semi Source #
The number of chromatic intervals between each Pitch.PitchClass
,
starting from 0, as returned by scale_read
. The length is the number of
degrees per octave. A diatonic-only scale will have all 1s, and a scale
without octaves has an empty layout.
This is analogous to Layout
, but is intended to be a minimal
implementation that all scales can export, without having to support the
full complexity of a chromatic scale.
Combined with scale_read
and scale_show
, I can use this to do math on
scale degrees.
merge
error_to_warn :: Error -> Log.Msg Source #
merge_logs :: Either Error (Stream.Stream a) -> [Log.Msg] -> Stream.Stream a Source #
testing
invalidate_damaged :: ScoreDamage -> Cache -> Cache Source #
Clear the damaged portions out of the cache so they will rederive.
Block damage also clears track caches that are on that block.