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

-- | Support to add or remove time in a score, and have it propagate up to
-- callers.
module Cmd.BlockResize (
    update_callers_rulers
    , update_callers, push_down_rulers
) where
import qualified Data.Foldable as Foldable
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Tree as Tree

import qualified Util.Lists as Lists
import qualified Util.Maps as Maps

import qualified Cmd.NoteTrackParse as NoteTrackParse
import qualified Cmd.Ruler.Extract as Extract
-- import qualified Cmd.Ruler.Modify as Modify
import qualified Cmd.Ruler.RulerUtil as RulerUtil

import qualified Derive.ParseTitle as ParseTitle
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Meter.Meter as Meter
import qualified Ui.TrackTree as TrackTree
import qualified Ui.Ui as Ui

import           Global
import           Types


update_callers_rulers :: Ui.M m => BlockId -> TrackTime -> TrackTime
    -> m [BlockId]
update_callers_rulers :: forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> m [BlockId]
update_callers_rulers BlockId
block_id TrackTime
pos TrackTime
delta = do
    [Tree Update]
updates <- forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> m [Tree Update]
update_callers BlockId
block_id TrackTime
pos TrackTime
delta
    forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> [Update] -> m ()
update_rulers BlockId
block_id TrackTime
pos TrackTime
delta (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
bottoms [Tree Update]
updates)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList [Tree Update]
updates

-- | The block has changed size by adding or removing time at the given point.
-- Find its callers and update the event durations.  This doesn't update any
-- rulers, so call either 'push_down_rulers' or 'update_callers_rulers'.
update_callers :: Ui.M m => BlockId -> TrackTime -> TrackTime
    -> m [Tree.Tree Update]
update_callers :: forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> m [Tree Update]
update_callers BlockId
block_id TrackTime
pos TrackTime
delta = do
    forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> m ()
modify_time BlockId
block_id TrackTime
pos TrackTime
delta
    [Tree Update]
updates <- forall (m :: * -> *).
M m =>
[TrackTime] -> BlockId -> m [Tree Update]
caller_updates [TrackTime
pos] BlockId
block_id
    forall (m :: * -> *). M m => TrackTime -> [Update] -> m ()
apply_updates TrackTime
delta (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList [Tree Update]
updates)
    forall (m :: * -> *) a. Monad m => a -> m a
return [Tree Update]
updates

push_down_rulers :: Ui.M m => [Tree.Tree Update] -> m ()
push_down_rulers :: forall (m :: * -> *). M m => [Tree Update] -> m ()
push_down_rulers [Tree Update]
updates =
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => BlockId -> m ()
push_down_ruler forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
Lists.unique forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
bottoms [Tree Update]
updates

modify_time :: Ui.M m => BlockId -> TrackTime -> TrackTime -> m ()
modify_time :: forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> m ()
modify_time BlockId
block_id TrackTime
pos TrackTime
delta = do
    [TrackId]
track_ids <- forall (m :: * -> *). M m => BlockId -> m [TrackId]
Ui.track_ids_of BlockId
block_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TrackId]
track_ids forall a b. (a -> b) -> a -> b
$ \TrackId
track_id ->
        forall (m :: * -> *). M m => TrackId -> (Events -> Events) -> m ()
Ui.modify_events TrackId
track_id forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> Events -> Events
move_events TrackTime
pos TrackTime
delta forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events -> Events
remove
    where
    remove :: Events -> Events
remove
        | TrackTime
delta forall a. Ord a => a -> a -> Bool
< TrackTime
0 = Range -> Events -> Events
Events.remove (TrackTime -> TrackTime -> Range
Events.Range TrackTime
pos (-TrackTime
delta))
        | Bool
otherwise = forall a. a -> a
id

