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

-- | Functions to deal with derive and score integration.
module Cmd.Repl.LIntegrate where
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Edit as Edit
import qualified Cmd.Integrate.Merge as Merge
import qualified Cmd.Perf as Perf
import qualified Cmd.Selection as Selection

import qualified Derive.Derive as Derive
import qualified Derive.Stack as Stack
import qualified Derive.Stream as Stream

import qualified Ui.Block as Block
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Ui as Ui

import           Global
import           Types


-- * create

-- | Create an integrated block from the focused block.  The block integrate
-- call will automatically create one block, but you have to use this if you
-- want more than one.  Actually, you can use it on a block without a `<<`
-- integrate call, but there isn't much point since it won't reintegrate until
-- you add one.
block :: Cmd.M m => m ViewId
block :: forall (m :: * -> *). M m => m ViewId
block = do
    BlockId
source_block <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    RulerId
ruler_id <- forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.block_ruler BlockId
source_block
    BlockId
dest_block <- forall (m :: * -> *). M m => RulerId -> m BlockId
Create.block RulerId
ruler_id
    forall (m :: * -> *).
M m =>
BlockId -> Maybe (BlockId, TrackDestinations) -> m ()
Ui.set_integrated_block BlockId
dest_block forall a b. (a -> b) -> a -> b
$
        forall a. a -> Maybe a
Just (BlockId
source_block, [NoteDestination] -> TrackDestinations
Block.DeriveDestinations [])
    forall (m :: * -> *). M m => [BlockId] -> m ()
Cmd.derive_immediately [BlockId
source_block]
    forall (m :: * -> *). M m => BlockId -> m ()
Cmd.inflict_block_damage BlockId
source_block
    forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
dest_block

-- | Create a block integrate copy of the selected block.  Details at
-- 'Block.ScoreDestinations'.
score_block :: Cmd.M m => m ViewId
score_block :: forall (m :: * -> *). M m => m ViewId
score_block = do
    BlockId
source_block <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    RulerId
ruler_id <- forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.block_ruler BlockId
source_block
    BlockId
dest_block <- forall (m :: * -> *). M m => RulerId -> m BlockId
Create.block RulerId
ruler_id
    forall (m :: * -> *).
M m =>
BlockId -> Maybe (BlockId, TrackDestinations) -> m ()
Ui.set_integrated_block BlockId
dest_block forall a b. (a -> b) -> a -> b
$
        forall a. a -> Maybe a
Just (BlockId
source_block, ScoreDestinations -> TrackDestinations
Block.ScoreDestinations [])
    forall (m :: * -> *). M m => BlockId -> m ()
Cmd.inflict_block_damage BlockId
source_block
    forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
dest_block

-- | Similar to 'block', explicitly create another track integrated from the
-- selected one, which should already have a `<` integrate call on it.
track :: Cmd.M m => m ()
track :: forall (m :: * -> *). M m => m ()
track = do
    (BlockId
block_id, TrackNum
_, TrackId
track_id, TrackTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, TrackTime)
Selection.get_insert
    forall (m :: * -> *).
M m =>
BlockId
-> ([(TrackId, TrackDestinations)]
    -> [(TrackId, TrackDestinations)])
-> m ()
Ui.modify_integrated_tracks BlockId
block_id
        ((TrackId
track_id, [NoteDestination] -> TrackDestinations
Block.DeriveDestinations []) :)
    forall (m :: * -> *). M m => [BlockId] -> m ()
Cmd.derive_immediately [BlockId
block_id]
    forall (m :: * -> *). M m => BlockId -> TrackId -> m ()
Cmd.inflict_track_damage BlockId
block_id TrackId
track_id

-- | Create a track integrate copy of the selected track.  Details at
-- 'Block.ScoreDestinations'.
score_track :: Cmd.M m => m ()
score_track :: forall (m :: * -> *). M m => m ()
score_track = do
    (BlockId
block_id, TrackNum
_, TrackId
track_id, TrackTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, TrackTime)
Selection.get_insert
    forall (m :: * -> *).
