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

{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
-- | Utilities for editing events.
module Cmd.EditUtil (
    Pos(..), get_pos
    -- * events
    , Modify
    , modify_event_at, modify_event_at_trigger
    , soft_insert
    , lookup_instrument
    -- * msgs
    , Key(..)
    , method_key
    , num_key, is_num_key
    , hex_key
    , Fallthrough(..)
    , fallthrough
    , input_to_note, inputs_to_notes
    -- * modify
    , modify_text_key
#ifdef TESTING
    , module Cmd.EditUtil
#endif
) where
import qualified Data.Char as Char
import qualified Data.Either as Either
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.Msg as Msg
import qualified Cmd.Perf as Perf
import qualified Cmd.Selection as Selection

import qualified Derive.DeriveT as DeriveT
import qualified Derive.Scale as Scale
import qualified Derive.ScoreT as ScoreT

import qualified Instrument.Common as Common
import qualified Perform.Pitch as Pitch
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Key as Key
import qualified Ui.Sel as Sel
import qualified Ui.Types as Types
import qualified Ui.Ui as Ui

import           Global
import           Types


-- | block tracknum start duration
--
-- The duration from the selection, so if it's zero, then an event duration
-- will be inferred by 'get_duration' based on the 'Cmd.state_note_duration'.
-- This is like 'Selection.Context', except focused on a single track.
data Pos = Pos !BlockId !TrackNum !TrackTime !TrackTime
    deriving (Pos -> Pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, TrackNum -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
forall a.
(TrackNum -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: TrackNum -> Pos -> ShowS
$cshowsPrec :: TrackNum -> Pos -> ShowS
Show)

instance Pretty Pos where pretty :: Pos -> Text
pretty = forall a. Show a => a -> Text
showt

get_pos :: Cmd.M m => m Pos
get_pos :: forall (m :: * -> *). M m => m Pos
get_pos = do
    (ViewId
view_id, Selection
sel) <- forall (m :: * -> *). M m => m (ViewId, Selection)
Selection.get_view_sel
    BlockId
block_id <- forall (m :: * -> *). M m => ViewId -> m BlockId
Ui.block_id_of ViewId
view_id
    let (TrackTime
start, TrackTime
dur) = let (TrackTime
s, TrackTime
e) = Selection -> (TrackTime, TrackTime)
Sel.range Selection
sel
            in case Selection -> Orientation
Sel.orientation Selection
sel of
                Orientation
Sel.Negative
                    | TrackTime
s forall a. Eq a => a -> a -> Bool
== TrackTime
e -> (TrackTime
e, -TrackTime
0)
                    | Bool
otherwise -> (TrackTime
e, TrackTime
s forall a. Num a => a -> a -> a
- TrackTime
e)
                Orientation
_ -> (TrackTime
s, TrackTime
e forall a. Num a => a -> a -> a
- TrackTime
s)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockId -> TrackNum -> TrackTime -> TrackTime -> Pos
Pos BlockId
block_id (Selection -> TrackNum
Selection.sel_point_track Selection
sel) TrackTime
start TrackTime
dur

-- * events

-- | Get the event under insertion point, creating an empty one if there is
-- none.
get_or_create_event :: Ui.M m => Bool -> TrackId -> TrackTime -> TrackTime
    -> m (Event.Event, Bool)
get_or_create_event :: forall (m :: * -> *).
M m =>
Bool -> TrackId -> TrackTime -> TrackTime -> m (Event, Bool)
get_or_create_event Bool
modify_dur TrackId
track_id TrackTime
pos TrackTime
dur = do
    Maybe Event
mb_event <- TrackTime -> Orientation -> Events -> Maybe Event
Events.at TrackTime
pos (TrackTime -> Orientation
Event.orientation_of TrackTime
dur) 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 modify :: Event -> Event
modify = if Bool
modify_dur then Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> a -> f -> f
#= TrackTime
dur else forall a. a -> a
id
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TrackTime -> TrackTime -> Text -> Event
Event.event TrackTime
pos TrackTime
dur Text
"", Bool
True) (\Event
evt -> (Event -> Event
modify Event
evt, Bool
False))
        Maybe Event
mb_event

-- | Modify event text.
type Modify = Maybe Text
    -- ^ Existing text, Nothing if the event will be created.
    -> (Maybe Text, Bool)
    -- ^ Nothing deletes the event, True to advance cursor

modify_event :: Cmd.M m => Bool -> Bool -> Modify -> m ()
modify_event :: forall (m :: * -> *). M m => Bool -> Bool -> Modify -> m ()
modify_event Bool
zero_dur Bool
modify_dur Modify
modify = do
    Pos
pos <- forall (m :: * -> *). M m => m Pos
get_pos
    forall (m :: * -> *). M m => Pos -> Bool -> Bool -> Modify -> m ()
modify_event_at Pos
pos Bool
zero_dur Bool
modify_dur Modify
modify

modify_event_at :: Cmd.M m => Pos
    -> Bool -- ^ If the selection is 0, then True means create a 0 dur event,
    -- otherwise use the time step. If the selection is nonzero, always use
    -- its duration.
    -> Bool -- ^ If True, modify the duration of an existing event.
    -> Modify -> m ()
modify_event_at :: forall (m :: * -> *). M m => Pos -> Bool -> Bool -> Modify -> m ()
modify_event_at (Pos BlockId
block_id TrackNum
tracknum TrackTime
start TrackTime
dur) Bool
zero_dur Bool
modify_dur Modify
modify =do
    TrackTime
dur <- forall {m :: * -> *}. M m => TrackTime -> m TrackTime
infer_duration TrackTime
dur
    TrackId
track_id <- forall (m :: * -> *). M m => BlockId -> TrackNum -> m TrackId
Ui.get_event_track_at BlockId
block_id TrackNum
tracknum
    (Event
event, Bool
created) <- forall (m :: * -> *).
M m =>
Bool -> TrackId -> TrackTime -> TrackTime -> m (Event, Bool)
get_or_create_event Bool
modify_dur TrackId
track_id TrackTime
start TrackTime
dur
    let (Maybe Text
val, Bool
advance) = Modify
modify forall a b. (a -> b) -> a -> b
$
            if Bool
created then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Event -> Text
Event.text Event
event)
    case Maybe Text