bottoms :: Tree.Tree a -> [a]
bottoms :: forall a. Tree a -> [a]
bottoms (Tree.Node a
x []) = [a
x]
bottoms (Tree.Node a
_ [Tree a]
subs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
bottoms [Tree a]
subs


-- * apply_updates

-- | To insert time: remove the given event, move everything below on the same
-- track down, then reinsert.
apply_updates :: Ui.M m => TrackTime -> [Update] -> m ()
apply_updates :: forall (m :: * -> *). M m => TrackTime -> [Update] -> m ()
apply_updates TrackTime
delta = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {m :: * -> *}.
M m =>
(BlockId, Map TrackId [(Event, TrackTime)]) -> m ()
apply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackTime
-> [Update] -> Map BlockId (Map TrackId [(Event, TrackTime)])
merge_updates TrackTime
delta
    where
    apply :: (BlockId, Map TrackId [(Event, TrackTime)]) -> m ()
apply (BlockId
block_id, Map TrackId [(Event, TrackTime)]
tracks) =
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList Map TrackId [(Event, TrackTime)]
tracks) forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, [(Event, TrackTime)]
event_deltas) ->
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> [a]
reverse [(Event, TrackTime)]
event_deltas) forall a b. (a -> b) -> a -> b
$ \(Event
event, TrackTime
delta) ->
                forall {m :: * -> *}.
M m =>
BlockId -> TrackId -> Event -> TrackTime -> m ()
update BlockId
block_id TrackId
track_id Event
event TrackTime
delta
    update :: BlockId -> TrackId -> Event -> TrackTime -> m ()
update BlockId
block_id TrackId
track_id Event
event TrackTime
delta = do
        forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.remove_event TrackId
track_id Event
event
        forall (m :: * -> *).
M m =>
BlockId -> TrackId -> TrackTime -> TrackTime -> m ()
move_events_children BlockId
block_id TrackId
track_id (Event -> TrackTime
Event.start Event
event) TrackTime
delta
        let dur :: TrackTime
dur = Event -> TrackTime
Event.duration Event
event forall a. Num a => a -> a -> a
+ TrackTime
delta
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Event -> Bool
Event.is_negative Event
event) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Ui.throw forall a b. (a -> b) -> a -> b
$ Text
"negative events not supported yet: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Event
event
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Event -> Bool
Event.is_negative Event
event Bool -> Bool -> Bool
&& TrackTime
dur forall a. Ord a => a -> a -> Bool
> TrackTime
0 Bool -> Bool -> Bool
|| TrackTime
dur forall a. Ord a => a -> a -> Bool
< TrackTime
0) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Ui.throw forall a b. (a -> b) -> a -> b
$ Text
"update delta " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty TrackTime
delta
                forall a. Semigroup a => a -> a -> a
<> Text
" would invert event: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Event
event
        forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
track_id forall a b. (a -> b) -> a -> b
$ Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
dur forall a b. (a -> b) -> a -> b
$ Event
event

move_events_children :: Ui.M m => BlockId -> TrackId -> TrackTime -> TrackTime
    -> m ()
move_events_children :: forall (m :: * -> *).
M m =>
BlockId -> TrackId -> TrackTime -> TrackTime -> m ()
move_events_children BlockId
block_id TrackId
track_id TrackTime
start TrackTime
delta = do
    [TrackId]
children <- forall a b. (a -> b) -> [a] -> [b]
map TrackInfo -> TrackId
Ui.track_id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> TrackId -> m [TrackInfo]
TrackTree.get_children_of BlockId
block_id TrackId
track_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (TrackId
track_id forall a. a -> [a] -> [a]
: [TrackId]
children) forall a b. (a -> b) -> a -> b
$ \TrackId
track_id ->
        forall (m :: * -> *). M m => TrackId -> (Events -> Events) -> m ()
Ui.modify_events TrackId
track_id forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> Events -> Events
move_events TrackTime
start TrackTime
delta

move_events :: TrackTime -> TrackTime -> Events.Events -> Events.Events
move_events :: TrackTime -> TrackTime -> Events -> Events
move_events TrackTime
pos TrackTime
delta Events
events = Events
pre forall a. Semigroup a => a -> a -> a
<> TrackTime -> Events -> Events
Events.move TrackTime
delta Events
post
    where (Events
pre, Events
post) = TrackTime -> Events -> (Events, Events)
Events.split TrackTime
pos Events
events

