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

-- | Repl cmds providing general UI state operations.
module Cmd.Repl.LState where
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Time as Time
import qualified Data.Vector as Vector

import qualified System.FilePath as FilePath
import           System.FilePath ((</>))
import qualified System.Posix as Posix

import qualified Util.Exceptions as Exceptions
import qualified Util.Lens as Lens
import qualified Util.Log as Log
import qualified Util.PPrint as PPrint
import qualified Util.Pretty as Pretty

import qualified App.Path as Path
import qualified App.ReplProtocol as ReplProtocol
import qualified Cmd.Clip as Clip
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.DiffPerformance as DiffPerformance
import qualified Cmd.Ky as Ky
import qualified Cmd.Lilypond
import qualified Cmd.Load.Midi as Load.Midi
import qualified Cmd.Msg as Msg
import qualified Cmd.PlayUtil as PlayUtil
import qualified Cmd.Repl.LBlock as LBlock
import qualified Cmd.Repl.LEvent as Repl.LEvent
import qualified Cmd.Repl.LTrack as LTrack
import qualified Cmd.Save as Save

import qualified Derive.Derive as Derive
import qualified Derive.LEvent as LEvent
import qualified Derive.Parse.Ky as Parse.Ky
import qualified Derive.Stream as Stream

import qualified Midi.Midi as Midi
import qualified Perform.Im.Convert as Im.Convert
import qualified Perform.Signal as Signal
import qualified Synth.Shared.Note as Shared.Note
import qualified Ui.Id as Id
import qualified Ui.Transform as Transform
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig

import           Global
import           Types


-- | Find text in block titles, track titles, or events.
find :: Text -> Cmd.CmdL Text
find :: Text -> CmdL Text
find Text
search = do
    [(BlockId, Text)]
blocks <- Text -> CmdL [(BlockId, Text)]
LBlock.find Text
search
    [(TrackId, Text)]
tracks <- forall (m :: * -> *). M m => Text -> m [(TrackId, Text)]
LTrack.find Text
search
    [(Range, Text)]
events <- Text -> CmdL [(Range, Text)]
Repl.LEvent.find Text
search
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. (a, a) -> [a]
section forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [(Text
"blocks:", forall a. Pretty a => a -> Text
Pretty.formatted [(BlockId, Text)]
blocks) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(BlockId, Text)]
blocks)]
        , [(Text
"tracks:", forall a. Pretty a => a -> Text
Pretty.formatted [(TrackId, Text)]
tracks) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TrackId, Text)]
tracks)]
        , [(Text
"events:", forall a. Pretty a => a -> Text
Pretty.formatted [(Range, Text)]
events) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Range, Text)]
events)]
        ]
    where section :: (a, a) -> [a]
section (a
title, a
doc) = [a
title, a
doc]

-- | Summarize the various types.  Is this really useful?
summary :: Cmd.CmdL Text
summary :: CmdL Text
summary = do
    Ui.State Map ViewId View
views Map BlockId Block
blocks Map TrackId Track
tracks Map RulerId Ruler
rulers Config
_ <- forall (m :: * -> *). M m => m State
Ui.get
    let f :: Map a a -> String
f Map a a
fm = [String] -> String
PPrint.list (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (forall k a. Map k a -> [k]
Map.keys Map a a
fm))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
txt forall a b. (a -> b) -> a -> b
$ [(String, String)] -> String
PPrint.record
        [ (String
"views", forall {a} {a}. Show a => Map a a -> String
f Map ViewId View
views), (String
"blocks", forall {a} {a}. Show a => Map a a -> String
f Map BlockId Block
blocks)
        , (String
"tracks", forall {a} {a}. Show a => Map a a -> String
f Map TrackId Track
tracks), (String
"rulers", forall {a} {a}. Show a => Map a a -> String
f Map RulerId Ruler
rulers)
        ]

stats :: Cmd.CmdL Text
stats :: CmdL Text
stats = State -> Text
Transform.show_stats forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m State
Ui.get

-- * configure

get_config :: Cmd.CmdL UiConfig.Config
get_config :: CmdL Config
get_config = Lens State Config
Ui.config forall (f :: * -> *) a b. Functor f => Lens a b -> f a -> f b
<#> forall (m :: * -> *). M m => m State
Ui.get

