{- | All operations that mutate the 'Song' inside an 'AppState': entering
fret numbers, deleting notes, changing durations, subdividing\/combining
beats, and adding\/deleting measures — plus the undo\/redo stack every
one of them goes through via 'withUndo'.

Every editing function here takes and returns a whole 'AppState' (not
just a 'Song') because several of them also need to read or update
cursor position, selection, or the in-progress fret-digit buffer
alongside the document edit itself. Pure cursor movement that doesn't
touch the document lives in "Termtab.UI.Types" instead; which keys call
which of these functions is decided in "Termtab.UI.Keybindings".
-}
module Termtab.UI.Editing (
    -- Editing operations
    enterFretDigit,
    deleteNoteAtCursor,
    insertRest,
    cycleDuration,
    subdivideBeat,
    combineBeats,
    addMeasure,
    deleteMeasure,
    -- Undo/redo
    withUndo,
    undo,
    redo,
    clearFretEntry,
    -- Helpers
    fretToPitch,
    modifyTrack,
    modifyBeats,
) where

import Data.Map.Strict qualified as Map
import Termtab.Defaults (defaultMeasureBeats)
import Termtab.Types
import Termtab.UI.Types

-- Nested update helpers

{- | Apply @f@ to the track at @tIdx@ within a 'Song'. The standard
entry point every editing operation below starts from — they compose
this with 'modifyBeats' and\/or 'modifyBeatAt' to reach the specific
beat\/note being edited.
-}
modifyTrack :: TrackIndex -> (Track -> Track) -> Song -> Song
modifyTrack :: TrackIndex -> (Track -> Track) -> Song -> Song
modifyTrack (TrackIndex Int
tIdx) Track -> Track
f Song
song =
    Song
song{songTracks = updateAt tIdx f (songTracks song)}

{- | Apply @f@ to the beat list for measure @mi@ of a track, treating a
missing entry as an empty list (so editing a measure a track has never
had beats in creates the entry rather than being a no-op).
-}
modifyBeats :: MeasureIndex -> ([Beat] -> [Beat]) -> Track -> Track
modifyBeats :: MeasureIndex -> ([Beat] -> [Beat]) -> Track -> Track
modifyBeats MeasureIndex
mi [Beat] -> [Beat]
f Track
track =
    Track
track{trackBeats = Map.alter (Just . f . maybe [] id) mi (trackBeats track)}

{- | Apply @f@ to the beat at @bIdx@ within a beat list, first padding the
list with default rest beats (via 'ensureLength') if the cursor is past
its current end — this is what lets editing move the cursor into
\"empty\" beat slots that only exist implicitly (see
'Termtab.UI.Types.currentMeasureBeatCount') and have a real 'Beat'
materialize there.
-}
modifyBeatAt :: BeatIndex -> (Beat -> Beat) -> [Beat] -> [Beat]
modifyBeatAt :: BeatIndex -> (Beat -> Beat) -> [Beat] -> [Beat]
modifyBeatAt (BeatIndex Int
bIdx) Beat -> Beat
f [Beat]
beats =
    let padded :: [Beat]
padded = Int -> [Beat] -> [Beat]
ensureLength (Int
bIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Beat]
beats
     in Int -> (Beat -> Beat) -> [Beat] -> [Beat]
forall a. Int -> (a -> a) -> [a] -> [a]
updateAt Int
bIdx Beat -> Beat
f [Beat]
padded

{- | Set or clear the note on one string of a beat, replacing whatever was
previously on that string. Setting a note also clears 'beatIsRest';
clearing the last note on a beat does /not/ set 'beatIsRest' back —
that's left as a note-less, non-rest beat (an empty chord, not silence).
-}
setNoteOnString :: StringIndex -> Maybe Note -> Beat -> Beat
setNoteOnString :: StringIndex -> Maybe Note -> Beat -> Beat
setNoteOnString StringIndex
sIdx Maybe Note
mNote Beat
beat =
    let others :: [Note]
others = (Note -> Bool) -> [Note] -> [Note]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Note
n -> Note -> Maybe StringIndex
noteString Note
n Maybe StringIndex -> Maybe StringIndex -> Bool
forall a. Eq a => a -> a -> Bool
/= StringIndex -> Maybe StringIndex
forall a. a -> Maybe a
Just StringIndex
sIdx) (Beat -> [Note]
beatNotes Beat
beat)
        newNotes :: [Note]
newNotes = case Maybe Note
mNote of
            Just Note
