-- 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

-- | Calls that use 'EnvKey.track_voice' to infer things about the track.
-- For example, you can automatically have the first and second tracks get
-- @hand=l@ and @hand=r@, respectively.  If you use the local definitions
-- file to bind @>pno = infer-hands@, then every @>pno@ track will both set the
-- instruments and the hand.  Only explicitly named instruments are counted,
-- so you can still have multiple tracks for one hand, if they are named @>@.
--
-- TODO this is experimental, because I'm not sure I like it.  It means
-- parts can change just by inserting a new note track, which seems
-- non-obvious.
module Derive.C.Prelude.InferTrackVoice (library) where
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.Sig as Sig

import Global


library :: Library.Library
library :: Library
library = forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
Library.transformers
    [ (Symbol
"infer-hands", (forall d. Taggable d => Transformer d
c_infer_hands :: Derive.Transformer Derive.Note))
    ]

c_infer_hands :: Derive.Taggable d => Derive.Transformer d
c_infer_hands :: forall d. Taggable d => Transformer d
c_infer_hands = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
Module.prelude CallName
"infer-hands" forall a. Monoid a => a
mempty
    Doc
"Infer `hand=l` and `hand=r` for the two tracks explicitly named with the\
    \ same instrument. >2 tracks is an error. This only sets `hand` if it\
    \ isn't already set."
    forall a b. (a -> b) -> a -> b
$ forall y d.
Taggable y =>
Transformer y d -> WithArgDoc (Transformer y d)
Sig.call0t forall a b. (a -> b) -> a -> b
$ \PassedArgs d
_ Deriver (Stream d)
deriver ->
        forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Text -> Deriver Bool
Derive.is_val_set Text
EnvKey.hand) Deriver (Stream d)
deriver forall a b. (a -> b) -> a -> b
$ do
            Maybe Int
voice <- forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.track_voice
            case Maybe Int
voice :: Maybe Int of
                Just Int
0 -> forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
EnvKey.hand (Text
"l" :: Text) Deriver (Stream d)
deriver
                Just Int
1 -> forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
EnvKey.hand (Text
"r" :: Text) Deriver (Stream d)
deriver
                Just Int
n -> forall a. HasCallStack => Text -> Deriver a
Derive.throw forall a b. (a -> b) -> a -> b
$
                    Text
"expected <=2 track-voices, got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Int
n
                Maybe Int
Nothing -> Deriver (Stream d)
deriver