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

{-# LANGUAGE ViewPatterns #-}
module Cmd.Msg where
import           Control.DeepSeq (deepseq)
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Vector as Vector

import qualified System.IO as IO

import qualified Util.Log as Log
import qualified Util.Pretty as Pretty
import qualified App.ReplProtocol as ReplProtocol
import qualified Cmd.InputNote as InputNote
import qualified Cmd.KeyLayouts as KeyLayouts
import qualified Derive.Derive as Derive
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
import qualified Derive.TrackWarp as TrackWarp

import qualified Local.KeyLayout
import qualified Midi.Midi as Midi
import qualified Perform.Transport as Transport
import qualified Synth.ImGc as ImGc
import qualified Ui.Id as Id
import qualified Ui.Key as Key
import qualified Ui.Track as Track
import qualified Ui.Ui as Ui
import qualified Ui.UiMsg as UiMsg

import           Control.Monad
import           Global
import           Types


data Msg =
    -- | Message from the UI.
    Ui UiMsg.UiMsg
    -- | Incoming midi message.
    | Midi Midi.ReadMessage
    -- | Incoming abstract note.  This is meant to enter a note and is not
    -- a MIDI NoteOn, though NoteOns may very well be translated into these.
    -- These are not generated from any subsystem, but instead translated from
    -- other msgs (such as Midi).
    | InputNote InputNote.Input
    -- | Message from the transport/play thread.
    | Transport Transport.Status
    -- | Message about the derivation status, from the background derivation
    -- threads.
    | DeriveStatus BlockId DeriveStatus
    -- | Message from the REPL socket, includes the socket handle than can be
    -- used to write a response.  Whoever responds to it should close the
    -- handle.
    | Socket IO.Handle ReplProtocol.Query
    deriving (Int -> Msg -> ShowS
[Msg] -> ShowS
Msg -> String
(Int -> Msg -> ShowS)
-> (Msg -> String) -> ([Msg] -> ShowS) -> Show Msg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Msg] -> ShowS
$cshowList :: [Msg] -> ShowS
show :: Msg -> String
$cshow :: Msg -> String
showsPrec :: Int -> Msg -> ShowS
$cshowsPrec :: Int -> Msg -> ShowS
Show)

show_short :: Msg -> Text
show_short :: Msg -> Text
show_short = \case
    Ui UiMsg
ui -> UiMsg -> Text
UiMsg.show_short UiMsg
ui
    Midi ReadMessage
midi -> ReadMessage -> Text
forall a. Pretty a => a -> Text
pretty ReadMessage
midi
    InputNote Input
note -> Input -> Text
forall a. Pretty a => a -> Text
pretty Input
note
    Transport Status
status -> Status -> Text
forall a. Pretty a => a -> Text
pretty Status
status
    -- show_short is used for timing, and Show DeriveStatus can force stuff in
    -- Performance, so let's avoid the Show instance.
    DeriveStatus BlockId
bid DeriveStatus
status -> BlockId -> Text
forall a. Ident a => a -> Text
Id.ident_text BlockId
bid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case DeriveStatus
status of
        DeriveStatus
OutOfDate -> Text
"OutOfDate"
        DeriveStatus
Deriving -> Text
"Deriving"
        DeriveComplete {} -> Text
"DeriveComplete"
        status :: DeriveStatus
status@(ImStatus {}) -> DeriveStatus -> Text
forall a. Pretty a => a -> Text
pretty DeriveStatus
status
    Socket Handle
_hdl Query
query -> Query -> Text
forall a. Pretty a => a -> Text
pretty Query
query

instance Pretty Msg where
    pretty :: Msg -> Text
pretty = \case
        Ui UiMsg
msg -> Text
"Ui: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UiMsg -> Text
forall a. Pretty a => a -> Text
pretty UiMsg
msg
        Midi ReadMessage
msg -> Text
"Midi: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReadMessage -> Text
forall a. Pretty a => a -> Text
pretty ReadMessage
msg
        InputNote Input
msg -> Text
"Input: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Input -> Text
forall a. Show a => a -> Text
showt Input
msg
        Transport Status
status -> Status -> Text
forall a. Pretty a => a -> Text
pretty Status
status
        DeriveStatus BlockId
bid DeriveStatus
status -> Text
"DeriveStatus: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockId -> Text
forall a. Show a => a -> Text
showt BlockId
bid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DeriveStatus -> Text
forall a. Pretty a => a -> Text
pretty DeriveStatus
status
        Socket Handle
_hdl Query
query -> Text
"Socket: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Query -> Text
forall a. Pretty a => a -> Text
pretty Query
query