-- | Merge Updates so the event updates for each track are together and in
-- Event.start order.  TODO if a track appears on multiple blocks it'll get
-- too many updates.
merge_updates :: TrackTime -> [Update]
    -> Map BlockId (Map TrackId [(Event.Event, TrackTime)])
merge_updates :: TrackTime
-> [Update] -> Map BlockId (Map TrackId [(Event, TrackTime)])
merge_updates TrackTime
delta =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {t :: * -> *} {a}.
Foldable t =>
[(t a, [Event])] -> [(Event, TrackTime)]
merge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k [a]
Maps.multimap) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k [a]
Maps.multimap
    where
    merge :: [(t a, [Event])] -> [(Event, TrackTime)]
merge [(t a, [Event])]
offset_events = forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn (Event -> TrackTime
Event.start forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
        [ (Event
event, TrackTime
delta forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
offsets))
        | (t a
offsets, [Event]
events) <- [(t a, [Event])]
offset_events, Event
event <- [Event]
events
        ]


-- * caller_updates

-- | The track times are splice point offsets, relative to the Event.starts.
type Update = (BlockId, (TrackId, ([TrackTime], [Event.Event])))

-- | How much to delete or insert, and where.
caller_updates :: Ui.M m => [TrackTime] -> BlockId -> m [Tree.Tree Update]
    -- ^ This tree is upside-down, leaves are the top-level callers.
    --
    -- There will be a branch for each call, so the same block can appear
    -- in multiple branches.  I could merge them, but maybe it's not necessary.
caller_updates :: forall (m :: * -> *).
M m =>
[TrackTime] -> BlockId -> m [Tree Update]
caller_updates = forall (m :: * -> *).
M m =>
[TrackTime] -> BlockId -> m [Tree Update]
get_callers
    where
    get_callers :: [TrackTime] -> BlockId -> m [Tree Update]
get_callers [TrackTime]
offsets BlockId
callee =
        forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
concatMapM ([TrackTime] -> (BlockId, [(TrackId, [Event])]) -> m [Tree Update]
updates_of [TrackTime]
offsets) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
M m =>
BlockId -> m [(BlockId, [(TrackId, [Event])])]
callers_of BlockId
callee
    -- TODO ignore calls with clip and Clip... use CallDuration?
    -- maybe I should have a thing that gets CallDuration of all block calls,
    -- and then it can update those.  I'll need it anyway if I want a 1:1
    -- highlight.
    updates_of :: [TrackTime] -> (BlockId, [(TrackId, [Event])]) -> m [Tree Update]
updates_of [TrackTime]
offsets (BlockId
block_id, [(TrackId, [Event])]
tracks) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(TrackId, [Event])]
tracks forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, [Event]
events) ->
        forall a. a -> [Tree a] -> Tree a
Tree.Node (BlockId
block_id, (TrackId
track_id, ([TrackTime]
offsets, [Event]
events))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            [TrackTime] -> BlockId -> m [Tree Update]
get_callers
                [Event -> TrackTime
Event.start Event
e forall a. Num a => a -> a -> a
+ TrackTime
offset | TrackTime
offset <- [TrackTime]
offsets, Event
e <- [Event]
events]
                BlockId
block_id

-- | All of the events that directly call the given BlockId.
--
-- TODO This just looks at syntax, but I should be able to get a more canonical
-- parent->child tree by looking in TrackWarp.
callers_of :: Ui.M m => BlockId -> m [(BlockId, [(TrackId, [Event.Event])])]
callers_of :: forall (m :: * -> *).
M m =>
BlockId -> m [(BlockId, [(TrackId, [Event])])]
callers_of BlockId
callee = forall {a} {a} {a}. [(a, [(a, [a])])] -> [(a, [(a, [a])])]
strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    [(BlockId, [TrackId])]
block_tracks <- forall (m :: * -> *). M m => m [(BlockId, [TrackId])]
Ui.all_block_track_ids
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(BlockId, [TrackId])]
block_tracks forall a b. (a -> b) -> a -> b
$ \(BlockId
block_id, [TrackId]
track_ids) -> do
        [TrackId]
