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

-- | Standalone driver for tscore.
module Derive.TScore.TScoreMain where
import qualified Control.Concurrent.MVar as MVar
import qualified Control.Exception as Exception
import qualified Control.Monad.Except as Except

import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Data.Tuple as Tuple
import qualified Data.Vector as Vector

import qualified System.Console.GetOpt as GetOpt
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.IO as IO

import qualified Util.Audio.PortAudio as PortAudio
import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Maps as Maps
import qualified Util.Pretty as Pretty
import qualified Util.Texts as Texts
import qualified Util.Thread as Thread

import qualified App.Config as App.Config
import qualified App.Path as Path
import qualified App.StaticConfig as StaticConfig

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Ky as Ky
import qualified Cmd.Performance as Performance
import qualified Cmd.SaveGitT as SaveGitT
import qualified Cmd.Simple as Simple

import qualified Derive.DeriveSaved as DeriveSaved
import qualified Derive.LEvent as LEvent
import qualified Derive.Parse.Instruments as Instruments
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
import qualified Derive.TScore.T as T
import qualified Derive.TScore.TScore as TScore

import qualified Instrument.Inst as Inst
import qualified Local.Config
import qualified Midi.Interface as Interface
import qualified Midi.Midi as Midi
import qualified Midi.MidiDriver as MidiDriver

import qualified Perform.Im.Convert as Im.Convert
import qualified Perform.Midi.Play as Midi.Play
import qualified Perform.Sc.Note as Sc.Note
import qualified Perform.Sc.Patch as Sc.Patch
import qualified Perform.Sc.Play as Sc.Play
import qualified Perform.Transport as Transport

import qualified Synth.StreamAudio as StreamAudio
import qualified Ui.Transform as Transform
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig

import           Global
import           Types


-- TODO this compiles Cmd.GlobalKeymap, why?
-- SyncKeycaps -> User.Elaforge.Config -> Local.Config -> DeriveSaved
--
-- So I must either split config into interactive and non-interactive, or have
-- some hack to open keycaps without directly calling SyncKeycaps.

-- * main

main :: IO ()
main :: IO ()
main = do
    (State -> State) -> IO ()
Log.configure forall a b. (a -> b) -> a -> b
$ \State
state -> State
state { state_priority :: Priority
Log.state_priority = Priority
Log.Notice }
    ([Flag]
flags, [String]
args, [String]
errors) <- forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
GetOpt.getOpt forall a. ArgOrder a
GetOpt.Permute [OptDescr Flag]
options forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        IO [String]
Environment.getArgs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors) forall a b. (a -> b) -> a -> b
$ forall {a}. [String] -> IO a
usage [String]
errors
    if  | Flag
Check forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
flags -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
check_score [String]
args
        | Flag
Dump forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
flags -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
dump_score [String]
args
        | Flag
List forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
flags -> IO ()
list_devices
        | Bool
otherwise -> case [String]
args of
            [String
fname] -> Maybe String -> String -> IO ()
play_score (forall a. [a] -> Maybe a
Lists.last [String
d | Device String
d <- [Flag]
flags]) String
fname
            [String]
_ -> forall {a}. [String] -> IO a
usage []
    where
    usage :: [String] -> IO a
usage [String]
errors = forall a. Error -> IO a
die forall a b. (a -> b) -> a -> b
$ Error -> Error
Text.stripEnd forall a b. (a -> b) -> a -> b
$ [Error] -> Error
Text.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Error
txt [String]
errors forall a. [a] -> [a] -> [a]
++
        [ Error
"usage: tscore [ flags ] input.tscore"
        , String -> Error
txt forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'\n') forall a b. (a -> b) -> a -> b
$ forall a. String -> [OptDescr a] -> String
GetOpt.usageInfo String
"" [OptDescr Flag]
options
        ]

data Flag = Check | Dump | List | Device String
    deriving (Flag -> Flag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show)

options :: [GetOpt.OptDescr Flag]
options :: [OptDescr Flag]
options =
    [ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option [] [String
"check"] (forall a. a -> ArgDescr a
GetOpt.NoArg Flag
Check) String
"check score only"
    , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option [] [String
"device"] (forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
Device String
"dev")
        String
"use named device"
    , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option [] [String
"dump"] (forall a. a -> ArgDescr a
GetOpt.NoArg Flag
Dump) String
"dump score"
    , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option [] [String
"list"] (forall a. a -> ArgDescr a
GetOpt.NoArg Flag
List) String
"list output devices"
    ]