data DeriveStatus =
    -- | The current derivation is out of date, but work has not yet started
    -- on a replacement.  The new Performance is already in
    -- 'Cmd.state_current_performance' but not in 'Cmd.state_performance' yet.
    OutOfDate
    | Deriving
    | DeriveComplete !Performance !ImStarted
    -- | The BlockId is the block to which this status applies, the BlockId
    -- in the containing DeriveStatus is the root block for the derivation.
    -- It's redundant for 'ImComplete', because only the root block gets one of
    -- those.
    | ImStatus !BlockId !(Set TrackId) !ImStatus
    deriving (Int -> DeriveStatus -> ShowS
[DeriveStatus] -> ShowS
DeriveStatus -> String
(Int -> DeriveStatus -> ShowS)
-> (DeriveStatus -> String)
-> ([DeriveStatus] -> ShowS)
-> Show DeriveStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeriveStatus] -> ShowS
$cshowList :: [DeriveStatus] -> ShowS
show :: DeriveStatus -> String
$cshow :: DeriveStatus -> String
showsPrec :: Int -> DeriveStatus -> ShowS
$cshowsPrec :: Int -> DeriveStatus -> ShowS
Show)

instance Pretty DeriveStatus where
    pretty :: DeriveStatus -> Text
pretty = \case
        ImStatus BlockId
block_id Set TrackId
track_ids ImStatus
status ->
            BlockId -> Text
forall a. Pretty a => a -> Text
pretty BlockId
block_id Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Set TrackId -> Text
forall a. Pretty a => a -> Text
pretty Set TrackId
track_ids Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ImStatus -> Text
forall a. Pretty a => a -> Text
pretty ImStatus
status
        DeriveStatus
status -> DeriveStatus -> Text
forall a. Show a => a -> Text
showt DeriveStatus
status

data ImStarted = ImStarted -- ^ im subprocess in progress
    | ImUnnecessary -- ^ no im notes, so no subprocesses started
    deriving (Int -> ImStarted -> ShowS
[ImStarted] -> ShowS
ImStarted -> String
(Int -> ImStarted -> ShowS)
-> (ImStarted -> String)
-> ([ImStarted] -> ShowS)
-> Show ImStarted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImStarted] -> ShowS
$cshowList :: [ImStarted] -> ShowS
show :: ImStarted -> String
$cshow :: ImStarted -> String
showsPrec :: Int -> ImStarted -> ShowS
$cshowsPrec :: Int -> ImStarted -> ShowS
Show)

data ImStatus =
    -- | start--end currently being rendered.
    ImRenderingRange !ScoreT.Instrument !RealTime !RealTime
    -- | Waveforms written for these chunks.
    | ImWaveformsCompleted ![Track.WaveformChunk]
    -- | True if the im subprocess had a failure.  The error will have been
    -- logged, and this flag will leave a visual indicator on the track that
    -- something went wrong.
    | ImComplete !Bool !(Maybe ImGc.Stats)
    deriving (Int -> ImStatus -> ShowS
[ImStatus] -> ShowS
ImStatus -> String
(Int -> ImStatus -> ShowS)
-> (ImStatus -> String) -> ([ImStatus] -> ShowS) -> Show ImStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImStatus] -> ShowS
$cshowList :: [ImStatus] -> ShowS
show :: ImStatus -> String
$cshow :: ImStatus -> String
showsPrec :: Int -> ImStatus -> ShowS
$cshowsPrec :: Int -> ImStatus -> ShowS
Show)

instance Pretty ImStatus where
    pretty :: ImStatus -> Text
pretty = \case
        ImRenderingRange Instrument
inst RealTime
start RealTime
end ->
            Instrument -> Text
forall a. Pretty a => a -> Text
pretty Instrument
inst Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealTime -> Text
forall a. Pretty a => a -> Text
pretty RealTime
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealTime -> Text
forall a. Pretty a => a -> Text
pretty RealTime
end Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        ImWaveformsCompleted [WaveformChunk]
waves ->
            Text -> [Text] -> Text
Text.intercalate Text
"," ((WaveformChunk -> Text) -> [WaveformChunk] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
txt (String -> Text)
-> (WaveformChunk -> String) -> WaveformChunk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaveformChunk -> String
Track._filename) [WaveformChunk]
waves)
        ImComplete Bool
failed Maybe Stats
_ -> Text
"ImComplete" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
failed then Text
"(failed)" else Text
""

-- Performance should be in "Cmd.Cmd", but that would be a circular import.

