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

-- | Cmds to do with \"refactoring\".  This basically means fancy
-- copy-paste-like operations.
module Cmd.Factor where
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Util.Num as Num

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Edit as Edit
import qualified Cmd.Ruler.RulerUtil as RulerUtil
import qualified Cmd.Selection as Selection

import qualified Derive.Eval as Eval
import qualified Ui.Block as Block
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Id as Id
import qualified Ui.Meter.Meter as Meter
import qualified Ui.Ruler as Ruler
import qualified Ui.Sel as Sel
import qualified Ui.Skeleton as Skeleton
import qualified Ui.Transform as Transform
import qualified Ui.Ui as Ui

import           Global
import           Types


-- | Split the block at the time of the current selection, and create a new
-- block and view with everything afterwards.  The old and new blocks are
-- renamed with @-1@ and @-2@ suffixes, respectively.  The old block is renamed
-- for symmetry with the new one, but mostly because it's changed duration, so
-- previous calls are probably no longer valid.
split_time :: Cmd.M m => m BlockId -- ^ BlockId of new block
split_time :: forall (m :: * -> *). M m => m BlockId
split_time = do
    (BlockId
block_id, TrackNum
_, TrackId
_, TrackTime
pos) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, TrackTime)
Selection.get_insert
    let (Id
from_block, Id
to_block) = BlockId -> (Id, Id)
split_names BlockId
block_id
    BlockId
to_block_id <- forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> Id -> m BlockId
split_time_at BlockId
block_id TrackTime
pos Id
to_block
    forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
to_block_id
    forall (m :: * -> *). M m => BlockId -> Id -> m ()
Create.rename_block BlockId
block_id Id
from_block
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
to_block_id

-- | Create a new block from template, then copy over all the events below the
-- given time.  Clear the source track, and trim events that overlap the split
-- point.  Modify the ruler (locally!) in the old and new blocks.
split_time_at :: Ui.M m => BlockId -> ScoreTime -> Id.Id -> m BlockId
split_time_at :: forall (m :: * -> *).
M m =>
BlockId -> TrackTime -> Id -> m BlockId
split_time_at BlockId
from_block_id TrackTime
pos Id
block_name = do
    [(TrackId, TrackNum)]
tracks <- forall (m :: * -> *). M m => BlockId -> m [(TrackId, TrackNum)]
Ui.tracknums_of BlockId
from_block_id
    -- Copy over the new events.
    [(TrackNum, [Event])]
track_events <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(TrackId, TrackNum)]
tracks forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, TrackNum
tracknum) -> do
        [Event]
events <- TrackTime -> Events -> [Event]
Events.at_after TrackTime
pos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events TrackId
track_id
        let shifted :: [Event]
shifted = forall a b. (a -> b) -> [a] -> [b]
map (Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. Num a => a -> a -> a
subtract TrackTime
pos) [Event]
events
        forall (m :: * -> *) a. Monad m => a -> m a
return (TrackNum
tracknum, [Event]
shifted)
    -- Trim the old events.
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TrackId, TrackNum)]
tracks forall a b. (a -> b) -> a -> b
$ \(TrackId
track_id, TrackNum
_) -> do
        Events
events <- forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackTime -> Events -> (Events, Events)
Events.split TrackTime
pos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events TrackId
track_id
        forall (m :: * -> *). M m => TrackId -> (Events -> Events) -> m ()
Ui.modify_events TrackId
track_id forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Bool -> TrackTime -> Events -> Events
Events.clip Bool
False TrackTime
pos Events
events
    -- Create new block.
    BlockId
to_block_id <- forall (m :: * -> *). M m => Bool -> BlockId -> Id -> m BlockId
Create.named_block_from_template Bool
False BlockId
from_block_id
        Id
block_name
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(TrackNum, [Event])]
track_events forall a b. (a -> b) -> a -> b
$ \(TrackNum
tracknum, [Event]
events) -> do
        TrackId
track_id <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m TrackId
Ui.get_event_track_at BlockId
to_block_id TrackNum
tracknum
        forall (m :: * -> *). M m => TrackId -> [Event] -> m ()
