{-# LANGUAGE RankNTypes #-}
module Derive.Library (
Library, library, generators, transformers, vals, pattern
, ToLibrary, Entry(..)
, Calls(..), both
, poly_generators, poly_transformers
, Shadowed, compile, compile_log
) where
import qualified Data.Either as Either
import qualified Data.Map.Strict as Map
import qualified Util.Log as Log
import qualified Util.Logger as Logger
import qualified Util.Maps as Maps
import qualified Util.Seq as Seq
import qualified Derive.Call.Module as Module
import qualified Derive.Derive as Derive
import qualified Derive.Expr as Expr
import Global
type Library = Derive.ScopesT
(Derive.Scope
[Entry (Derive.Generator Derive.Note)]
[Entry (Derive.Generator Derive.Control)]
[Entry (Derive.Generator Derive.Pitch)])
(Derive.Scope
[Entry (Derive.Transformer Derive.Note)]
[Entry (Derive.Transformer Derive.Control)]
[Entry (Derive.Transformer Derive.Pitch)])
(Derive.Scope
[Entry (Derive.TrackCall Derive.Note)]
[Entry (Derive.TrackCall Derive.Control)]
[Entry (Derive.TrackCall Derive.Pitch)])
[Entry Derive.ValCall]
data Entry call =
Single !Expr.Symbol !call
| Pattern !(Derive.PatternCall call)
instance Show Library where show :: Library -> String
show Library
_ = String
"((Library))"
instance Pretty (Entry call) where
pretty :: Entry call -> Text
pretty (Single Symbol
sym call
_) = Symbol -> Text
Expr.unsym Symbol
sym
pretty (Pattern PatternCall call
pattern) = Text
"pattern:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PatternCall call -> Text
forall call. PatternCall call -> Text
Derive.pat_description PatternCall call
pattern
library :: ToLibrary call => [(Expr.Symbol, call)] -> Library
library :: forall call. ToLibrary call => [(Symbol, call)] -> Library
library [] = Library
forall a. Monoid a => a
mempty
library [(Symbol, call)]
calls = [Entry call] -> Library -> Library
forall call. ToLibrary call => [Entry call] -> Library -> Library
to_library (((Symbol, call) -> Entry call) -> [(Symbol, call)] -> [Entry call]
forall a b. (a -> b) -> [a] -> [b]
map ((Symbol -> call -> Entry call) -> (Symbol, call) -> Entry call
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Symbol -> call -> Entry call
forall call. Symbol -> call -> Entry call
Single) [(Symbol, call)]
calls) Library
forall a. Monoid a => a
mempty
generators :: ToLibrary (Derive.Generator call) =>
[(Expr.Symbol, Derive.Generator call)] -> Library
generators :: forall call.
ToLibrary (Generator call) =>
[(Symbol, Generator call)] -> Library
generators = [(Symbol, Generator call)] -> Library
forall call. ToLibrary call => [(Symbol, call)] -> Library
library
transformers :: ToLibrary (Derive.Transformer call) =>
[(Expr.Symbol, Derive.Transformer call)] -> Library
transformers :: forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
transformers = [(Symbol, Transformer call)] -> Library
forall call. ToLibrary call => [(Symbol, call)] -> Library
library
vals :: [(Expr.Symbol, Derive.ValCall)] -> Library
vals :: [(Symbol, ValCall)] -> Library
vals = [(Symbol, ValCall)] -> Library
forall call. ToLibrary call => [(Symbol, call)] -> Library
library
pattern :: ToLibrary call => Derive.PatternCall call -> Library
pattern :: forall call. ToLibrary call => PatternCall call -> Library
pattern PatternCall call
c = [Entry call] -> Library -> Library
forall call. ToLibrary call => [Entry call] -> Library -> Library
to_library [PatternCall call -> Entry call
forall call. PatternCall call -> Entry call
Pattern PatternCall call
c] Library
forall a. Monoid a => a
mempty
data Calls d = Calls {
forall d. Calls d -> Generator d
generator :: !(Derive.Generator d)
, forall d. Calls d -> Transformer d
transformer :: !(Derive.Transformer d)
}
both :: (ToLibrary (Derive.Generator d), ToLibrary (Derive.Transformer d)) =>
[(Expr.Symbol, Calls d)] -> Library
both :: forall d.
(ToLibrary (Generator d), ToLibrary (Transformer d)) =>
[(Symbol, Calls d)] -> Library
both [(Symbol, Calls d)]
sym_calls =
[(Symbol, Generator d)] -> Library
forall call.
ToLibrary (Generator call) =>
[(Symbol, Generator call)] -> Library
generators ([Symbol] -> [Generator d] -> [(Symbol, Generator d)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
syms ((Calls d -> Generator d) -> [Calls d] -> [Generator d]
forall a b. (a -> b) -> [a] -> [b]
map Calls d -> Generator d
forall d. Calls d -> Generator d
generator [Calls d]
calls))
Library -> Library -> Library
forall a. Semigroup a => a -> a -> a
<> [(Symbol, Transformer d)] -> Library
forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
transformers ([Symbol] -> [Transformer d] -> [(Symbol, Transformer d)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
syms ((Calls d -> Transformer d) -> [Calls d] -> [Transformer d]
forall a b. (a -> b) -> [a] -> [b]
map Calls d -> Transformer d
forall d. Calls d -> Transformer d
transformer [Calls d]
calls))
where ([Symbol]
syms, [Calls d]
calls) = [(Symbol, Calls d)] -> ([Symbol], [Calls d])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Symbol, Calls d)]
sym_calls
poly_generators ::
(forall d. Derive.CallableExpr d => [(Expr.Symbol, Derive.Generator d)])
-> Library
poly_generators :: (forall d. CallableExpr d => [(Symbol, Generator d)]) -> Library
poly_generators forall d. CallableExpr d => [(Symbol, Generator d)]
calls = [Library] -> Library
forall a. Monoid a => [a] -> a
mconcat
[ [(Symbol, Generator Note)] -> Library
forall call.
ToLibrary (Generator call) =>
[(Symbol, Generator call)] -> Library
generators ([(Symbol, Generator Note)]
forall d. CallableExpr d => [(Symbol, Generator d)]
calls :: [(Expr.Symbol, Derive.Generator Derive.Note)])
, [(Symbol, Generator Control)] -> Library
forall call.
ToLibrary (Generator call) =>
[(Symbol, Generator call)] -> Library
generators ([(Symbol, Generator Control)]
forall d. CallableExpr d => [(Symbol, Generator d)]
calls :: [(Expr.Symbol, Derive.Generator Derive.Control)])
, [(Symbol, Generator Pitch)] -> Library
forall call.
ToLibrary (Generator call) =>
[(Symbol, Generator call)] -> Library
generators ([(Symbol, Generator Pitch)]
forall d. CallableExpr d => [(Symbol, Generator d)]
calls :: [(Expr.Symbol, Derive.Generator Derive.Pitch)])
]
poly_transformers ::
(forall d. Derive.CallableExpr d => [(Expr.Symbol, Derive.Transformer d)])
-> Library
poly_transformers :: (forall d. CallableExpr d => [(Symbol, Transformer d)]) -> Library
poly_transformers forall d. CallableExpr d => [(Symbol, Transformer d)]
calls = [Library] -> Library
forall a. Monoid a => [a] -> a
mconcat
[ [(Symbol, Transformer Note)] -> Library
forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
transformers ([(Symbol, Transformer Note)]
forall d. CallableExpr d => [(Symbol, Transformer d)]
calls :: [(Expr.Symbol, Derive.Transformer Derive.Note)])
, [(Symbol, Transformer Control)] -> Library
forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
transformers ([(Symbol, Transformer Control)]
forall d. CallableExpr d => [(Symbol, Transformer d)]
calls :: [(Expr.Symbol, Derive.Transformer Derive.Control)])
, [(Symbol, Transformer Pitch)] -> Library
forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
transformers ([(Symbol, Transformer Pitch)]
forall d. CallableExpr d => [(Symbol, Transformer d)]
calls :: [(Expr.Symbol, Derive.Transformer Derive.Pitch)])
]
class ToLibrary call where
to_library :: [Entry call] -> Library -> Library
instance ToLibrary (Derive.Generator Derive.Note) where
to_library :: [Entry (Generator Note)] -> Library -> Library
to_library = (Library
:-> Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> gen
Derive.s_generator(Library
:-> Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)])
-> Lens
(Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)])
[Entry (Generator Note)]
-> Lens Library [Entry (Generator Note)]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens
(Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)])
[Entry (Generator Note)]
forall {note} {control} {pitch}. Scope note control pitch :-> note
Derive.s_note #=)
instance ToLibrary (Derive.Generator Derive.Control) where
to_library :: [Entry (Generator Control)] -> Library -> Library
to_library = (Library
:-> Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> gen
Derive.s_generator(Library
:-> Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)])
-> Lens
(Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)])
[Entry (Generator Control)]
-> Lens Library [Entry (Generator Control)]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens
(Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)])
[Entry (Generator Control)]
forall {note} {control} {pitch}.
Scope note control pitch :-> control
Derive.s_control #=)
instance ToLibrary (Derive.Generator Derive.Pitch) where
to_library :: [Entry (Generator Pitch)] -> Library -> Library
to_library = (Library
:-> Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> gen
Derive.s_generator(Library
:-> Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)])
-> Lens
(Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)])
[Entry (Generator Pitch)]
-> Lens Library [Entry (Generator Pitch)]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens
(Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)])
[Entry (Generator Pitch)]
forall {note} {control} {pitch}. Scope note control pitch :-> pitch
Derive.s_pitch #=)
instance ToLibrary (Derive.Transformer Derive.Note) where
to_library :: [Entry (Transformer Note)] -> Library -> Library
to_library = (Library
:-> Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> trans
Derive.s_transformer(Library
:-> Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)])
-> Lens
(Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)])
[Entry (Transformer Note)]
-> Lens Library [Entry (Transformer Note)]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens
(Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)])
[Entry (Transformer Note)]
forall {note} {control} {pitch}. Scope note control pitch :-> note
Derive.s_note #=)
instance ToLibrary (Derive.Transformer Derive.Control) where
to_library :: [Entry (Transformer Control)] -> Library -> Library
to_library = (Library
:-> Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> trans
Derive.s_transformer(Library
:-> Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)])
-> Lens
(Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)])
[Entry (Transformer Control)]
-> Lens Library [Entry (Transformer Control)]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens
(Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)])
[Entry (Transformer Control)]
forall {note} {control} {pitch}.
Scope note control pitch :-> control
Derive.s_control #=)
instance ToLibrary (Derive.Transformer Derive.Pitch) where
to_library :: [Entry (Transformer Pitch)] -> Library -> Library
to_library = (Library
:-> Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> trans
Derive.s_transformer(Library
:-> Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)])
-> Lens
(Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)])
[Entry (Transformer Pitch)]
-> Lens Library [Entry (Transformer Pitch)]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens
(Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)])
[Entry (Transformer Pitch)]
forall {note} {control} {pitch}. Scope note control pitch :-> pitch
Derive.s_pitch #=)
instance ToLibrary (Derive.TrackCall Derive.Note) where
to_library :: [Entry (TrackCall Note)] -> Library -> Library
to_library = (Library
:-> Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> track
Derive.s_track(Library
:-> Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)])
-> Lens
(Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)])
[Entry (TrackCall Note)]
-> Lens Library [Entry (TrackCall Note)]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens
(Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)])
[Entry (TrackCall Note)]
forall {note} {control} {pitch}. Scope note control pitch :-> note
Derive.s_note #=)
instance ToLibrary (Derive.TrackCall Derive.Control) where
to_library :: [Entry (TrackCall Control)] -> Library -> Library
to_library = (Library
:-> Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> track
Derive.s_track(Library
:-> Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)])
-> Lens
(Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)])
[Entry (TrackCall Control)]
-> Lens Library [Entry (TrackCall Control)]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens
(Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)])
[Entry (TrackCall Control)]
forall {note} {control} {pitch}.
Scope note control pitch :-> control
Derive.s_control #=)
instance ToLibrary (Derive.TrackCall Derive.Pitch) where
to_library :: [Entry (TrackCall Pitch)] -> Library -> Library
to_library = (Library
:-> Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> track
Derive.s_track(Library
:-> Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)])
-> Lens
(Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)])
[Entry (TrackCall Pitch)]
-> Lens Library [Entry (TrackCall Pitch)]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens
(Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)])
[Entry (TrackCall Pitch)]
forall {note} {control} {pitch}. Scope note control pitch :-> pitch
Derive.s_pitch #=)
instance ToLibrary Derive.ValCall where
to_library :: [Entry ValCall] -> Library -> Library
to_library = (Library :-> [Entry ValCall]
forall {gen} {trans} {track} {val}.
ScopesT gen trans track val :-> val
Derive.s_val #=)
type Shadowed = ((Text, Module.Module), [Expr.Symbol])
compile :: Library -> (Derive.Builtins, [Shadowed])
compile :: Library -> (Builtins, [Shadowed])
compile (Derive.Scopes Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)]
lgen Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)]
ltrans Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)]
ltrack [Entry ValCall]
lval) = Logger Shadowed Builtins -> (Builtins, [Shadowed])
forall w a. Logger w a -> (a, [w])
Logger.runId (Logger Shadowed Builtins -> (Builtins, [Shadowed]))
-> Logger Shadowed Builtins -> (Builtins, [Shadowed])
forall a b. (a -> b) -> a -> b
$ MkScopeCallMaps
(Generator Note) (Generator Control) (Generator Pitch)
-> MkScopeCallMaps
(Transformer Note) (Transformer Control) (Transformer Pitch)
-> MkScopeCallMaps
(TrackCall Note) (TrackCall Control) (TrackCall Pitch)
-> ModuleMap ValCall
-> Builtins
forall gen trans track val.
gen -> trans -> track -> val -> ScopesT gen trans track val
Derive.Scopes
(MkScopeCallMaps
(Generator Note) (Generator Control) (Generator Pitch)
-> MkScopeCallMaps
(Transformer Note) (Transformer Control) (Transformer Pitch)
-> MkScopeCallMaps
(TrackCall Note) (TrackCall Control) (TrackCall Pitch)
-> ModuleMap ValCall
-> Builtins)
-> LoggerT
Shadowed
Identity
(MkScopeCallMaps
(Generator Note) (Generator Control) (Generator Pitch))
-> LoggerT
Shadowed
Identity
(MkScopeCallMaps
(Transformer Note) (Transformer Control) (Transformer Pitch)
-> MkScopeCallMaps
(TrackCall Note) (TrackCall Control) (TrackCall Pitch)
-> ModuleMap ValCall
-> Builtins)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Generator Note -> CallDoc)
-> (Generator Control -> CallDoc)
-> (Generator Pitch -> CallDoc)
-> Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)]
-> LoggerT
Shadowed
Identity
(MkScopeCallMaps
(Generator Note) (Generator Control) (Generator Pitch))
forall {a} {f :: * -> *} {call} {call} {call}.
(MonadLogger ((a, Module), [Symbol]) f, IsString a) =>
(call -> CallDoc)
-> (call -> CallDoc)
-> (call -> CallDoc)
-> Scope [Entry call] [Entry call] [Entry call]
-> f (Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
compile_scope Generator Note -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Generator Control -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Generator Pitch -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Scope
[Entry (Generator Note)]
[Entry (Generator Control)]
[Entry (Generator Pitch)]
lgen
LoggerT
Shadowed
Identity
(MkScopeCallMaps
(Transformer Note) (Transformer Control) (Transformer Pitch)
-> MkScopeCallMaps
(TrackCall Note) (TrackCall Control) (TrackCall Pitch)
-> ModuleMap ValCall
-> Builtins)
-> LoggerT
Shadowed
Identity
(MkScopeCallMaps
(Transformer Note) (Transformer Control) (Transformer Pitch))
-> LoggerT
Shadowed
Identity
(MkScopeCallMaps
(TrackCall Note) (TrackCall Control) (TrackCall Pitch)
-> ModuleMap ValCall -> Builtins)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Transformer Note -> CallDoc)
-> (Transformer Control -> CallDoc)
-> (Transformer Pitch -> CallDoc)
-> Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)]
-> LoggerT
Shadowed
Identity
(MkScopeCallMaps
(Transformer Note) (Transformer Control) (Transformer Pitch))
forall {a} {f :: * -> *} {call} {call} {call}.
(MonadLogger ((a, Module), [Symbol]) f, IsString a) =>
(call -> CallDoc)
-> (call -> CallDoc)
-> (call -> CallDoc)
-> Scope [Entry call] [Entry call] [Entry call]
-> f (Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
compile_scope Transformer Note -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Transformer Control -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Transformer Pitch -> CallDoc
forall func. Call func -> CallDoc
Derive.call_doc Scope
[Entry (Transformer Note)]
[Entry (Transformer Control)]
[Entry (Transformer Pitch)]
ltrans
LoggerT
Shadowed
Identity
(MkScopeCallMaps
(TrackCall Note) (TrackCall Control) (TrackCall Pitch)
-> ModuleMap ValCall -> Builtins)
-> LoggerT
Shadowed
Identity
(MkScopeCallMaps
(TrackCall Note) (TrackCall Control) (TrackCall Pitch))
-> LoggerT Shadowed Identity (ModuleMap ValCall -> Builtins)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TrackCall Note -> CallDoc)
-> (TrackCall Control -> CallDoc)
-> (TrackCall Pitch -> CallDoc)
-> Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)]
-> LoggerT
Shadowed
Identity
(MkScopeCallMaps
(TrackCall Note) (TrackCall Control) (TrackCall Pitch))
forall {a} {f :: * -> *} {call} {call} {call}.
(MonadLogger ((a, Module), [Symbol]) f, IsString a) =>
(call -> CallDoc)
-> (call -> CallDoc)
-> (call -> CallDoc)
-> Scope [Entry call] [Entry call] [Entry call]
-> f (Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
compile_scope TrackCall Note -> CallDoc
forall d. TrackCall d -> CallDoc
Derive.tcall_doc TrackCall Control -> CallDoc
forall d. TrackCall d -> CallDoc
Derive.tcall_doc TrackCall Pitch -> CallDoc
forall d. TrackCall d -> CallDoc
Derive.tcall_doc Scope
[Entry (TrackCall Note)]
[Entry (TrackCall Control)]
[Entry (TrackCall Pitch)]
ltrack
LoggerT Shadowed Identity (ModuleMap ValCall -> Builtins)
-> LoggerT Shadowed Identity (ModuleMap ValCall)
-> Logger Shadowed Builtins
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> (ValCall -> CallDoc)
-> [Entry ValCall]
-> LoggerT Shadowed Identity (ModuleMap ValCall)
forall {f :: * -> *} {a} {call}.
MonadLogger ((a, Module), [Symbol]) f =>
a
-> (call -> CallDoc)
-> [Entry call]
-> f (Map Module (CallMap call))
compile_entries Text
"val" ValCall -> CallDoc
Derive.vcall_doc [Entry ValCall]
lval
where
compile_scope :: (call -> CallDoc)
-> (call -> CallDoc)
-> (call -> CallDoc)
-> Scope [Entry call] [Entry call] [Entry call]
-> f (Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
compile_scope call -> CallDoc
doc1 call -> CallDoc
doc2 call -> CallDoc
doc3 (Derive.Scope [Entry call]
note [Entry call]
control [Entry call]
pitch) =
Map Module (CallMap call)
-> Map Module (CallMap call)
-> Map Module (CallMap call)
-> Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call))
forall note control pitch.
note -> control -> pitch -> Scope note control pitch
Derive.Scope
(Map Module (CallMap call)
-> Map Module (CallMap call)
-> Map Module (CallMap call)
-> Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
-> f (Map Module (CallMap call))
-> f (Map Module (CallMap call)
-> Map Module (CallMap call)
-> Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
-> (call -> CallDoc)
-> [Entry call]
-> f (Map Module (CallMap call))
forall {f :: * -> *} {a} {call}.
MonadLogger ((a, Module), [Symbol]) f =>
a
-> (call -> CallDoc)
-> [Entry call]
-> f (Map Module (CallMap call))
compile_entries a
"note" call -> CallDoc
doc1 [Entry call]
note
f (Map Module (CallMap call)
-> Map Module (CallMap call)
-> Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
-> f (Map Module (CallMap call))
-> f (Map Module (CallMap call)
-> Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a
-> (call -> CallDoc)
-> [Entry call]
-> f (Map Module (CallMap call))
forall {f :: * -> *} {a} {call}.
MonadLogger ((a, Module), [Symbol]) f =>
a
-> (call -> CallDoc)
-> [Entry call]
-> f (Map Module (CallMap call))
compile_entries a
"control" call -> CallDoc
doc2 [Entry call]
control
f (Map Module (CallMap call)
-> Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
-> f (Map Module (CallMap call))
-> f (Scope
(Map Module (CallMap call))
(Map Module (CallMap call))
(Map Module (CallMap call)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a
-> (call -> CallDoc)
-> [Entry call]
-> f (Map Module (CallMap call))
forall {f :: * -> *} {a} {call}.
MonadLogger ((a, Module), [Symbol]) f =>
a
-> (call -> CallDoc)
-> [Entry call]
-> f (Map Module (CallMap call))
compile_entries a
"pitch" call -> CallDoc
doc3 [Entry call]
pitch
compile_entries :: a
-> (call -> CallDoc)
-> [Entry call]
-> f (Map Module (CallMap call))
compile_entries a
kind call -> CallDoc
get_doc = ([(Module, CallMap call)] -> Map Module (CallMap call))
-> f [(Module, CallMap call)] -> f (Map Module (CallMap call))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Module, CallMap call)] -> Map Module (CallMap call)
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
(f [(Module, CallMap call)] -> f (Map Module (CallMap call)))
-> ([Entry call] -> f [(Module, CallMap call)])
-> [Entry call]
-> f (Map Module (CallMap call))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Module, [Entry call]) -> f (Module, CallMap call))
-> [(Module, [Entry call])] -> f [(Module, CallMap call)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (a -> (Module, [Entry call]) -> f (Module, CallMap call)
forall {m :: * -> *} {a} {t} {call}.
MonadLogger ((a, t), [Symbol]) m =>
a -> (t, [Entry call]) -> m (t, CallMap call)
compile1 a
kind)
([(Module, [Entry call])] -> f [(Module, CallMap call)])
-> ([Entry call] -> [(Module, [Entry call])])
-> [Entry call]
-> f [(Module, CallMap call)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry call -> Module) -> [Entry call] -> [(Module, [Entry call])]
forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
Seq.keyed_group_sort (CallDoc -> Module
Derive.cdoc_module (CallDoc -> Module)
-> (Entry call -> CallDoc) -> Entry call -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry call -> CallDoc
entry_doc)
where
entry_doc :: Entry call -> CallDoc
entry_doc (Single Symbol
_ call
call) = call -> CallDoc
get_doc call
call
entry_doc (Pattern PatternCall call
pattern) = PatternCall call -> CallDoc
forall call. PatternCall call -> CallDoc
Derive.pat_call_doc PatternCall call
pattern
compile1 :: a -> (t, [Entry call]) -> m (t, CallMap call)
compile1 a
kind (t
module_, [Entry call]
entries) = do
let ([(Symbol, call)]
singles, [PatternCall call]
patterns) = [Entry call] -> ([(Symbol, call)], [PatternCall call])
forall {b}. [Entry b] -> ([(Symbol, b)], [PatternCall b])
partition [Entry call]
entries
let (Map Symbol call
cmap, [(Symbol, call)]
dups) = [(Symbol, call)] -> (Map Symbol call, [(Symbol, call)])
forall a b. Ord a => [(a, b)] -> (Map a b, [(a, b)])
Maps.unique [(Symbol, call)]
singles
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Symbol, call)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Symbol, call)]
dups) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
((a, t), [Symbol]) -> m ()
forall w (m :: * -> *). MonadLogger w m => w -> m ()
Logger.log ((a
kind, t
module_), ((Symbol, call) -> Symbol) -> [(Symbol, call)] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, call) -> Symbol
forall a b. (a, b) -> a
fst [(Symbol, call)]
dups)
(t, CallMap call) -> m (t, CallMap call)
forall (m :: * -> *) a. Monad m => a -> m a
return ((t, CallMap call) -> m (t, CallMap call))
-> (t, CallMap call) -> m (t, CallMap call)
forall a b. (a -> b) -> a -> b
$ (t
module_,) (CallMap call -> (t, CallMap call))
-> CallMap call -> (t, CallMap call)
forall a b. (a -> b) -> a -> b
$ Derive.CallMap
{ call_map :: Map Symbol call
call_map = Map Symbol call
cmap
, call_patterns :: [PatternCall call]
call_patterns = [PatternCall call]
patterns
}
partition :: [Entry b] -> ([(Symbol, b)], [PatternCall b])
partition = [Either (Symbol, b) (PatternCall b)]
-> ([(Symbol, b)], [PatternCall b])
forall a b. [Either a b] -> ([a], [b])
Either.partitionEithers ([Either (Symbol, b) (PatternCall b)]
-> ([(Symbol, b)], [PatternCall b]))
-> ([Entry b] -> [Either (Symbol, b) (PatternCall b)])
-> [Entry b]
-> ([(Symbol, b)], [PatternCall b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry b -> Either (Symbol, b) (PatternCall b))
-> [Entry b] -> [Either (Symbol, b) (PatternCall b)]
forall a b. (a -> b) -> [a] -> [b]
map Entry b -> Either (Symbol, b) (PatternCall b)
forall {b}. Entry b -> Either (Symbol, b) (PatternCall b)
partition1
partition1 :: Entry b -> Either (Symbol, b) (PatternCall b)
partition1 (Single Symbol
sym b
call) = (Symbol, b) -> Either (Symbol, b) (PatternCall b)
forall a b. a -> Either a b
Left (Symbol
sym, b
call)
partition1 (Pattern PatternCall b
pattern) = PatternCall b -> Either (Symbol, b) (PatternCall b)
forall a b. b -> Either a b
Right PatternCall b
pattern
compile_log :: Log.LogMonad m => Library -> m Derive.Builtins
compile_log :: forall (m :: * -> *). LogMonad m => Library -> m Builtins
compile_log Library
lib = do
let (Builtins
builtins, [Shadowed]
shadows) = Library -> (Builtins, [Shadowed])
compile Library
lib
[Shadowed] -> (Shadowed -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Shadowed]
shadows ((Shadowed -> m ()) -> m ()) -> (Shadowed -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \((Text
call_type, Module
_module), [Symbol]
calls) ->
Text -> m ()
forall (m :: * -> *). (Stack, LogMonad m) => Text -> m ()
Log.warn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
call_type Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" shadowed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Symbol] -> Text
forall a. Pretty a => a -> Text
pretty [Symbol]
calls
Builtins -> m Builtins
forall (m :: * -> *) a. Monad m => a -> m a
return Builtins
builtins