val of
        Maybe Text
Nothing -> forall (m :: * -> *). M m => TrackId -> Range -> m ()
Ui.remove_events_range TrackId
track_id
            (TrackTime -> Orientation -> Range
Events.Point TrackTime
start (TrackTime -> Orientation
Event.orientation_of TrackTime
dur))
        Just Text
new_text -> forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
track_id
            (Lens Event Text
Event.text_ forall f a. Lens f a -> a -> f -> f
#= Text
new_text forall a b. (a -> b) -> a -> b
$ Event
event)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
advance forall (m :: * -> *). M m => m ()
Selection.advance
    where
    infer_duration :: TrackTime -> m TrackTime
infer_duration TrackTime
dur
        | TrackTime
dur forall a. Eq a => a -> a -> Bool
/= TrackTime
0 = forall (m :: * -> *) a. Monad m => a -> m a
return TrackTime
dur
        | Bool
zero_dur = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ((forall a. Eq a => a -> a -> Bool
==Orientation
Types.Positive) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m Orientation
get_orientation)
            (forall (m :: * -> *) a. Monad m => a -> m a
return TrackTime
0) (forall (m :: * -> *) a. Monad m => a -> m a
return (-TrackTime
0))
        | Bool
otherwise = forall (m :: * -> *). M m => TrackNum -> TrackTime -> m TrackTime
get_duration TrackNum
tracknum TrackTime
start

-- | Like 'modify_event_at', but take 'triggered_inst' into account.
modify_event_at_trigger :: Cmd.M m => Pos -> Bool -> Bool -> Modify -> m ()
modify_event_at_trigger :: forall (m :: * -> *). M m => Pos -> Bool -> Bool -> Modify -> m ()
modify_event_at_trigger Pos
pos Bool
zero_dur Bool
modify_dur Modify
f = do
    Bool
trigger_inst <- forall (m :: * -> *). M m => Maybe Instrument -> m Bool
triggered_inst forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m (Maybe Instrument)
lookup_instrument
    forall (m :: * -> *). M m => Pos -> Bool -> Bool -> Modify -> m ()
modify_event_at Pos
pos (Bool
zero_dur Bool -> Bool -> Bool
|| Bool
trigger_inst) Bool
modify_dur Modify
f