Ui.insert_events TrackId
track_id [Event]
events
    -- Trim rulers on each.
    let dur :: TrackTime
dur = TrackTime -> TrackTime
Meter.time_to_duration TrackTime
pos
    forall (m :: * -> *).
M m =>
BlockId -> ([MSection] -> [MSection]) -> m ()
local_sections BlockId
from_block_id forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> [MSection] -> [MSection]
RulerUtil.extract TrackTime
0 TrackTime
dur
    forall (m :: * -> *).
M m =>
BlockId -> ([MSection] -> [MSection]) -> m ()
local_sections BlockId
to_block_id forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> [MSection] -> [MSection]
RulerUtil.delete TrackTime
0 TrackTime
dur
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
to_block_id

split_names :: BlockId -> (Id.Id, Id.Id)
split_names :: BlockId -> (Id, Id)
split_names BlockId
block_id =
    ((Text -> Text) -> Id -> Id
Id.modify_name (forall a. Semigroup a => a -> a -> a
<>Text
"-1") Id
id, (Text -> Text) -> Id -> Id
Id.modify_name (forall a. Semigroup a => a -> a -> a
<>Text
"-2") Id
id)
    where id :: Id
id = forall a. Ident a => a -> Id
Id.unpack_id BlockId
block_id

-- | Put all tracks with a after the selection into a new block.
--
-- Unlike 'split_time' I don't rename the source block, because the length
-- is unchanged.
split_track :: Cmd.M m => m BlockId
split_track :: forall (m :: * -> *). M m => m BlockId
split_track = do
    (BlockId
block_id, TrackNum
tracknum, TrackId
_, TrackTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, TrackTime)
Selection.get_insert
    BlockId
to_block_id <- forall (m :: * -> *). M m => BlockId -> TrackNum -> Id -> m BlockId
split_track_at BlockId
block_id TrackNum
tracknum
        (forall a b. (a, b) -> b
snd (BlockId -> (Id, Id)
split_names BlockId
block_id))
    forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
to_block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
to_block_id

split_track_at :: Ui.M m => BlockId -> TrackNum -> Id.Id -> m BlockId
split_track_at :: forall (m :: * -> *). M m => BlockId -> TrackNum -> Id -> m BlockId
split_track_at BlockId
from_block_id TrackNum
split_at Id
block_name = do
    BlockId
to_block_id <- forall (m :: * -> *). M m => Id -> RulerId -> m BlockId
Create.named_block Id
block_name forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.ruler_of BlockId
from_block_id
    -- Move tracks.
    [(TrackNum, Track)]
tracks <- forall a b. [a] -> [b] -> [(a, b)]
zip [TrackNum
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Track]
Block.block_tracks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block BlockId
from_block_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Ord a => a -> a -> Bool
<TrackNum
split_at) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(TrackNum, Track)]
tracks) forall a b. (a -> b) -> a -> b
$ \(TrackNum
tracknum, Track
track) ->
        forall (m :: * -> *). M m => BlockId -> TrackNum -> Track -> m ()
Ui.insert_track BlockId
to_block_id (TrackNum
tracknum forall a. Num a => a -> a -> a
- TrackNum
split_at forall a. Num a => a -> a -> a
+ TrackNum
1) Track
track
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
>=TrackNum
split_at) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a. [a] -> [a]
reverse [(TrackNum, Track)]
tracks)) forall a b. (a -> b) -> a -> b
$
        \(TrackNum
tracknum, Track
_) -> forall (m :: * -> *). M m => BlockId -> TrackNum -> m ()
Ui.remove_track BlockId
from_block_id TrackNum
tracknum
    -- Copy over the skeleton.
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (m :: * -> *). M m => BlockId -> m Bool
Ui.has_explicit_skeleton BlockId
to_block_id) forall a b. (a -> b) -> a -> b
$ do
        Skeleton
skeleton <- forall (m :: * -> *). M m => BlockId -> m Skeleton
Ui.get_skeleton BlockId
from_block_id
        forall (m :: * -> *). M m => BlockId -> Skeleton -> m ()
