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

-- | Block level cmds.
module Cmd.Repl.LBlock where
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Data.Text.Lazy as Lazy

import qualified Util.Html as Html
import qualified Util.Lists as Lists
import qualified Util.Pretty as Pretty

import qualified Cmd.BlockConfig as BlockConfig
import qualified Cmd.BlockResize as BlockResize
import qualified Cmd.CallDoc as CallDoc
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.ModifyEvents as ModifyEvents
import qualified Cmd.Repl.Util as Util
import qualified Cmd.Selection as Selection

import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Expr as Expr
import qualified Derive.Parse as Parse
import qualified Derive.ParseTitle as ParseTitle
import qualified Derive.ShowVal as ShowVal

import           Global hiding (pretty)
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.Sel as Sel
import qualified Ui.Track as Track
import qualified Ui.Ui as Ui

import           Types


-- | All BlockIds, along with the count of views for each one.
list :: Cmd.CmdL [(BlockId, Int)]
list :: CmdL [(BlockId, TrackNum)]
list = do
    [BlockId]
block_ids <- forall (m :: * -> *). M m => m [BlockId]
Ui.all_block_ids
    [BlockId]
view_blocks <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Ui.gets forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map View -> BlockId
Block.view_block forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Map ViewId View
Ui.state_views
    forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (BlockId
block_id, forall (t :: * -> *) a.
Foldable t =>
(a -> Bool) -> t a -> TrackNum
Lists.count (forall a. Eq a => a -> a -> Bool
==BlockId
block_id) [BlockId]
view_blocks)
        | BlockId
block_id <- [BlockId]
block_ids
        ]

-- | Find BlockIds that match the string.
find_id :: Ui.M m => Text -> m [BlockId]
find_id :: forall (m :: * -> *). M m => SymbolName -> m [BlockId]
find_id SymbolName
match = forall a. (a -> Bool) -> [a] -> [a]
filter (forall id. Ident id => SymbolName -> id -> Bool
Util.match_id SymbolName
match) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (m :: * -> *) a. M m => (State -> a) -> m a
Ui.gets (forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Map BlockId Block
Ui.state_blocks)

pretty :: Ui.M m => BlockId -> m Text
pretty :: forall (m :: * -> *). M m => BlockId -> m SymbolName
pretty BlockId
block_id = do
    Block
block <- forall (m :: * -> *). M m => BlockId -> m Block
Ui.get_block BlockId
block_id
    Map TrackId Track
tracks <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Ui.gets State -> Map TrackId Track
Ui.state_tracks
    [BlockId]
view_blocks <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Ui.gets forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map View -> BlockId
Block.view_block forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Map ViewId View
Ui.state_views
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> SymbolName
Pretty.formatted forall a b. (a -> b) -> a -> b
$
        forall {t :: * -> *} {p}.
(Foldable t, Eq p) =>
t p -> Map TrackId Track -> p -> Block -> Doc
pretty_tracks [BlockId]
view_blocks Map TrackId Track
tracks BlockId
block_id Block
block
    where
    pretty_tracks :: t p -> Map TrackId Track -> p -> Block -> Doc
pretty_tracks t p
view_blocks Map TrackId Track
tracks p
block_id Block
block =
        forall a. Pretty a => a -> Doc
Pretty.format (Block -> SymbolName
Block.block_title Block
block)
            Doc -> Doc -> Doc
Pretty.<+> SymbolName -> Doc
Pretty.text (SymbolName
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> SymbolName
showt TrackNum
views forall a. Semigroup a => a -> a -> a
<> SymbolName
" views)")
            Doc -> Doc -> Doc
Pretty.<+> [SymbolName] -> Doc
Pretty.textList (forall a b. (a -> b) -> [a] -> [b]
map Track -> SymbolName
track (Block -> [Track]
Block.block_tracks Block
block))
        where
        track :: Track -> SymbolName
track Track
t = forall a. Pretty a => a -> SymbolName
Pretty.pretty (Track -> TracklikeId
Block.tracklike_id Track
t)
            forall a. Semigroup a => a -> a -> a
<> SymbolName
" (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> SymbolName
showt (Track -> TrackNum
track_events Track
t) forall a. Semigroup a => a -> a -> a
<> SymbolName
" events)"
        views :: TrackNum