track_ids <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall (m :: * -> *). M m => TrackId -> m Bool
is_note_track [TrackId]
track_ids
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BlockId
block_id,) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TrackId]
track_ids forall a b. (a -> b) -> a -> b
$ \TrackId
track_id -> do
            [(Event, NonEmpty BlockId)]
calls <- forall (m :: * -> *).
M m =>
Bool -> BlockId -> TrackId -> m [(Event, NonEmpty BlockId)]
NoteTrackParse.track_block_calls Bool
False BlockId
block_id TrackId
track_id
            forall (m :: * -> *) a. Monad m => a -> m a
return (TrackId
track_id,
                [Event
event | (Event
event, BlockId
call :| [BlockId]
_) <- [(Event, NonEmpty BlockId)]
calls, BlockId
call forall a. Eq a => a -> a -> Bool
== BlockId
callee])
    where
    strip :: [(a, [(a, [a])])] -> [(a, [(a, [a])])]
strip = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)))

is_note_track :: Ui.M m => TrackId -> m Bool
is_note_track :: forall (m :: * -> *). M m => TrackId -> m Bool
is_note_track = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Bool
ParseTitle.is_note_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => TrackId -> m Text
Ui.get_track_title

-- * update_rulers

{- | For a positive delta, copy the ruler from the callee block to its
    corresponding times in the top blocks, or delete time for a negative delta.
    Then propagate the ruler changes back down with
    'Extract.push_down_recursive'.

    Another approach would be to copy or delete ruler in all the intermediate
    blocks too, which seems like I could then avoid
    'Extract.push_down_recursive',  but I'd still need to renumber if changed
    event durations made the measure count change.
-}
update_rulers :: Ui.M m => BlockId -> TrackTime -> TrackTime -> [Update] -> m ()
update_rulers :: forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> [Update] -> m ()
update_rulers BlockId
block_id TrackTime
pos TrackTime
delta [Update]
top_updates = do
    [MSection]
fragment <- if TrackTime
delta forall a. Ord a => a -> a -> Bool
> TrackTime
0 then forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> m [MSection]
extract_meter BlockId
block_id TrackTime
pos TrackTime
delta
        else forall (m :: * -> *) a. Monad m => a -> m a
return []
    let msg :: Text
msg = Text
"ruler modification is ambiguous due to multiple updated tracks: "
            forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty [Update]
top_updates
    Map BlockId [TrackTime]
inserts <- forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Ui.require Text
msg forall a b. (a -> b) -> a -> b
$ [Update] -> Maybe (Map BlockId [TrackTime])
insert_points [Update]
top_updates
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList Map BlockId [TrackTime]
inserts) forall a b. (a -> b) -> a -> b
$ \(BlockId
top_block_id, [TrackTime]
offsets) -> do
        forall (m :: * -> *).
M m =>
Scope -> BlockId -> (Meter -> Meter) -> m [RulerId]
RulerUtil.local_meter Scope
RulerUtil.Block BlockId
top_block_id forall a b. (a -> b) -> a -> b
$
            ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections forall a b. (a -> b) -> a -> b
$ if TrackTime
delta forall a. Ord a => a -> a -> Bool
> TrackTime
0
                then [MSection] -> [TrackTime] -> [MSection] -> [MSection]
splice [MSection]
fragment [TrackTime]
offsets
                else TrackTime -> [TrackTime] -> [MSection] -> [MSection]
delete (-TrackTime
delta) [TrackTime]
offsets
        forall (m :: * -> *). M m => BlockId -> m ()
push_down_ruler BlockId
top_block_id

push_down_ruler :: Ui.M m => BlockId -> m ()
push_down_ruler :: forall (m :: * -> *). M m => BlockId -> m ()
push_down_ruler BlockId
block_id = do
    TrackId