Ui.set_skeleton BlockId
to_block_id forall a b. (a -> b) -> a -> b
$ [Edge] -> Skeleton
Skeleton.make
            [ (TrackNum
fromforall a. Num a => a -> a -> a
-TrackNum
split_at forall a. Num a => a -> a -> a
+ TrackNum
1, TrackNum
toforall a. Num a => a -> a -> a
-TrackNum
split_at forall a. Num a => a -> a -> a
+ TrackNum
1)
            | (TrackNum
from, TrackNum
to) <- Skeleton -> [Edge]
Skeleton.flatten Skeleton
skeleton
            , TrackNum
from forall a. Ord a => a -> a -> Bool
>= TrackNum
split_at Bool -> Bool -> Bool
&& TrackNum
to forall a. Ord a => a -> a -> Bool
>= TrackNum
split_at
            ]
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
to_block_id

-- | Copy the selection into a new block, and replace it with a call to that
-- block.
selection :: Cmd.M m => Id.Id -> m BlockId
selection :: forall (m :: * -> *). M m => Id -> m BlockId
selection Id
name = do
    BlockId
block_id <- forall (m :: * -> *). M m => Bool -> Bool -> Id -> m BlockId
selection_ Bool
True Bool
False Id
name
    forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
block_id

-- | Copy the selection to a relative block, and replace it with a relative
-- block call.
selection_relative :: Cmd.M m => Id.Id -> m BlockId
selection_relative :: forall (m :: * -> *). M m => Id -> m BlockId
selection_relative Id
name = do
    BlockId
block_id <- forall (m :: * -> *). M m => Bool -> Bool -> Id -> m BlockId
selection_ Bool
True Bool
True Id
name
    forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
block_id

-- | Same as 'selection_relative' because I always type the wrong one.
relative_selection :: Cmd.M m => Id.Id -> m BlockId
relative_selection :: forall (m :: * -> *). M m => Id -> m BlockId
relative_selection = forall (m :: * -> *). M m => Id -> m BlockId
selection_relative

-- | Create a number of alternate versions of the selection, and insert
-- an @alt@ call.
selection_alts :: Cmd.M m => Bool -> Int -> Id.Id -> m [BlockId]
selection_alts :: forall (m :: * -> *). M m => Bool -> TrackNum -> Id -> m [BlockId]
selection_alts Bool
relative TrackNum
alts Id
name
    | TrackNum
alts forall a. Ord a => a -> a -> Bool
<= TrackNum
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise = do
        BlockId
alt1 <- forall (m :: * -> *). M m => Bool -> Bool -> Id -> m BlockId
selection_ Bool
True Bool
relative forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> Id -> Id
Id.modify_name (forall a. Semigroup a => a -> a -> a
<>Text
"1") Id
name
        (BlockId
block_id, [TrackNum]
_, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *).
M m =>
m (BlockId, [TrackNum], [TrackId], Range)
Selection.tracks
        [BlockId]
altn <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TrackNum
2..TrackNum
alts] forall a b. (a -> b) -> a -> b
$ \TrackNum
n ->
            forall (m :: * -> *). M m => Bool -> BlockId -> Id -> m BlockId
Create.named_block_from_template Bool
True BlockId
alt1 forall a b. (a -> b) -> a -> b
$
                BlockId -> Id -> Id
alt_name BlockId
block_id ((Text -> Text) -> Id -> Id
Id.modify_name (forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt TrackNum
n) Id
name)
        let alts :: [BlockId]
alts = BlockId
alt1 forall a. a -> [a] -> [a]
: [BlockId]
altn
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view [BlockId]
alts
        let call :: Text
call = [Text] -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$
                Text
"alt" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BlockId -> BlockId -> Text
Eval.block_id_to_call Bool
relative BlockId
block_id) [BlockId]
alts
        let (TrackTime
start, TrackTime
end) = Range -> (TrackTime, TrackTime)
Events.range_times Range
range
        forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (forall a. [a] -> Maybe a
Lists.head [TrackId]
track_ids) forall a b. (a -> b) -> a -> b
$ \TrackId
track_id ->
            forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