-- | Instruments with the triggered flag set don't pay attention to note off,
-- so I can make the duration 0.
triggered_inst :: Cmd.M m => Maybe ScoreT.Instrument -> m Bool
triggered_inst :: forall (m :: * -> *). M m => Maybe Instrument -> m Bool
triggered_inst Maybe Instrument
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- don't know, but guess it's not
triggered_inst (Just Instrument
inst) = forall a. Ord a => a -> Set a -> Bool
Set.member Flag
Common.Triggered forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => Instrument -> m (Set Flag)
common_flags Instrument
inst

common_flags :: Cmd.M m => ScoreT.Instrument -> m (Set Common.Flag)
common_flags :: forall (m :: * -> *). M m => Instrument -> m (Set Flag)
common_flags Instrument
inst = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ResolvedInstrument -> Set Flag
flags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
M m =>
Instrument -> m (Maybe ResolvedInstrument)
Cmd.lookup_instrument Instrument
inst
    where flags :: ResolvedInstrument -> Set Flag
flags = forall code. Common code -> Set Flag
Common.common_flags forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolvedInstrument -> Common InstrumentCode
Cmd.inst_common

get_duration :: Cmd.M m => TrackNum -> TrackTime -> m TrackTime
get_duration :: forall (m :: * -> *). M m => TrackNum -> TrackTime -> m TrackTime
get_duration TrackNum
tracknum TrackTime
start = do
    Orientation
orient <- forall (m :: * -> *). M m => m Orientation
get_orientation
    TimeStep
step <- forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets (EditState -> TimeStep
Cmd.state_note_duration forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit)
    TrackTime
end <- forall (m :: * -> *).
M m =>
TrackNum -> TrackTime -> TrackNum -> TimeStep -> m TrackTime
Selection.step_from TrackNum
tracknum TrackTime
start
        (if Orientation
orient forall a. Eq a => a -> a -> Bool
== Orientation
Types.Positive then TrackNum
1 else -TrackNum
1) TimeStep
step
    forall (m :: * -> *) a. Monad m => a -> m a
return (TrackTime
end forall a. Num a => a -> a -> a
- TrackTime
start)

get_orientation :: Cmd.M m => m Types.Orientation
get_orientation :: forall (m :: * -> *). M m => m Orientation
get_orientation = forall (m :: * -> *) a. M m => (State -> a) -> m a
Cmd.gets forall a b. (a -> b) -> a -> b
$ EditState -> Orientation
Cmd.state_note_orientation forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EditState
Cmd.state_edit

-- | Insert an event, but only if there isn't already a non-empty one there.
soft_insert :: Cmd.M m => Text -> m ()
soft_insert :: forall (m :: * -> *). M m => Text -> m ()
soft_insert Text
text = forall (m :: * -> *). M m => Bool -> Bool -> Modify -> m ()
modify_event Bool
True Bool
True forall a b. (a -> b) -> a -> b
$ \Maybe Text
old_text ->
    if Text -> Bool
Text.null (forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
old_text) then (forall a. a -> Maybe a
Just Text
text, Bool
True)
        else (Maybe Text
old_text, Bool
False)

lookup_instrument :: Cmd.M m => m (Maybe ScoreT.Instrument)
lookup_instrument :: forall (m :: * -> *). M m => m (Maybe Instrument)
lookup_instrument = forall (m :: * -> *). M m => Track -> m (Maybe Instrument)
Perf.lookup_instrument forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m Track
Selection.track

-- * msgs

data Key = Backspace | Key Char
    deriving (Key -> Key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, TrackNum -> Key -> ShowS
[Key] -> ShowS
Key -> String
forall a.
(TrackNum -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: TrackNum -> Key -> ShowS
$cshowsPrec :: TrackNum -> Key -> ShowS
Show)

-- | Extract a key for method input.  [a-z0-9._-]
method_key :: Msg.Msg -> Maybe Key
method_key :: Msg -> Maybe Key
method_key = (Char -> Bool) -> Msg -> Maybe Key
extract_key (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isSpace)

-- | Extract a key for control value input.  [0-9._-]
num_key :: Msg.Msg -> Maybe Key
num_key :: Msg -> Maybe Key
num_key = (Char -> Bool) -> Msg -> Maybe Key
extract_key forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> Bool
Char.isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"_.-" :: [Char])