get_default :: Cmd.CmdL UiConfig.Default
get_default :: CmdL Default
get_default = Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Default
UiConfig.default_ forall (f :: * -> *) a b. Functor f => Lens a b -> f a -> f b
<#> forall (m :: * -> *). M m => m State
Ui.get

get_default_tempo :: Cmd.CmdL Signal.Y
get_default_tempo :: CmdL Y
get_default_tempo = Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Default
UiConfig.default_forall a b c. Lens a b -> Lens b c -> Lens a c
#Default :-> Y
UiConfig.tempo forall (f :: * -> *) a b. Functor f => Lens a b -> f a -> f b
<#> forall (m :: * -> *). M m => m State
Ui.get

set_default_tempo :: Signal.Y -> Cmd.CmdL ()
set_default_tempo :: Y -> CmdL ()
set_default_tempo Y
t = forall (m :: * -> *). M m => (Config -> Config) -> m ()
Ui.modify_config forall a b. (a -> b) -> a -> b
$ Config :-> Default
UiConfig.default_forall a b c. Lens a b -> Lens b c -> Lens a c
#Default :-> Y
UiConfig.tempo forall f a. Lens f a -> a -> f -> f
#= Y
t

ky :: Ui.M m => m ReplProtocol.Result
ky :: forall (m :: * -> *). M m => m Result
ky = do
    Text
ky <- forall (m :: * -> *). M m => m Text
get_ky
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NonEmpty Editor -> Result
ReplProtocol.Edit forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> NonEmpty a
:| []) forall a b. (a -> b) -> a -> b
$ ReplProtocol.Editor
        { _file :: File
_file = FileType -> Text -> File
ReplProtocol.Text FileType
ReplProtocol.Ky Text
ky
        , _line_number :: Int
_line_number = Int
0
        , _on_save :: Maybe Text
_on_save = forall a. a -> Maybe a
Just Text
"LState.set_ky %s"
        , _on_send :: Maybe Text
_on_send = forall a. Maybe a
Nothing
        }

get_ky :: Ui.M m => m Text
get_ky :: forall (m :: * -> *). M m => m Text
get_ky = forall (m :: * -> *). M m => m Text
Parse.Ky.get_ky

set_ky :: Text -> Cmd.CmdT IO Text
set_ky :: Text -> CmdL Text
set_ky = Text -> CmdL Text
Ky.set

-- ** meta

get_meta :: Cmd.CmdL UiConfig.Meta
get_meta :: CmdL Meta
get_meta = Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Meta
UiConfig.meta forall (f :: * -> *) a b. Functor f => Lens a b -> f a -> f b
<#> forall (m :: * -> *). M m => m State
Ui.get

set_creation_time :: Cmd.CmdL ()
set_creation_time :: CmdL ()
set_creation_time = do
    UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
Time.getCurrentTime
    forall (m :: * -> *). M m => (Config -> Config) -> m ()
Ui.modify_config forall a b. (a -> b) -> a -> b
$ Config :-> Meta
UiConfig.metaforall a b c. Lens a b -> Lens b c -> Lens a c
#Meta :-> UTCTime
UiConfig.creation forall f a. Lens f a -> a -> f -> f
#= UTCTime
now

get_notes :: Cmd.M m => m Text
get_notes :: forall (m :: * -> *). M m => m Text
get_notes = Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Meta
UiConfig.metaforall a b c. Lens a b -> Lens b c -> Lens a c
#Meta :-> Text
UiConfig.notes forall (f :: * -> *) a b. Functor f => Lens a b -> f a -> f b
<#> forall (m :: * -> *). M m => m State
Ui.get

set_notes :: Cmd.M m => Text -> m ()
set_notes :: forall (m :: * -> *). M m => Text -> m ()
set_notes = forall (m :: * -> *). M m => (Config -> Config) -> m ()
Ui.modify_config forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config :-> Meta
UiConfig.metaforall a b c. Lens a b -> Lens b c -> Lens a c
#Meta :-> Text
UiConfig.notes #=)

-- *** performance

save_perf :: Cmd.CmdT IO Text
save_perf :: CmdL Text
save_perf = do
    Config
config <- forall (m :: * -> *) a. M m => (Config -> a) -> m a
Ui.get_config forall a. a -> a
id
    Maybe Text
midi <- if Allocations -> Bool
UiConfig.has_midi (Config -> Allocations
UiConfig.config_allocations Config
config)
        then CmdL ()
