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

{- | Lilypond compiles are always kicked off manually.

    I used to have some support for automatically reinvoking lilypond after
    changes to a block, but it didn't seem too useful, since any useful amount
    of lilypond score takes quite a while to compile.

    Set 1t to equal one quarter note, quantize to 16th notes.  Configure
    \"inst\" with short and long names, then change them.

    > LLily.set_quarter_duration 1
    > LLily.set_quantize Lilypond.D16
    > LLily.modify_config =<< LLily.set_staves [("inst", "long", "short")]
    > LLily.modify_staff "inst" $ Lilypond.short #= "a" . Lilypond.long #= "b"
-}
module Cmd.Repl.LLily where
import qualified Data.Text.Lazy as Lazy
import qualified System.FilePath as FilePath

import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Processes as Processes
import qualified Util.Thread as Thread

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Lilypond
import qualified Cmd.Repl.LPerf as LPerf
import qualified Cmd.Repl.Util as Util
import qualified Cmd.Selection as Selection

import qualified Derive.Cache as Cache
import qualified Derive.Derive as Derive
import qualified Derive.LEvent as LEvent
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
import qualified Derive.Stream as Stream

import qualified Perform.Lilypond as Lilypond
import qualified Ui.Events as Events
import qualified Ui.Id as Id
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig

import           Global
import           Types


-- * config

get_config :: Ui.M m => m Lilypond.Config
get_config :: forall (m :: * -> *). M m => m Config
get_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

modify_config :: Ui.M m => (Lilypond.Config -> Lilypond.Config) -> m ()
modify_config :: forall (m :: * -> *). M m => (Config -> Config) -> m ()
modify_config Config -> Config
modify = forall (m :: * -> *). M m => (Config -> Config) -> m ()
Ui.modify_config forall a b. (a -> b) -> a -> b
$ Config :-> Config
UiConfig.lilypond forall f a. Lens f a -> (a -> a) -> f -> f
%= Config -> Config
modify

with_config :: Cmd.M m => Lilypond.Config -> m a -> m a
with_config :: forall (m :: * -> *) a. M m => Config -> m a -> m a
with_config Config
config = forall (m :: * -> *) a. M m => (Config -> Config) -> m a -> m a
Ui.with_config (Config :-> Config
UiConfig.lilypond forall f a. Lens f a -> a -> f -> f
#= Config
config)

set_quarter_duration :: Ui.M m => RealTime -> m ()
set_quarter_duration :: forall (m :: * -> *). M m => RealTime -> m ()
set_quarter_duration RealTime
dur = forall (m :: * -> *). M m => (Config -> Config) -> m ()
modify_config forall a b. (a -> b) -> a -> b
$ \Config
config ->
    Config
config { config_quarter_duration :: RealTime
Lilypond.config_quarter_duration = RealTime
dur }

set_quantize :: Ui.M m => Lilypond.Duration -> m ()
set_quantize :: forall (m :: * -> *). M m => Duration -> m ()
set_quantize Duration
dur = forall (m :: * -> *). M m => (Config -> Config) -> m ()
modify_config forall a b. (a -> b) -> a -> b
$ \Config
config ->
    Config
config { config_quantize :: Duration
Lilypond.config_quantize = Duration
dur }

set_dotted_rests :: Ui.M m => Bool -> m ()
set_dotted_rests :: forall (m :: * -> *). M m => Bool -> m ()
set_dotted_rests Bool
b = forall (m :: * -> *). M m => (Config -> Config) -> m ()
modify_config forall a b. (a -> b) -> a -> b
$ \Config
config ->
    Config
config { config_dotted_rests :: Bool
Lilypond.config_dotted_rests = Bool
b }

toggle_display :: Ui.M m => Util.Instrument -> m ()
toggle_display :: forall (m :: * -> *). M m => Text -> m ()
toggle_display Text
inst = forall (m :: * -> *).
M m =>
Text -> (StaffConfig -> StaffConfig) -> m ()
modify_staff Text
inst forall a b. (a -> b) -> a -> b
$ StaffConfig :-> Bool
Lilypond.display forall f a. Lens f a -> (a -> a) -> f -> f
%= Bool -> Bool
not