track_id forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> Text -> Event
Event.event TrackTime
start (TrackTime
endforall a. Num a => a -> a -> a
-TrackTime
start) Text
call
        forall (m :: * -> *) a. Monad m => a -> m a
return [BlockId]
alts
    where
    alt_name :: BlockId -> Id -> Id
alt_name BlockId
block_id Id
name =
        if Bool
relative then BlockId -> Id -> Id
make_relative BlockId
block_id Id
name else Id
name

-- | Copy the selection into a new block, and replace it with a call to that
-- block.
selection_ :: Cmd.M m => Bool
    -- ^ replace the copied events with a call to the new block
    -> Bool -- ^ create relative block call
    -> Id.Id -> m BlockId
selection_ :: forall (m :: * -> *). M m => Bool -> Bool -> Id -> m BlockId
selection_ Bool
replace Bool
relative Id
name = do
    (BlockId
block_id, [TrackNum]
tracknums, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *).
M m =>
m (BlockId, [TrackNum], [TrackId], Range)
Selection.tracks
    Id
name <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
relative
        then BlockId -> Id -> Id
make_relative BlockId
block_id Id
name else Id
name
    BlockId
to_block_id <- forall (m :: * -> *).
M m =>
Id -> BlockId -> [TrackNum] -> [TrackId] -> Range -> m BlockId
extract Id
name BlockId
block_id [TrackNum]
tracknums [TrackId]
track_ids Range
range
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
replace forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
BlockId -> [TrackId] -> Range -> BlockId -> Bool -> m ()
replace_with_call BlockId
block_id [TrackId]
track_ids Range
range BlockId
to_block_id Bool
relative
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
to_block_id

make_relative :: BlockId -> Id.Id -> Id.Id
make_relative :: BlockId -> Id -> Id
make_relative BlockId
caller Id
name =
    Text -> Id -> Id
Id.set_name (BlockId -> Text -> Text
Eval.make_relative BlockId
caller (Id -> Text
Id.id_name Id
name)) Id
name

-- | Copy the ranges to a new block with the given Id.
extract :: Ui.M m => Id.Id -> BlockId -> [TrackNum] -> [TrackId]
    -> Events.Range -> m BlockId
extract :: forall (m :: * -> *).
M m =>
Id -> BlockId -> [TrackNum] -> [TrackId] -> Range -> m BlockId
extract Id
name BlockId
block_id [TrackNum]
tracknums [TrackId]
track_ids Range
range = do
    RulerId
ruler_id <- forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.block_ruler BlockId
block_id
    BlockId
to_block_id <- forall (m :: * -> *). M m => Id -> RulerId -> m BlockId
Create.named_block Id
name RulerId
ruler_id
    let (TrackTime
start, TrackTime
end) = Range -> (TrackTime, TrackTime)
Events.range_times Range
range
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [TrackNum
1..] [TrackId]
track_ids) forall a b. (a -> b) -> a -> b
$ \(TrackNum
tracknum, TrackId
track_id) -> do
        Text
title <- forall (m :: * -> *). M m => TrackId -> m Text
Ui.get_track_title TrackId
track_id
        Events
events <- Range -> Events -> Events
Events.in_range Range
range forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events TrackId
track_id
        -- Shift the events back to start at 0.
        forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> Text -> Events -> m TrackId
Create.track BlockId
to_block_id TrackNum
tracknum Text
title forall a b. (a -> b) -> a -> b
$
            (Event -> Event) -> Events -> Events
Events.map_events (Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= forall a. Num a => a -> a -> a
subtract TrackTime
start) Events
events
    forall (m :: * -> *).
M m =>
BlockId -> BlockId -> [TrackNum] -> m ()
clipped_skeleton BlockId
block_id BlockId
to_block_id [TrackNum]
tracknums
    -- It's easier to create all the tracks and then delete the empty ones.
    -- If I tried to just not create those tracks then 'clipped_skeleton' would
    -- have to get more complicated.
    forall (m :: * -> *). M m => BlockId -> m ()
delete_empty_tracks BlockId
to_block_id
    -- Create a clipped ruler.
    forall (m :: * -> *).