{- | This holds the final performance for a given block.  It is used to
    actually play music, and poked and prodded in a separate thread to control
    its evaluation.

    This is basically the same as 'Derive.Result'.  I could make them be the
    same, but Performance wasn't always the same and may not be the same in the
    future.

    Unlike other records, the fields here are all lazy.  This is because I need
    to put an unevaluated Performance into Cmd.state_current_performances, and
    then force the fields in a separate thread.  Also I need to modify
    'perf_damage' without forcing any of the others.
-}
data Performance = Performance {
    Performance -> Cache
perf_derive_cache :: Derive.Cache
    -- | This is the forced result of a derivation.
    , Performance -> Vector Event
perf_events :: Vector.Vector Score.Event
    -- | Logs from the derivation are written separately.
    , Performance -> [Msg]
perf_logs :: [Log.Msg]
    -- | The logs are only written on the first play, to minimize error spam.
    -- So there's a flag which says whether these logs have been written or
    -- not.  I don't clear the logs, so 'Cmd.Repl.LPerf.cache_stats' can
    -- inspect them.
    , Performance -> Bool
perf_logs_written :: Bool
    , Performance -> TrackDynamic
perf_track_dynamic :: Derive.TrackDynamic
    , Performance -> [Integrated]
perf_integrated :: [Derive.Integrated]
    -- | ScoreDamage is normally calculated automatically from the UI diff,
    -- but Cmds can also intentionally inflict damage to cause a rederive.
    , Performance -> ScoreDamage
perf_damage :: Derive.ScoreDamage
    , Performance -> [TrackWarp]
perf_warps :: [TrackWarp.TrackWarp]
    , Performance -> TrackSignals
perf_track_signals :: Track.TrackSignals
    , Performance -> BlockDeps
perf_block_deps :: Derive.BlockDeps
    -- | This is the score state at the time of the performance.  It's needed
    -- to interpret 'perf_track_signals', because at the time signals are sent
    -- (in 'Cmd.PlayC.cmd_play_msg'), the Ui.State may have unsynced changes.
    , Performance -> State
perf_ui_state :: Ui.State
    }

-- | Force a Performance so that it can be used without a lag.
force_performance :: Performance -> ()
force_performance :: Performance -> ()
force_performance (Performance Cache
_cache Vector Event
events [Msg]
logs Bool
_logs_written TrackDynamic
track_dyn
        [Integrated]
_integrated ScoreDamage
_damage [TrackWarp]
warps TrackSignals
track_sigs BlockDeps
block_deps State
ui_state) =
    [Msg]
logs [Msg] -> Vector Event -> Vector Event
forall a b. NFData a => a -> b -> b
`deepseq` Vector Event
events Vector Event -> [TrackWarp] -> [TrackWarp]
forall a b. NFData a => a -> b -> b
`deepseq` [TrackWarp]
warps [TrackWarp] -> TrackDynamic -> TrackDynamic
forall a b. NFData a => a -> b -> b
`deepseq` TrackDynamic
track_dyn
        TrackDynamic -> TrackSignals -> TrackSignals
forall a b. NFData a => a -> b -> b
`deepseq` TrackSignals
track_sigs TrackSignals -> BlockDeps -> BlockDeps
forall a b. NFData a => a -> b -> b
`deepseq` BlockDeps
block_deps BlockDeps -> State -> State
forall a b. NFData a => a -> b -> b
`deepseq` State
ui_state
        State -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()

instance Show Performance where
    show :: Performance -> String
show Performance
perf = String
"((Performance " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Vector Event -> Int
forall a. Vector a -> Int
Vector.length (Performance -> Vector Event
perf_events Performance
perf))
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" events " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Msg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Performance -> [Msg]
perf_logs Performance
perf)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" logs))"
        -- Show events and logs.  This way there's a hint to look at logs if
        -- there are mysteriously no events.

instance Pretty Performance where
    format :: Performance -> Doc