set_code :: Ui.M m => Util.Instrument -> [Text] -> m ()
set_code :: forall (m :: * -> *). M m => Text -> [Text] -> m ()
set_code Text
inst [Text]
code = forall (m :: * -> *).
M m =>
Text -> (StaffConfig -> StaffConfig) -> m ()
modify_staff Text
inst forall a b. (a -> b) -> a -> b
$ StaffConfig :-> [Text]
Lilypond.code forall f a. Lens f a -> a -> f -> f
#= [Text]
code

modify_staff :: Ui.M m => Util.Instrument
    -> (Lilypond.StaffConfig -> Lilypond.StaffConfig) -> m ()
modify_staff :: forall (m :: * -> *).
M m =>
Text -> (StaffConfig -> StaffConfig) -> m ()
modify_staff Text
inst_ StaffConfig -> StaffConfig
modify = do
    Config
config <- forall (m :: * -> *). M m => m Config
get_config
    let staves :: [(Instrument, StaffConfig)]
staves = Config -> [(Instrument, StaffConfig)]
Lilypond.config_staves Config
config
    case forall a. (a -> Bool) -> (a -> a) -> [a] -> Maybe [a]
Lists.findModify ((forall a. Eq a => a -> a -> Bool
==Instrument
inst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second StaffConfig -> StaffConfig
modify) [(Instrument, StaffConfig)]
staves of
        Maybe [(Instrument, StaffConfig)]
Nothing -> forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Ui.throw forall a b. (a -> b) -> a -> b
$ Text
"no staff config for " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Instrument
inst
        Just [(Instrument, StaffConfig)]
staves -> forall (m :: * -> *). M m => (Config -> Config) -> m ()
modify_config forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$
            Config
config { config_staves :: [(Instrument, StaffConfig)]
Lilypond.config_staves = [(Instrument, StaffConfig)]
staves }
    where inst :: Instrument
inst = Text -> Instrument
Util.instrument Text
inst_

-- | Set staff config, [(instrument, long_name, short_name)].  The order
-- determines the order of the staves on the page.
--
-- If there is no staff config, all instruments get staves.  Otherwise, only
-- instruments with 'Lilypond.StaffConfig's and 'Lilypond.staff_display' are
-- displayed.
set_staves :: Ui.M m => [(Text, Lilypond.Instrument, Lilypond.Instrument)]
    -> m (Lilypond.Config -> Lilypond.Config)
set_staves :: forall (m :: * -> *).
M m =>
[(Text, Text, Text)] -> m (Config -> Config)
set_staves [(Text, Text, Text)]
staves
    | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Instrument]
dups) = forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Ui.throw forall a b. (a -> b) -> a -> b
$ Text
"duplicate instruments: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty [Instrument]
dups
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Config
config ->
        Config
config { config_staves :: [(Instrument, StaffConfig)]
Lilypond.config_staves = forall a b. (a -> b) -> [a] -> [b]
map (Text, Text, Text) -> (Instrument, StaffConfig)
mk [(Text, Text, Text)]
staves }
    where
    dups :: [Instrument]
dups = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => (a -> k) -> [a] -> ([a], [(a, [a])])
Lists.partitionDups forall a. a -> a
id [Text -> Instrument
Util.instrument Text
inst | (Text
inst, Text
_, Text
_) <- [(Text, Text, Text)]
staves]
    mk :: (Text, Text, Text) -> (Instrument, StaffConfig)
mk (Text
inst, Text
long, Text
short) = (,) (Text -> Instrument
Util.instrument Text
inst) forall a b. (a -> b) -> a -> b
$
        StaffConfig
Lilypond.empty_staff_config
            { staff_long :: Text
Lilypond.staff_long = Text
long, staff_short :: Text
Lilypond.staff_short = Text
short }

-- * compile

-- | Compile multiple blocks, with an explicit movement structure.
blocks :: Lilypond.Title -> [(Lilypond.Title, BlockId)] -> Cmd.CmdL Text
blocks :: Text -> [(Text, BlockId)] -> CmdL Text
blocks Text
title [(Text, BlockId)]
movements = do
    [[Event]]