n -> Note
n Note -> [Note] -> [Note]
forall a. a -> [a] -> [a]
: [Note]
others
            Maybe Note
Nothing -> [Note]
others
     in Beat
beat{beatNotes = newNotes, beatIsRest = False}

-- Pitch calculation

{- | Compute the sounding 'Pitch' for a fret on a string of an 'Instrument':
open-string pitch (from the tuning, if the string index is in range)
plus the fret number. A 'Standard' instrument (or an out-of-range
string) has no tuning to add, so the fret number is used directly as the
pitch — a fallback rather than a meaningful pitch, since fret entry
shouldn't normally happen on a non-fretted track.
-}
fretToPitch :: Instrument -> StringIndex -> FretNumber -> Pitch
fretToPitch :: Instrument -> StringIndex -> FretNumber -> Pitch
fretToPitch Instrument
instr (StringIndex Int
s) (FretNumber Int
f) =
    case Instrument -> Maybe [Pitch]
tuningPitches Instrument
instr of
        Just [Pitch]
pitches
            | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
            , Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Pitch] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pitch]
pitches ->
                let Pitch Int
base = [Pitch]
pitches [Pitch] -> Int -> Pitch
forall a. HasCallStack => [a] -> Int -> a
!! Int
s in Int -> Pitch
Pitch (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
f)
        Maybe [Pitch]
_ -> Int -> Pitch
Pitch Int
f
  where
    tuningPitches :: Instrument -> Maybe [Pitch]
tuningPitches (Guitar [Pitch]
t Int
_) = [Pitch] -> Maybe [Pitch]
forall a. a -> Maybe a
Just [Pitch]
t
    tuningPitches (Bass [Pitch]
t Int
_) = [Pitch] -> Maybe [Pitch]
forall a. a -> Maybe a
Just [Pitch]
t
    tuningPitches (Standard MidiProgram
_) = Maybe [Pitch]
forall a. Maybe a
Nothing

-- Editing operations

{- | Handle one typed fret digit at the cursor position. Consecutive digits
accumulate into a multi-digit fret number via 'asFretEntry'
(@combined = prev * 10 + digit@), reset back to just the new digit if
the combined value would exceed 24 (an invalid fret number). Writes a
'Note' with a fixed 'Velocity' of 100 and records the edit on the undo
stack.
-}
enterFretDigit :: Int -> AppState -> AppState
enterFretDigit :: Int -> AppState -> AppState
enterFretDigit Int
digit AppState
st =
    case AppState -> Maybe Track
currentTrack AppState
st of
        Maybe Track
Nothing -> AppState
st
        Just Track
track ->
            let sIdx :: StringIndex
sIdx = AppState -> StringIndex
asCurrentString AppState
st
                mIdx :: MeasureIndex
mIdx = AppState -> MeasureIndex
asCurrentMeasure AppState
st
                bIdx :: BeatIndex
bIdx = AppState -> BeatIndex
asCurrentBeat AppState
st
                -- Multi-digit fret accumulation
                fret :: Int
fret = case AppState -> Maybe FretNumber
asFretEntry AppState
st of
                    Just (FretNumber Int
prev) ->
                        let combined :: Int
combined = Int
prev Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
digit
                         in if Int
combined Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
24 then Int
combined else Int
digit
                    Maybe FretNumber
Nothing -> Int
digit
                fretNum :: FretNumber
fretNum = Int -> FretNumber
FretNumber Int
fret
                pitch :: Pitch
pitch = Instrument -> StringIndex -> FretNumber -> Pitch
fretToPitch (Track -> Instrument
trackInstrument Track
track) StringIndex
sIdx FretNumber
fretNum
                note :: Note
note =
                    Note
                        { notePitch :: Pitch
notePitch = Pitch
pitch
                        , noteVelocity :: Velocity
noteVelocity = Int -> Velocity
Velocity Int
100
                        , noteEffects :: [NoteEffect]
noteEffects = []
                        , noteString :: Maybe StringIndex
noteString = StringIndex -> Maybe StringIndex
forall a. a -> Maybe a
Just StringIndex
sIdx
                        , noteFret :: Maybe FretNumber
noteFret = FretNumber -> Maybe FretNumber
forall a. a -> Maybe a
Just FretNumber
fretNum
                        }
                editSong :: Song -> Song
editSong =
                    TrackIndex -> (Track -> Track) -> Song -> Song
modifyTrack (AppState -> TrackIndex
asCurrentTrack AppState
st) ((Track -> Track) -> Song -> Song)
-> (Track -> Track) -> Song -> Song
forall a b. (a -> b) -> a -> b
$
                        MeasureIndex -> ([Beat] -> [Beat]) -> Track -> Track