format (Performance Cache
cache Vector Event
events [Msg]
logs Bool
logs_written TrackDynamic
track_dynamic
            [Integrated]
integrated ScoreDamage
damage [TrackWarp]
warps TrackSignals
track_signals BlockDeps
block_deps State
_ui_state) =
        Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Performance"
        [ (Text
"cache", [CacheKey] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format ([CacheKey] -> Doc) -> [CacheKey] -> Doc
forall a b. (a -> b) -> a -> b
$ Map CacheKey Cached -> [CacheKey]
forall k a. Map k a -> [k]
Map.keys (Map CacheKey Cached -> [CacheKey])
-> Map CacheKey Cached -> [CacheKey]
forall a b. (a -> b) -> a -> b
$ (\(Derive.Cache Map CacheKey Cached
c) -> Map CacheKey Cached
c) Cache
cache)
        , (Text
"events", Int -> Doc
forall a. Pretty a => a -> Doc
Pretty.format (Vector Event -> Int
forall a. Vector a -> Int
Vector.length Vector Event
events))
        , (Text
"logs", [Msg] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [Msg]
logs)
        , (Text
"logs_written", Bool -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Bool
logs_written)
        , (Text
"track_dynamic", TrackDynamic -> Doc
forall a. Pretty a => a -> Doc
Pretty.format TrackDynamic
track_dynamic)
        , (Text
"integrated", [Integrated] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [Integrated]
integrated)
        , (Text
"damage", ScoreDamage -> Doc
forall a. Pretty a => a -> Doc
Pretty.format ScoreDamage
damage)
        , (Text
"warps", [TrackWarp] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [TrackWarp]
warps)
        , (Text
"track_signals", TrackSignals -> Doc
forall a. Pretty a => a -> Doc
Pretty.format TrackSignals
track_signals)
        , (Text
"block_deps", BlockDeps -> Doc
forall a. Pretty a => a -> Doc
Pretty.format BlockDeps
block_deps)
        ]

-- * views

-- To reduce dependency on the exact structure of 'Msg', and to avoid long hard
-- to read cases, use the view functions here.  They can be conveniently used
-- with the ViewPatterns feature.

mouse :: Msg -> Maybe UiMsg.MouseEvent
mouse :: Msg -> Maybe MouseEvent
mouse (Ui (UiMsg.UiMsg Context
_ (UiMsg.MsgEvent (UiMsg.Mouse MouseEvent
mouse)))) =
    MouseEvent -> Maybe MouseEvent
forall a. a -> Maybe a
Just MouseEvent
mouse
mouse Msg
_ = Maybe MouseEvent
forall a. Maybe a
Nothing

mouse_down :: Msg -> Bool
mouse_down :: Msg -> Bool
mouse_down Msg
msg = case Msg -> Maybe MouseEvent
mouse Msg
msg of
    Just (UiMsg.MouseEvent { mouse_state :: MouseEvent -> MouseState
UiMsg.mouse_state = UiMsg.MouseDown Int
_ }) -> Bool
True
    Maybe MouseEvent
_ -> Bool
False

kbd :: Msg -> Maybe (UiMsg.KbdState, [Key.Modifier], Key.Key, Maybe Char)
kbd :: Msg -> Maybe (KbdState, [Modifier], Key, Maybe Char)
kbd (Ui (UiMsg.UiMsg Context
_ (UiMsg.MsgEvent (UiMsg.Kbd KbdState
state [Modifier]
mods Key
key Maybe Char
text)))) =
    (KbdState, [Modifier], Key, Maybe Char)
-> Maybe (KbdState, [Modifier], Key, Maybe Char)
forall a. a -> Maybe a
Just (KbdState
state, [Modifier]
mods, Key
key, Maybe Char
text)
kbd Msg
_ = Maybe (KbdState, [Modifier], Key, Maybe Char)
forall a. Maybe a
Nothing

key :: Msg -> Maybe (UiMsg.KbdState, Key.Key)
key :: Msg -> Maybe (KbdState, Key)
key (Msg -> Maybe (KbdState, [Modifier], Key, Maybe Char)
kbd -> Just (KbdState
state, [Modifier]
_, Key
key, Maybe Char
_)) = (KbdState, Key) -> Maybe (KbdState, Key)
forall a. a -> Maybe a
Just (KbdState
state, Key
key)
key Msg
_ = Maybe (KbdState, Key)
forall a. Maybe a
Nothing

key_down :: Msg -> Maybe Key.Key
key_down :: Msg -> Maybe Key
key_down (Msg -> Maybe (KbdState, Key)
key -> Just (KbdState
UiMsg.KeyDown, Key
k)) = Key -> Maybe Key
forall a. a -> Maybe a
Just Key
k
key_down Msg
_ = Maybe Key
forall a. Maybe a
Nothing

-- | The text that this keydown wants to enter, if any.
text :: Msg -> Maybe (Key.Key, Maybe Char)
text :: Msg -> Maybe (Key, Maybe Char)
text (Msg -> Maybe (KbdState, [Modifier], Key, Maybe Char)
kbd -> Just (KbdState
UiMsg.KeyDown, [Modifier]
_, Key
key, Maybe Char
text)) = (Key, Maybe Char) -> Maybe (Key, Maybe Char)
forall a. a -> Maybe a
Just (Key
key, Maybe Char
text)
text Msg
_ = Maybe (Key, Maybe Char)
forall a. Maybe a
Nothing