events <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((forall (m :: * -> *) d. LogMonad m => [LEvent d] -> m [d]
LEvent.write_logs forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
derive) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Text, BlockId)]
movements
    Text -> [Movement] -> CmdL Text
compile_explicit Text
title (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Text, BlockId)]
movements) [[Event]]
events)

-- | Compile the given block as lilypond.  If there are movements, they are
-- extracted from the events.
block :: BlockId -> Cmd.CmdL Text
block :: BlockId -> CmdL Text
block BlockId
block_id = Text -> BlockId -> CmdL Text
block_title (BlockId -> Text
block_id_title BlockId
block_id) BlockId
block_id

-- | Compile the given block, but only with a single instrument.
block_inst :: Maybe Text -> Util.Instrument -> BlockId -> Cmd.CmdT IO Text
block_inst :: Maybe Text -> Text -> BlockId -> CmdL Text
block_inst Maybe Text
maybe_title Text
inst BlockId
block_id = do
    Config
config <- forall (m :: * -> *). M m => m Config
get_config
    let title :: Text
title = forall a. a -> Maybe a -> a
fromMaybe (BlockId -> Text
block_id_title BlockId
block_id) Maybe Text
maybe_title
    forall (m :: * -> *) a. M m => Config -> m a -> m a
with_config (Instrument -> Config -> Config
solo_instrument (Text -> Instrument
Util.instrument Text
inst) Config
config) forall a b. (a -> b) -> a -> b
$
        Text -> BlockId -> CmdL Text
block_title (Text
title forall a. Semigroup a => a -> a -> a
<> Text
" - " forall a. Semigroup a => a -> a -> a
<> Text
inst) BlockId
block_id

solo_instrument :: ScoreT.Instrument -> Lilypond.Config -> Lilypond.Config
solo_instrument :: Instrument -> Config -> Config
solo_instrument Instrument
inst = Config :-> [(Instrument, StaffConfig)]
Lilypond.staves forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a b. (a -> b) -> [a] -> [b]
map (Instrument, StaffConfig) -> (Instrument, StaffConfig)
solo
    where
    solo :: (Instrument, StaffConfig) -> (Instrument, StaffConfig)
solo (Instrument, StaffConfig)
staff
        | forall a b. (a, b) -> a
fst (Instrument, StaffConfig)
staff forall a. Eq a => a -> a -> Bool
== Instrument
inst = (Instrument, StaffConfig)
staff
        | Bool
otherwise = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (StaffConfig :-> Bool
Lilypond.display forall f a. Lens f a -> (a -> a) -> f -> f
%= Bool -> Bool
not) (Instrument, StaffConfig)
staff

block_title :: Lilypond.Title -> BlockId -> Cmd.CmdT IO Text
block_title :: Text -> BlockId -> CmdL Text
block_title Text
title BlockId
block_id =
    Text -> [Event] -> CmdL Text
compile_extract Text
title forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) d. LogMonad m => [LEvent d] -> m [d]
LEvent.write_logs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
derive BlockId
block_id

-- | Compile the current block.
current :: Cmd.CmdL Text
current :: CmdL Text
current = BlockId -> CmdL Text
block forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block

-- | Show the output of the lilypond for the given block.
view_block :: BlockId -> Cmd.CmdL ()
view_block :: BlockId -> CmdL ()
view_block BlockId
block_id = do
    FilePath
filename <- forall (m :: * -> *). M m => Text -> m FilePath
Cmd.Lilypond.ly_filename forall a b. (a -> b) -> a -> b
$ BlockId -> Text
block_id_title BlockId
block_id
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
Thread.start forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ()
Processes.call
        FilePath
"open" [FilePath -> FilePath -> FilePath
FilePath.replaceExtension FilePath
filename FilePath
".pdf"]

view :: Cmd.CmdL ()
view :: CmdL ()
view = BlockId -> CmdL ()
view_block forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block

-- * from events