die :: Text -> IO a
die :: forall a. Error -> IO a
die Error
msg = do
    Handle -> Error -> IO ()
Text.IO.hPutStrLn Handle
IO.stderr Error
msg
    forall a. IO a
Exit.exitFailure

get_device :: String -> IO StreamAudio.Device
get_device :: String -> IO Device
get_device String
name = do
    ([(String, Device)]
devs, String
_) <- IO ([(String, Device)], String)
StreamAudio.getDevices
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. (Stack, MonadIO m) => Error -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Error
"unknown device: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Error
showt String
name) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
==String
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, Device)]
devs

initialize_midi :: (Interface.Interface -> IO a) -> IO a
initialize_midi :: forall a. (Interface -> IO a) -> IO a
initialize_midi Interface -> IO a
app = forall a. Initialize a
MidiDriver.initialize String
"tscore" (forall a b. a -> b -> a
const Bool
False) forall a b. (a -> b) -> a -> b
$ \case
    Left Error
err -> forall a. Error -> IO a
die forall a b. (a -> b) -> a -> b
$ Error
"error initializing midi: " forall a. Semigroup a => a -> a -> a
<> Error
err
    Right RawInterface WriteMessage
midi_interface -> Interface -> IO a
app forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RawInterface WriteMessage -> IO Interface
Interface.track_interface RawInterface WriteMessage
midi_interface

check_score :: FilePath -> IO ()
check_score :: String -> IO ()
check_score String
fname = do
    Error
source <- String -> IO Error
Text.IO.readFile String
fname
    case Error -> Either Error (State, [Allocation])
TScore.parse_score Error
source of
        Left Error
err -> Error -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ String -> Error
txt String
fname forall a. Semigroup a => a -> a -> a
<> Error
": " forall a. Semigroup a => a -> a -> a
<> Error
err
        Right (State
ui_state, [Allocation]
_allocs) ->
            Error -> IO ()
Text.IO.putStr forall a b. (a -> b) -> a -> b
$ State -> Error
Transform.show_stats State
ui_state

-- TODO show duration?  I have to derive for that though.
-- Maybe check should derive!

score_stats :: T.Score -> Text
score_stats :: Score -> Error
score_stats (T.Score [(Pos, Toplevel)]
toplevels) = [Error] -> Error
Text.unwords
    [ forall a. Show a => a -> Error
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block WrappedTracks]
blocks), Error
"blocks"
    , forall a. Show a => a -> Error
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Track Call]
tracks), Error
"tracks"
    , forall a. Show a => a -> Error
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Note Call (NPitch Pitch) NDuration]
notes) forall a. Semigroup a => a -> a -> a
<> Error
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Error
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rest Duration]
rests), Error
"notes/rests"
    ]
    where
    blocks :: [Block WrappedTracks]
blocks = [Block WrappedTracks
b | (Pos
_, T.BlockDefinition Block WrappedTracks
b) <- [(Pos, Toplevel)]
toplevels]
    tracks :: [Track Call]
tracks =
        [ Track Call
t | Block WrappedTracks
b <- [Block WrappedTracks]
blocks, T.WrappedTracks Pos
_ [Tracks Call]
wraps <- [forall tracks. Block tracks -> tracks
T.block_tracks Block WrappedTracks
b]
        , T.Tracks [Track Call]
ts <- [Tracks Call]
wraps, Track Call
t <- [Track Call]
ts
        ]
    notes :: [Note Call (NPitch Pitch) NDuration]
notes = [Note Call (NPitch Pitch) NDuration
n | Track Call
t <- [Track Call]
tracks, T.TNote Pos
_ Note Call (NPitch Pitch) NDuration
n <- forall call.
Track call -> [Token call (NPitch Pitch) NDuration Duration]
T.track_tokens Track Call
t]
    rests :: [Rest Duration]
rests = [Rest Duration
n | Track Call
t <- [Track Call]
tracks, T.TRest Pos
_ Rest Duration
n <- forall call.
Track call -> [Token call (NPitch Pitch) NDuration Duration]
T.track_tokens Track Call
t]