M m =>
BlockId -> ([MSection] -> [MSection]) -> m ()
local_sections BlockId
to_block_id forall a b. (a -> b) -> a -> b
$
        TrackTime -> TrackTime -> [MSection] -> [MSection]
RulerUtil.extract (TrackTime -> TrackTime
Meter.time_to_duration TrackTime
start)
            (TrackTime -> TrackTime
Meter.time_to_duration TrackTime
end)
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
to_block_id

-- | Clear selected range and put in a call to the new block.
replace_with_call :: Ui.M m => BlockId -> [TrackId] -> Events.Range -> BlockId
    -> Bool -> m ()
replace_with_call :: forall (m :: * -> *).
M m =>
BlockId -> [TrackId] -> Range -> BlockId -> Bool -> m ()
replace_with_call BlockId
block_id [TrackId]
track_ids Range
range BlockId
to_block_id Bool
relative = do
    forall (m :: * -> *). M m => [TrackId] -> Range -> m ()
Edit.clear_range [TrackId]
track_ids Range
range
    let (TrackTime
start, TrackTime
end) = Range -> (TrackTime, TrackTime)
Events.range_times Range
range
    forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (forall a. [a] -> Maybe a
Lists.head [TrackId]
track_ids) forall a b. (a -> b) -> a -> b
$ \TrackId
track_id ->
        forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
track_id forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> Text -> Event
Event.event TrackTime
start (TrackTime
endforall a. Num a => a -> a -> a
-TrackTime
start)
            (Bool -> BlockId -> BlockId -> Text
Eval.block_id_to_call Bool
relative BlockId
block_id BlockId
to_block_id)

-- ** relative calls

-- | Rename all blocks with the old parent as a prefix.  Unlike
-- 'rebase_relative_calls', this doesn't modify any events.
rebase_ids :: Ui.M m => BlockId -> BlockId -> m ()
rebase_ids :: forall (m :: * -> *). M m => BlockId -> BlockId -> m ()
rebase_ids BlockId
old_parent BlockId
new_parent = forall (m :: * -> *). M m => (Id -> Id) -> m ()
Transform.map_block_ids forall a b. (a -> b) -> a -> b
$ \Id
id ->
    case BlockId -> BlockId -> BlockId -> Maybe Id
rebase_id BlockId
old_parent BlockId
new_parent (Id -> BlockId
Id.BlockId Id
id) of
        Maybe Id
Nothing -> Id
id
        Just Id
new_id -> Id
new_id

-- | Move a relative callee from one parent to another, or Nothing if it's
-- not a child of that parent.
rebase_id :: BlockId -> BlockId -> BlockId -> Maybe Id.Id
rebase_id :: BlockId -> BlockId -> BlockId -> Maybe Id
rebase_id BlockId
old_parent BlockId
new_parent BlockId
child = case BlockId -> Maybe (BlockId, Id)
Eval.parse_relative_id BlockId
child of
    Just (BlockId
parent, Id
name)
        | BlockId
parent forall a. Eq a => a -> a -> Bool
== BlockId
old_parent -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ BlockId -> Id -> Id
make_relative BlockId
new_parent Id
name
        | Bool
otherwise -> forall a. Maybe a
Nothing
    Maybe (BlockId, Id)
Nothing -> forall a. Maybe a
Nothing

-- | If there's a point selection, create a new empty block based on the
-- current one.  If the selection has time, then the new block will have only
-- the selected tracks with a ruler clipped to the selected range.
block_from_template :: Cmd.M m => m ()
block_from_template :: forall (m :: * -> *). M m => m ()
block_from_template = do
    Selection
sel <- forall (m :: * -> *). M m => m Selection
Selection.get
    if Selection -> Bool
Sel.is_point Selection
sel
        then forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => Bool -> BlockId -> m BlockId
Create.block_from_template Bool
False
            forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
        else forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *). M m => m BlockId
block_template_from_selection

delete_empty_tracks :: Ui.M m => BlockId -> m ()
delete_empty_tracks :: forall (m :: * -> *). M m => BlockId -> m ()
delete_empty_tracks BlockId
block_id = do
    [TrackId]