-- | Is the key appropriate for editing decimal numbers?
is_num_key :: Key -> Bool
is_num_key :: Key -> Bool
is_num_key Key
Backspace = Bool
True
is_num_key (Key Char
c) = Char -> Bool
Char.isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"_.-" :: [Char])

-- | Is the key appropriate for editing control track hex numbers?
-- Also includes @-@ for negation.
hex_key :: Msg.Msg -> Maybe Key
hex_key :: Msg -> Maybe Key
hex_key = (Char -> Bool) -> Msg -> Maybe Key
extract_key forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> Bool
Char.isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"-abcdefg" :: [Char])

extract_key :: (Char -> Bool) -> Msg.Msg -> Maybe Key
extract_key :: (Char -> Bool) -> Msg -> Maybe Key
extract_key Char -> Bool
f (Msg -> Maybe (Key, Maybe Char)
Msg.text -> Just (Key
key, Maybe Char
text)) = case Key
key of
    Key
Key.Backspace -> forall a. a -> Maybe a
Just Key
Backspace
    Key
_ -> case Maybe Char
text of
        Just Char
c | Char -> Bool
f Char
c -> forall a. a -> Maybe a
Just (Char -> Key
Key Char
c)
        Maybe Char
_ -> forall a. Maybe a
Nothing
extract_key Char -> Bool
_ Msg
_ = forall a. Maybe a
Nothing

data Fallthrough = WantBackspace | NoBackspace

-- | Let keys that have a modifier down fall through.
--
-- When edit mode is on, the edit cmds tend to catch all msgs.  However, some
-- msgs should go through anyway.
fallthrough :: Cmd.M m => Fallthrough -> Msg.Msg -> m ()
fallthrough :: forall (m :: * -> *). M m => Fallthrough -> Msg -> m ()
fallthrough Fallthrough
want_backspace Msg
msg = do
    [Modifier]
keys_down <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Map k a -> [k]
Map.keys forall (m :: * -> *). M m => m (Map Modifier Modifier)
Cmd.keys_down
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Modifier -> Bool
is_mod [Modifier]
keys_down) --  || Msg.key_down msg == Just Key.Backspace)
        forall (m :: * -> *) a. M m => m a
Cmd.abort
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Msg -> Maybe Key
Msg.key_down Msg
msg forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Key
Key.Backspace) forall a b. (a -> b) -> a -> b
$ case Fallthrough
want_backspace of
        -- When a range is selected, always let the global
        -- Edit.cmd_clear_selected handle it.
        Fallthrough
WantBackspace -> forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Bool
Sel.is_point forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). M m => m Selection
Selection.get) forall (m :: * -> *) a. M m => m a
Cmd.abort
        Fallthrough
NoBackspace -> forall (m :: * -> *) a. M m => m a
Cmd.abort
    where
    -- Abort if there are modifiers down, so commands still work.
    -- Except shift, of course.  Oh, and midi, otherwise a note off would
    -- always fall through.
    is_mod :: Modifier -> Bool
is_mod = \case
        Cmd.KeyMod Modifier
m -> case Modifier
m of
            Modifier
Key.Shift -> Bool
False
            Modifier
_ -> Bool
True
        Cmd.MidiMod Channel
_ Key
_ -> Bool
False
        Modifier
_ -> Bool
True

-- | Convert an InputKey to the symbolic Note that it should be.
--
-- Due to enharmonics this can depend on the current key and even be
-- ambiguous.
input_to_note :: Cmd.M m => Pitch.Input -> m Pitch.Note
input_to_note :: forall (m :: * -> *). M m => Input -> m Note
input_to_note Input
input = do
    Track
track <- forall (m :: * -> *). M m => m Track
Selection.track
    Scale
scale <- forall (m :: * -> *). M m => Track -> m Scale
Perf.get_scale Track
track
    Environ
env <- forall (m :: * -> *). M m => Track -> m Environ
Perf.get_environ Track
track
    case Scale -> Environ -> Input -> Either PitchError Note
Scale.scale_input_to_note Scale
scale Environ
env Input
input of
        -- This just means the key isn't in the scale, it happens a lot so no
        -- need to shout about it.
        Left PitchError
DeriveT.InvalidInput -> forall (m :: * -> *) a. M m => m a
Cmd.abort
        Left PitchError