list_devices :: IO ()
list_devices :: IO ()
list_devices = forall a. IO a -> IO a
PortAudio.initialize forall a b. (a -> b) -> a -> b
$ forall a. (Interface -> IO a) -> IO a
initialize_midi forall a b. (a -> b) -> a -> b
$ \Interface
midi_interface -> do
    String -> IO ()
putStrLn String
"Audio devices:"
    ([(String, Device)]
devs, String
default_dev) <- IO ([(String, Device)], String)
StreamAudio.getDevices
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Device)]
devs) forall a b. (a -> b) -> a -> b
$ \String
dev ->
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ (if String
dev forall a. Eq a => a -> a -> Bool
== String
default_dev then String
"* " else String
"  ") forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
dev
    String -> IO ()
putStrLn String
"Midi devices:"
    [(WriteDevice, [WriteDevice])]
wdevs <- forall write_message.
RawInterface write_message -> IO [(WriteDevice, [WriteDevice])]
Interface.write_devices Interface
midi_interface
    StaticConfig
static_config <- IO StaticConfig
Local.Config.load_static_config
    [(WriteDevice, [WriteDevice])]
-> Map WriteDevice WriteDevice -> IO ()
print_midi_devices [(WriteDevice, [WriteDevice])]
wdevs
        (Midi -> Map WriteDevice WriteDevice
StaticConfig.wdev_map (StaticConfig -> Midi
StaticConfig.midi StaticConfig
static_config))

dump_score :: FilePath -> IO ()
dump_score :: String -> IO ()
dump_score String
fname = do
    Error
source <- String -> IO Error
Text.IO.readFile String
fname
    Config
cmd_config <- IO Config
DeriveSaved.load_cmd_config
    (State
ui_state, State
cmd_state) <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Error -> IO a
die forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Config -> Error -> IO (Either Error (State, State))
load_score Config
cmd_config Error
source
    State
dump <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Error -> IO a
die forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Error
pretty) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        forall a. State -> StateId a -> Either Error a
Ui.eval State
ui_state forall (m :: * -> *). M m => m State
Simple.dump_state
    forall a. Pretty a => a -> IO ()
Pretty.pprint State
dump
    String -> IO ()
putStrLn String
"\n\tscore events:"
    BlockId
block_id <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Error -> IO a
die Error
"no root block") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Maybe BlockId
UiConfig.root forall f a. Lens f a -> f -> a
#$ State
ui_state
    let (Vector Event
events, [Msg]
logs) = State -> State -> BlockId -> (Vector Event, [Msg])
derive State
ui_state State
cmd_state BlockId
block_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write [Msg]
logs
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Error -> IO ()
Text.IO.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Error
Score.short_event) Vector Event
events

    Vector Event
events <- State -> State -> BlockId -> Vector Event -> IO (Vector Event)
dump_im State
ui_state State
cmd_state BlockId
block_id Vector Event
events
    let (([LEvent WriteMessage]
midi_msgs, [LEvent Note]
sc_msgs), [Msg]
logs) =
            State
-> State
-> Vector Event
-> (([LEvent WriteMessage], [LEvent Note]), [Msg])
DeriveSaved.perform State
cmd_state State
ui_state Vector Event
events
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write [Msg]
logs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEvent WriteMessage]
midi_msgs) forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn String
"\n\tmidi msgs:"
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Pretty a => a -> IO ()
Pretty.pprint [LEvent WriteMessage]
midi_msgs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEvent Note]
sc_msgs) forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn String
"\n\tsc msgs:"
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Pretty a => a -> IO ()
Pretty.pprint [LEvent Note]
sc_msgs

dump_im :: Ui.State -> Cmd.State -> BlockId -> Vector.Vector Score.Event
    -> IO (Vector.Vector Score.Event)
dump_im :: State -> State -> BlockId -> Vector Event -> IO (Vector Event)
dump_im State
ui_state State
cmd_state BlockId
block_id Vector Event
events = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Note]
im_notes Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Msg]
logs) forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn String
"\n\tim events:"
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write [Msg]
logs
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Pretty a => a -> IO ()
Pretty.pprint [Note]
im_notes
    forall (m :: * -> *) a. Monad m => a -> m a