views = forall (t :: * -> *) a.
Foldable t =>
(a -> Bool) -> t a -> TrackNum
Lists.count (forall a. Eq a => a -> a -> Bool
==p
block_id) t p
view_blocks
        get :: Track -> Maybe Track
get = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map TrackId Track
tracks forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Track -> Maybe TrackId
Block.track_id
        track_events :: Track -> TrackNum
track_events = forall b a. b -> (a -> b) -> Maybe a -> b
maybe TrackNum
0 (Events -> TrackNum
Events.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> Events
Track.track_events) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> Maybe Track
get

-- | Find all blocks with the given text in their titles.
find :: Text -> Cmd.CmdL [(BlockId, Text)]
find :: SymbolName -> CmdL [(BlockId, SymbolName)]
find SymbolName
substr = (SymbolName -> Bool) -> CmdL [(BlockId, SymbolName)]
find_f (SymbolName
substr `Text.isInfixOf`)

find_f :: (Text -> Bool) -> Cmd.CmdL [(BlockId, Text)]
find_f :: (SymbolName -> Bool) -> CmdL [(BlockId, SymbolName)]
find_f SymbolName -> Bool
match = do
    [BlockId]
block_ids <- forall (m :: * -> *). M m => m [BlockId]
Ui.all_block_ids
    [SymbolName]
titles <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). M m => BlockId -> m SymbolName
Ui.get_block_title [BlockId]
block_ids
    forall (m :: * -> *) a. Monad m => a -> m a
return [(BlockId
block_id, SymbolName
title) | (BlockId
block_id, SymbolName
title) <- forall a b. [a] -> [b] -> [(a, b)]
zip [BlockId]
block_ids [SymbolName]
titles,
        SymbolName -> Bool
match SymbolName
title]

-- | Transform all block titles.
map_titles :: (Text -> Text) -> Cmd.CmdL ()
map_titles :: (SymbolName -> SymbolName) -> CmdL ()
map_titles SymbolName -> SymbolName
modify = do
    [BlockId]
block_ids <- forall (m :: * -> *). M m => m [BlockId]
Ui.all_block_ids
    [SymbolName]
titles <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). M m => BlockId -> m SymbolName
Ui.get_block_title [BlockId]
block_ids
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [BlockId]
block_ids [SymbolName]
titles) forall a b. (a -> b) -> a -> b
$ \(BlockId
block_id, SymbolName
title) ->
        forall (m :: * -> *). M m => BlockId -> SymbolName -> m ()
Ui.set_block_title BlockId
block_id (SymbolName -> SymbolName
modify SymbolName
title)

replace_titles :: Text -> Text -> Cmd.CmdL ()
replace_titles :: SymbolName -> SymbolName -> CmdL ()
replace_titles SymbolName
from SymbolName
to = (SymbolName -> SymbolName) -> CmdL ()
map_titles forall a b. (a -> b) -> a -> b
$ HasCallStack =>
SymbolName -> SymbolName -> SymbolName -> SymbolName
Text.replace SymbolName
from SymbolName
to

set_all_implicit :: Cmd.M m => m ()
set_all_implicit :: forall (m :: * -> *). M m => m ()
set_all_implicit = do
    [BlockId]
block_ids <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Ui.gets forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Map BlockId Block
Ui.state_blocks
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\BlockId
b -> forall (m :: * -> *). M m => BlockId -> Skeleton -> m ()
Ui.set_skeleton_config BlockId
b Skeleton
Block.Implicit) [BlockId]
block_ids

set_explicit :: Cmd.M m => m ()
set_explicit :: forall (m :: * -> *). M m => m ()
set_explicit = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *). M m => BlockId -> Skeleton -> m ()
Ui.set_skeleton_config BlockId
block_id Skeleton
Block.Explicit

set_implicit :: Cmd.M m => m ()
set_implicit :: forall (m :: * -> *). M m => m ()
set_implicit = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *). M m => BlockId -> Skeleton -> m ()
Ui.set_skeleton_config BlockId
block_id Skeleton
Block.Implicit

-- * doc

doc :: Cmd.CmdL Text
doc :: CmdL SymbolName
doc = Text -> SymbolName
Lazy.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Text
CallDoc.doc_text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmdL Document
track_doc

doc_equal :: CallDoc.SymbolName -> Cmd.CmdL Text
doc_equal :: SymbolName -> CmdL SymbolName
doc_equal SymbolName
name = (SymbolName -> CallName -> Bool) -> CmdL SymbolName
find_doc (\SymbolName
sym CallName
_call -> SymbolName
sym forall a. Eq a => a -> a -> Bool
== SymbolName
name)

