-- 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 forall a. Maybe a
Nothing 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) = forall {a}. [LEvent a] -> [LEvent a]
increases 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 forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Instrument
warned -> Maybe Event -> Set Instrument -> [Event] -> [LEvent a]
go (forall a. a -> Maybe a
Just Event
event) Set Instrument
warned [Event]
events
            | Bool
otherwise -> forall {a}. Text -> LEvent a
warn (Text
"instrument not found: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Instrument
inst)
                forall a. a -> [a] -> [a]
: Maybe Event -> Set Instrument -> [Event] -> [LEvent a]
go (forall a. a -> Maybe a
Just Event
event) (forall a. Ord a => a -> Set a -> Set a
Set.insert Instrument
inst Set Instrument
warned) [Event]
events
        Just ResolvedInstrument
resolved ->
            forall a b. (a -> b) -> [a] -> [b]
map forall a. Msg -> LEvent a
LEvent.Log [Msg]
postproc_logs forall a. [a] -> [a] -> [a]
++ [LEvent a]
converted
                forall a. [a] -> [a] -> [a]
++ Maybe Event -> Set Instrument -> [Event] -> [LEvent a]
go (forall a. a -> Maybe a
Just Event
event) Set Instrument
warned [Event]
events
            where
            code :: InstrumentCode
code = forall code. Common code -> code
Common.common_code forall a b. (a -> b) -> a -> b
$ forall code. Inst code -> Common code
Inst.inst_common forall a b. (a -> b) -> a -> b
$
                ResolvedInstrument -> Inst
Cmd.inst_instrument ResolvedInstrument
resolved
            converted :: [LEvent a]
converted = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Msg -> Msg) -> LEvent a -> LEvent a
LEvent.map_log (Event -> Msg -> Msg
add_stack Event
event)) 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 forall a. Ord a => a -> a -> Bool
< Event -> RealTime
Score.event_start Event
prev =
                forall {a}. Text -> LEvent a
warn (Text
"start of " forall a. Semigroup a => a -> a -> a
<> Event -> Text
Score.short_event Event
event
                    forall a. Semigroup a => a -> a -> a
<> Text
" less than previous " forall a. Semigroup a => a -> a -> a
<> Event -> Text
Score.short_event Event
prev)
                forall a. a -> [a] -> [a]
: [LEvent a]
events
            | Bool
otherwise = [LEvent a]
events
        warn :: Text -> LEvent a
warn = forall a. Msg -> LEvent a
LEvent.Log forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack => Priority -> Maybe Stack -> Text -> Msg
Log.msg Priority
Log.Warn (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 = forall a. a -> Maybe a
Just (Event -> Stack
Score.event_stack Event
event) }