return Vector Event
rest_events
    where
    (Vector Event
im_events, Vector Event
rest_events) = forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
Vector.partition Event -> Bool
is_im_event Vector Event
events
    ([Note]
im_notes, [Msg]
logs) = forall d. [LEvent d] -> ([d], [Msg])
LEvent.partition forall a b. (a -> b) -> a -> b
$
        BlockId
-> (Instrument -> Maybe ResolvedInstrument)
-> [Event]
-> [LEvent Note]
Im.Convert.convert BlockId
block_id Instrument -> Maybe ResolvedInstrument
lookup_inst forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
Vector.toList Vector Event
im_events
    is_im_event :: Event -> Bool
is_im_event =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall {code}. Inst code -> Bool
is_im forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolvedInstrument -> Inst
Cmd.inst_instrument) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instrument -> Maybe ResolvedInstrument
lookup_inst
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Instrument
Score.event_instrument
    is_im :: Inst code -> Bool
is_im (Inst.Inst (Inst.Im {}) Common code
_) = Bool
True
    is_im Inst code
_ = Bool
False
    lookup_inst :: Instrument -> Maybe ResolvedInstrument
lookup_inst = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> State -> Instrument -> Either Error ResolvedInstrument
Cmd.state_lookup_instrument State
ui_state State
cmd_state

play_score :: Maybe String -> FilePath -> IO ()
play_score :: Maybe String -> String -> IO ()
play_score Maybe String
mb_device String
fname = forall a. IO a -> IO a
PortAudio.initialize forall a b. (a -> b) -> a -> b
$ forall a. (Interface -> IO a) -> IO a
initialize_midi forall a b. (a -> b) -> a -> b
$
        \Interface
midi_interface -> do
    Error
source <- String -> IO Error
Text.IO.readFile String
fname
    Config
cmd_config <- Interface -> IO Config
load_cmd_config Interface
midi_interface
    (State
ui_state, State
cmd_state) <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Error -> IO a
die forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Config -> Error -> IO (Either Error (State, State))
load_score Config
cmd_config Error
source
    State -> State -> IO ()
initialize_instruments State
ui_state State
cmd_state

    BlockId
block_id <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Error -> IO a
die Error
"no root block") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Maybe BlockId
UiConfig.root forall f a. Lens f a -> f -> a
#$ State
ui_state
    let (Vector Event
im_events, [Msg]
logs) = State -> State -> BlockId -> (Vector Event, [Msg])
derive State
ui_state State
cmd_state BlockId
block_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write [Msg]
logs

    let start :: RealTime
start = RealTime
0 -- TODO from cmdline

    let score_path :: String
score_path = String
fname
    ([Process]
procs, Vector Event
events) <- String
-> State
-> State
-> Vector Event
-> BlockId
-> IO ([Process], Vector Event)
perform_im String
score_path State
cmd_state State
ui_state Vector Event
im_events
        BlockId
block_id
    PlayControl
play_ctl <- IO PlayControl
Transport.play_control
    ActivePlayers
players <- IO ActivePlayers
Transport.active_players
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Process]
procs) forall a b. (a -> b) -> a -> b
$ do
        Maybe Device
mb_device <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO Device
get_device Maybe String
mb_device
        Maybe Device
-> String
-> ActivePlayers
-> PlayControl
-> BlockId
-> RealTime
-> Vector Event
-> Set Instrument
-> [Process]
-> IO ()
play_im Maybe Device
mb_device String
score_path ActivePlayers
players PlayControl
play_ctl BlockId
block_id RealTime
start Vector Event
im_events
            (State -> Set Instrument
get_im_instruments State
ui_state) [Process]
procs

    let (([LEvent WriteMessage]
midi_msgs, [LEvent Note]
sc_msgs), [Msg]
logs) =
            State
-> State
-> Vector Event
-> (([LEvent WriteMessage], [LEvent Note]), [Msg])
DeriveSaved.perform State
cmd_state State
ui_state Vector Event
events
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write [Msg]
logs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEvent Note]
sc_msgs) forall a b. (a -> b) -> a -> b
$ State -> PlayNotes -> Maybe RealTime -> IO ()
Sc.Play.play
        (Sc.Play.State { _play_control :: PlayControl
_play_control = PlayControl
play_ctl, _players :: ActivePlayers
_players = ActivePlayers
players })
        (Sc.Note.PlayNotes { shift :: RealTime
shift = RealTime
0, stretch :: RealTime
stretch = RealTime
1, notes :: [LEvent Note]
notes = [LEvent Note]
sc_msgs })
        forall a. Maybe a
