-- Copyright 2021 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Utilities to use manual integration.
module Cmd.Integrate.Manual where
import qualified Data.Map as Map

import qualified App.Config as Config
import qualified Cmd.BlockConfig as BlockConfig
import qualified Cmd.Integrate.Convert as Convert
import qualified Cmd.Integrate.Merge as Merge
import qualified Cmd.ModifyNotes as ModifyNotes

import qualified Derive.ParseTitle as ParseTitle
import qualified Derive.ScoreT as ScoreT
import qualified Derive.Stack as Stack

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.Ui as Ui

import           Global
import           Types


convert_note_track :: Block.SourceKey -> ModifyNotes.NoteTrack
    -> (Convert.Track, [Convert.Track])
convert_note_track :: SourceKey -> NoteTrack -> (Track, [Track])
convert_note_track SourceKey
key (ModifyNotes.NoteTrack Events
notes Controls
controls) =
    ( SourceKey -> Events -> Track
convert_track SourceKey
ParseTitle.note_track Events
notes
    , forall a b. (a -> b) -> [a] -> [b]
map (Control, Events) -> Track
convert (forall k a. Map k a -> [(k, a)]
Map.toAscList Controls
controls)
    )
    where
    convert :: (Control, Events) -> Track
convert (ModifyNotes.Pitch ScaleId
scale_id, Events
events) =
        SourceKey -> Events -> Track
convert_track (ScaleId -> SourceKey
ParseTitle.scale_to_title ScaleId
scale_id) Events
events
    convert (ModifyNotes.Control Control
control, Events
events) =
        SourceKey -> Events -> Track
convert_track (Typed Control -> SourceKey
ParseTitle.control_to_title (forall a. a -> Typed a
ScoreT.untyped Control
control))
            Events
events
    convert_track :: SourceKey -> Events -> Track
convert_track SourceKey
title = SourceKey -> [Event] -> Track
Convert.Track SourceKey
title
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (SourceKey -> Event -> Event
add_stack SourceKey
key) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events -> [Event]
Events.ascending

add_stack :: Block.SourceKey -> Event.Event -> Event.Event
add_stack :: SourceKey -> Event -> Event
add_stack SourceKey
key Event
event =
    Lens Event (Maybe Stack)
Event.stack_ forall f a. Lens f a -> a -> f -> f
#= forall a. a -> Maybe a
Just (Stack -> IndexKey -> Stack
Event.Stack Stack
stack (Event -> IndexKey
Event.start Event
event)) forall a b. (a -> b) -> a -> b
$ Event
event
    where stack :: Stack
stack = Frame -> Stack -> Stack
Stack.add (SourceKey -> Frame
Stack.Call SourceKey
key) Stack
Stack.empty

-- | Create or re-integrate a block with the given tracks.
block :: Ui.M m => Block.SourceKey -> BlockId -> RulerId -> Text
    -> Convert.Tracks -> m (Maybe BlockId)
block :: forall (m :: * -> *).
M m =>
SourceKey
-> BlockId -> RulerId -> SourceKey -> Tracks -> m (Maybe BlockId)
block SourceKey
source_key BlockId
block_id RulerId
ruler_id SourceKey
block_title Tracks
tracks = do
    ([NoteDestination]
dests, Bool
created) <- forall (m :: * -> *). M m => BlockId -> m (Maybe Block)
Ui.lookup_block BlockId
block_id forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Block
Nothing -> do
            forall (m :: * -> *).
M m =>
Id -> SourceKey -> [Track] -> m BlockId
Ui.create_block (forall a. Ident a => a -> Id
Id.unpack_id BlockId
block_id) SourceKey
block_title
                [TracklikeId -> Width -> Track
Block.track (RulerId -> TracklikeId
Block.RId RulerId
ruler_id) Width
Config.ruler_width]
            forall (m :: * -> *) a. Monad m => a -> m a
return ([], Bool
True)
        Just Block
exist -> do
            forall (m :: * -> *). M m => BlockId -> RulerId -> m ()
Ui.set_ruler_id BlockId
block_id RulerId
ruler_id
            case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SourceKey
source_key (Block -> ManualDestinations
Block.block_integrated_manual Block
exist) of
                Maybe [NoteDestination]
Nothing -> forall (m :: * -> *) a. (Stack, M m) => SourceKey -> m a
Ui.throw forall a b. (a -> b) -> a -> b
$
                    SourceKey
"block to integrate already exists: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> SourceKey
pretty BlockId
block_id
                Just [NoteDestination]
dests -> do
                    forall (m :: * -> *). M m => BlockId -> SourceKey -> m ()
Ui.set_block_title BlockId
block_id SourceKey
block_title
                    forall (m :: * -> *) a. Monad m => a -> m a
return ([NoteDestination]
dests, Bool
False)
    [NoteDestination]
new_dests <- forall (m :: * -> *).
M m =>
MergeTitles
-> BlockId -> Tracks -> [NoteDestination] -> m [NoteDestination]
Merge.merge_tracks MergeTitles
Merge.ReplaceTitles BlockId
block_id Tracks
tracks [NoteDestination]
dests
    forall (m :: * -> *).
M m =>
BlockId -> SourceKey -> Maybe [NoteDestination] -> m ()
Ui.set_integrated_manual BlockId
block_id SourceKey
source_key (forall a. a -> Maybe a
Just [NoteDestination]
new_dests)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
created forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *). M m => BlockId -> m ()
BlockConfig.toggle_merge_all BlockId
block_id
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
created then forall a. a -> Maybe a
Just BlockId
block_id else forall a. Maybe a
Nothing