save_midi forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Text
"saved midi") else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Maybe Text
im <- if Allocations -> Bool
UiConfig.has_im (Config -> Allocations
UiConfig.config_allocations Config
config)
        then CmdL ()
save_im forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Text
"saved im") else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    -- TODO sc
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
", " forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
Maybe.catMaybes [Maybe Text
midi, Maybe Text
im]

-- | Save the current root MIDI performance as \"correct\".
save_midi :: Cmd.CmdT IO ()
save_midi :: CmdL ()
save_midi = forall a.
Lens Meta (Map BlockId (Performance a))
-> (BlockId -> CmdT IO a) -> CmdL ()
save_performance Meta :-> Map BlockId MidiPerformance
UiConfig.midi_performances
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Vector a
Vector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => BlockId -> m [WriteMessage]
perform_midi)

save_im :: Cmd.CmdT IO ()
save_im :: CmdL ()
save_im = forall a.
Lens Meta (Map BlockId (Performance a))
-> (BlockId -> CmdT IO a) -> CmdL ()
save_performance Meta :-> Map BlockId ImPerformance
UiConfig.im_performances forall (m :: * -> *). M m => BlockId -> m (Vector Note)
perform_im

save_lilypond :: Cmd.CmdT IO ()
save_lilypond :: CmdL ()
save_lilypond = forall a.
Lens Meta (Map BlockId (Performance a))
-> (BlockId -> CmdT IO a) -> CmdL ()
save_performance Meta :-> Map BlockId LilypondPerformance
UiConfig.lilypond_performances
    forall (m :: * -> *). M m => BlockId -> m Text
perform_lilypond

--