Nothing

    -- TODO since I have to wait for im, I may have to bump MIDI forward.
    -- Of course they won't be very in sync anyway...
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEvent WriteMessage]
midi_msgs) forall a b. (a -> b) -> a -> b
$
        PlayControl
-> ActivePlayers
-> Interface
-> State
-> State
-> [LEvent WriteMessage]
-> IO ()
play_midi PlayControl
play_ctl ActivePlayers
players Interface
midi_interface State
cmd_state State
ui_state [LEvent WriteMessage]
midi_msgs

    String -> IO () -> IO ThreadId
Thread.startLogged String
"kbd" forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn String
"press return to stop player"
        String
_ <- IO String
IO.getLine
        PlayControl -> IO ()
Transport.stop_player PlayControl
play_ctl
    String -> IO ()
putStrLn String
"waiting for players to complete..."
    ActivePlayers -> IO ()
Transport.wait_player_stopped ActivePlayers
players
    Seconds -> IO ()
Thread.delay Seconds
0.1 -- let threads print final logs before exiting
    String -> IO ()
putStrLn String
"done"

initialize_instruments :: Ui.State -> Cmd.State -> IO ()
initialize_instruments :: State -> State -> IO ()
initialize_instruments State
ui_state State
cmd_state = do
    (Either String ()
result, [Msg]
logs) <- forall (m :: * -> *) a.
Monad m =>
State -> State -> CmdT m a -> m (Either String a, [Msg])
Cmd.eval State
ui_state State
cmd_state CmdT IO ()
sc_initialize
    case Either String ()
result of
        Left String
err -> forall (m :: * -> *). (Stack, LogMonad m) => Error -> m ()
Log.warn forall a b. (a -> b) -> a -> b
$ String -> Error
txt String
err
        Right () -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write [Msg]
logs

-- | Ask scsynth to load the patches.  TODO: if this gets slow, is there some
-- way to detect if the server is up to date and skip this?
sc_initialize :: Cmd.CmdT IO ()
sc_initialize :: CmdT IO ()
sc_initialize = do
    [Instrument]
insts <- forall (m :: * -> *) a. M m => (Config -> a) -> m a
Ui.get_config forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Allocations -> Map Instrument Allocation
UiConfig.unallocations
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Allocations
UiConfig.config_allocations
    [Patch]
patches <- forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ResolvedInstrument -> Maybe Patch
Cmd.sc_patch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
(Stack, M m) =>
Instrument -> m ResolvedInstrument
Cmd.get_instrument [Instrument]
insts
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Patch]
patches) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        IO ()
Sc.Play.add_default_group
        [Patch] -> IO ()
sc_initialize_patches [Patch]
patches

sc_initialize_patches :: [Sc.Patch.Patch] -> IO ()
sc_initialize_patches :: [Patch] -> IO ()
sc_initialize_patches [Patch]
patches = IO (Either Error Error)
Sc.Play.version forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Error
err -> forall (m :: * -> *) a. (Stack, MonadIO m) => Error -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Error
"can't initialize sc patches: " forall a. Semigroup a => a -> a -> a
<> Error
err
    Right Error
msg -> do
        Error -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Error
"found scsynth: " forall a. Semigroup a => a -> a -> a
<> Error
msg
        Error -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Error
"loading patches: "
            forall a. Semigroup a => a -> a -> a
<> [Error] -> Error
Text.unwords (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Textlike a => a -> Error
Texts.toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Patch -> PatchName
Sc.Patch.name) [Patch]
patches)
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Patch -> IO ()
Sc.Play.initialize_patch [Patch]
patches
        ((), Error
dur) <- forall (m :: * -> *) a. MonadIO m => m a -> m (a, Error)
Thread.timeActionText forall a b. (a -> b) -> a -> b
$ IO ()
Sc.Play.sync
        Error -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Error
"sync took: " forall a. Semigroup a => a -> a -> a
<> Error
dur

-- * midi