modifyBeats MeasureIndex
mIdx (([Beat] -> [Beat]) -> Track -> Track)
-> ([Beat] -> [Beat]) -> Track -> Track
forall a b. (a -> b) -> a -> b
$
                            BeatIndex -> (Beat -> Beat) -> [Beat] -> [Beat]
modifyBeatAt BeatIndex
bIdx ((Beat -> Beat) -> [Beat] -> [Beat])
-> (Beat -> Beat) -> [Beat] -> [Beat]
forall a b. (a -> b) -> a -> b
$
                                StringIndex -> Maybe Note -> Beat -> Beat
setNoteOnString StringIndex
sIdx (Note -> Maybe Note
forall a. a -> Maybe a
Just Note
note)
             in (Song -> Song) -> AppState -> AppState
withUndo Song -> Song
editSong AppState
st{asFretEntry = Just fretNum}

-- | Remove whatever note is on the cursor's string at the cursor's beat.
deleteNoteAtCursor :: AppState -> AppState
deleteNoteAtCursor :: AppState -> AppState
deleteNoteAtCursor AppState
st =
    case AppState -> Maybe Track
currentTrack AppState
st of
        Maybe Track
Nothing -> AppState
st
        Just Track
_track ->
            let sIdx :: StringIndex
sIdx = AppState -> StringIndex
asCurrentString AppState
st
                editSong :: Song -> Song
editSong =
                    TrackIndex -> (Track -> Track) -> Song -> Song
modifyTrack (AppState -> TrackIndex
asCurrentTrack AppState
st) ((Track -> Track) -> Song -> Song)
-> (Track -> Track) -> Song -> Song
forall a b. (a -> b) -> a -> b
$
                        MeasureIndex -> ([Beat] -> [Beat]) -> Track -> Track
modifyBeats (AppState -> MeasureIndex
asCurrentMeasure AppState
st) (([Beat] -> [Beat]) -> Track -> Track)
-> ([Beat] -> [Beat]) -> Track -> Track
forall a b. (a -> b) -> a -> b
$
                            BeatIndex -> (Beat -> Beat) -> [Beat] -> [Beat]
modifyBeatAt (AppState -> BeatIndex
asCurrentBeat AppState
st) ((Beat -> Beat) -> [Beat] -> [Beat])
-> (Beat -> Beat) -> [Beat] -> [Beat]
forall a b. (a -> b) -> a -> b
$
                                StringIndex -> Maybe Note -> Beat -> Beat
setNoteOnString StringIndex
sIdx Maybe Note
forall a. Maybe a
Nothing
             in (Song -> Song) -> AppState -> AppState
withUndo Song -> Song
editSong AppState
st

-- | Turn the beat at the cursor into a rest, clearing any notes it had.
insertRest :: AppState -> AppState
insertRest :: AppState -> AppState
insertRest AppState
st =
    let editSong :: Song -> Song
editSong =
            TrackIndex -> (Track -> Track) -> Song -> Song
modifyTrack (AppState -> TrackIndex
asCurrentTrack AppState
st) ((Track -> Track) -> Song -> Song)
-> (Track -> Track) -> Song -> Song
forall a b. (a -> b) -> a -> b
$
                MeasureIndex -> ([Beat] -> [Beat]) -> Track -> Track
modifyBeats (AppState -> MeasureIndex
asCurrentMeasure AppState
st) (([Beat] -> [Beat]) -> Track -> Track)
-> ([Beat] -> [Beat]) -> Track -> Track
forall a b. (a -> b) -> a -> b
$
                    BeatIndex -> (Beat -> Beat) -> [Beat] -> [Beat]
modifyBeatAt (AppState -> BeatIndex
asCurrentBeat AppState
st) ((Beat -> Beat) -> [Beat] -> [Beat])
-> (Beat -> Beat) -> [Beat] -> [Beat]
forall a b. (a -> b) -> a -> b
$
                        \Beat
beat -> Beat
beat{beatIsRest = True, beatNotes = []}
     in (Song -> Song) -> AppState -> AppState
withUndo Song -> Song
editSong AppState
st

{- | Advance the duration of the beat at the cursor to the next value in
'nextDuration''s cycle.
-}
cycleDuration :: AppState -> AppState
cycleDuration :: AppState -> AppState
cycleDuration AppState
st =
    let editSong :: Song -> Song
editSong =
            TrackIndex -> (Track -> Track) -> Song -> Song