from_events :: [Score.Event] -> Cmd.CmdL Text
from_events :: [Event] -> CmdL Text
from_events [Event]
events = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    Text -> [Event] -> CmdL Text
compile_extract (BlockId -> Text
block_id_title BlockId
block_id) [Event]
events

-- * compile_ly

-- | Run lilypond with explicit movements.
compile_explicit :: Lilypond.Title -> [Cmd.Lilypond.Movement]
    -> Cmd.CmdL Text
compile_explicit :: Text -> [Movement] -> CmdL Text
compile_explicit Text
title [Movement]
movements = do
    Config
config <- forall (m :: * -> *). M m => m Config
get_config
    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 -> [Movement] -> (Either Msg Text, [Msg])
Cmd.Lilypond.explicit_movements Config
config Text
title [Movement]
movements
    case Either Msg Text
result of
        Left Msg
err -> do
            forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write Msg
err
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Msg -> Text
Log.msg_text Msg
err
        Right Text
output -> do
            FilePath
filename <- forall (m :: * -> *). M m => Text -> m FilePath
Cmd.Lilypond.ly_filename Text
title
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
Cmd.Lilypond.compile_ly FilePath
filename Text
output
            forall (m :: * -> *) a. Monad m => a -> m a
return Text
""

-- | Extract movements from the events and run lilypond.  Return any error.
compile_extract :: Lilypond.Title -> [Score.Event] -> Cmd.CmdT IO Text
compile_extract :: Text -> [Event] -> CmdL Text
compile_extract Text
title [Event]
events = do
    Config
config <- forall (m :: * -> *). M m => m Config
get_config
    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 -> do
            forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write Msg
err
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Msg -> Text
Log.msg_text Msg
err
        Right Text
output -> do
            FilePath
filename <- forall (m :: * -> *). M m => Text -> m FilePath
Cmd.Lilypond.ly_filename Text
title
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
Cmd.Lilypond.compile_ly FilePath
filename Text
output
            forall (m :: * -> *) a. Monad m => a -> m a
return Text
""

block_id_title :: BlockId -> Lilypond.Title
block_id_title :: BlockId -> Text
block_id_title = forall a. Ident a => a -> Text
Id.ident_name

-- * debugging

-- | Convert the block to lilypond score.
block_ly :: Cmd.M m => BlockId -> m Lazy.Text
block_ly :: forall (m :: * -> *). M m => BlockId -> m Text
block_ly BlockId
block_id = do
    Config