play_midi :: Transport.PlayControl -> Transport.ActivePlayers
    -> Interface.Interface -> Cmd.State -> Ui.State
    -> [LEvent.LEvent Midi.WriteMessage] -> IO ()
play_midi :: PlayControl
-> ActivePlayers
-> Interface
-> State
-> State
-> [LEvent WriteMessage]
-> IO ()
play_midi PlayControl
play_ctl ActivePlayers
players Interface
midi_interface State
cmd_state State
ui_state [LEvent WriteMessage]
midi_msgs = do
    [(WriteDevice, [WriteDevice])]
wdevs <- forall write_message.
RawInterface write_message -> IO [(WriteDevice, [WriteDevice])]
Interface.write_devices Interface
midi_interface
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall write_message.
RawInterface write_message -> WriteDevice -> IO Bool
Interface.connect_write_device Interface
midi_interface) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(WriteDevice, [WriteDevice])]
wdevs)
    MVar State
mvar <- forall a. a -> IO (MVar a)
MVar.newMVar State
ui_state
    State
-> Maybe SyncConfig
-> Error
-> [LEvent WriteMessage]
-> Maybe RealTime
-> IO ()
Midi.Play.play (MVar State -> State
midi_state MVar State
mvar) forall a. Maybe a
Nothing Error
"tscore" [LEvent WriteMessage]
midi_msgs forall a. Maybe a
Nothing
    where
    midi_state :: MVar State -> State
midi_state MVar State
mvar = Midi.Play.State
        { _play_control :: PlayControl
_play_control = PlayControl
play_ctl
        , _players :: ActivePlayers
_players = ActivePlayers
players
        , _info :: Info
_info = MVar State -> Info
transport_info MVar State
mvar
        , _im_end :: Maybe RealTime
_im_end = forall a. Maybe a
Nothing
        }
    transport_info :: MVar State -> Info
transport_info MVar State
mvar = Transport.Info
        { info_send_status :: Status -> IO ()
info_send_status = \Status
status -> forall a. Show a => a -> IO ()
print Status
status -- TODO
        , info_midi_writer :: Message -> IO ()
info_midi_writer = State -> Message -> IO ()
Cmd.state_midi_writer State
cmd_state
        , info_midi_abort :: IO ()
info_midi_abort = forall write_message. RawInterface write_message -> IO ()
Interface.abort Interface
midi_interface
        , info_get_current_time :: IO RealTime
info_get_current_time = forall write_message. RawInterface write_message -> IO RealTime
Interface.now Interface
midi_interface
        -- This is unused by midi player, but Midi.Play wants it anyway
        , info_state :: MVar State
info_state = MVar State
mvar
        }

print_midi_devices :: [(Midi.WriteDevice, [Midi.WriteDevice])]
    -> Map Midi.WriteDevice Midi.WriteDevice -> IO ()
print_midi_devices :: [(WriteDevice, [WriteDevice])]
-> Map WriteDevice WriteDevice -> IO ()
print_midi_devices [(WriteDevice, [WriteDevice])]
wdevs Map WriteDevice WriteDevice
wdev_map =
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(WriteDevice, [WriteDevice])]
wdevs forall a b. (a -> b) -> a -> b
$ \(WriteDevice
wdev, [WriteDevice]
aliases) -> Error -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ [Error] -> Error
Text.unwords forall a b. (a -> b) -> a -> b
$
        [ Error
"  " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Error
pretty WriteDevice
wdev
        , if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WriteDevice]
aliases then Error
"" else forall a. Pretty a => a -> Error
pretty [WriteDevice]
aliases
        , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Error
"" ((Error
"<- "<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> [Error] -> Error
Text.intercalate Error
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Error
pretty) forall a b. (a -> b) -> a -> b
$
            forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WriteDevice
wdev Map WriteDevice [WriteDevice]
wdev_to_names
        ]
    where wdev_to_names :: Map WriteDevice [WriteDevice]
wdev_to_names = forall k a. Ord k => [(k, a)] -> Map k [a]
Maps.multimap forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
Tuple.swap forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map WriteDevice WriteDevice
wdev_map

-- * derive

derive :: Ui.State -> Cmd.State -> BlockId
    -> (Vector.Vector Score.Event, [Log.Msg])