key_mods :: Msg -> Maybe [Key.Modifier]
key_mods :: Msg -> Maybe [Modifier]
key_mods (Msg -> Maybe (KbdState, [Modifier], Key, Maybe Char)
kbd -> Just (KbdState
_, [Modifier]
mods, Key
_, Maybe Char
_)) = [Modifier] -> Maybe [Modifier]
forall a. a -> Maybe a
Just [Modifier]
mods
key_mods Msg
_ = Maybe [Modifier]
forall a. Maybe a
Nothing

-- | A key action by keycap.  This is different from 'text' because it should
-- be just the keycap, not taking shift or alt or anything into account.
keycap :: Msg -> Maybe (UiMsg.KbdState, Char)
keycap :: Msg -> Maybe (KbdState, Char)
keycap Msg
msg = case Msg -> Maybe (KbdState, Key)
key Msg
msg of
    Just (KbdState
state, Key.Char Char
c) -> (KbdState, Char) -> Maybe (KbdState, Char)
forall a. a -> Maybe a
Just (KbdState
state, Char
c)
    Maybe (KbdState, Key)
_ -> Maybe (KbdState, Char)
forall a. Maybe a
Nothing

-- | This is like 'keycap', but it takes shift into account.  This is because
-- it's convenient to bind to a single Char including shifted, and not have to
-- pass around a ([Key.Modifier], Char) or (Bool, Char).
char :: Msg -> Maybe (UiMsg.KbdState, Char)
char :: Msg -> Maybe (KbdState, Char)
char (Msg -> Maybe (KbdState, [Modifier], Key, Maybe Char)
kbd -> Just (KbdState
state, [Modifier]
mods, Key.Char Char
c, Maybe Char
_))
    | Modifier
Key.Shift Modifier -> [Modifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods =
        (KbdState
state,) (Char -> (KbdState, Char)) -> Maybe Char -> Maybe (KbdState, Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Layout -> Char -> Maybe Char
KeyLayouts.to_shifted Layout
Local.KeyLayout.layout Char
c
        -- I have to use the keylayout instead of 'text' because fltk doesn't
        -- give me text for KeyUps.
    | Bool
otherwise= (KbdState, Char) -> Maybe (KbdState, Char)
forall a. a -> Maybe a
Just (KbdState
state, Char
c)
char Msg
_ = Maybe (KbdState, Char)
forall a. Maybe a
Nothing

char_down :: Msg -> Maybe Char
char_down :: Msg -> Maybe Char
char_down (Msg -> Maybe (KbdState, Char)
char -> Just (KbdState
UiMsg.KeyDown, Char
c)) = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
char_down Msg
_ = Maybe Char
forall a. Maybe a
Nothing

midi :: Msg -> Maybe Midi.Message
midi :: Msg -> Maybe Message
midi (Midi (Midi.ReadMessage { rmsg_msg :: ReadMessage -> Message
Midi.rmsg_msg = Message
msg })) = Message -> Maybe Message
forall a. a -> Maybe a
Just Message
msg
midi Msg
_ = Maybe Message
forall a. Maybe a
Nothing

context :: Msg -> Maybe UiMsg.Context
context :: Msg -> Maybe Context
context (Ui (UiMsg.UiMsg Context
context Msg
_)) = Context -> Maybe Context
forall a. a -> Maybe a
Just Context
context
context Msg
_ = Maybe Context
forall a. Maybe a
Nothing

context_track :: Msg -> Maybe (TrackNum, UiMsg.Track)
context_track :: Msg -> Maybe (Int, Track)
context_track = Context -> Maybe (Int, Track)
UiMsg.ctx_track (Context -> Maybe (Int, Track))
-> (Msg -> Maybe Context) -> Msg -> Maybe (Int, Track)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Msg -> Maybe Context
context

context_track_pos :: Msg -> Maybe (TrackNum, ScoreTime)
context_track_pos :: Msg -> Maybe (Int, ScoreTime)
context_track_pos Msg
msg = Msg -> Maybe (Int, Track)
context_track Msg
msg Maybe (Int, Track)
-> ((Int, Track) -> Maybe (Int, ScoreTime))
-> Maybe (Int, ScoreTime)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
tracknum, Track
t) -> case Track
t of
    UiMsg.Track ScoreTime
pos -> (Int, ScoreTime) -> Maybe (Int, ScoreTime)
forall a. a -> Maybe a
Just (Int
tracknum, ScoreTime
pos)
    Track
_ -> Maybe (Int, ScoreTime)
forall a. Maybe a
Nothing