-- 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 #-}
-- | Utilities for the Library type.
module Derive.Library (
    -- * make
    Library, library, generators, transformers, vals, pattern
    , ToLibrary, Entry(..)
    , Calls(..), both
    , poly_generators, poly_transformers
    -- * compile
    , 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


-- | The holds the libary of statically-declared calls.  It gets compiled to
-- 'Derive.Builtins' by 'compile'.
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

-- * make

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

-- | This is just a specialization of 'library', just for documentation.
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

-- | This is just a specialization of 'library', just for documentation.
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

-- | This is just a specialization of 'library', just for documentation.
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

-- | Bundle a generator and transformer together, so I can define them
-- together.  Functions to create these are in "Derive.Call.Make".
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

-- | Add a polymorphic generator to all call types.
--
-- The Callable constraint is not needed here, but callers will have it, and
-- for some reason you can't coerce a parametric variable into a constrained
-- one.
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)])
    ]

-- ** ToLibrary

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 #=)

-- * compile

-- | Warnings for shadowed symbols.  ((call_type, module), symbols)
type Shadowed = ((Text, Module.Module), [Expr.Symbol])

-- | Convert Library to Builtins.  This indexes by module and also gives me
-- a place to emit warnings about duplicate symbol names.
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