derive :: State -> State -> BlockId -> (Vector Event, [Msg])
derive State
ui_state State
cmd_state BlockId
block_id = (Performance -> Vector Event
Cmd.perf_events Performance
perf, [Msg]
warns forall a. [a] -> [a] -> [a]
++ [Msg]
logs)
    where
    (Performance
perf, [Msg]
logs) = State -> State -> BlockId -> (Performance, [Msg])
Performance.derive State
ui_state State
cmd_state BlockId
block_id
    warns :: [Msg]
warns = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>=Priority
Log.Warn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> Priority
Log.msg_priority) (Performance -> [Msg]
Cmd.perf_logs Performance
perf)

-- Derived from Solkattu.Play.derive_to_disk.
perform_im :: FilePath -> Cmd.State -> Ui.State -> Vector.Vector Score.Event
    -> BlockId -> IO ([Performance.Process], Vector.Vector Score.Event)
perform_im :: String
-> State
-> State
-> Vector Event
-> BlockId
-> IO ([Process], Vector Event)
perform_im String
score_path State
cmd_state State
ui_state Vector Event
events BlockId
block_id = do
    let im_config :: Config
im_config = Config -> Config
Cmd.config_im (State -> Config
Cmd.state_config State
cmd_state)
        lookup_inst :: Instrument -> Maybe ResolvedInstrument
lookup_inst = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> State -> Instrument -> Either Error ResolvedInstrument
Cmd.state_lookup_instrument State
ui_state State
cmd_state
    ([Process]
procs, Vector Event
non_im) <- Config
-> (Instrument -> Maybe ResolvedInstrument)
-> String
-> RealTime
-> RealTime
-> BlockId
-> Vector Event
-> IO ([Process], Vector Event)
Performance.evaluate_im Config
im_config Instrument -> Maybe ResolvedInstrument
lookup_inst String
score_path
        RealTime
0 RealTime
1 BlockId
block_id Vector Event
events
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Process]
procs, Vector Event
non_im)

play_im :: Maybe StreamAudio.Device -> FilePath -> Transport.ActivePlayers
    -> Transport.PlayControl -> BlockId -> RealTime
    -> Vector.Vector Score.Event -> Set ScoreT.Instrument
    -> [Performance.Process] -> IO ()
play_im :: Maybe Device
-> String
-> ActivePlayers
-> PlayControl
-> BlockId
-> RealTime
-> Vector Event
-> Set Instrument
-> [Process]
-> IO ()
play_im Maybe Device
mb_device String
score_path ActivePlayers
players PlayControl
play_ctl BlockId
block_id RealTime
start Vector Event
events
        Set Instrument
im_instruments [Process]
procs = do
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"\nim render:"
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Process]
procs forall a b. (a -> b) -> a -> b
$ \(String
cmd, [String]
args) ->
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String
"%" forall a. a -> [a] -> [a]
: String
cmd forall a. a -> [a] -> [a]
: [String]
args
    MVar ()
ready <- forall a. IO (MVar a)
MVar.newEmptyMVar
    String -> IO () -> IO ThreadId
Thread.startLogged String
"play_im" forall a b. (a -> b) -> a -> b
$ do
        Bool
ok <- IO () -> Set Instrument -> Set Process -> IO Bool
Performance.wait_for_subprocesses
            (forall a. MVar a -> a -> IO ()
MVar.putMVar MVar ()
ready ())
            Set Instrument
expected_instruments
            (forall a. Ord a => [a] -> Set a
Set.fromList [Process]
procs)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (Stack, LogMonad m) => Error -> m ()
Log.warn Error
"background render had a problem"
    forall (m :: * -> *). (Stack, LogMonad m) => Error -> m ()
Log.debug forall a b. (a -> b) -> a -> b
$ Error
"wait for instruments: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Error
pretty Set Instrument
expected_instruments
    forall a. MVar a -> IO a
MVar.takeMVar MVar ()
ready
    let Transport.PlayControl Flag
quit = PlayControl
play_ctl
    let muted :: Set Instrument
muted = forall a. Monoid a => a
mempty
    ActivePlayers -> IO ()
Transport.player_started ActivePlayers
players
    String -> IO () -> IO ThreadId
Thread.startLogged String
"stream_audio" forall a b. (a -> b) -> a -> b
$
        Maybe Device