M m =>
BlockId
-> ([(TrackId, TrackDestinations)]
    -> [(TrackId, TrackDestinations)])
-> m ()
Ui.modify_integrated_tracks BlockId
block_id
        ((TrackId
track_id, ScoreDestinations -> TrackDestinations
Block.ScoreDestinations []) :)
    forall (m :: * -> *). M m => BlockId -> TrackId -> m ()
Cmd.inflict_track_damage BlockId
block_id TrackId
track_id

clear_score_track :: Cmd.M m => m ()
clear_score_track :: forall (m :: * -> *). M m => m ()
clear_score_track = do
    (BlockId
block_id, [TrackNum]
_, [TrackId]
track_ids, Range
_) <- forall (m :: * -> *).
M m =>
m (BlockId, [TrackNum], [TrackId], Range)
Selection.tracks
    forall (m :: * -> *).
M m =>
BlockId
-> ([(TrackId, TrackDestinations)]
    -> [(TrackId, TrackDestinations)])
-> m ()
Ui.modify_integrated_tracks BlockId
block_id forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [TrackId]
track_ids) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

clear_score_tracks_of :: Ui.M m => BlockId -> m ()
clear_score_tracks_of :: forall (m :: * -> *). M m => BlockId -> m ()
clear_score_tracks_of BlockId
block_id =
    forall (m :: * -> *).
M m =>
BlockId
-> ([(TrackId, TrackDestinations)]
    -> [(TrackId, TrackDestinations)])
-> m ()
Ui.modify_integrated_tracks BlockId
block_id (forall a b. a -> b -> a
const [])


-- * revert

-- | Revert the selected range back to the integrated state.
sel_revert :: Cmd.M m => m ()
sel_revert :: forall (m :: * -> *). M m => m ()
sel_revert = do
    (BlockId
block_id, [TrackNum]
_, [TrackId]
track_ids, Range
range) <- forall (m :: * -> *).
M m =>
m (BlockId, [TrackNum], [TrackId], Range)
Selection.tracks
    forall (m :: * -> *). M m => [TrackId] -> Range -> m ()
Edit.clear_range [TrackId]
track_ids Range
range
    [(TrackId, (Source, EventIndex))]
by_dest <- Block -> [(TrackId, (Source, EventIndex))]
Block.destination_to_source forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block BlockId
block_id
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
        [ forall (m :: * -> *). M m => BlockId -> TrackId -> [Event] -> m ()
Ui.insert_block_events BlockId
block_id TrackId
track_id
            (forall a b. (a -> b) -> [a] -> [b]
map Event -> Event
Event.unmodified (forall k a. Map k a -> [a]
Map.elems EventIndex
index))
        | (TrackId
track_id, (Source
_, EventIndex
index)) <- [(TrackId, (Source, EventIndex))]
by_dest
        , TrackId
track_id forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TrackId]
track_ids
        ]

delete_manual :: Cmd.M m => Block.SourceKey -> m ()
delete_manual :: forall (m :: * -> *). M m => Text -> m ()
delete_manual Text
key = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *).
M m =>
BlockId -> Text -> Maybe [NoteDestination] -> m ()
Ui.set_integrated_manual BlockId
block_id Text
key forall a. Maybe a
Nothing


-- * inspect

track_sources :: Cmd.M m => m Text
track_sources :: forall (m :: * -> *). M m => m Text
track_sources = do
    Block
block <- forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
List.intercalate [Text
""] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Pretty a => (a, TrackDestinations) -> [Text]
show_source forall a b. (a -> b) -> a -> b
$
        Block -> [(TrackId, TrackDestinations)]
Block.block_integrated_tracks Block
block
    where
    show_source :: (a, TrackDestinations) -> [Text]
show_source (a
source, TrackDestinations
dests) =
        Text
"=== source: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty a
source forall a. a -> [a] -> [a]
: TrackDestinations -> [Text]
show_track_dests TrackDestinations
dests

show_track_dests :: Block.TrackDestinations -> [Text]
show_track_dests :: TrackDestinations -> [Text]
show_track_dests = \case
    Block.DeriveDestinations [NoteDestination]
