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

-- | Utilities for writing Convert modules, which take Score.Events to the
-- performer specific events.
module Perform.ConvertUtil where
import qualified Data.Set as Set

import qualified Util.Log as Log
import qualified Cmd.Cmd as Cmd
import qualified Derive.LEvent as LEvent
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT

import qualified Instrument.Common as Common
import qualified Instrument.Inst as Inst

import           Global


-- | Wrapper that performs common operations for convert functions.
-- Warn if the input isn't sorted, look up the instrument, and run
-- 'Cmd.inst_postproc'.
convert :: (Score.Event -> Cmd.ResolvedInstrument -> [LEvent.LEvent a])
    -> (ScoreT.Instrument -> Maybe Cmd.ResolvedInstrument)
    -> [Score.Event] -> [LEvent.LEvent a]
convert :: forall a.
(Event -> ResolvedInstrument -> [LEvent a])
-> (Instrument -> Maybe ResolvedInstrument)
-> [Event]
-> [LEvent a]
convert Event -> ResolvedInstrument -> [LEvent a]
process Instrument -> Maybe ResolvedInstrument
lookup_inst = Maybe Event -> Set Instrument -> [Event] -> [LEvent a]
go Maybe Event
forall a. Maybe a
Nothing Set Instrument
forall a. Set a
Set.empty
    where
    go :: Maybe Event -> Set Instrument -> [Event] -> [LEvent a]
go Maybe Event
_ Set Instrument
_ [] = []
    go Maybe Event
maybe_prev Set Instrument
warned (Event
event : [Event]
events) = [LEvent a] -> [LEvent a]
forall {a}. [LEvent a] -> [LEvent a]
increases ([LEvent a] -> [LEvent a]) -> [LEvent a] -> [LEvent a]
forall a b. (a -> b) -> a -> b
$ case Instrument -> Maybe ResolvedInstrument
lookup_inst Instrument
inst of
        Maybe ResolvedInstrument
Nothing
            -- Only warn the first time an instrument isn't seen, to avoid
            -- spamming the log.
            | Instrument
inst Instrument -> Set Instrument -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Instrument
warned -> Maybe Event -> Set Instrument -> [Event] -> [LEvent a]
go (Event -> Maybe Event
forall a. a -> Maybe a
Just Event
event) Set Instrument
warned [Event]
events
            | Bool
otherwise -> Text -> LEvent a
forall {a}. Text -> LEvent a
warn (Text
"instrument not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Instrument -> Text
forall a. Pretty a => a -> Text
pretty Instrument
inst)
                LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: Maybe Event -> Set Instrument -> [Event] -> [LEvent a]
go (Event -> Maybe Event
forall a. a -> Maybe a
Just Event
event) (Instrument -> Set Instrument -> Set Instrument
forall a. Ord a => a -> Set a -> Set a
Set.insert Instrument
inst Set Instrument
warned) [Event]
events
        Just ResolvedInstrument
resolved ->
            (Msg -> LEvent a) -> [Msg] -> [LEvent a]
forall a b. (a -> b) -> [a] -> [b]
map Msg -> LEvent a
forall a. Msg -> LEvent a
LEvent.Log [Msg]
postproc_logs [LEvent a] -> [LEvent a] -> [LEvent a]
forall a. [a] -> [a] -> [a]
++ [LEvent a]
converted
                [LEvent a] -> [LEvent a] -> [LEvent a]
forall a. [a] -> [a] -> [a]
++ Maybe Event -> Set Instrument -> [Event] -> [LEvent a]
go (Event -> Maybe Event
forall a. a -> Maybe a
Just Event
event) Set Instrument
warned [Event]
events
            where
            code :: InstrumentCode
code = Common InstrumentCode -> InstrumentCode
forall code. Common code -> code
Common.common_code (Common InstrumentCode -> InstrumentCode)
-> Common InstrumentCode -> InstrumentCode
forall a b. (a -> b) -> a -> b
$ Inst InstrumentCode -> Common InstrumentCode
forall code. Inst code -> Common code
Inst.inst_common (Inst InstrumentCode -> Common InstrumentCode)
-> Inst InstrumentCode -> Common InstrumentCode
forall a b. (a -> b) -> a -> b
$
                ResolvedInstrument -> Inst InstrumentCode
Cmd.inst_instrument ResolvedInstrument
resolved
            converted :: [LEvent a]
converted = (LEvent a -> LEvent a) -> [LEvent a] -> [LEvent a]
forall a b. (a -> b) -> [a] -> [b]
map ((Msg -> Msg) -> LEvent a -> LEvent a
forall a. (Msg -> Msg) -> LEvent a -> LEvent a
LEvent.map_log (Event -> Msg -> Msg
add_stack Event
event)) ([LEvent a] -> [LEvent a]) -> [LEvent a] -> [LEvent a]
forall a b. (a -> b) -> a -> b
$
                Event -> ResolvedInstrument -> [LEvent a]
process Event
event' ResolvedInstrument
resolved
            (Event
event', [Msg]
postproc_logs) = InstrumentCode -> InstrumentPostproc
Cmd.inst_postproc InstrumentCode
code Event
event
        where
        inst :: Instrument
inst = Event -> Instrument
Score.event_instrument Event
event
        -- Sorted is a postcondition of the deriver, verify that.
        increases :: [LEvent a] -> [LEvent a]
increases [LEvent a]
events
            | Just Event
prev <- Maybe Event
maybe_prev,
                    Event -> RealTime
Score.event_start Event
event RealTime -> RealTime -> Bool
forall a. Ord a => a -> a -> Bool
< Event -> RealTime
Score.event_start Event
prev =
                Text -> LEvent a
forall {a}. Text -> LEvent a
warn (Text
"start of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Event -> Text
Score.short_event Event
event
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" less than previous " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Event -> Text
Score.short_event Event
prev)
                LEvent a -> [LEvent a] -> [LEvent a]
forall a. a -> [a] -> [a]
: [LEvent a]
events
            | Bool
otherwise = [LEvent a]
events
        warn :: Text -> LEvent a
warn = Msg -> LEvent a
forall a. Msg -> LEvent a
LEvent.Log (Msg -> LEvent a) -> (Text -> Msg) -> Text -> LEvent a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack => Priority -> Maybe Stack -> Text -> Msg
Priority -> Maybe Stack -> Text -> Msg
Log.msg Priority
Log.Warn (Stack -> Maybe Stack
forall a. a -> Maybe a
Just (Event -> Stack
Score.event_stack Event
event))

add_stack :: Score.Event -> Log.Msg -> Log.Msg
add_stack :: Event -> Msg -> Msg
add_stack Event
event Msg
msg = Msg
msg { msg_stack :: Maybe Stack
Log.msg_stack = Stack -> Maybe Stack
forall a. a -> Maybe a
Just (Event -> Stack
Score.event_stack Event
event) }