err -> forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Cmd.throw forall a b. (a -> b) -> a -> b
$ Text
"input_to_note " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Input
input forall a. Semigroup a => a -> a -> a
<> Text
" for "
            forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty (Scale -> ScaleId
Scale.scale_id Scale
scale) forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty PitchError
err
        Right Note
note -> forall (m :: * -> *) a. Monad m => a -> m a
return Note
note

-- | Like 'input_to_note', but more efficient for multiple inputs.
inputs_to_notes :: Cmd.M m => [(key, Pitch.Input)] -> m [(key, Pitch.Note)]
inputs_to_notes :: forall (m :: * -> *) key. M m => [(key, Input)] -> m [(key, Note)]
inputs_to_notes [(key, Input)]
key_inputs = do
    Track
track <- forall (m :: * -> *). M m => m Track
Selection.track
    Scale
scale <- forall (m :: * -> *). M m => Track -> m Scale
Perf.get_scale Track
track
    Environ
env <- forall (m :: * -> *). M m => Track -> m Environ
Perf.get_environ Track
track
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
Either.rights forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Scale -> Environ -> Input -> Either PitchError Note
Scale.scale_input_to_note Scale
scale Environ
env)) [(key, Input)]
key_inputs

-- * modify

-- | Since there's no use for leading spaces, just a space makes an empty
-- event.  Backspacing the last character return Nothing, which deletes the
-- event.  If I want a "" event I can create one with space.
modify_text_key :: [Key.Modifier] -> Key -> Text -> Maybe Text
modify_text_key :: [Modifier] -> Key -> Text -> Maybe Text
modify_text_key [Modifier]
mods Key
key Text
s = case Key
key of
    Key
Backspace
        | Modifier
Key.Shift forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods -> Text -> Maybe Text
backspace_expr Text
s
        | Bool
otherwise -> Text -> Maybe Text
backspace Text
s
    Key Char
' ' | Text -> Bool
Text.null Text
s -> forall a. a -> Maybe a
Just Text
""
    Key Char
c
        -- It really shouldn't be non-printable, but check just in case.
        | Char -> Bool
Char.isPrint Char
c -> forall a. a -> Maybe a
Just (Text -> Char -> Text
Text.snoc Text
s Char
c)
        | Bool
otherwise -> forall a. a -> Maybe a
Just Text
s

backspace :: Text -> Maybe Text
backspace :: Text -> Maybe Text
backspace Text
s
    | Text -> Bool
Text.null Text
s2 = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just Text
s2
    where s2 :: Text
s2 = TrackNum -> Text -> Text
Text.take (Text -> TrackNum
Text.length Text
s forall a. Num a => a -> a -> a
- TrackNum
1) Text
s

backspace_expr :: Text -> Maybe Text
backspace_expr :: Text -> Maybe Text
backspace_expr Text
s
    | Text -> Bool
Text.null Text
s = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text
drop_expr Text
s

-- | Drop a parenthesized expression, or a `symbol` up to its matching
-- backtick.
drop_expr :: Text -> Text
drop_expr :: Text -> Text
drop_expr Text
expr = Text -> Text
Text.reverse forall a b. (a -> b) -> a -> b
$ String -> Text
txt String
rev
    where
    rev :: String
rev = case Text -> String
untxt forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.reverse forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
' ') Text
expr of
        Char
')' : String
s -> forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
' ') (forall {t}. (Eq t, Num t) => t -> ShowS
go Integer
1 String
s)
        Char
'`' : String
s -> case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'`') String
s of
            Char
'`' : String
rest -> String
rest
            String
"" -> String
s
            String
_ -> String
s
        String
s -> forall a. TrackNum -> [a] -> [a]
drop TrackNum
1 String
s
    go :: t -> ShowS
go t
0 String
s = String
s
    go t
nest String
s = case String
s of
        String
"" -> Text -> String
untxt forall a b. (a -> b) -> a -> b
$ TrackNum -> Text -> Text
Text.drop TrackNum
1 Text
expr -- No balanced paren, just drop 1.
        -- These are backwards because the string is reversed.
        Char
')' : String
s -> t -> ShowS
go (t
nestforall a. Num a => a -> a -> a
+t
1) String
s
        Char
'(' : String
s -> t -> ShowS
go (t
nestforall a. Num a => a -> a -> a
-t
1) String
s
        Char
_ : String
s -> t -> ShowS
go t
nest String
s