modifyTrack (AppState -> TrackIndex
asCurrentTrack AppState
st) ((Track -> Track) -> Song -> Song)
-> (Track -> Track) -> Song -> Song
forall a b. (a -> b) -> a -> b
$
                MeasureIndex -> ([Beat] -> [Beat]) -> Track -> Track
modifyBeats (AppState -> MeasureIndex
asCurrentMeasure AppState
st) (([Beat] -> [Beat]) -> Track -> Track)
-> ([Beat] -> [Beat]) -> Track -> Track
forall a b. (a -> b) -> a -> b
$
                    BeatIndex -> (Beat -> Beat) -> [Beat] -> [Beat]
modifyBeatAt (AppState -> BeatIndex
asCurrentBeat AppState
st) ((Beat -> Beat) -> [Beat] -> [Beat])
-> (Beat -> Beat) -> [Beat] -> [Beat]
forall a b. (a -> b) -> a -> b
$
                        \Beat
beat -> Beat
beat{beatDuration = nextDuration (beatDuration beat)}
     in (Song -> Song) -> AppState -> AppState
withUndo Song -> Song
editSong AppState
st

{- | The next duration in the cycle
@Whole -> Half -> Quarter -> Eighth -> Sixteenth -> Thirty2nd -> Whole@,
used by 'cycleDuration'. 'Dotted'\/'Triplet' modifiers are stripped
(not cycled through themselves) — cycling a dotted or triplet duration
advances its base value and drops the modifier.
-}
nextDuration :: Duration -> Duration
nextDuration :: Duration -> Duration
nextDuration Duration
Whole = Duration
Half
nextDuration Duration
Half = Duration
Quarter
nextDuration Duration
Quarter = Duration
Eighth
nextDuration Duration
Eighth = Duration
Sixteenth
nextDuration Duration
Sixteenth = Duration
Thirty2nd
nextDuration Duration
Thirty2nd = Duration
Whole
nextDuration (Dotted Duration
d) = Duration -> Duration
nextDuration Duration
d
nextDuration (Triplet Duration
d) = Duration -> Duration
nextDuration Duration
d

-- Undo/Redo

{- | Apply an edit @f@ to the current song, pushing the /pre-edit/ song onto
'asUndoStack' (capped at 100 entries) and clearing 'asRedoStack' — as
with any standard undo model, making a new edit discards the redo
history from before it. Every editing operation in this module goes
through this rather than setting 'asSong' directly, so undo\/redo stay
consistent.
-}
withUndo :: (Song -> Song) -> AppState -> AppState
withUndo :: (Song -> Song) -> AppState -> AppState
withUndo Song -> Song
f AppState
st =
    AppState
st
        { asSong = f (asSong st)
        , asUndoStack = take 100 (asSong st : asUndoStack st)
        , asRedoStack = []
        }

{- | Pop the most recent song off 'asUndoStack' and make it current,
pushing the song being replaced onto 'asRedoStack'. Sets 'asMessage' to
report whether there was anything to undo.
-}
undo :: AppState -> AppState
undo :: AppState -> AppState
undo AppState
st = case AppState -> [Song]
asUndoStack AppState
st of
    [] -> AppState
st{asMessage = Just "Nothing to undo"}
    (Song
prev : [Song]
rest) ->
        AppState
st
            { asSong = prev
            , asUndoStack = rest
            , asRedoStack = take 100 (asSong st : asRedoStack st)
            , asMessage = Just "Undo"
            }

{- | The inverse of 'undo': pop 'asRedoStack' and make it current, pushing
the replaced song back onto 'asUndoStack'.
-}
redo :: AppState -> AppState
redo :: AppState -> AppState
redo AppState
st = case AppState -> [Song]
asRedoStack AppState
st of
    [] -> AppState
st{asMessage = Just "Nothing to redo"}
    (Song
next : [Song]
rest) ->
        AppState
st
            { asSong = next
            , asRedoStack = rest
            , asUndoStack = take 100 (asSong st : asUndoStack st)
            , asMessage = Just "Redo"
            }

{- | Reset the multi-digit fret accumulator ('asFretEntry'), e.g. when the
cursor moves away from the beat being entered.
-}
clearFretEntry :: AppState -> AppState
clearFretEntry :: AppState -> AppState
clearFretEntry AppState
st = AppState
st{asFretEntry = Nothing}

-- Internal helpers