doc_like :: Text -> Cmd.CmdL Text
doc_like :: SymbolName -> CmdL SymbolName
doc_like SymbolName
pattern = (SymbolName -> CallName -> Bool) -> CmdL SymbolName
find_doc forall a b. (a -> b) -> a -> b
$ \SymbolName
sym (Derive.CallName SymbolName
call) ->
    SymbolName
pattern SymbolName -> SymbolName -> Bool
`Text.isInfixOf` SymbolName
sym Bool -> Bool -> Bool
|| SymbolName
pattern SymbolName -> SymbolName -> Bool
`Text.isInfixOf` SymbolName
call

find_doc :: (CallDoc.SymbolName -> Derive.CallName -> Bool) -> Cmd.CmdL Text
find_doc :: (SymbolName -> CallName -> Bool) -> CmdL SymbolName
find_doc SymbolName -> CallName -> Bool
matches  = Text -> SymbolName
Lazy.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Text
CallDoc.doc_text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolName -> CallName -> Bool) -> Document -> Document
CallDoc.filter_calls SymbolName -> CallName -> Bool
matches forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmdL Document
track_doc

-- | Write HTML documentation for the selected track to
-- @build/derive_doc.html@.
html_doc :: Cmd.CmdL ()
html_doc :: CmdL ()
html_doc = do
    Document
doc <- CmdL Document
track_doc
    AppDir
app_dir <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (Config -> AppDir
Cmd.config_app_dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Config
Cmd.state_config)
    HtmlState
hstate <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> AppDir -> IO HtmlState
Html.get_html_state FilePath
"haddock" AppDir
app_dir
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> SymbolName -> IO ()
Text.IO.writeFile FilePath
"build/derive_doc.html" forall a b. (a -> b) -> a -> b
$
        Html -> SymbolName
Html.un_html forall a b. (a -> b) -> a -> b
$ HtmlState -> Document -> Html
CallDoc.doc_html HtmlState
hstate Document
doc

-- | Print a summary of bindings in scope, grouped by namespace and sorted by
-- shadow priority.  This is useful to see if your call is being shadowed.
--
-- If the same call shows up twice it may mean you imported the same module
-- twice.
bindings_equal :: CallDoc.SymbolName -> Cmd.CmdL Text
bindings_equal :: SymbolName -> CmdL SymbolName
bindings_equal SymbolName
name = (SymbolName -> Bool) -> CmdL SymbolName
find_bindings (forall a. Eq a => a -> a -> Bool
==SymbolName
name)

find_bindings :: (CallDoc.SymbolName -> Bool) -> Cmd.CmdL Text
find_bindings :: (SymbolName -> Bool) -> CmdL SymbolName
find_bindings SymbolName -> Bool
matches = Document -> SymbolName
CallDoc.bindings_text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolName -> CallName -> Bool) -> Document -> Document
CallDoc.filter_calls (\SymbolName
sym CallName
_call -> SymbolName -> Bool
matches SymbolName
sym) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmdL Document
track_doc

track_doc :: Cmd.CmdL CallDoc.Document
track_doc :: CmdL Document
track_doc = do
    (BlockId
block_id, TrackNum
_, TrackId
track_id, ScoreTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, ScoreTime)
Selection.get_insert
    forall (m :: * -> *). M m => BlockId -> TrackId -> m Document
CallDoc.track BlockId
block_id TrackId
track_id

-- * block call

-- | Rename focused block.
--
-- It doesn't update TrackIds so they may still be named under their old block,
-- but track id names aren't supposed to carry meaning anyway.
rename :: Id.Id -> Cmd.CmdL ()
rename :: Id -> CmdL ()
rename Id
to = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). M m => BlockId -> Id -> m ()
Create.rename_block Id
to forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block

-- | Rename a block and update all calls to it in all blocks.  This is not
-- totally accurate since it updates all symbols that match, but it doesn't
-- know that the symbol would be definitely used as a block call.  So if you
-- have @clef = treble@ and a block named @treble@, it will update both.  I
-- could probably solve this by switching back to separate string and symbol
-- types, but it seems like a minor issue.
rename_all :: BlockId -> Id.Id -> Cmd.CmdL ()
rename_all :: BlockId -> Id -> CmdL ()
rename_all BlockId
from Id
to = do
    forall (m :: * -> *). M m => BlockId -> Id -> m ()