track_ids <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Events -> Bool
Events.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events)
        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 (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => TrackId -> m ()
Ui.destroy_track [TrackId]
track_ids

-- * named block

block_template_from_selection :: Cmd.M m => m BlockId
block_template_from_selection :: forall (m :: * -> *). M m => m BlockId
block_template_from_selection =
    forall (m :: * -> *).
M m =>
m (BlockId, [TrackNum], [TrackId], Range)
Selection.tracks forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(BlockId
block_id, [TrackNum]
_, [TrackId]
track_ids, Range
range) -> do
        BlockId
to_block_id <- forall (m :: * -> *).
M m =>
BlockId -> [TrackId] -> Range -> m BlockId
block_template BlockId
block_id [TrackId]
track_ids Range
range
        forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
to_block_id
        forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
to_block_id

-- | Create a new block with the given tracks and ruler clipped to the given
-- range.
block_template :: Ui.M m => BlockId -> [TrackId] -> Events.Range -> m BlockId
block_template :: forall (m :: * -> *).
M m =>
BlockId -> [TrackId] -> Range -> m BlockId
block_template BlockId
block_id [TrackId]
track_ids Range
range = do
    BlockId
to_block_id <- forall (m :: * -> *). M m => RulerId -> m BlockId
Create.block forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.block_ruler BlockId
block_id
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [TrackNum
1..] [TrackId]
track_ids) forall a b. (a -> b) -> a -> b
$ \(TrackNum
tracknum, TrackId
track_id) -> do
        Text
title <- forall (m :: * -> *). M m => TrackId -> m Text
Ui.get_track_title TrackId
track_id
        forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> Text -> Events -> m TrackId
Create.track BlockId
to_block_id TrackNum
tracknum Text
title forall a. Monoid a => a
mempty
    -- Create skeleton.
    forall (m :: * -> *).
M m =>
BlockId -> BlockId -> [TrackNum] -> m ()
clipped_skeleton BlockId
block_id BlockId
to_block_id
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). M m => BlockId -> TrackId -> m TrackNum
Ui.get_tracknum_of BlockId
block_id) [TrackId]
track_ids
    -- Create a clipped ruler.
    let (TrackTime
start, TrackTime
end) = Range -> (TrackTime, TrackTime)
Events.range_times Range
range
    forall (m :: * -> *).
M m =>
BlockId -> ([MSection] -> [MSection]) -> m ()
local_sections BlockId
to_block_id forall a b. (a -> b) -> a -> b
$
        TrackTime -> TrackTime -> [MSection] -> [MSection]
RulerUtil.extract (TrackTime -> TrackTime
Meter.time_to_duration TrackTime
start)
            (TrackTime -> TrackTime
Meter.time_to_duration TrackTime
end)
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
to_block_id

clipped_skeleton :: Ui.M m => BlockId -> BlockId -> [TrackNum] -> m ()
clipped_skeleton :: forall (m :: * -> *).
M m =>
BlockId -> BlockId -> [TrackNum] -> m ()
clipped_skeleton BlockId
from_block BlockId
to_block [TrackNum]
tracknums =
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (m :: * -> *). M m => BlockId -> m Bool
Ui.has_explicit_skeleton BlockId
to_block) forall a b. (a -> b) -> a -> b
$
        case (forall a. Ord a => [a] -> Maybe a
Lists.minimum [TrackNum]
tracknums, forall a. Ord a => [a] -> Maybe a
Lists.maximum [TrackNum]
tracknums) of
            (Just TrackNum
low, Just TrackNum
high) -> do
                [Edge]
edges <- Skeleton -> [Edge]
Skeleton.flatten forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m Skeleton
Ui.get_skeleton BlockId
from_block
                forall (m :: * -> *). M m => BlockId -> Skeleton -> m ()