get_midi_performance :: BlockId -> Cmd.CmdL UiConfig.MidiPerformance
get_midi_performance :: BlockId -> CmdL MidiPerformance
get_midi_performance BlockId
block_id =
    forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Cmd.require (Text
"no saved performance for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt BlockId
block_id)
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. M m => (Config -> a) -> m a
Ui.get_config
            (Config :-> Meta
UiConfig.metaforall a b c. Lens a b -> Lens b c -> Lens a c
#Meta :-> Map BlockId MidiPerformance
UiConfig.midi_performances forall a b c. Lens a b -> Lens b c -> Lens a c
# forall k a. Ord k => k -> Lens (Map k a) (Maybe a)
Lens.map BlockId
block_id #$)

-- | Compare the current root block performance against the saved one.
verify_performance :: Cmd.CmdL Text
verify_performance :: CmdL Text
verify_performance = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Ui.get_root_id
    MidiPerformance
perf <- BlockId -> CmdL MidiPerformance
get_midi_performance BlockId
block_id
    [WriteMessage]
midi <- forall (m :: * -> *). M m => BlockId -> m [WriteMessage]
perform_midi BlockId
block_id
    let name :: Text
name = forall a. Ident a => a -> Text
Id.ident_name BlockId
block_id
    String
dir <- forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Cmd.require Text
"need a save dir to put tmp files"
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets State -> Maybe String
Cmd.state_save_dir
    (Maybe Text
maybe_diff, [String]
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        String
-> String
-> MidiPerformance
-> [WriteMessage]
-> IO (Maybe Text, [String])
DiffPerformance.diff_midi (Text -> String
untxt Text
name) String
dir MidiPerformance
perf [WriteMessage]
midi
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"ok!" Maybe Text
maybe_diff

save_performance :: Lens UiConfig.Meta (Map BlockId (UiConfig.Performance a))
    -> (BlockId -> Cmd.CmdT IO a) -> Cmd.CmdT IO ()
save_performance :: forall a.
Lens Meta (Map BlockId (Performance a))
-> (BlockId -> CmdT IO a) -> CmdL ()
save_performance Lens Meta (Map BlockId (Performance a))
field BlockId -> CmdT IO a
perform = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Ui.get_root_id
    a
events <- BlockId -> CmdT IO a
perform BlockId
block_id
    Performance a
perf <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (Performance a)
UiConfig.make_performance a
events
    forall (m :: * -> *). M m => (Meta -> Meta) -> m ()
Ui.modify_meta forall a b. (a -> b) -> a -> b
$ Lens Meta (Map BlockId (Performance a))
field forall f a. Lens f a -> (a -> a) -> f -> f
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BlockId
block_id Performance a
perf

--

perform_midi :: Cmd.M m => BlockId -> m [Midi.WriteMessage]
perform_midi :: forall (m :: * -> *). M m => BlockId -> m [WriteMessage]
perform_midi BlockId
block_id = do
    Performance
perf <- forall (m :: * -> *). M m => BlockId -> m Performance
Cmd.get_performance BlockId
block_id
    forall d. [LEvent d] -> [d]
LEvent.events_of forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
M m =>
RealTime -> Vector Event -> m ([LEvent WriteMessage], Notes)
PlayUtil.perform_from RealTime
0 (Performance -> Vector Event
Cmd.perf_events Performance
perf)

perform_im :: Cmd.M m => BlockId -> m (Vector.Vector Shared.Note.Note)
perform_im :: forall (m :: * -> *). M m => BlockId -> m (Vector Note)
perform_im BlockId
block_id = do
    Performance
perf <- forall (m :: * -> *). M m => BlockId -> m Performance
Cmd.get_performance BlockId
block_id
    Instrument -> Maybe ResolvedInstrument
lookup_inst <- forall (m :: * -> *).
M m =>
m (Instrument -> Maybe ResolvedInstrument)
Cmd.get_lookup_instrument
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
Vector.fromList forall a b. (a -> b) -> a -> b
$ forall d. [LEvent d] -> [d]
LEvent.events_of 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 (Performance -> Vector Event
Msg.perf_events Performance
perf)

perform_lilypond :: Cmd.M m => BlockId -> m Text
perform_lilypond :: forall (m :: * -> *). M m => BlockId -> m Text
perform_lilypond BlockId
block_id = do
    [Event]
events <- forall (m :: * -> *) a. LogMonad m => Stream a -> m [a]
Stream.write_logs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Stream Event
Derive.r_events
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m Result
Cmd.Lilypond.derive_block BlockId
block_id
    Config
config <- Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Config
UiConfig.lilypond forall (f :: * -> *) a b. Functor f => Lens a b -> f a -> f b
<#> forall (m :: * -> *). M m => m State
Ui.get
    Either Msg Text
result <- forall (m :: * -> *) a. LogMonad m => (a, [Msg]) -> m a
LEvent.write_snd forall a b. (a -> b) -> a -> b
$
        Config -> Text -> [Event] -> (Either Msg Text, [Msg])
Cmd.Lilypond.extract_movements Config
config Text
"title" [Event]
events
    case Either Msg Text
result of
        Left Msg
err -> forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write Msg
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Msg -> Text
Log.msg_text Msg
err)
        Right Text
ly -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.Lazy.toStrict Text
ly


-- * transform

set_namespace :: Id.Namespace -> Cmd.CmdL ()
set_namespace :: Namespace -> CmdL ()
set_namespace = forall (m :: * -> *). M m => Namespace -> m ()
Create.rename_project

-- | Set the score namespace to the given one.  Also update the project_dir
-- and move the actual directory.
rename :: Id.Namespace -> Cmd.CmdL ()
rename :: Namespace -> CmdL ()
rename Namespace
ns = do
    forall (m :: * -> *). M m => Namespace -> m ()
Create.rename_project Namespace
ns
    forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets State -> Maybe (Writable, SaveFile)
Cmd.state_save_file forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Writable, SaveFile)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (Writable
_, Cmd.SaveState Canonical
fn) -> do
            Canonical
new_path <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Canonical
Path.canonical forall a b. (a -> b) -> a -> b
$
                Namespace -> String -> String
replace_dir Namespace
ns (Canonical -> String
Path.to_path Canonical
fn)
            forall (m :: * -> *). M m => (State -> State) -> m ()
Cmd.modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st
                { state_save_file :: Maybe (Writable, SaveFile)
Cmd.state_save_file =
                    -- Assume the new name is new, and thus defaults to
                    -- ReadWrite.
                    forall a. a -> Maybe a
Just (Writable
Cmd.ReadWrite, Canonical -> SaveFile
Cmd.SaveState Canonical
new_path)
                }
        Just (Writable
_, Cmd.SaveRepo Canonical
repo) -> do
            let old_dir :: String
old_dir = String -> String
FilePath.takeDirectory (Canonical -> String
Path.to_path Canonical
repo)
                new_dir :: String