-> Flag -> String -> BlockId -> Set Instrument -> RealTime -> IO ()
StreamAudio.play Maybe Device
mb_device Flag
quit String
score_path BlockId
block_id Set Instrument
muted RealTime
start
            forall a b. IO a -> IO b -> IO a
`Exception.finally` ActivePlayers -> IO ()
Transport.player_stopped ActivePlayers
players
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
    -- This is a bit too tricky.  I want to make sure all instruments have
    -- the chunk at 'start' rendered.  But I can only wait for im instruments,
    -- or I'll be waiting forever, and then only the ones that are actually
    -- used.  I could filter on start, but since im emits empty chunks for
    -- instruments that haven't started, it should be harmless to wait for them
    -- all.
    expected_instruments :: Set Instrument
expected_instruments = forall a b. (a -> b -> a) -> a -> Vector b -> a
Vector.foldl' Set Instrument -> Event -> Set Instrument
add forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
        forall a. (a -> Bool) -> Vector a -> Vector a
Vector.filter ((forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Instrument
im_instruments) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Instrument
Score.event_instrument)
        Vector Event
events
    add :: Set Instrument -> Event -> Set Instrument
add = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Instrument
Score.event_instrument

get_im_instruments :: Ui.State -> Set ScoreT.Instrument
get_im_instruments :: State -> Set Instrument
get_im_instruments = 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 forall a b. (a, b) -> a
fst
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Allocation -> Bool
UiConfig.is_im_allocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Lens Config (Map Instrument Allocation)
UiConfig.allocations_map #$)

-- * load

type Error = Text

load_cmd_config :: Interface.Interface -> IO Cmd.Config
load_cmd_config :: Interface -> IO Config
load_cmd_config Interface
midi_interface = do
    StaticConfig
static_config <- IO StaticConfig
Local.Config.load_static_config
    AppDir
app_dir <- IO AppDir
Path.get_app_dir
    Canonical
save_dir <- String -> IO Canonical
Path.canonical forall a b. (a -> b) -> a -> b
$ AppDir -> Relative -> String
Path.to_absolute AppDir
app_dir Relative
App.Config.save_dir
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AppDir -> Canonical -> Interface -> StaticConfig -> User -> Config
StaticConfig.cmd_config AppDir
app_dir Canonical
save_dir Interface
midi_interface
        StaticConfig
static_config (Error -> Error -> User
SaveGitT.User Error
"user" Error
"name")

load_score :: Cmd.Config -> Text -> IO (Either Error (Ui.State, Cmd.State))
load_score :: Config -> Error -> IO (Either Error (State, State))
load_score Config
cmd_config Error
source = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT forall a b. (a -> b) -> a -> b
$ do
    (State
ui_state, [Allocation]
allocs) <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
tryRight forall a b. (a -> b) -> a -> b
$ Error -> Either Error (State, [Allocation])
TScore.parse_score Error
source
    -- TODO adjust starting line in error
    (Builtins
builtins, InstrumentAliases
aliases) <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
tryRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Error
"parsing %ky: "<>)
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([String]
-> Error -> IO (Either Error (Builtins, InstrumentAliases))
Ky.load forall a. [a]
ky_paths (Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Error
UiConfig.ky forall f a. Lens f a -> f -> a
#$ State
ui_state))
    let cmd_state :: State
cmd_state =  Builtins -> InstrumentAliases -> State -> State
DeriveSaved.add_library Builtins
builtins InstrumentAliases
aliases forall a b. (a -> b) -> a -> b
$
            Config -> State
Cmd.initial_state Config
cmd_config
    Allocations
allocs <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
tryRight forall a b. (a -> b) -> a -> b
$ LookupBackend
-> [Allocation] -> Allocations -> Either Error Allocations
Instruments.update_ui
        (State -> LookupBackend
Cmd.get_lookup_backend State
cmd_state) [Allocation]
allocs
        (Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Allocations
UiConfig.allocations forall f a. Lens f a -> f -> a
#$ State
ui_state)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Allocations
UiConfig.allocations forall f a. Lens f a -> a -> f -> f
#= Allocations
allocs forall a b. (a -> b) -> a -> b
$ State
ui_state, State
cmd_state)
    where
    -- For now, I don't support ky import.
    ky_paths :: [a]
ky_paths = []