Ui.set_skeleton BlockId
to_block forall a b. (a -> b) -> a -> b
$ [Edge] -> Skeleton
Skeleton.make
                    [ (TrackNum
fromforall a. Num a => a -> a -> a
-TrackNum
low forall a. Num a => a -> a -> a
+ TrackNum
1, TrackNum
toforall a. Num a => a -> a -> a
-TrackNum
low forall a. Num a => a -> a -> a
+ TrackNum
1) | (TrackNum
from, TrackNum
to) <- [Edge]
edges
                    , forall a. Ord a => a -> a -> a -> Bool
Num.inRange TrackNum
low (TrackNum
highforall a. Num a => a -> a -> a
+TrackNum
1) TrackNum
from, forall a. Ord a => a -> a -> a -> Bool
Num.inRange TrackNum
low (TrackNum
highforall a. Num a => a -> a -> a
+TrackNum
1) TrackNum
to
                    ]
            (Maybe TrackNum, Maybe TrackNum)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * order block

-- | Create a new block containing calls to the given BlockIds.
order_block :: Cmd.M m => Id.Id -> [BlockId] -> m BlockId
order_block :: forall (m :: * -> *). M m => Id -> [BlockId] -> m BlockId
order_block Id
name [BlockId]
block_ids = do
    BlockId
block_id <- forall (m :: * -> *). M m => Id -> RulerId -> m BlockId
Create.named_block Id
name RulerId
Ui.no_ruler
    forall (m :: * -> *). M m => BlockId -> [BlockId] -> m TrackId
order_track BlockId
block_id [BlockId]
block_ids
    forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
block_id

-- | Append a track to the given block with calls to the given BlockIds.  The
-- calling track will have a 1:1 time relationship with the calls, which is
-- useful for lilypond derivation since it only understands 1:1.  Also
-- modify the ruler to be the concatenation of the rulers of the sub-blocks.
order_track :: Ui.M m => BlockId -> [BlockId] -> m TrackId
order_track :: forall (m :: * -> *). M m => BlockId -> [BlockId] -> m TrackId
order_track BlockId
block_id [BlockId]
sub_blocks = do
    [RulerId]
ruler_ids <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.ruler_of [BlockId]
sub_blocks
    [Meter]
meters <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). M m => RulerId -> m Meter
RulerUtil.get_meter [RulerId]
ruler_ids
    let durs :: [TrackTime]
durs = forall a b. (a -> b) -> [a] -> [b]
map Meter -> TrackTime
Meter.meter_end [Meter]
meters
        starts :: [TrackTime]
starts = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) TrackTime
0 [TrackTime]
durs
        events :: [Event]
events =
            [ TrackTime -> TrackTime -> Text -> Event
Event.event TrackTime
start TrackTime
dur (BlockId -> Text
block_id_to_call BlockId
block_id)
            | (TrackTime
start, TrackTime
dur, BlockId
block_id) <- forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [TrackTime]
starts [TrackTime]
durs [BlockId]
sub_blocks
            ]
    forall (m :: * -> *). M m => BlockId -> (Meter -> Meter) -> m ()
local_block BlockId
block_id forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Meter]
meters
    forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> Text -> Events -> m TrackId
Create.track BlockId
block_id TrackNum
9999 Text
">" ([Event] -> Events
Events.from_list [Event]
events)

block_id_to_call :: BlockId -> Text
block_id_to_call :: BlockId -> Text
block_id_to_call = forall a. Ident a => a -> Text
Id.ident_name

-- * util

local_sections :: Ui.M m => BlockId -> ([Meter.MSection] -> [Meter.MSection])
    -> m ()
local_sections :: forall (m :: * -> *).
M m =>
BlockId -> ([MSection] -> [MSection]) -> m ()
local_sections BlockId
block_id = forall (m :: * -> *). M m => BlockId -> (Meter -> Meter) -> m ()
local_block BlockId
block_id forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MSection] -> [MSection]) -> Meter -> Meter
Meter.modify_sections

local_block :: Ui.M m => BlockId -> (Meter.Meter -> Meter.Meter) -> m ()
local_block :: forall (m :: * -> *). M m => BlockId -> (Meter -> Meter) -> m ()
local_block BlockId
block_id Meter -> Meter
modify = do
    forall (m :: * -> *). M m => BlockId -> ModifyRuler -> m [RulerId]
RulerUtil.local_block BlockId
block_id (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Meter -> Meter) -> Ruler -> Ruler
Ruler.modify_meter Meter -> Meter
modify)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()