{- | Apply @f@ to the element at index @n@, leaving the list unchanged if
@n@ is out of range.
-}
updateAt :: Int -> (a -> a) -> [a] -> [a]
updateAt :: forall a. Int -> (a -> a) -> [a] -> [a]
updateAt Int
_ a -> a
_ [] = []
updateAt Int
0 a -> a
f (a
x : [a]
xs) = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
updateAt Int
n a -> a
f (a
x : [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> (a -> a) -> [a] -> [a]
forall a. Int -> (a -> a) -> [a] -> [a]
updateAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> a
f [a]
xs

-- | An empty quarter-note rest, used by 'ensureLength' to pad a beat list.
defaultBeat :: Beat
defaultBeat :: Beat
defaultBeat = Beat{beatDuration :: Duration
beatDuration = Duration
Quarter, beatNotes :: [Note]
beatNotes = [], beatIsRest :: Bool
beatIsRest = Bool
True}

{- | Pad a beat list with 'defaultBeat' rests up to length @n@, leaving it
unchanged if already at least that long.
-}
ensureLength :: Int -> [Beat] -> [Beat]
ensureLength :: Int -> [Beat] -> [Beat]
ensureLength Int
n [Beat]
beats
    | [Beat] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Beat]
beats Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = [Beat]
beats
    | Bool
otherwise = [Beat]
beats [Beat] -> [Beat] -> [Beat]
forall a. [a] -> [a] -> [a]
++ Int -> Beat -> [Beat]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Beat] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Beat]
beats) Beat
defaultBeat

-- Measure operations

{- | Insert a new measure immediately after the cursor's current measure,
inheriting its time\/key signature (but not its tempo change), and
populate it with default rest beats (via 'defaultMeasureBeats') in every
track. All measures after the insertion point are re-indexed, and every
track's 'trackBeats' keys past that point are shifted up by one measure
so existing content stays attached to the same musical measure it was
in before the insertion.
-}
addMeasure :: AppState -> AppState
addMeasure :: AppState -> AppState
addMeasure AppState
st =
    let song :: Song
song = AppState -> Song
asSong AppState
st
        MeasureIndex Int
curM = AppState -> MeasureIndex
asCurrentMeasure AppState
st
        -- Inherit time/key sig from current measure
        curMeasure :: Measure
curMeasure = case AppState -> Maybe Measure
currentMeasure AppState
st of
            Just Measure
m -> Measure
m
            Maybe Measure
Nothing -> MeasureIndex
-> TimeSignature -> KeySignature -> Maybe Tempo -> Measure
Measure (Int -> MeasureIndex
MeasureIndex Int
0) (Int -> Int -> TimeSignature
TimeSignature Int
4 Int
4) (Int -> Mode -> KeySignature
KeySignature Int
0 Mode
Major) Maybe Tempo
forall a. Maybe a
Nothing
        newMIdx :: MeasureIndex
newMIdx = Int -> MeasureIndex
MeasureIndex (Int
curM Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        newMeasure :: Measure
newMeasure =
            Measure
curMeasure
                { measureIndex = newMIdx
                , tempoChange = Nothing
                }
        -- Insert measure into songMeasures after current position
        ([Measure]
before, [Measure]
after) = Int -> [Measure] -> ([Measure], [Measure])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
curM Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Song -> [Measure]
songMeasures Song
song)
        -- Re-index measures after insertion
        reindexed :: [Measure]
reindexed = (Int -> Measure -> Measure) -> [Int] -> [Measure] -> [Measure]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Measure
m -> Measure
m{measureIndex = MeasureIndex i}) [Int
0 ..] ([Measure]
before [Measure] -> [Measure] -> [Measure]
forall a. [a] -> [a] -> [a]
++ [Measure
newMeasure] [Measure] -> [Measure] -> [Measure]
forall a. [a] -> [a] -> [a]
++ [Measure]
after)
        -- Add default beats for the new measure in all tracks
        newBeats :: [Beat]
newBeats = TimeSignature -> [Beat]
defaultMeasureBeats (Measure -> TimeSignature
timeSignature Measure
curMeasure)
        updatedTracks :: [Track]
updatedTracks =
            (Track -> Track) -> [Track] -> [Track]
forall a b. (a -> b) -> [a] -> [b]
map
                ( \Track
track ->
                    -- Shift existing beat map entries after the insertion point
                    let shifted :: Map MeasureIndex [Beat]
shifted = (MeasureIndex -> MeasureIndex)
-> Map MeasureIndex [Beat] -> Map MeasureIndex [Beat]
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (\(MeasureIndex Int
k) -> if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
curM then Int -> MeasureIndex
MeasureIndex (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) else Int -> MeasureIndex
MeasureIndex Int
k) (Track -> Map MeasureIndex [Beat]
trackBeats Track
track)
                     in Track
track{trackBeats = Map.insert newMIdx newBeats shifted}
                )
                (Song -> [Track]
songTracks Song
song)
        newSong :: Song