Create.rename_block BlockId
from Id
to
    forall (m :: * -> *). M m => Track m -> m ()
ModifyEvents.note_tracks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
(SymbolName -> SymbolName) -> Track m
ModifyEvents.text forall a b. (a -> b) -> a -> b
$ BlockId -> Id -> SymbolName -> SymbolName
replace_block_call BlockId
from Id
to

-- | Rename block calls in a single block.
replace :: BlockId -> Id.Id -> Cmd.CmdL ()
replace :: BlockId -> Id -> CmdL ()
replace BlockId
from Id
to = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *). M m => BlockId -> Track m -> m ()
ModifyEvents.block BlockId
block_id forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
M m =>
(SymbolName -> Bool) -> Track m -> Track m
ModifyEvents.tracks_named SymbolName -> Bool
ParseTitle.is_note_track forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
Monad m =>
(SymbolName -> SymbolName) -> Track m
ModifyEvents.text forall a b. (a -> b) -> a -> b
$ BlockId -> Id -> SymbolName -> SymbolName
replace_block_call BlockId
from Id
to

replace_block_call :: BlockId -> Id.Id -> Text -> Text
replace_block_call :: BlockId -> Id -> SymbolName -> SymbolName
replace_block_call BlockId
from Id
to = (SymbolName -> SymbolName) -> SymbolName -> SymbolName
map_symbol SymbolName -> SymbolName
replace
    where
    replace :: SymbolName -> SymbolName
replace SymbolName
sym
        | SymbolName
sym forall a. Eq a => a -> a -> Bool
== forall a. Ident a => a -> SymbolName
Id.ident_name BlockId
from = forall a. Ident a => a -> SymbolName
Id.ident_name Id
to
        | SymbolName
sym forall a. Eq a => a -> a -> Bool
== forall a. Ident a => a -> SymbolName
Id.ident_text BlockId
from = forall a. Ident a => a -> SymbolName
Id.ident_text Id
to
        | Bool
otherwise = SymbolName
sym

map_symbol :: (Text -> Text) -> Text -> Text
map_symbol :: (SymbolName -> SymbolName) -> SymbolName -> SymbolName
map_symbol SymbolName -> SymbolName
f SymbolName
text =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const SymbolName
text) (forall a. ShowVal a => a -> SymbolName
ShowVal.show_val forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolName -> SymbolName) -> Expr -> Expr
map_text SymbolName -> SymbolName
f) (SymbolName -> Either SymbolName Expr
Parse.parse_expr SymbolName
text)

-- | Transform both Symbols and Strs.
map_text :: (Text -> Text) -> DeriveT.Expr -> DeriveT.Expr
map_text :: (SymbolName -> SymbolName) -> Expr -> Expr
map_text SymbolName -> SymbolName
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a. (Symbol -> Symbol) -> Call a -> Call a
Expr.map_symbol (SymbolName -> Symbol
Expr.Symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolName -> SymbolName
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> SymbolName
Expr.unsym)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Str -> Str) -> Call Val -> Call Val
DeriveT.map_str (SymbolName -> Str
Expr.Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolName -> SymbolName
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> SymbolName
Expr.unstr)

-- * create

-- | If the events under the cursor are a block calls, create blocks that don't
-- already exist.  Optionally use a template block.
for_event :: Maybe BlockId -> Cmd.CmdL ()
for_event :: Maybe BlockId -> CmdL ()
for_event Maybe BlockId
maybe_template = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {t :: * -> *} {a}. Foldable t => (a, t Event) -> CmdL ()
make forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m SelectedEvents
Selection.events
    where
    make :: (a, t Event) -> CmdL ()
make (a
_, t Event
events) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Event -> CmdT IO ViewId
make1 t Event
events
    make1 :: Event -> CmdT IO ViewId
make1 Event
event = do
        Id
id <- forall a (m :: * -> *).
(HasCallStack, Ident a, M m) =>
SymbolName -> m a
Ui.read_id (Event -> SymbolName
Event.text Event
event)
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe Id -> CmdT IO ViewId
named BlockId -> Id -> CmdT IO ViewId
named_from Maybe BlockId
maybe_template Id
id