track_id <- forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Ui.require (Text
"no note track: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty BlockId
block_id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
Lists.head
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall (m :: * -> *). M m => TrackId -> m Bool
is_note_track forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m [TrackId]
Ui.track_ids_of BlockId
block_id
    forall (m :: * -> *). M m => Bool -> BlockId -> TrackId -> m ()
Extract.push_down_recursive Bool
False BlockId
block_id TrackId
track_id

insert_points :: [Update] -> Maybe (Map BlockId [TrackTime])
insert_points :: [Update] -> Maybe (Map BlockId [TrackTime])
insert_points = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {a}. [(a, ([TrackTime], [Event]))] -> Maybe [TrackTime]
check forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k [a]
Maps.multimap
    where
    check :: [(a, ([TrackTime], [Event]))] -> Maybe [TrackTime]
check [(a
_, ([TrackTime]
offsets, [Event]
events))] =
        forall a. a -> Maybe a
Just [TrackTime
offset forall a. Num a => a -> a -> a
+ Event -> TrackTime
Event.start Event
e | TrackTime
offset <- [TrackTime]
offsets, Event
e <- [Event]
events]
    check [(a, ([TrackTime], [Event]))]
_ = forall a. Maybe a
Nothing

splice :: [Meter.MSection] -> [TrackTime] -> [Meter.MSection]
    -> [Meter.MSection]
splice :: [MSection] -> [TrackTime] -> [MSection] -> [MSection]
splice [MSection]
fragment [TrackTime]
offsets = [TrackTime] -> [MSection] -> [MSection]
go (forall a. Ord a => [a] -> [a]
List.sort [TrackTime]
offsets)
    where
    go :: [TrackTime] -> [MSection] -> [MSection]
go [] [MSection]
sections = [MSection]
sections
    go (TrackTime
t:[TrackTime]
ts) [MSection]
sections = [MSection]
pre forall a. Semigroup a => a -> a -> a
<> [MSection]
fragment forall a. Semigroup a => a -> a -> a
<> [TrackTime] -> [MSection] -> [MSection]
go [TrackTime]
ts [MSection]
post
        where ([MSection]
pre, [MSection]
post) = TrackTime -> [MSection] -> ([MSection], [MSection])
Meter.sections_split TrackTime
t [MSection]
sections

delete :: TrackTime -> [TrackTime] -> [Meter.MSection] -> [Meter.MSection]
delete :: TrackTime -> [TrackTime] -> [MSection] -> [MSection]
delete TrackTime
delta [TrackTime]
offsets = [TrackTime] -> [MSection] -> [MSection]
go (forall a. Ord a => [a] -> [a]
List.sort [TrackTime]
offsets)
    where
    go :: [TrackTime] -> [MSection] -> [MSection]
go [] [MSection]
sections = [MSection]
sections
    go (TrackTime
t:[TrackTime]
ts) [MSection]
sections = [MSection]
pre forall a. Semigroup a => a -> a -> a
<> [TrackTime] -> [MSection] -> [MSection]
go [TrackTime]
ts (TrackTime -> [MSection] -> [MSection]
Meter.sections_drop TrackTime
delta [MSection]
post)
        where ([MSection]
pre, [MSection]
post) = TrackTime -> [MSection] -> ([MSection], [MSection])
Meter.sections_split TrackTime
t [MSection]
sections

extract_meter :: Ui.M m => BlockId -> TrackTime -> TrackTime
    -> m [Meter.MSection]
extract_meter :: forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> TrackTime -> m [MSection]
extract_meter BlockId
block_id TrackTime
pos TrackTime
delta = do
    Meter
meter <- forall (m :: * -> *). M m => RulerId -> m Meter
RulerUtil.get_meter forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.ruler_of BlockId
block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> [MSection] -> [MSection]
RulerUtil.extract TrackTime
pos (TrackTime
pos forall a. Num a => a -> a -> a
+ TrackTime
delta) (Meter -> [MSection]
Meter.meter_sections Meter
meter)