newSong = Song
song{songMeasures = reindexed, songTracks = updatedTracks}
     in (Song -> Song) -> AppState -> AppState
withUndo (Song -> Song -> Song
forall a b. a -> b -> a
const Song
newSong) AppState
st

{- | Delete the cursor's current measure, refusing (with a status message)
if it's the song's only measure. Every track's beats for that measure
are dropped and later measures' 'trackBeats' keys shift down by one to
close the gap, mirroring 'addMeasure''s shift in the opposite direction.
The cursor is clamped to the new last measure if it was on (or past) the
one just removed.
-}
deleteMeasure :: AppState -> AppState
deleteMeasure :: AppState -> AppState
deleteMeasure AppState
st
    | AppState -> Int
measureCount AppState
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = AppState
st{asMessage = Just "Cannot delete last measure"}
    | Bool
otherwise =
        let song :: Song
song = AppState -> Song
asSong AppState
st
            MeasureIndex Int
curM = AppState -> MeasureIndex
asCurrentMeasure AppState
st
            -- Remove measure from songMeasures
            measures' :: [Measure]
measures' = [Measure
m | (Int
i, Measure
m) <- [Int] -> [Measure] -> [(Int, Measure)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] (Song -> [Measure]
songMeasures Song
song), Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
curM]
            reindexed :: [Measure]
reindexed = (Int -> Measure -> Measure) -> [Int] -> [Measure] -> [Measure]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Measure
m -> Measure
m{measureIndex = MeasureIndex i}) [Int
0 ..] [Measure]
measures'
            -- Remove beats and shift indices
            updatedTracks :: [Track]
updatedTracks =
                (Track -> Track) -> [Track] -> [Track]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \Track
track ->
                        let beats' :: Map MeasureIndex [Beat]
beats' = MeasureIndex -> Map MeasureIndex [Beat] -> Map MeasureIndex [Beat]
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (Int -> MeasureIndex
MeasureIndex Int
curM) (Track -> Map MeasureIndex [Beat]
trackBeats Track
track)
                            shifted :: Map MeasureIndex [Beat]
shifted = (MeasureIndex -> MeasureIndex)
-> Map MeasureIndex [Beat] -> Map MeasureIndex [Beat]
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (\(MeasureIndex Int
k) -> if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
curM then Int -> MeasureIndex
MeasureIndex (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) else Int -> MeasureIndex
MeasureIndex Int
k) Map MeasureIndex [Beat]
beats'
                         in Track
track{trackBeats = shifted}
                    )
                    (Song -> [Track]
songTracks Song
song)
            newSong :: Song
newSong = Song
song{songMeasures = reindexed, songTracks = updatedTracks}
            -- Adjust cursor if past end
            newM :: Int
newM = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
curM ([Measure] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Measure]
reindexed Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
         in ((Song -> Song) -> AppState -> AppState
withUndo (Song -> Song -> Song
forall a b. a -> b -> a
const Song
newSong) AppState
st){asCurrentMeasure = MeasureIndex newM, asCurrentBeat = BeatIndex 0}

-- Subdivide / Combine

{- | Split the beat at the cursor into @n@ equal beats (each getting the
subdivided 'Duration' from 'subdivideDuration', and all n copies of the
original beat's content — notes are duplicated across the new beats, not
distributed). A no-op for @n < 2@. If the cursor sits past the current
beat list, the list is padded first (via 'ensureLength') so there's a
beat there to subdivide.
-}
subdivideBeat :: Int -> AppState -> AppState
subdivideBeat :: Int -> AppState -> AppState
subdivideBeat Int
n AppState
st
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = AppState
st
    | Bool
otherwise =
        let editSong :: Song -> Song
editSong =
                TrackIndex -> (Track -> Track) -> Song -> Song
modifyTrack (AppState -> TrackIndex
asCurrentTrack AppState
st) ((Track -> Track) -> Song -> Song)
-> (Track -> Track) -> Song -> Song
forall a b. (a -> b) -> a -> b
$
                    MeasureIndex -> ([Beat] -> [Beat]) -> Track -> Track