-- | Copy the current block into a new empty block with the given name.
named :: Id.Id -> Cmd.CmdL ViewId
named :: Id -> CmdT IO ViewId
named Id
name = forall a b c. (a -> b -> c) -> b -> a -> c
flip BlockId -> Id -> CmdT IO ViewId
named_from Id
name forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block

named_from :: BlockId -> Id.Id -> Cmd.CmdL ViewId
named_from :: BlockId -> Id -> CmdT IO ViewId
named_from BlockId
template_id Id
name =
    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 -> Id -> m BlockId
Create.named_block_from_template Bool
False BlockId
template_id Id
name

-- | Create a named block with the same structure as the focused one.
copy :: Bool -> Id.Id -> Cmd.CmdL ViewId
copy :: Bool -> Id -> CmdT IO ViewId
copy Bool
copy_events Id
name = do
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    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 -> Id -> m BlockId
Create.named_block_from_template Bool
copy_events BlockId
block_id Id
name

-- * destroy

destroy :: Ui.M m => [BlockId] -> m ()
destroy :: forall (m :: * -> *). M m => [BlockId] -> m ()
destroy = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => BlockId -> m ()
Create.destroy_block

destroy_except :: [BlockId] -> Cmd.CmdL ()
destroy_except :: [BlockId] -> CmdL ()
destroy_except [BlockId]
keep = do
    [BlockId]
block_ids <- forall (m :: * -> *). M m => m [BlockId]
Ui.all_block_ids
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => BlockId -> m ()
Create.destroy_block (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, Eq a) => a -> t a -> Bool
`elem` [BlockId]
keep)) [BlockId]
block_ids)

-- * dividers

-- | Insert a divider to the right of the selection.
divide :: Cmd.CmdL ()
divide :: CmdL ()
divide = do
    (BlockId
block_id, TrackNum
tracknum, TrackId
_, ScoreTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, ScoreTime)
Selection.get_insert
    forall (m :: * -> *). M m => BlockId -> TrackNum -> Track -> m ()
Ui.insert_track BlockId
block_id (TrackNum
tracknumforall a. Num a => a -> a -> a
+TrackNum
1) Track
Block.divider

-- | Remove a divider to the right of the selection.  The selection likes to
-- skip dividers so they can't be deleted normally.
undivide :: Cmd.CmdL ()
undivide :: CmdL ()
undivide = do
    (BlockId
block_id, TrackNum
tracknum, TrackId
_, ScoreTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, ScoreTime)
Selection.get_insert
    [Track]
tracks <- 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
block_id
    let found :: Maybe (TrackNum, Track)
found = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
==Track
Block.divider) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
            (forall a. TrackNum -> [a] -> [a]
drop TrackNum
tracknum (forall a b. [a] -> [b] -> [(a, b)]
zip [TrackNum
0..] [Track]
tracks))
    forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (TrackNum, Track)
found forall a b. (a -> b) -> a -> b
$ \(TrackNum
n, Track
_) -> forall (m :: * -> *). M m => BlockId -> TrackNum -> m ()
Ui.remove_track BlockId
block_id TrackNum
n

collapse_children :: Cmd.M m => m ()
collapse_children :: forall (m :: * -> *). M m => m ()
collapse_children = do
    (BlockId
block_id, TrackNum
_, TrackId
track_id, ScoreTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, ScoreTime)
Selection.get_insert
    forall (m :: * -> *). M m => BlockId -> TrackId -> m ()
BlockConfig.collapse_children BlockId
block_id TrackId
track_id

expand_children :: Cmd.M m => m ()
expand_children :: forall (m :: * -> *). M m => m ()
expand_children = do
    (BlockId
block_id, TrackNum
_, TrackId
track_id, ScoreTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, ScoreTime)
Selection.get_insert
    forall (m :: * -> *). M m => BlockId -> TrackId -> m ()
BlockConfig.expand_children BlockId
block_id TrackId
track_id

-- * merge

append :: Cmd.M m => BlockId -> m ()
append :: forall (m :: * -> *). M m => BlockId -> m ()
append BlockId
source = do
    BlockId
dest <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *). M m => BlockId -> BlockId -> m ()
BlockConfig.append BlockId
dest BlockId
source

create_merged :: Cmd.M m => BlockId -> BlockId -> m ViewId
create_merged :: forall (m :: * -> *). M m => BlockId -> BlockId -> m ViewId
create_merged BlockId
b1 BlockId
b2 = do
    RulerId