new_dir = String -> String -> String
FilePath.replaceFileName String
old_dir
                    (Text -> String
untxt (Namespace -> Text
Id.un_namespace Namespace
ns))
            -- System.Directory.renameDirectory deletes the destination
            -- diretory for some reason.  I'd rather throw an exception.
            forall a. IO a -> CmdT IO a
Cmd.rethrow_io forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Maybe a)
Exceptions.ignoreEnoent forall a b. (a -> b) -> a -> b
$
                String -> String -> IO ()
Posix.rename String
old_dir String
new_dir
            Canonical
new_path <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Canonical
Path.canonical forall a b. (a -> b) -> a -> b
$
                String
new_dir String -> String -> String
</> String -> String
FilePath.takeFileName (Canonical -> String
Path.to_path Canonical
repo)
            forall (m :: * -> *). M m => (State -> State) -> m ()
Cmd.modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st
                { state_save_file :: Maybe (Writable, SaveFile)
Cmd.state_save_file =
                    forall a. a -> Maybe a
Just (Writable
Cmd.ReadWrite, Canonical -> SaveFile
Cmd.SaveState Canonical
new_path)
                }
    where
    replace_dir :: Namespace -> String -> String
replace_dir Namespace
ns String
path = String
new_dir String -> String -> String
</> String -> String
FilePath.takeFileName String
path
        where
        new_dir :: String
new_dir = String -> String -> String
FilePath.replaceFileName (String -> String
FilePath.takeDirectory String
path)
            (Text -> String
untxt (Namespace -> Text
Id.un_namespace Namespace
ns))

fix :: Cmd.M m => m [Text]
fix :: forall (m :: * -> *). M m => m [Text]
fix = forall (m :: * -> *). M m => m [Text]
Ui.fix_state

-- * load

load_midi :: FilePath -> Cmd.CmdL BlockId
load_midi :: String -> CmdL BlockId
load_midi = String -> CmdL BlockId
Load.Midi.load

-- | Load the state from the file and merge it with the current state.  This
-- will fail if any IDs collide, so hopefully they live in different
-- namespaces.  In fact, this is why IDs have namespaces.
load_merge :: Bool -> FilePath -> Cmd.CmdL ()
load_merge :: Bool -> String -> CmdL ()
load_merge = Maybe Namespace -> Bool -> String -> CmdL ()
load_as_ forall a. Maybe a
Nothing

-- | Load another score and put it in a new namespace.  Will probably fail if
-- the score itself uses multiple namespaces.
load_as :: Text -> Bool -- ^ if True, open views
    -> FilePath -> Cmd.CmdL ()
load_as :: Text -> Bool -> String -> CmdL ()
load_as = Maybe Namespace -> Bool -> String -> CmdL ()
load_as_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Namespace
Id.namespace

load_as_ :: Maybe Id.Namespace -> Bool -> FilePath -> Cmd.CmdL ()
load_as_ :: Maybe Namespace -> Bool -> String -> CmdL ()
load_as_ Maybe Namespace
maybe_ns Bool
open_views String
fn = do
    (State
new_state, StateSaveFile
_) <- String -> CmdT IO (State, StateSaveFile)
Save.read String
fn
    State
new_state <- forall (m :: * -> *) a.
M m =>
Text -> State -> StateId a -> m State
Ui.exec_rethrow Text
"strip clip" State
new_state forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *). M m => Namespace -> m ()
Transform.destroy_namespace Namespace
Clip.clip_namespace
        forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Namespace
maybe_ns forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => (Namespace -> Namespace) -> m ()
Transform.map_namespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
open_views forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => ViewId -> m ()
Ui.destroy_view forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m [ViewId]
Ui.all_view_ids
    State
state <- forall (m :: * -> *). M m => m State
Ui.get
    State
merged <- forall (m :: * -> *) err a.
(Stack, M m) =>
(err -> Text) -> Either err a -> m a
Cmd.require_right ((Text
"merge state: "<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Text
pretty) forall a b. (a -> b) -> a -> b
$
        State -> State -> Either Error State
Transform.merge_states State
state State
new_state
    forall (m :: * -> *). M m => State -> m ()
Ui.put State
merged

-- | Destroy the given namespace.
unload :: Ui.M m => Text -> m ()
unload :: forall (m :: * -> *). M m => Text -> m ()
unload = forall (m :: * -> *). M m => Namespace -> m ()
Transform.destroy_namespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Namespace
Id.namespace