modifyBeats (AppState -> MeasureIndex
asCurrentMeasure AppState
st) (([Beat] -> [Beat]) -> Track -> Track)
-> ([Beat] -> [Beat]) -> Track -> Track
forall a b. (a -> b) -> a -> b
$
                        \[Beat]
beats ->
                            let BeatIndex Int
bIdx = AppState -> BeatIndex
asCurrentBeat AppState
st
                                padded :: [Beat]
padded = Int -> [Beat] -> [Beat]
ensureLength (Int
bIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Beat]
beats
                                ([Beat]
before, [Beat]
rest) = Int -> [Beat] -> ([Beat], [Beat])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
bIdx [Beat]
padded
                             in case [Beat]
rest of
                                    (Beat
beat : [Beat]
after) ->
                                        let subDur :: Duration
subDur = Int -> Duration -> Duration
subdivideDuration Int
n (Beat -> Duration
beatDuration Beat
beat)
                                            subBeats :: [Beat]
subBeats = Int -> Beat -> [Beat]
forall a. Int -> a -> [a]
replicate Int
n Beat
beat{beatDuration = subDur}
                                         in [Beat]
before [Beat] -> [Beat] -> [Beat]
forall a. [a] -> [a] -> [a]
++ [Beat]
subBeats [Beat] -> [Beat] -> [Beat]
forall a. [a] -> [a] -> [a]
++ [Beat]
after
                                    [] -> [Beat]
padded
         in (Song -> Song) -> AppState -> AppState
withUndo Song -> Song
editSong AppState
st

{- | The 'Duration' one sub-beat gets when a beat is split @n@ ways, used
by 'subdivideBeat'. Halving (@n = 2@) walks one step down the standard
duration ladder, floored at 'Thirty2nd'. @n = 3@ (triplet) reuses the
halved value wrapped in 'Triplet' — Guitar Pro\/standard notation
convention for a triplet is \"the next shorter note value, three in the
space of two\" rather than a distinct duration of its own. @n = 4@
applies the halving twice. Any other @n@ is a no-op (returns the
duration unchanged).
-}
subdivideDuration :: Int -> Duration -> Duration
subdivideDuration :: Int -> Duration -> Duration
subdivideDuration Int
2 Duration
Whole = Duration
Half
subdivideDuration Int
2 Duration
Half = Duration
Quarter
subdivideDuration Int
2 Duration
Quarter = Duration
Eighth
subdivideDuration Int
2 Duration
Eighth = Duration
Sixteenth
subdivideDuration Int
2 Duration
Sixteenth = Duration
Thirty2nd
subdivideDuration Int
2 Duration
_ = Duration
Thirty2nd -- can't subdivide further
subdivideDuration Int
3 Duration
d = Duration -> Duration
Triplet (Int -> Duration -> Duration
subdivideDuration Int
2 Duration
d) -- triplets use the half-value wrapped
subdivideDuration Int
4 Duration
d = Int -> Duration -> Duration
subdivideDuration Int
2 (Int -> Duration -> Duration
subdivideDuration Int
2 Duration
d)
subdivideDuration Int
_ Duration
d = Duration
d

{- | Merge the beats between 'asSelectionStart' and the cursor (inclusive,
order-independent) into a single beat, on the condition that the
selection doesn't cross a measure boundary. The merged beat's notes are
the concatenation of all selected beats' notes (so overlapping strings
across beats are /not/ deduplicated — a chord built from previously
separate beats keeps every note) and its duration is the running sum via
'addDurations'. Clears the selection and returns to 'NormalMode' on
success; sets a status message and makes no edit if there's no active
selection or it spans measures.
-}
combineBeats :: AppState -> AppState
combineBeats :: AppState -> AppState
combineBeats AppState
st = case AppState -> Maybe (MeasureIndex, BeatIndex)
asSelectionStart AppState
st of
    Maybe (MeasureIndex, BeatIndex)
Nothing -> AppState
st{asMessage = Just "Select beats first (v)"}
    Just (MeasureIndex
selMi, BeatIndex
selBi) ->
        let mi :: MeasureIndex
mi = AppState -> MeasureIndex
asCurrentMeasure AppState
st
         in if MeasureIndex
selMi MeasureIndex -> MeasureIndex -> Bool
forall a. Eq a => a -> a -> Bool
/= MeasureIndex
mi
                then AppState
st{asMessage = Just "Selection must be within one measure"}
                else
                    let BeatIndex Int
startB = BeatIndex -> BeatIndex -> BeatIndex
forall a. Ord a => a -> a -> a
min BeatIndex
selBi (AppState -> BeatIndex
asCurrentBeat AppState
st)
                        BeatIndex Int
