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

-- | 'StaticConfig' is an app-level configuration hook.  The idea is that
-- the local configuration can use it to override things.
module App.StaticConfig where
import qualified Data.Map as Map
import qualified Data.Set as Set

import qualified App.Config as Config
import qualified App.Path as Path
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Msg as Msg
import qualified Cmd.SaveGitT as SaveGitT

import qualified Derive.Derive as Derive
import qualified Instrument.Inst as Inst
import qualified Midi.Interface as Interface
import qualified Midi.Midi as Midi
import qualified Synth.Shared.Config as Shared.Config
import qualified Ui.Color as Color

import           Global


-- * static config

data StaticConfig = StaticConfig {
    StaticConfig -> InstrumentDb
instrument_db :: Cmd.InstrumentDb
    -- | These Cmds are run before any of the usual ones, and can implement
    -- local global keymaps and whatnot.
    , StaticConfig -> [Msg -> CmdT IO Status]
global_cmds :: [Msg.Msg -> Cmd.CmdT IO Cmd.Status]

    -- | Default global namespace for deriver calls.
    , StaticConfig -> Builtins
builtins :: Derive.Builtins

    -- | Run this on startup, given the app's argv.  It can set up an initial
    -- block, load a given file, or do nothing.
    -- Remember that no block is focused when this is run, so cmds that need
    -- a focused block will abort.
    , StaticConfig -> [String] -> Either Text (CmdT IO Status)
setup_cmd :: [String] -> Either Text (Cmd.CmdT IO Cmd.Status)
        -- ^ Left on error
    , StaticConfig -> CmdT IO ()
post_setup_cmd :: Cmd.CmdT IO ()
    , StaticConfig -> Midi
midi :: Midi
    , StaticConfig -> Map Highlight Color
highlight_colors :: Map Color.Highlight Color.Color
    -- | See 'Cmd.config_im_play_direct'.
    , StaticConfig -> Bool
im_play_direct :: Bool
    }

empty :: StaticConfig
empty :: StaticConfig
empty = StaticConfig
    { instrument_db :: InstrumentDb
instrument_db = forall code. Db code
Inst.empty
    , global_cmds :: [Msg -> CmdT IO Status]
global_cmds = []
    , builtins :: Builtins
builtins = forall a. Monoid a => a
mempty
    , setup_cmd :: [String] -> Either Text (CmdT IO Status)
setup_cmd = forall a b. a -> b -> a
const (forall a b. a -> Either a b
Left Text
"StaticConfig.setup_cmd not configured")
    , post_setup_cmd :: CmdT IO ()
post_setup_cmd = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , midi :: Midi
midi = Midi
empty_midi
    , highlight_colors :: Map Highlight Color
highlight_colors = forall a. Monoid a => a
mempty
    , im_play_direct :: Bool
im_play_direct = Bool
False
    }

data Midi = Midi {
    -- | Reroute the hardware level read and write devices.  This way,
    -- instruments and saved scores can use symbolic names which are then
    -- mapped to the devices exported by the MIDI driver.
    --
    -- Because input devices are likely to be relatively static, the
    -- read device map is only configured here.
    Midi -> Map ReadDevice ReadDevice
rdev_map :: Map Midi.ReadDevice Midi.ReadDevice
    -- | WriteDevices may vary per score, e.g. softsynths may listen at any
    -- number of virtual devices.  This map is taken as a default, but may
    -- be overridden by the score loaded.
    , Midi -> Map WriteDevice WriteDevice
wdev_map :: Map Midi.WriteDevice Midi.WriteDevice

    -- | Open the given devices on startup.  Even if they aren't plugged in,
    -- they'll be added to the read list so they're automatically connected if
    -- they are plugged in.  If you open a virtual device for both reading and
    -- writing you'll get a loop, so don't do that.
    --
    -- There's no corresponding write_devices because if you don't want
    -- to write to a device, just don't write to it!
    , Midi -> Set ReadDevice
read_devices :: Set Midi.ReadDevice
    } deriving (Int -> Midi -> ShowS
[Midi] -> ShowS
Midi -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Midi] -> ShowS
$cshowList :: [Midi] -> ShowS
show :: Midi -> String
$cshow :: Midi -> String
showsPrec :: Int -> Midi -> ShowS
$cshowsPrec :: Int -> Midi -> ShowS
Show)

empty_midi :: Midi
empty_midi :: Midi
empty_midi = Map ReadDevice ReadDevice
-> Map WriteDevice WriteDevice -> Set ReadDevice -> Midi
Midi forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty forall a. Set a
Set.empty

make_rdev_map :: [(Text, Text)] -> Map Midi.ReadDevice Midi.ReadDevice
make_rdev_map :: [(Text, Text)] -> Map ReadDevice ReadDevice
make_rdev_map = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> ReadDevice
Midi.read_device Text -> ReadDevice
Midi.read_device)

make_wdev_map :: [(Text, Text)] -> Map Midi.WriteDevice Midi.WriteDevice
make_wdev_map :: [(Text, Text)] -> Map WriteDevice WriteDevice
make_wdev_map = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> WriteDevice
Midi.write_device Text -> WriteDevice
Midi.write_device)

make_read_devices :: [Text] -> Set Midi.ReadDevice
make_read_devices :: [Text] -> Set ReadDevice
make_read_devices = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> ReadDevice
Midi.read_device

-- | Create a 'Cmd.Config' from a StaticConfig.
cmd_config :: Path.AppDir -> Path.Canonical -> Interface.Interface
    -> StaticConfig -> SaveGitT.User -> Cmd.Config
cmd_config :: AppDir -> Canonical -> Interface -> StaticConfig -> User -> Config
cmd_config AppDir
app_dir Canonical
save_dir Interface
interface StaticConfig
config User
git_user = Cmd.Config
    { config_app_dir :: AppDir
config_app_dir = AppDir
app_dir
    , config_save_dir :: Canonical
config_save_dir = Canonical
save_dir
    , config_midi_interface :: Interface
config_midi_interface = Interface
interface
    , config_ky_paths :: [String]
config_ky_paths = forall a b. (a -> b) -> [a] -> [b]
map (AppDir -> Relative -> String
Path.to_absolute AppDir
app_dir) [Relative]
Config.ky_paths
    , config_rdev_map :: Map ReadDevice ReadDevice
config_rdev_map = Midi -> Map ReadDevice ReadDevice
rdev_map Midi
midi_config
    , config_wdev_map :: Map WriteDevice WriteDevice
config_wdev_map = Midi -> Map WriteDevice WriteDevice
wdev_map Midi
midi_config
    , config_instrument_db :: InstrumentDb
config_instrument_db = StaticConfig -> InstrumentDb
instrument_db StaticConfig
config
    , config_builtins :: Builtins
config_builtins = StaticConfig -> Builtins
builtins StaticConfig
config
    , config_highlight_colors :: Map Highlight Color
config_highlight_colors = StaticConfig -> Map Highlight Color
highlight_colors StaticConfig
config
    , config_im :: Config
config_im = AppDir -> Config
Shared.Config.config AppDir
app_dir
    , config_git_user :: User
config_git_user = User
git_user
    , config_im_play_direct :: Bool
config_im_play_direct = StaticConfig -> Bool
im_play_direct StaticConfig
config
    }
    where midi_config :: Midi
midi_config = StaticConfig -> Midi
midi StaticConfig
config