dests -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NoteDestination -> [Text]
show_dest [NoteDestination]
dests
    Block.ScoreDestinations ScoreDestinations
dests -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TrackId, (TrackId, EventIndex)) -> [Text]
show_score_dest ScoreDestinations
dests

show_score_dest :: (TrackId, (TrackId, Block.EventIndex)) -> [Text]
show_score_dest :: (TrackId, (TrackId, EventIndex)) -> [Text]
show_score_dest (TrackId
source, (TrackId
dest, EventIndex
events)) =
    Text
"== " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty TrackId
source forall a. Semigroup a => a -> a -> a
<> Text
" -> " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty TrackId
dest forall a. Semigroup a => a -> a -> a
<> Text
":"
    forall a. a -> [a] -> [a]
: EventIndex -> [Text]
show_index EventIndex
events

show_dest :: Block.NoteDestination -> [Text]
show_dest :: NoteDestination -> [Text]
show_dest (Block.NoteDestination Text
key (TrackId, EventIndex)
note Map Text (TrackId, EventIndex)
controls) =
    Text
"== key: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Text
key
        forall a. a -> [a] -> [a]
: Text
"== note: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty (forall a b. (a, b) -> a
fst (TrackId, EventIndex)
note) forall a. a -> [a] -> [a]
: EventIndex -> [Text]
show_index (forall a b. (a, b) -> b
snd (TrackId, EventIndex)
note)
        forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Pretty a => (Text, (a, EventIndex)) -> [Text]
show_control (forall k a. Map k a -> [(k, a)]
Map.toList Map Text (TrackId, EventIndex)
controls)
    where
    show_control :: (Text, (a, EventIndex)) -> [Text]
show_control (Text
name, (a
track_id, EventIndex
index)) =
        Text
"== control " forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty a
track_id
        forall a. a -> [a] -> [a]
: EventIndex -> [Text]
show_index EventIndex
index

show_index :: Block.EventIndex -> [Text]
show_index :: EventIndex -> [Text]
show_index = forall a b. (a -> b) -> [a] -> [b]
map Event -> Text
show_event forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems

show_event :: Event.Event -> Text
show_event :: Event -> Text
show_event Event
e = forall a. Monoid a => [a] -> a
mconcat
    [ forall a. Pretty a => a -> Text
pretty (Event -> TrackTime
Event.start Event
e), Text
"+", forall a. Pretty a => a -> Text
pretty (Event -> TrackTime
Event.duration Event
e)
    , Text
" ", forall a. Pretty a => a -> Text
pretty (Event -> Text
Event.text Event
e)
    , Text
" ", forall a. a -> Maybe a -> a
fromMaybe Text
"?" forall a b. (a -> b) -> a -> b
$
        Stack -> Maybe Text
Stack.pretty_ui_inner forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> Stack
Event.stack_stack forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event -> Maybe Stack
Event.stack Event
e
    ]

-- | Show the integration state in an abbreviated way.
-- This is an inverse mapping from dest to source.
dest_to_sources :: Cmd.M m => m [(TrackId, (Block.Source, Text))]
dest_to_sources :: forall (m :: * -> *). M m => m [(TrackId, (Source, Text))]
dest_to_sources = do
    Block
block <- forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    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 (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 EventIndex -> Text
Block.short_event_index)) forall a b. (a -> b) -> a -> b
$
        Block -> [(TrackId, (Source, EventIndex))]
Block.destination_to_source Block
block

sel_edits :: Cmd.M m => m ([Event.IndexKey], [Merge.Edit])
sel_edits :: forall (m :: * -> *). M m => m ([TrackTime], [Edit])
sel_edits = do
    (BlockId
block_id, TrackNum
_, TrackId
track_id, TrackTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, TrackTime)
Selection.get_insert
    forall (m :: * -> *).
M m =>
BlockId -> TrackId -> m ([TrackTime], [Edit])
edits BlockId
block_id TrackId
track_id

edits :: Cmd.M m => BlockId -> TrackId -> m ([Event.IndexKey], [Merge.Edit])
edits :: forall (m :: * -> *).
M m =>
BlockId -> TrackId -> m ([TrackTime], [Edit])
edits BlockId
block_id TrackId
track_id = do
    Block