ruler_id <- forall (m :: * -> *). M m => BlockId -> m RulerId
Ui.block_ruler BlockId
b1
    BlockId
new <- forall (m :: * -> *). M m => RulerId -> m BlockId
Create.block RulerId
ruler_id
    forall (m :: * -> *). M m => BlockId -> BlockId -> m ()
BlockConfig.append BlockId
new BlockId
b1
    forall (m :: * -> *). M m => BlockId -> BlockId -> m ()
BlockConfig.append BlockId
new BlockId
b2
    forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
new

-- * stretch

stretch_block :: ScoreTime -> BlockId -> Cmd.CmdL ()
stretch_block :: ScoreTime -> BlockId -> CmdL ()
stretch_block ScoreTime
factor BlockId
block_id = forall (m :: * -> *). M m => BlockId -> Track m -> m ()
ModifyEvents.block BlockId
block_id forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *). Monad m => (Event -> Event) -> Track m
ModifyEvents.event (ScoreTime -> Event -> Event
stretch ScoreTime
factor)

stretch :: ScoreTime -> Event.Event -> Event.Event
stretch :: ScoreTime -> Event -> Event
stretch ScoreTime
factor = (Lens Event ScoreTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
*ScoreTime
factor)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens Event ScoreTime
Event.duration_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
*ScoreTime
factor))

-- * add / remove time

-- | Add time encompassed by the selection to this block, expand its event in
-- caller blocks, and renumber the ruler globally.  This is like a super
-- 'Cmd.Edit.cmd_insert_time'.
add_time :: Cmd.M m => m ()
add_time :: forall (m :: * -> *). M m => m ()
add_time = do
    Selection
sel <- forall (m :: * -> *). M m => m Selection
Selection.get
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    [Tree Update]
updates <- forall (m :: * -> *).
M m =>
BlockId -> ScoreTime -> ScoreTime -> m [Tree Update]
BlockResize.update_callers BlockId
block_id (Selection -> ScoreTime
Sel.min Selection
sel)
        (Selection -> ScoreTime
Sel.duration Selection
sel)
    forall (m :: * -> *). M m => [Tree Update] -> m ()
BlockResize.push_down_rulers [Tree Update]
updates

remove_time :: Cmd.M m => m ()
remove_time :: forall (m :: * -> *). M m => m ()
remove_time = do
    Selection
sel <- forall (m :: * -> *). M m => m Selection
Selection.get
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    [Tree Update]
updates <- forall (m :: * -> *).
M m =>
BlockId -> ScoreTime -> ScoreTime -> m [Tree Update]
BlockResize.update_callers BlockId
block_id (Selection -> ScoreTime
Sel.min Selection
sel)
        (- Selection -> ScoreTime
Sel.duration Selection
sel)
    forall (m :: * -> *). M m => [Tree Update] -> m ()
BlockResize.push_down_rulers [Tree Update]
updates

-- | Like 'add_time' and 'remove_time', except this will splice the selected
-- bit of ruler into the corresponding times in the top track.  This is useful
-- if there are changing time signatures, and you want to move future time
-- signatures along with the events.
add_time_ruler :: Cmd.M m => m [BlockId]
add_time_ruler :: forall (m :: * -> *). M m => m [BlockId]
add_time_ruler = do
    Selection
sel <- forall (m :: * -> *). M m => m Selection
Selection.get
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *).
M m =>
BlockId -> ScoreTime -> ScoreTime -> m [BlockId]
BlockResize.update_callers_rulers BlockId
block_id (Selection -> ScoreTime
Sel.min Selection
sel) (Selection -> ScoreTime
Sel.duration Selection
sel)

remove_time_ruler :: Cmd.M m => m [BlockId]
remove_time_ruler :: forall (m :: * -> *). M m => m [BlockId]
remove_time_ruler = do
    Selection
sel <- forall (m :: * -> *). M m => m Selection
Selection.get
    BlockId
block_id <- forall (m :: * -> *). M m => m BlockId
Cmd.get_focused_block
    forall (m :: * -> *).
M m =>
BlockId -> ScoreTime -> ScoreTime -> m [BlockId]
BlockResize.update_callers_rulers BlockId
block_id (Selection -> ScoreTime
Sel.min Selection
sel)
        (- Selection -> ScoreTime
Sel.duration Selection
sel)