endB = BeatIndex -> BeatIndex -> BeatIndex
forall a. Ord a => a -> a -> a
max BeatIndex
selBi (AppState -> BeatIndex
asCurrentBeat AppState
st)
                        editSong :: Song -> Song
editSong =
                            TrackIndex -> (Track -> Track) -> Song -> Song
modifyTrack (AppState -> TrackIndex
asCurrentTrack AppState
st) ((Track -> Track) -> Song -> Song)
-> (Track -> Track) -> Song -> Song
forall a b. (a -> b) -> a -> b
$
                                MeasureIndex -> ([Beat] -> [Beat]) -> Track -> Track
modifyBeats MeasureIndex
mi (([Beat] -> [Beat]) -> Track -> Track)
-> ([Beat] -> [Beat]) -> Track -> Track
forall a b. (a -> b) -> a -> b
$
                                    \[Beat]
beats ->
                                        let padded :: [Beat]
padded = Int -> [Beat] -> [Beat]
ensureLength (Int
endB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Beat]
beats
                                            ([Beat]
before, [Beat]
rest) = Int -> [Beat] -> ([Beat], [Beat])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
startB [Beat]
padded
                                            ([Beat]
selected, [Beat]
after) = Int -> [Beat] -> ([Beat], [Beat])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
endB Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Beat]
rest
                                            combinedNotes :: [Note]
combinedNotes = (Beat -> [Note]) -> [Beat] -> [Note]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Beat -> [Note]
beatNotes [Beat]
selected
                                            combinedDur :: Duration
combinedDur = (Duration -> Duration -> Duration) -> [Duration] -> Duration
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Duration -> Duration -> Duration
addDurations ((Beat -> Duration) -> [Beat] -> [Duration]
forall a b. (a -> b) -> [a] -> [b]
map Beat -> Duration
beatDuration [Beat]
selected)
                                            combined :: Beat
combined =
                                                Beat
                                                    { beatDuration :: Duration
beatDuration = Duration
combinedDur
                                                    , beatNotes :: [Note]
beatNotes = [Note]
combinedNotes
                                                    , beatIsRest :: Bool
beatIsRest = [Note] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Note]
combinedNotes
                                                    }
                                         in [Beat]
before [Beat] -> [Beat] -> [Beat]
forall a. [a] -> [a] -> [a]
++ [Beat
combined] [Beat] -> [Beat] -> [Beat]
forall a. [a] -> [a] -> [a]
++ [Beat]
after
                     in ((Song -> Song) -> AppState -> AppState
withUndo Song -> Song
editSong AppState
st)
                            { asCurrentBeat = BeatIndex startB
                            , asInputMode = NormalMode
                            , asSelectionStart = Nothing
                            , asMessage = Just "Combined"
                            }

-- | Approximate duration addition — returns the closest standard duration.
addDurations :: Duration -> Duration -> Duration
addDurations :: Duration -> Duration -> Duration
addDurations Duration
a Duration
b =
    let total :: Int
total = Duration -> Int
durationValue Duration
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Duration -> Int
durationValue Duration
b
     in Int -> Duration
fromDurationValue Int
total

{- | Sixteenth-note units for a 'Duration', used by 'addDurations' to sum
combined beats before converting back with 'fromDurationValue'.
-}
durationValue :: Duration -> Int
durationValue :: Duration -> Int
durationValue Duration
Whole = Int
16
durationValue Duration
Half = Int
8
durationValue Duration
Quarter = Int
4
durationValue Duration
Eighth = Int
2
durationValue Duration
Sixteenth = Int
1
durationValue Duration
Thirty2nd = Int
1 -- approximate
durationValue (Dotted Duration
d) = Duration -> Int
durationValue Duration
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Duration -> Int
durationValue Duration
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
durationValue (Triplet Duration
d) = Duration -> Int
durationValue Duration
d Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3

{- | Round a sixteenth-note unit total down to the nearest standard
(undotted, non-triplet) 'Duration' at or below it — the inverse of
'durationValue', but lossy for values that don't land exactly on a
standard duration (e.g. 12 units rounds down to 'Quarter', not
'Dotted Quarter').
-}
fromDurationValue :: Int -> Duration
fromDurationValue :: Int -> Duration
fromDurationValue Int
v
    | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
16 = Duration
Whole
    | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 = Duration
Half
    | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 = Duration
Quarter
    | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 = Duration
Eighth
    | Bool
otherwise = Duration
Sixteenth