config <- forall (m :: * -> *). M m => m Config
get_config
    ([Event]
events, [Msg]
derive_logs) <- forall d. [LEvent d] -> ([d], [Msg])
LEvent.partition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
derive BlockId
block_id
    let (Either Msg Text
result, [Msg]
logs) = Config -> Text -> [Event] -> (Either Msg Text, [Msg])
Cmd.Lilypond.extract_movements Config
config
            (BlockId -> Text
block_id_title BlockId
block_id) [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 forall a b. (a -> b) -> a -> b
$ [Msg]
derive_logs forall a. [a] -> [a] -> [a]
++ [Msg]
logs
    case Either Msg Text
result of
        Left Msg
err -> do
            forall (m :: * -> *). LogMonad m => Msg -> m ()
Log.write Msg
err
            forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Cmd.throw forall a b. (a -> b) -> a -> b
$ Msg -> Text
Log.msg_text Msg
err
        Right Text
ly -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
ly

-- | Derive the block to ly events.
convert :: Cmd.M m => BlockId -> m [Lilypond.Event]
convert :: forall (m :: * -> *). M m => BlockId -> m [Event]
convert BlockId
block_id = do
    Config
config <- forall (m :: * -> *). M m => m Config
get_config
    ([Event]
score_events, [Msg]
derive_logs) <- forall d. [LEvent d] -> ([d], [Msg])
LEvent.partition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
derive BlockId
block_id
    let ([Event]
events, [Msg]
logs) = Config -> [Event] -> ([Event], [Msg])
Cmd.Lilypond.convert Config
config [Event]
score_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 forall a b. (a -> b) -> a -> b
$ [Msg]
derive_logs forall a. [a] -> [a] -> [a]
++ [Msg]
logs
    forall (m :: * -> *) a. Monad m => a -> m a
return [Event]
events

e_note :: Lilypond.Event -> (Lilypond.Time, Lilypond.Time, Text)
e_note :: Event -> (Time, Time, Text)
e_note Event
e = (Event -> Time
Lilypond.event_start Event
e, Event -> Time
Lilypond.event_duration Event
e,
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall a. ToLily a => a -> Text
Lilypond.to_lily (Event -> Maybe Pitch
Lilypond.event_pitch Event
e))

-- ** LPerf

-- | Run a lilypond derive and return score events.
derive :: Cmd.M m => BlockId -> m [LEvent.LEvent Score.Event]
derive :: forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
derive BlockId
block_id =
    forall a. Stream a -> [LEvent a]
Stream.to_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Stream Event
Derive.r_events forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m Result
Cmd.Lilypond.derive_block BlockId
block_id

block_events :: Cmd.M m => BlockId -> m [LEvent.LEvent Score.Event]
block_events :: forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
block_events = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [LEvent Event] -> [LEvent Event]
LPerf.normalize_events forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
block_events_unnormalized

block_events_unnormalized :: Cmd.M m => BlockId -> m [LEvent.LEvent Score.Event]
block_events_unnormalized :: forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
block_events_unnormalized BlockId
block_id =
    forall a. Stream a -> [LEvent a]
Stream.to_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Stream Event
Derive.r_events forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m Result
Cmd.Lilypond.derive_block BlockId
block_id

-- | Like 'LPerf.sel_events', but use the lilypond derive.
sel_events :: Cmd.M m => m [LEvent.LEvent Score.Event]
sel_events :: forall (m :: * -> *). M m => m [LEvent Event]
sel_events = forall a. [LEvent a] -> [LEvent a]
filter_logs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
M m =>
Bool -> (BlockId -> m [LEvent Event]) -> m [LEvent Event]
get_sel Bool
False forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
block_events

-- | Like 'sel_events' but take the root derivation.
root_sel_events :: Cmd.M m => m [LEvent.LEvent Score.Event]
root_sel_events :: forall (m :: * -> *). M m => m [LEvent Event]
root_sel_events = forall a. [LEvent a] -> [LEvent a]
filter_logs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
M m =>
Bool -> (BlockId -> m [LEvent Event]) -> m [LEvent Event]
get_sel Bool
True forall (m :: * -> *). M m => BlockId -> m [LEvent Event]
block_events

filter_logs :: [LEvent.LEvent a] -> [LEvent.LEvent a]
filter_logs :: forall a. [LEvent a] -> [LEvent a]
filter_logs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall d. (Msg -> Bool) -> LEvent d -> Bool
LEvent.event_or (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> Bool
Cache.is_cache_log))

get_sel :: Cmd.M m => Bool -- ^ from root
    -> (BlockId -> m [LEvent.LEvent Score.Event])
    -> m [LEvent.LEvent Score.Event]
get_sel :: forall (m :: * -> *).
M m =>
Bool -> (BlockId -> m [LEvent Event]) -> m [LEvent Event]
get_sel Bool
from_root BlockId -> m [LEvent Event]
derive_events = do
    (BlockId
block_id, [TrackNum]
_, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *).
M m =>
m (BlockId, [TrackNum], [TrackId], Range)
Selection.tracks
    let (TrackTime
start, TrackTime
end) = Range -> (TrackTime, TrackTime)
Events.range_times Range
range
    [LEvent Event]
events <- BlockId -> m [LEvent Event]
derive_events
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< if Bool
from_root then forall (m :: * -> *). M m => m BlockId
Ui.get_root_id else forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
block_id
    -- Lilypond derivation skips tempo tracks, so the usual ScoreTime ->
    -- RealTime map doesn't work.
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Stack)
-> [BlockId]
-> [TrackId]
-> TrackTime
-> TrackTime
-> [LEvent a]
-> [LEvent a]
LPerf.in_score_range Event -> Stack
Score.event_stack [BlockId
block_id] [TrackId]
track_ids
        TrackTime
start TrackTime
end [LEvent Event]
events