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

-- | The @import@ call, and support.
module Derive.C.Prelude.Import (library) where
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Set as Set

import qualified Derive.Call.Module as Module
import qualified Derive.Derive as Derive
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Library as Library
import qualified Derive.Scale as Scale
import qualified Derive.Sig as Sig


library :: Library.Library
library :: Library
library = (forall d. CallableExpr d => [(Symbol, Transformer d)]) -> Library
Library.poly_transformers
    [ (Symbol
"import", forall d. CallableExpr d => Transformer d
c_import)
    , (Symbol
"imports", forall d. CallableExpr d => Transformer d
c_import_symbol)
    , (Symbol
"scale", forall d. CallableExpr d => Transformer d
c_scale)
    ]

c_import :: Derive.CallableExpr d => Derive.Transformer d
c_import :: forall d. CallableExpr d => Transformer d
c_import = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
Module.prelude CallName
"import" forall a. Monoid a => a
mempty
    Doc
"Import the given modules into scope. Calls of all types (note, control,\
    \ pitch, val) are imported. If names clash, the ones from later modules\
    \ win."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d)
Sig.callt (forall a. Typecheck a => ArgName -> Doc -> Parser (NonEmpty a)
Sig.many1 ArgName
"module" Doc
"Import these modules.") forall a b. (a -> b) -> a -> b
$ \NonEmpty Text
modules PassedArgs d
_ Deriver (Stream d)
d ->
        forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Bool -> Module -> Deriver a -> Deriver a
Derive.with_imported Bool
False) Deriver (Stream d)
d forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map Text -> Module
Module.Module (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Text
modules)

c_import_symbol :: Derive.CallableExpr d => Derive.Transformer d
c_import_symbol :: forall d. CallableExpr d => Transformer d
c_import_symbol = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
Module.prelude CallName
"import-symbol" forall a. Monoid a => a
mempty
    Doc
"Import a single symbol, or list of symbols. This imports from all\
    \ namespaces simultaneously: note, control, pitch, and val.\
    \ TODO fix it if it's a problem."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d)
Sig.callt ((,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => ArgName -> Doc -> Parser a
Sig.required ArgName
"module" Doc
"Import this module."
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Typecheck a => ArgName -> Doc -> Parser (NonEmpty a)
Sig.many1 ArgName
"symbol" Doc
"Import these symbols."
    ) forall a b. (a -> b) -> a -> b
$ \(Text
module_, NonEmpty Symbol
syms) PassedArgs d
_args ->
        forall a. Module -> Set Symbol -> Deriver a -> Deriver a
Derive.with_imported_symbols (Text -> Module
Module.Module Text
module_)
            (forall a. Ord a => [a] -> Set a
Set.fromList (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Symbol
syms))

c_scale :: Derive.CallableExpr d => Derive.Transformer d
c_scale :: forall d. CallableExpr d => Transformer d
c_scale = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
Module.prelude CallName
"scale" forall a. Monoid a => a
mempty
    Doc
"Bring a scale into scope."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d)
Sig.callt ((,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Typecheck a =>
ArgName -> EnvironDefault -> Doc -> Parser a
Sig.required_env ArgName
"scale" EnvironDefault
Sig.Unprefixed Doc
"Look up scale by name."
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Typecheck a => ArgName -> Doc -> Parser [a]
Sig.many ArgName
"args" Doc
"Scale arguments."
    ) forall a b. (a -> b) -> a -> b
$ \(Text
name, [Val]
scale_args) PassedArgs d
_args Deriver (Stream d)
deriver -> do
        Scale
scale <- CallName -> [Val] -> Deriver Scale
Scale.get (Text -> CallName
Derive.CallName Text
name) [Val]
scale_args
        -- Set env var so subsequent calls default it.
        forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val_raw Text
EnvKey.scale Text
name forall a b. (a -> b) -> a -> b
$
            forall d. Scale -> Deriver d -> Deriver d
Derive.with_scale Scale
scale Deriver (Stream d)
deriver