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

-- | Export a 'synth' with all the supported patches.
module Synth.Sampler.PatchDb (db, synth) where
import qualified Data.Map as Map

import qualified Util.Maps as Maps
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Instrument.ImInst as ImInst
import qualified Instrument.Inst as Inst
import qualified Perform.Im.Patch as Im.Patch
import qualified Synth.Faust.EffectC as EffectC
import qualified Synth.Sampler.Patch as Patch
import qualified Synth.Sampler.Patch.Break as Break
import qualified Synth.Sampler.Patch.CengCeng as CengCeng
import qualified Synth.Sampler.Patch.Java as Java
import qualified Synth.Sampler.Patch.Kajar as Kajar
import qualified Synth.Sampler.Patch.KendangBali as KendangBali
import qualified Synth.Sampler.Patch.LittleGong as LittleGong
import qualified Synth.Sampler.Patch.Metronome as Metronome
import qualified Synth.Sampler.Patch.Mridangam as Mridangam
import qualified Synth.Sampler.Patch.Rambat as Rambat
import qualified Synth.Sampler.Patch.Reyong as Reyong
import qualified Synth.Sampler.Patch.Sample as Sample
import qualified Synth.Sampler.Patch.ScGamelan as ScGamelan
import qualified Synth.Sampler.Patch.Wayang as Wayang
import qualified Synth.Sampler.Patch.Zheng as Zheng
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Control as Control

import           Global


db :: Patch.Db
db :: Db
db = FilePath -> [Patch] -> Db
Patch.db FilePath
Config.unsafeSamplerRoot forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Patch]
Break.patches
    , [Patch]
CengCeng.patches
    , [Patch]
Java.patches
    , [Patch]
Kajar.patches
    , [Patch]
KendangBali.patches
    , [Patch]
LittleGong.patches
    , [Patch]
Metronome.patches
    , [Patch]
Mridangam.patches
    , [Patch]
Rambat.patches
    , [Patch]
Reyong.patches
    , [Patch]
Sample.patches
    , [Patch]
ScGamelan.patches
    , [Patch]
Wayang.patches
    , [Patch]
Zheng.patches
    , [Text -> FilePath -> NoteNumber -> Patch
Patch.simple Text
"test" FilePath
"open.flac" NoteNumber
60]
    ]

-- | Declaration for "Local.Instrument".
synth :: Inst.SynthDecl Cmd.InstrumentCode
synth :: SynthDecl InstrumentCode
synth = forall code. Text -> Text -> [(Text, Inst code)] -> SynthDecl code
Inst.SynthDecl Text
Config.samplerName Text
"音 sampler" forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Patch -> Inst InstrumentCode
make) (forall k a. Map k a -> [(k, a)]
Map.toList (Db -> Map Text Patch
Patch._patches Db
db))
    where
    make :: Patch -> Inst InstrumentCode
make Patch
p = Patch -> Inst InstrumentCode
ImInst.make_inst forall a b. (a -> b) -> a -> b
$
        Patch :-> Patch
ImInst.patchforall a b c. Lens a b -> Lens b c -> Lens a c
#Patch :-> Map Control Text
Im.Patch.controls forall f a. Lens f a -> (a -> a) -> f -> f
%= Maybe EffectConfig -> Map Control Text -> Map Control Text
update (Patch -> Maybe EffectConfig
Patch._effect Patch
p) forall a b. (a -> b) -> a -> b
$
        Patch -> Patch
Patch._karyaPatch Patch
p
    update :: Maybe EffectConfig -> Map Control Text -> Map Control Text
update Maybe EffectConfig
effect Map Control Text
controls = forall a. Monoid a => [a] -> a
mconcat
        [ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty EffectConfig -> Map Control Text
effectControls Maybe EffectConfig
effect
        , Map Control Text
controls
        , Map Control Text
Patch.standardControls
        ]

effectControls :: Patch.EffectConfig -> Map Control.Control Text
effectControls :: EffectConfig -> Map Control Text
effectControls (Patch.EffectConfig Text
name Map Control Control
toEffectControl) =
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Map Text (Either Text Patch)
EffectC.patches of
        Just (Right Patch
effect) ->
            forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (\Control
c -> forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Control
c Control
c Map Control Control
toScoreControl) forall a b. (a -> b) -> a -> b
$
                ((Text
"Effect: " forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
": ") <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall ptr cptr. EffectT ptr cptr -> Map Control (cptr, Text)
EffectC._controls Patch
effect
        Maybe (Either Text Patch)
_ -> forall a. Monoid a => a
mempty
    where
    toScoreControl :: Map Control Control
toScoreControl = forall a k. Ord a => Map k a -> Map a k
Maps.invert Map Control Control
toEffectControl