block <- forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block BlockId
block_id
    EventIndex
index <- forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Cmd.require Text
"track is not integrated from anywhere" forall a b. (a -> b) -> a -> b
$
        forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TrackId
track_id forall a b. (a -> b) -> a -> b
$ Maybe (BlockId, TrackDestinations)
-> [(TrackId, TrackDestinations)] -> [(TrackId, EventIndex)]
indices_of (Block -> Maybe (BlockId, TrackDestinations)
Block.block_integrated Block
block)
            (Block -> [(TrackId, TrackDestinations)]
Block.block_integrated_tracks Block
block)
    Events
events <- forall (m :: * -> *). M m => TrackId -> m Events
Ui.get_events TrackId
track_id
    let (Set TrackTime
deleted, [Edit]
edits) = EventIndex -> [Event] -> (Set TrackTime, [Edit])
Merge.diff_events EventIndex
index (Events -> [Event]
Events.ascending Events
events)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Set a -> [a]
Set.toList Set TrackTime
deleted, forall a. (a -> Bool) -> [a] -> [a]
filter Edit -> Bool
Merge.is_modified [Edit]
edits)

-- | Show source UI events.
indices :: Cmd.M m => m [(TrackId, (Block.Source, Block.EventIndex))]
indices :: forall (m :: * -> *). M m => m [(TrackId, (Source, EventIndex))]
indices =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> [(TrackId, (Source, EventIndex))]
Block.destination_to_source forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block

indices_of :: Maybe (BlockId, Block.TrackDestinations)
    -> [(TrackId, Block.TrackDestinations)] -> [(TrackId, Block.EventIndex)]
indices_of :: Maybe (BlockId, TrackDestinations)
-> [(TrackId, TrackDestinations)] -> [(TrackId, EventIndex)]
indices_of Maybe (BlockId, TrackDestinations)
integrated [(TrackId, TrackDestinations)]
integrated_tracks =
    [(TrackId, EventIndex)]
block_indices forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. (a, TrackDestinations) -> [(TrackId, EventIndex)]
dest_indices [(TrackId, TrackDestinations)]
integrated_tracks
    where
    block_indices :: [(TrackId, EventIndex)]
block_indices = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall {a}. (a, TrackDestinations) -> [(TrackId, EventIndex)]
dest_indices Maybe (BlockId, TrackDestinations)
integrated
    dest_indices :: (a, TrackDestinations) -> [(TrackId, EventIndex)]
dest_indices (a
_, Block.DeriveDestinations [NoteDestination]
dests) =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NoteDestination -> [(TrackId, EventIndex)]
derive_indices [NoteDestination]
dests
    dest_indices (a
_, Block.ScoreDestinations ScoreDestinations
dests) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd ScoreDestinations
dests
    derive_indices :: NoteDestination -> [(TrackId, EventIndex)]
derive_indices (Block.NoteDestination Text
_ (TrackId, EventIndex)
note Map Text (TrackId, EventIndex)
controls) =
        (TrackId, EventIndex)
note forall a. a -> [a] -> [a]
: forall k a. Map k a -> [a]
Map.elems Map Text (TrackId, EventIndex)
controls

-- | This is always going to be empty because cache strips collect_integrated.
-- That's too bad because sometimes I want to see the original events, for
-- debugging.
integrated :: Cmd.M m => m Text
integrated :: forall (m :: * -> *). M m => m Text
integrated = do
    [Integrated]
integrated <- Performance -> [Integrated]
Cmd.perf_integrated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). M m => BlockId -> m Performance
Perf.get forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Integrated -> [Text]
fmt [Integrated]
integrated
    where
    fmt :: Integrated -> [Text]
fmt (Derive.Integrated Either BlockId TrackId
source Stream Event
events) =
        forall a. Pretty a => a -> Text
pretty Either BlockId TrackId
source forall a. a -> [a] -> [a]
: Stream Event -> [Text]
Stream.short_events Stream Event
events