From de4ec92460c23eb98e057cbcabd05d51604d4a9f Mon Sep 17 00:00:00 2001 From: Enrico Maria De Angelis Date: Wed, 3 Sep 2025 20:32:30 +0100 Subject: [PATCH 1/4] Whitespace changes --- System/Console/Haskeline/Command.hs | 10 +- System/Console/Haskeline/Command/History.hs | 12 +-- System/Console/Haskeline/Command/KillRing.hs | 18 ++-- System/Console/Haskeline/Command/Undo.hs | 5 +- System/Console/Haskeline/LineState.hs | 29 +++--- System/Console/Haskeline/Vi.hs | 101 +++++++++---------- 6 files changed, 86 insertions(+), 89 deletions(-) diff --git a/System/Console/Haskeline/Command.hs b/System/Console/Haskeline/Command.hs index 6d326527..f9cfba58 100644 --- a/System/Console/Haskeline/Command.hs +++ b/System/Console/Haskeline/Command.hs @@ -1,7 +1,7 @@ module System.Console.Haskeline.Command( -- * Commands Effect(..), - KeyMap(..), + KeyMap(..), CmdM(..), Command, KeyCommand, @@ -34,9 +34,9 @@ import System.Console.Haskeline.LineState import System.Console.Haskeline.Key data Effect = LineChange (Prefix -> LineChars) - | PrintLines [String] - | ClearScreen - | RingBell + | PrintLines [String] + | ClearScreen + | RingBell lineChange :: LineState s => s -> Effect lineChange = LineChange . flip lineChars @@ -91,7 +91,7 @@ useKey k x = KeyMap $ \k' -> if k==k' then Just (Consumed x) else Nothing -- TODO: could just be a monadic action that returns a Char. useChar :: (Char -> Command m s t) -> KeyCommand m s t useChar act = KeyMap $ \k -> case k of - Key m (KeyChar c) | isPrint c && m==noModifier + Key m (KeyChar c) | isPrint c && m == noModifier -> Just $ Consumed (act c) _ -> Nothing diff --git a/System/Console/Haskeline/Command/History.hs b/System/Console/Haskeline/Command/History.hs index 37cd02e1..34344a26 100644 --- a/System/Console/Haskeline/Command/History.hs +++ b/System/Console/Haskeline/Command/History.hs @@ -17,7 +17,7 @@ data HistLog = HistLog {pastHistory, futureHistory :: [[Grapheme]]} prevHistoryM :: [Grapheme] -> HistLog -> Maybe ([Grapheme],HistLog) prevHistoryM _ HistLog {pastHistory = []} = Nothing prevHistoryM s HistLog {pastHistory=ls:past, futureHistory=future} - = Just (ls, + = Just (ls, HistLog {pastHistory=past, futureHistory= s:future}) prevHistories :: [Grapheme] -> HistLog -> [([Grapheme],HistLog)] @@ -45,7 +45,7 @@ runHistoryFromFile (Just file) stifleAmt f = do return x prevHistory, firstHistory :: Save s => s -> HistLog -> (s, HistLog) -prevHistory s h = let (s',h') = fromMaybe (listSave s,h) +prevHistory s h = let (s',h') = fromMaybe (listSave s,h) $ prevHistoryM (listSave s) h in (listRestore s',h') @@ -73,7 +73,7 @@ reverseHist f = do modify reverser return y where - reverser h = HistLog {futureHistory=pastHistory h, + reverser h = HistLog {futureHistory=pastHistory h, pastHistory=futureHistory h} data SearchMode = SearchMode {searchTerm :: [Grapheme], @@ -90,7 +90,7 @@ directionName Reverse = "reverse-i-search" instance LineState SearchMode where beforeCursor _ sm = beforeCursor prefix (foundHistory sm) - where + where prefix = stringToGraphemes ("(" ++ directionName (direction sm) ++ ")`") ++ searchTerm sm ++ stringToGraphemes "': " afterCursor = afterCursor . foundHistory @@ -105,14 +105,14 @@ startSearchMode :: Direction -> InsertMode -> SearchMode startSearchMode dir im = SearchMode {searchTerm = [],foundHistory=im, direction=dir} addChar :: Char -> SearchMode -> SearchMode -addChar c s = s {searchTerm = listSave $ insertChar c +addChar c s = s {searchTerm = listSave $ insertChar c $ listRestore $ searchTerm s} searchHistories :: Direction -> [Grapheme] -> [([Grapheme],HistLog)] -> Maybe (SearchMode,HistLog) searchHistories dir text = foldr mplus Nothing . map findIt where - findIt (l,h) = do + findIt (l,h) = do im <- findInLine text l return (SearchMode text im dir,h) diff --git a/System/Console/Haskeline/Command/KillRing.hs b/System/Console/Haskeline/Command/KillRing.hs index dee97b49..6a181e41 100644 --- a/System/Console/Haskeline/Command/KillRing.hs +++ b/System/Console/Haskeline/Command/KillRing.hs @@ -45,10 +45,10 @@ pasteCommand use = \s -> do modify $ saveToUndo $ argState s setState $ applyArg (use p) s -deleteFromDiff' :: InsertMode -> InsertMode -> ([Grapheme],InsertMode) +deleteFromDiff' :: InsertMode -> InsertMode -> ([Grapheme], InsertMode) deleteFromDiff' (IMode xs1 ys1) (IMode xs2 ys2) | posChange >= 0 = (take posChange ys1, IMode xs1 ys2) - | otherwise = (take (negate posChange) ys2 ,IMode xs2 ys1) + | otherwise = (take (negate posChange) ys2, IMode xs2 ys1) where posChange = length xs2 - length xs1 @@ -56,37 +56,37 @@ killFromHelper :: (MonadState KillRing m, MonadState Undo m, Save s, Save t) => KillHelper -> Command m s t killFromHelper helper = saveForUndo >=> \oldS -> do - let (gs,newIM) = applyHelper helper (save oldS) + let (gs, newIM) = applyHelper helper (save oldS) modify (push gs) setState (restore newIM) killFromArgHelper :: (MonadState KillRing m, MonadState Undo m, Save s, Save t) => KillHelper -> Command m (ArgMode s) t killFromArgHelper helper = saveForUndo >=> \oldS -> do - let (gs,newIM) = applyArgHelper helper (fmap save oldS) + let (gs, newIM) = applyArgHelper helper (fmap save oldS) modify (push gs) setState (restore newIM) copyFromArgHelper :: (MonadState KillRing m, Save s) => KillHelper -> Command m (ArgMode s) s copyFromArgHelper helper = \oldS -> do - let (gs,_) = applyArgHelper helper (fmap save oldS) + let (gs, _) = applyArgHelper helper (fmap save oldS) modify (push gs) setState (argState oldS) data KillHelper = SimpleMove (InsertMode -> InsertMode) - | GenericKill (InsertMode -> ([Grapheme],InsertMode)) + | GenericKill (InsertMode -> ([Grapheme], InsertMode)) -- a generic kill gives more flexibility, but isn't repeatable. - -- for example: dd,cc, % + -- for example: dd, cc, % killAll :: KillHelper killAll = GenericKill $ \(IMode xs ys) -> (reverse xs ++ ys, emptyIM) -applyHelper :: KillHelper -> InsertMode -> ([Grapheme],InsertMode) +applyHelper :: KillHelper -> InsertMode -> ([Grapheme], InsertMode) applyHelper (SimpleMove move) im = deleteFromDiff' im (move im) applyHelper (GenericKill act) im = act im -applyArgHelper :: KillHelper -> ArgMode InsertMode -> ([Grapheme],InsertMode) +applyArgHelper :: KillHelper -> ArgMode InsertMode -> ([Grapheme], InsertMode) applyArgHelper (SimpleMove move) im = deleteFromDiff' (argState im) (applyArg move im) applyArgHelper (GenericKill act) im = act (argState im) diff --git a/System/Console/Haskeline/Command/Undo.hs b/System/Console/Haskeline/Command/Undo.hs index 116c8305..4d3bcc55 100644 --- a/System/Console/Haskeline/Command/Undo.hs +++ b/System/Console/Haskeline/Command/Undo.hs @@ -19,7 +19,7 @@ initialUndo = Undo {pastUndo = [emptyIM], futureRedo = []} saveToUndo :: Save s => s -> Undo -> Undo saveToUndo s undo - | not isSame = Undo {pastUndo = toSave:pastUndo undo,futureRedo=[]} + | not isSame = Undo {pastUndo = toSave:pastUndo undo, futureRedo=[]} | otherwise = undo where toSave = save s @@ -39,7 +39,7 @@ redoFuture ls u@Undo {futureRedo = (futureLS:lss)} saveForUndo :: (Save s, MonadState Undo m) - => Command m s s + => Command m s s saveForUndo s = do modify (saveToUndo s) return s @@ -47,4 +47,3 @@ saveForUndo s = do commandUndo, commandRedo :: (MonadState Undo m, Save s) => Command m s s commandUndo = simpleCommand $ liftM Right . update . undoPast commandRedo = simpleCommand $ liftM Right . update . redoFuture - diff --git a/System/Console/Haskeline/LineState.hs b/System/Console/Haskeline/LineState.hs index 79537bfb..00194384 100644 --- a/System/Console/Haskeline/LineState.hs +++ b/System/Console/Haskeline/LineState.hs @@ -163,7 +163,7 @@ listRestore xs = restore $ IMode (reverse xs) [] class Move s where goLeft, goRight, moveToStart, moveToEnd :: s -> s - + -- | The standard line state representation; considers the cursor to be located -- between two characters. The first list is reversed. data InsertMode = IMode [Grapheme] [Grapheme] @@ -181,7 +181,7 @@ instance Save InsertMode where restore = id instance Move InsertMode where - goLeft im@(IMode [] _) = im + goLeft im@(IMode [] _) = im goLeft (IMode (x:xs) ys) = IMode xs (x:ys) goRight im@(IMode _ []) = im @@ -194,7 +194,7 @@ emptyIM :: InsertMode emptyIM = IMode [] [] -- | Insert one character, which may be combining, to the left of the cursor. --- +-- insertChar :: Char -> InsertMode -> InsertMode insertChar c im@(IMode xs ys) | isCombiningChar c = case xs of @@ -203,7 +203,7 @@ insertChar c im@(IMode xs ys) z:zs -> IMode (addCombiner z c : zs) ys | otherwise = IMode (baseGrapheme c : xs) ys --- | Insert a sequence of characters to the left of the cursor. +-- | Insert a sequence of characters to the left of the cursor. insertString :: String -> InsertMode -> InsertMode insertString s (IMode xs ys) = IMode (reverse (stringToGraphemes s) ++ xs) ys @@ -212,12 +212,12 @@ deleteNext im@(IMode _ []) = im deleteNext (IMode xs (_:ys)) = IMode xs ys deletePrev im@(IMode [] _) = im -deletePrev (IMode (_:xs) ys) = IMode xs ys +deletePrev (IMode (_:xs) ys) = IMode xs ys skipLeft, skipRight :: (Char -> Bool) -> InsertMode -> InsertMode -skipLeft f (IMode xs ys) = let (ws,zs) = span (f . baseChar) xs +skipLeft f (IMode xs ys) = let (ws,zs) = span (f . baseChar) xs in IMode zs (reverse ws ++ ys) -skipRight f (IMode xs ys) = let (ws,zs) = span (f . baseChar) ys +skipRight f (IMode xs ys) = let (ws,zs) = span (f . baseChar) ys in IMode (reverse ws ++ xs) zs transposeChars :: InsertMode -> InsertMode @@ -326,7 +326,7 @@ instance Functor ArgMode where instance LineState s => LineState (ArgMode s) where beforeCursor _ am = let pre = map baseGrapheme $ "(arg: " ++ show (arg am) ++ ") " - in beforeCursor pre (argState am) + in beforeCursor pre (argState am) afterCursor = afterCursor . argState instance Result s => Result (ArgMode s) where @@ -342,15 +342,15 @@ startArg = ArgMode addNum :: Int -> ArgMode s -> ArgMode s addNum n am | arg am >= 1000 = am -- shouldn't ever need more than 4 digits - | otherwise = am {arg = arg am * 10 + n} + | otherwise = am {arg = arg am * 10 + n} --- todo: negatives +-- TODO: negatives applyArg :: (s -> s) -> ArgMode s -> s applyArg f am = repeatN (arg am) f (argState am) repeatN :: Int -> (a -> a) -> a -> a repeatN n f | n <= 1 = f - | otherwise = f . repeatN (n-1) f + | otherwise = f . repeatN (n-1) f applyCmdArg :: (InsertMode -> InsertMode) -> ArgMode CommandMode -> CommandMode applyCmdArg f am = withCommandMode (repeatN (arg am) f) (argState am) @@ -406,10 +406,9 @@ afterChar _ _ = False goRightUntil, goLeftUntil :: (InsertMode -> Bool) -> InsertMode -> InsertMode goRightUntil f = loop . goRight where - loop im@(IMode _ ys) | null ys || f im = im + loop im@(IMode _ ys) | null ys || f im = im | otherwise = loop (goRight im) goLeftUntil f = loop . goLeft where - loop im@(IMode xs _) | null xs || f im = im - | otherwise = loop (goLeft im) - + loop im@(IMode xs _) | null xs || f im = im + | otherwise = loop (goLeft im) diff --git a/System/Console/Haskeline/Vi.hs b/System/Console/Haskeline/Vi.hs index a5bcb52d..2638475f 100644 --- a/System/Console/Haskeline/Vi.hs +++ b/System/Console/Haskeline/Vi.hs @@ -14,7 +14,7 @@ import System.Console.Haskeline.LineState import System.Console.Haskeline.InputT import Data.Char -import Control.Monad(liftM, (>=>)) +import Control.Monad (liftM, (>=>)) import Control.Monad.Catch (MonadMask) type EitherMode = Either CommandMode InsertMode @@ -38,12 +38,11 @@ type InputCmd s t = forall m . (MonadIO m, MonadMask m) => Command (ViT m) s t type InputKeyCmd s t = forall m . (MonadIO m, MonadMask m) => KeyCommand (ViT m) s t viKeyCommands :: InputKeyCmd InsertMode (Maybe String) -viKeyCommands = choiceCmd [ - simpleChar '\n' +> finish +viKeyCommands = choiceCmd + [ simpleChar '\n' +> finish , ctrlChar 'd' +> eofIfEmpty , simpleInsertions >+> viCommands - , simpleChar '\ESC' +> change enterCommandMode - >=> viCommandActions + , simpleChar '\ESC' +> change enterCommandMode >=> viCommandActions ] viCommands :: InputCmd InsertMode (Maybe String) @@ -51,34 +50,35 @@ viCommands = keyCommand viKeyCommands simpleInsertions :: InputKeyCmd InsertMode InsertMode simpleInsertions = choiceCmd - [ simpleKey LeftKey +> change goLeft - , simpleKey RightKey +> change goRight - , simpleKey Backspace +> change deletePrev - , simpleKey Delete +> change deleteNext - , simpleKey Home +> change moveToStart - , simpleKey End +> change moveToEnd - , insertChars - , ctrlChar 'l' +> clearScreenCmd - , simpleKey UpKey +> historyBack - , simpleKey DownKey +> historyForward - , simpleKey SearchReverse +> searchForPrefix Reverse - , simpleKey SearchForward +> searchForPrefix Forward - , searchHistory - , simpleKey KillLine +> killFromHelper (SimpleMove moveToStart) - , ctrlChar 'w' +> killFromHelper wordErase - , completionCmd (simpleChar '\t') - ] + [ simpleKey LeftKey +> change goLeft + , simpleKey RightKey +> change goRight + , simpleKey Backspace +> change deletePrev + , simpleKey Delete +> change deleteNext + , simpleKey Home +> change moveToStart + , simpleKey End +> change moveToEnd + , insertChars + , ctrlChar 'l' +> clearScreenCmd + , simpleKey UpKey +> historyBack + , simpleKey DownKey +> historyForward + , simpleKey SearchReverse +> searchForPrefix Reverse + , simpleKey SearchForward +> searchForPrefix Forward + , searchHistory + , simpleKey KillLine +> killFromHelper (SimpleMove moveToStart) + , ctrlChar 'w' +> killFromHelper wordErase + , completionCmd (simpleChar '\t') + ] insertChars :: InputKeyCmd InsertMode InsertMode insertChars = useChar $ loop [] where - loop ds d = change (insertChar d) >=> keyChoiceCmd [ - useChar $ loop (d:ds) + loop ds d = change (insertChar d) + >=> keyChoiceCmd + [ useChar $ loop (d:ds) , withoutConsuming (storeCharInsertion (reverse ds)) ] - storeCharInsertion s = storeLastCmd $ change (applyArg - $ withCommandMode $ insertString s) - >=> return . Left + storeCharInsertion s = storeLastCmd + $ change (applyArg $ withCommandMode $ insertString s) + >=> return . Left -- If we receive a ^D and the line is empty, return Nothing -- otherwise, act like '\n' (mimicking how Readline behaves) @@ -101,13 +101,13 @@ viCommandActions = keyChoiceCmd [ chooseEitherMode (Right im) = viCommands im exitingCommands :: InputKeyCmd CommandMode InsertMode -exitingCommands = choiceCmd [ +exitingCommands = choiceCmd [ simpleChar 'i' +> change insertFromCommandMode , simpleChar 'I' +> change (moveToStart . insertFromCommandMode) , simpleKey Home +> change (moveToStart . insertFromCommandMode) , simpleChar 'a' +> change appendFromCommandMode , simpleChar 'A' +> change (moveToEnd . appendFromCommandMode) - , simpleKey End +> change (moveToStart . insertFromCommandMode) + , simpleKey End +> change (moveToStart . insertFromCommandMode) , simpleChar 's' +> change (insertFromCommandMode . deleteChar) , simpleChar 'S' +> noArg >=> killAndStoreI killAll , simpleChar 'C' +> noArg >=> killAndStoreI (SimpleMove moveToEnd) @@ -116,8 +116,8 @@ exitingCommands = choiceCmd [ simpleCmdActions :: InputKeyCmd CommandMode CommandMode simpleCmdActions = choiceCmd [ simpleChar '\ESC' +> change id -- helps break out of loops - , simpleChar 'r' +> replaceOnce - , simpleChar 'R' +> replaceLoop + , simpleChar 'r' +> replaceOnce + , simpleChar 'R' +> replaceLoop , simpleChar 'D' +> noArg >=> killAndStoreCmd (SimpleMove moveToEnd) , ctrlChar 'l' +> clearScreenCmd , simpleChar 'u' +> commandUndo @@ -125,7 +125,7 @@ simpleCmdActions = choiceCmd [ -- vi-mode quirk: history is put at the start of the line. , simpleChar 'j' +> historyForward >=> change moveToStart , simpleChar 'k' +> historyBack >=> change moveToStart - , simpleKey DownKey +> historyForward >=> change moveToStart + , simpleKey DownKey +> historyForward >=> change moveToStart , simpleKey UpKey +> historyBack >=> change moveToStart , simpleChar '/' +> viEnterSearch '/' Reverse , simpleChar '?' +> viEnterSearch '?' Forward @@ -218,11 +218,11 @@ repeatableCmdToIMode = simpleChar 'c' +> deletionToInsertCmd deletionCmd :: InputCmd (ArgMode CommandMode) CommandMode deletionCmd = keyChoiceCmd - [ reinputArg >+> deletionCmd - , simpleChar 'd' +> killAndStoreCmd killAll - , useMovementsForKill (change argState) killAndStoreCmd - , withoutConsuming (change argState) - ] + [ reinputArg >+> deletionCmd + , simpleChar 'd' +> killAndStoreCmd killAll + , useMovementsForKill (change argState) killAndStoreCmd + , withoutConsuming (change argState) + ] deletionToInsertCmd :: InputCmd (ArgMode CommandMode) EitherMode deletionToInsertCmd = keyChoiceCmd @@ -239,11 +239,11 @@ deletionToInsertCmd = keyChoiceCmd yankCommand :: InputCmd (ArgMode CommandMode) CommandMode yankCommand = keyChoiceCmd - [ reinputArg >+> yankCommand - , simpleChar 'y' +> copyAndStore killAll - , useMovementsForKill (change argState) copyAndStore - , withoutConsuming (change argState) - ] + [ reinputArg >+> yankCommand + , simpleChar 'y' +> copyAndStore killAll + , useMovementsForKill (change argState) copyAndStore + , withoutConsuming (change argState) + ] where copyAndStore = storedCmdAction . copyFromArgHelper @@ -262,7 +262,7 @@ goToWordDelEnd = goRightUntil $ atStart (not . isWordChar) goToBigWordDelEnd = goRightUntil $ atStart (not . isBigWordChar) -movements :: [(Key,InsertMode -> InsertMode)] +movements :: [(Key, InsertMode -> InsertMode)] movements = [ (simpleChar 'h', goLeft) , (simpleChar 'l', goRight) , (simpleChar ' ', goRight) @@ -381,11 +381,11 @@ storedAction :: Monad m => SavedCommand m -> SavedCommand m storedAction act = storeLastCmd act >=> act storedCmdAction :: Monad m => Command (ViT m) (ArgMode CommandMode) CommandMode - -> Command (ViT m) (ArgMode CommandMode) CommandMode + -> Command (ViT m) (ArgMode CommandMode) CommandMode storedCmdAction act = storeLastCmd (liftM Left . act) >=> act storedIAction :: Monad m => Command (ViT m) (ArgMode CommandMode) InsertMode - -> Command (ViT m) (ArgMode CommandMode) InsertMode + -> Command (ViT m) (ArgMode CommandMode) InsertMode storedIAction act = storeLastCmd (liftM Right . act) >=> act killAndStoreCmd :: MonadIO m => KillHelper -> Command (ViT m) (ArgMode CommandMode) CommandMode @@ -421,14 +421,13 @@ viEnterSearch :: Monad m => Char -> Direction viEnterSearch c dir s = setState (SearchEntry emptyIM c) >>= loopEntry where modifySE f se = se {entryState = f (entryState se)} - loopEntry = keyChoiceCmd [ - editEntry >+> loopEntry - , simpleChar '\n' +> \se -> - viSearchHist dir (searchText se) s + loopEntry = keyChoiceCmd + [ editEntry >+> loopEntry + , simpleChar '\n' +> \se -> viSearchHist dir (searchText se) s , withoutConsuming (change (const s)) ] - editEntry = choiceCmd [ - useChar (change . modifySE . insertChar) + editEntry = choiceCmd + [ useChar (change . modifySE . insertChar) , simpleKey LeftKey +> change (modifySE goLeft) , simpleKey RightKey +> change (modifySE goRight) , simpleKey Backspace +> change (modifySE deletePrev) From 118df9ef0de7f74897cf35819e5a3155ca185316 Mon Sep 17 00:00:00 2001 From: Enrico Maria De Angelis Date: Wed, 3 Sep 2025 20:39:06 +0100 Subject: [PATCH 2/4] Preferring fmap or <$> to liftM and useKey to +>, defining flipDir and doAfter Regarding preferring `useKey` over `+>`, the rationale is: while `>+>` is truly just a generic combinator (it is indeed just `flip (fmap . flip (>=>))`), so giving it a name is complicated, `useKey` is not, and the operator `+>` is just one more thing to remember. `useKey` is way more informative and can be used infixed anyway; the only drawback is that some parenthesis are needed. Renamed killAndStoreIE to killAndStoreE as I didn't know what "I" stood for, and killAndStoreCmd to killAndStoreC for consistency. Moved copyAndStore out for storing. --- System/Console/Haskeline/Command.hs | 13 +- System/Console/Haskeline/Command/History.hs | 4 + System/Console/Haskeline/Command/KillRing.hs | 2 +- System/Console/Haskeline/Vi.hs | 167 ++++++++++--------- 4 files changed, 98 insertions(+), 88 deletions(-) diff --git a/System/Console/Haskeline/Command.hs b/System/Console/Haskeline/Command.hs index f9cfba58..bf12003c 100644 --- a/System/Console/Haskeline/Command.hs +++ b/System/Console/Haskeline/Command.hs @@ -20,10 +20,12 @@ module System.Console.Haskeline.Command( change, changeFromChar, (+>), + useKey, useChar, choiceCmd, keyChoiceCmd, keyChoiceCmdM, + doAfter, doBefore ) where @@ -110,9 +112,15 @@ keyChoiceCmd = keyCommand . choiceCmd keyChoiceCmdM :: [KeyMap (CmdM m a)] -> CmdM m a keyChoiceCmdM = GetKey . choiceCmd +doBefore :: Monad m => Command m s t -> KeyCommand m t u -> KeyCommand m s u +doBefore g km = fmap (g >=>) km + +doAfter :: Monad m => KeyCommand m s t -> Command m t u -> KeyCommand m s u +doAfter km g = fmap (>=> g) km + infixr 6 >+> (>+>) :: Monad m => KeyCommand m s t -> Command m t u -> KeyCommand m s u -km >+> g = fmap (>=> g) km +(>+>) = doAfter -- attempt to run the command (predicated on getting a valid key); but if it fails, just keep -- going. @@ -155,6 +163,3 @@ change = (setState .) changeFromChar :: (LineState t, Monad m) => (Char -> s -> t) -> KeyCommand m s t changeFromChar f = useChar $ change . f - -doBefore :: Monad m => Command m s t -> KeyCommand m t u -> KeyCommand m s u -doBefore cmd = fmap (cmd >=>) diff --git a/System/Console/Haskeline/Command/History.hs b/System/Console/Haskeline/Command/History.hs index 34344a26..ae8d143f 100644 --- a/System/Console/Haskeline/Command/History.hs +++ b/System/Console/Haskeline/Command/History.hs @@ -84,6 +84,10 @@ data SearchMode = SearchMode {searchTerm :: [Grapheme], data Direction = Forward | Reverse deriving (Show,Eq) +flipDir :: Direction -> Direction +flipDir Forward = Reverse +flipDir Reverse = Forward + directionName :: Direction -> String directionName Forward = "i-search" directionName Reverse = "reverse-i-search" diff --git a/System/Console/Haskeline/Command/KillRing.hs b/System/Console/Haskeline/Command/KillRing.hs index 6a181e41..d0dcb1cc 100644 --- a/System/Console/Haskeline/Command/KillRing.hs +++ b/System/Console/Haskeline/Command/KillRing.hs @@ -38,7 +38,7 @@ runKillRing act = do pasteCommand :: (Save s, MonadState KillRing m, MonadState Undo m) => ([Grapheme] -> s -> s) -> Command m (ArgMode s) s pasteCommand use = \s -> do - ms <- liftM peek get + ms <- peek <$> get case ms of Nothing -> return $ argState s Just p -> do diff --git a/System/Console/Haskeline/Vi.hs b/System/Console/Haskeline/Vi.hs index 2638475f..b8c13a54 100644 --- a/System/Console/Haskeline/Vi.hs +++ b/System/Console/Haskeline/Vi.hs @@ -14,7 +14,7 @@ import System.Console.Haskeline.LineState import System.Console.Haskeline.InputT import Data.Char -import Control.Monad (liftM, (>=>)) +import Control.Monad (liftM2, (>=>)) import Control.Monad.Catch (MonadMask) type EitherMode = Either CommandMode InsertMode @@ -39,10 +39,10 @@ type InputKeyCmd s t = forall m . (MonadIO m, MonadMask m) => KeyCommand (ViT m) viKeyCommands :: InputKeyCmd InsertMode (Maybe String) viKeyCommands = choiceCmd - [ simpleChar '\n' +> finish - , ctrlChar 'd' +> eofIfEmpty + [ simpleChar '\n' `useKey` finish + , ctrlChar 'd' `useKey` eofIfEmpty , simpleInsertions >+> viCommands - , simpleChar '\ESC' +> change enterCommandMode >=> viCommandActions + , simpleChar '\ESC' `useKey` (change enterCommandMode >=> viCommandActions) ] viCommands :: InputCmd InsertMode (Maybe String) @@ -50,21 +50,21 @@ viCommands = keyCommand viKeyCommands simpleInsertions :: InputKeyCmd InsertMode InsertMode simpleInsertions = choiceCmd - [ simpleKey LeftKey +> change goLeft - , simpleKey RightKey +> change goRight - , simpleKey Backspace +> change deletePrev - , simpleKey Delete +> change deleteNext - , simpleKey Home +> change moveToStart - , simpleKey End +> change moveToEnd + [ simpleKey LeftKey `useKey` change goLeft + , simpleKey RightKey `useKey` change goRight + , simpleKey Backspace `useKey` change deletePrev + , simpleKey Delete `useKey` change deleteNext + , simpleKey Home `useKey` change moveToStart + , simpleKey End `useKey` change moveToEnd , insertChars - , ctrlChar 'l' +> clearScreenCmd - , simpleKey UpKey +> historyBack - , simpleKey DownKey +> historyForward - , simpleKey SearchReverse +> searchForPrefix Reverse - , simpleKey SearchForward +> searchForPrefix Forward + , ctrlChar 'l' `useKey` clearScreenCmd + , simpleKey UpKey `useKey` historyBack + , simpleKey DownKey `useKey` historyForward + , simpleKey SearchReverse `useKey` searchForPrefix Reverse + , simpleKey SearchForward `useKey` searchForPrefix Forward , searchHistory - , simpleKey KillLine +> killFromHelper (SimpleMove moveToStart) - , ctrlChar 'w' +> killFromHelper wordErase + , simpleKey KillLine `useKey` killFromHelper (SimpleMove moveToStart) + , ctrlChar 'w' `useKey` killFromHelper wordErase , completionCmd (simpleChar '\t') ] @@ -89,8 +89,8 @@ eofIfEmpty s viCommandActions :: InputCmd CommandMode (Maybe String) viCommandActions = keyChoiceCmd [ - simpleChar '\n' +> finish - , ctrlChar 'd' +> eofIfEmpty + simpleChar '\n' `useKey` finish + , ctrlChar 'd' `useKey` eofIfEmpty , simpleCmdActions >+> viCommandActions , exitingCommands >+> viCommands , repeatedCommands >+> chooseEitherMode @@ -102,36 +102,36 @@ viCommandActions = keyChoiceCmd [ exitingCommands :: InputKeyCmd CommandMode InsertMode exitingCommands = choiceCmd [ - simpleChar 'i' +> change insertFromCommandMode - , simpleChar 'I' +> change (moveToStart . insertFromCommandMode) - , simpleKey Home +> change (moveToStart . insertFromCommandMode) - , simpleChar 'a' +> change appendFromCommandMode - , simpleChar 'A' +> change (moveToEnd . appendFromCommandMode) - , simpleKey End +> change (moveToStart . insertFromCommandMode) - , simpleChar 's' +> change (insertFromCommandMode . deleteChar) - , simpleChar 'S' +> noArg >=> killAndStoreI killAll - , simpleChar 'C' +> noArg >=> killAndStoreI (SimpleMove moveToEnd) + simpleChar 'i' `useKey` change insertFromCommandMode + , simpleChar 'I' `useKey` change (moveToStart . insertFromCommandMode) + , simpleKey Home `useKey` change (moveToStart . insertFromCommandMode) + , simpleChar 'a' `useKey` change appendFromCommandMode + , simpleChar 'A' `useKey` change (moveToEnd . appendFromCommandMode) + , simpleKey End `useKey` change (moveToStart . insertFromCommandMode) + , simpleChar 's' `useKey` change (insertFromCommandMode . deleteChar) + , simpleChar 'S' `useKey` (noArg >=> killAndStoreI killAll) + , simpleChar 'C' `useKey` (noArg >=> killAndStoreI (SimpleMove moveToEnd)) ] simpleCmdActions :: InputKeyCmd CommandMode CommandMode simpleCmdActions = choiceCmd [ - simpleChar '\ESC' +> change id -- helps break out of loops - , simpleChar 'r' +> replaceOnce - , simpleChar 'R' +> replaceLoop - , simpleChar 'D' +> noArg >=> killAndStoreCmd (SimpleMove moveToEnd) - , ctrlChar 'l' +> clearScreenCmd - , simpleChar 'u' +> commandUndo - , ctrlChar 'r' +> commandRedo + simpleChar '\ESC' `useKey` change id -- helps break out of loops + , simpleChar 'r' `useKey` replaceOnce + , simpleChar 'R' `useKey` replaceLoop + , simpleChar 'D' `useKey` (noArg >=> killAndStoreC (SimpleMove moveToEnd)) + , ctrlChar 'l' `useKey` clearScreenCmd + , simpleChar 'u' `useKey` commandUndo + , ctrlChar 'r' `useKey` commandRedo -- vi-mode quirk: history is put at the start of the line. - , simpleChar 'j' +> historyForward >=> change moveToStart - , simpleChar 'k' +> historyBack >=> change moveToStart - , simpleKey DownKey +> historyForward >=> change moveToStart - , simpleKey UpKey +> historyBack >=> change moveToStart - , simpleChar '/' +> viEnterSearch '/' Reverse - , simpleChar '?' +> viEnterSearch '?' Forward - , simpleChar 'n' +> viSearchHist Reverse [] - , simpleChar 'N' +> viSearchHist Forward [] - , simpleKey KillLine +> noArg >=> killAndStoreCmd (SimpleMove moveToStart) + , simpleChar 'j' `useKey` (historyForward >=> change moveToStart) + , simpleChar 'k' `useKey` (historyBack >=> change moveToStart) + , simpleKey DownKey `useKey` (historyForward >=> change moveToStart) + , simpleKey UpKey `useKey` (historyBack >=> change moveToStart) + , simpleChar '/' `useKey` viEnterSearch '/' Reverse + , simpleChar '?' `useKey` viEnterSearch '?' Forward + , simpleChar 'n' `useKey` viSearchHist Reverse [] + , simpleChar 'N' `useKey` viSearchHist Forward [] + , simpleKey KillLine `useKey` (noArg >=> killAndStoreC (SimpleMove moveToStart)) ] replaceOnce :: InputCmd CommandMode CommandMode @@ -166,11 +166,11 @@ pureMovements = choiceCmd $ charMovements ++ map mkSimpleCommand movements useMovementsForKill :: Command m s t -> (KillHelper -> Command m s t) -> KeyCommand m s t useMovementsForKill alternate useHelper = choiceCmd $ specialCases - ++ map (\(k,move) -> k +> useHelper (SimpleMove move)) movements + ++ map (\(k,move) -> k `useKey` useHelper (SimpleMove move)) movements where - specialCases = [ simpleChar 'e' +> useHelper (SimpleMove goToWordDelEnd) - , simpleChar 'E' +> useHelper (SimpleMove goToBigWordDelEnd) - , simpleChar '%' +> useHelper (GenericKill deleteMatchingBrace) + specialCases = [ simpleChar 'e' `useKey` useHelper (SimpleMove goToWordDelEnd) + , simpleChar 'E' `useKey` useHelper (SimpleMove goToBigWordDelEnd) + , simpleChar '%' `useKey` useHelper (GenericKill deleteMatchingBrace) -- Note 't' and 'f' behave differently than in pureMovements. , charMovement 'f' $ \c -> goRightUntil $ afterChar (==c) , charMovement 'F' $ \c -> goLeftUntil $ overChar (==c) @@ -186,21 +186,21 @@ repeatableCommands :: InputKeyCmd (ArgMode CommandMode) EitherMode repeatableCommands = choiceCmd [ repeatableCmdToIMode , repeatableCmdMode >+> return . Left - , simpleChar '.' +> saveForUndo >=> runLastCommand + , simpleChar '.' `useKey` (saveForUndo >=> runLastCommand) ] where - runLastCommand s = liftM lastCommand get >>= ($ s) + runLastCommand s = fmap lastCommand get >>= ($ s) repeatableCmdMode :: InputKeyCmd (ArgMode CommandMode) CommandMode repeatableCmdMode = choiceCmd - [ simpleChar 'x' +> repeatableChange deleteChar - , simpleChar 'X' +> repeatableChange (withCommandMode deletePrev) - , simpleChar '~' +> repeatableChange (goRight . flipCase) - , simpleChar 'p' +> storedCmdAction (pasteCommand pasteGraphemesAfter) - , simpleChar 'P' +> storedCmdAction (pasteCommand pasteGraphemesBefore) - , simpleChar 'd' +> deletionCmd - , simpleChar 'y' +> yankCommand - , ctrlChar 'w' +> killAndStoreCmd wordErase + [ simpleChar 'x' `useKey` repeatableChange deleteChar + , simpleChar 'X' `useKey` repeatableChange (withCommandMode deletePrev) + , simpleChar '~' `useKey` repeatableChange (goRight . flipCase) + , simpleChar 'p' `useKey` storedCmdAction (pasteCommand pasteGraphemesAfter) + , simpleChar 'P' `useKey` storedCmdAction (pasteCommand pasteGraphemesBefore) + , simpleChar 'd' `useKey` deletionCmd + , simpleChar 'y' `useKey` yankCommand + , ctrlChar 'w' `useKey` killAndStoreC wordErase , pureMovements ] where @@ -214,25 +214,25 @@ flipCase (CMode xs y zs) = CMode xs (modifyBaseChar flipCaseG y) zs | otherwise = toLower c repeatableCmdToIMode :: InputKeyCmd (ArgMode CommandMode) EitherMode -repeatableCmdToIMode = simpleChar 'c' +> deletionToInsertCmd +repeatableCmdToIMode = simpleChar 'c' `useKey` deletionToInsertCmd deletionCmd :: InputCmd (ArgMode CommandMode) CommandMode deletionCmd = keyChoiceCmd [ reinputArg >+> deletionCmd - , simpleChar 'd' +> killAndStoreCmd killAll - , useMovementsForKill (change argState) killAndStoreCmd + , simpleChar 'd' `useKey` killAndStoreC killAll + , useMovementsForKill (change argState) killAndStoreC , withoutConsuming (change argState) ] deletionToInsertCmd :: InputCmd (ArgMode CommandMode) EitherMode deletionToInsertCmd = keyChoiceCmd [ reinputArg >+> deletionToInsertCmd - , simpleChar 'c' +> killAndStoreIE killAll + , simpleChar 'c' `useKey` killAndStoreE killAll -- vim, for whatever reason, treats cw same as ce and cW same as cE. -- readline does this too, so we should also. - , simpleChar 'w' +> killAndStoreIE (SimpleMove goToWordDelEnd) - , simpleChar 'W' +> killAndStoreIE (SimpleMove goToBigWordDelEnd) - , useMovementsForKill (liftM Left . change argState) killAndStoreIE + , simpleChar 'w' `useKey` killAndStoreE (SimpleMove goToWordDelEnd) + , simpleChar 'W' `useKey` killAndStoreE (SimpleMove goToBigWordDelEnd) + , useMovementsForKill (fmap Left . change argState) killAndStoreE , withoutConsuming (return . Left . argState) ] @@ -240,12 +240,10 @@ deletionToInsertCmd = keyChoiceCmd yankCommand :: InputCmd (ArgMode CommandMode) CommandMode yankCommand = keyChoiceCmd [ reinputArg >+> yankCommand - , simpleChar 'y' +> copyAndStore killAll + , simpleChar 'y' `useKey` copyAndStore killAll , useMovementsForKill (change argState) copyAndStore , withoutConsuming (change argState) ] - where - copyAndStore = storedCmdAction . copyFromArgHelper reinputArg :: LineState s => InputKeyCmd (ArgMode s) (ArgMode s) reinputArg = foreachDigit restartArg ['1'..'9'] >+> loop @@ -302,12 +300,12 @@ isWordChar = isAlphaNum .||. (=='_') isOtherChar = not . (isSpace .||. isWordChar) (.||.) :: (a -> Bool) -> (a -> Bool) -> a -> Bool -(f .||. g) x = f x || g x +(.||.) = liftM2 (||) foreachDigit :: (Monad m, LineState t) => (Int -> s -> t) -> [Char] -> KeyCommand m s t foreachDigit f ds = choiceCmd $ map digitCmd ds - where digitCmd d = simpleChar d +> change (f (toDigit d)) + where digitCmd d = simpleChar d `useKey` change (f (toDigit d)) toDigit d = fromEnum d - fromEnum '0' @@ -363,8 +361,8 @@ replaceLoop = saveForUndo >=> change insertFromCommandMode >=> loop where loop = try (oneReplaceCmd >+> loop) oneReplaceCmd = choiceCmd [ - simpleKey LeftKey +> change goLeft - , simpleKey RightKey +> change goRight + simpleKey LeftKey `useKey` change goLeft + , simpleKey RightKey `useKey` change goRight , changeFromChar replaceCharIM ] @@ -382,20 +380,23 @@ storedAction act = storeLastCmd act >=> act storedCmdAction :: Monad m => Command (ViT m) (ArgMode CommandMode) CommandMode -> Command (ViT m) (ArgMode CommandMode) CommandMode -storedCmdAction act = storeLastCmd (liftM Left . act) >=> act +storedCmdAction act = storeLastCmd (fmap Left . act) >=> act storedIAction :: Monad m => Command (ViT m) (ArgMode CommandMode) InsertMode -> Command (ViT m) (ArgMode CommandMode) InsertMode -storedIAction act = storeLastCmd (liftM Right . act) >=> act +storedIAction act = storeLastCmd (fmap Right . act) >=> act -killAndStoreCmd :: MonadIO m => KillHelper -> Command (ViT m) (ArgMode CommandMode) CommandMode -killAndStoreCmd = storedCmdAction . killFromArgHelper +killAndStoreC :: MonadIO m => KillHelper -> Command (ViT m) (ArgMode CommandMode) CommandMode +killAndStoreC = storedCmdAction . killFromArgHelper killAndStoreI :: MonadIO m => KillHelper -> Command (ViT m) (ArgMode CommandMode) InsertMode killAndStoreI = storedIAction . killFromArgHelper -killAndStoreIE :: MonadIO m => KillHelper -> Command (ViT m) (ArgMode CommandMode) EitherMode -killAndStoreIE helper = storedAction (killFromArgHelper helper >=> return . Right) +killAndStoreE :: MonadIO m => KillHelper -> Command (ViT m) (ArgMode CommandMode) EitherMode +killAndStoreE helper = storedAction (killFromArgHelper helper >=> return . Right) + +copyAndStore :: MonadIO m => KillHelper -> Command (ViT m) (ArgMode CommandMode) CommandMode +copyAndStore = storedCmdAction . copyFromArgHelper noArg :: Monad m => Command m s (ArgMode s) noArg = return . startArg 1 @@ -423,15 +424,15 @@ viEnterSearch c dir s = setState (SearchEntry emptyIM c) >>= loopEntry modifySE f se = se {entryState = f (entryState se)} loopEntry = keyChoiceCmd [ editEntry >+> loopEntry - , simpleChar '\n' +> \se -> viSearchHist dir (searchText se) s + , simpleChar '\n' `useKey` \se -> viSearchHist dir (searchText se) s , withoutConsuming (change (const s)) ] editEntry = choiceCmd [ useChar (change . modifySE . insertChar) - , simpleKey LeftKey +> change (modifySE goLeft) - , simpleKey RightKey +> change (modifySE goRight) - , simpleKey Backspace +> change (modifySE deletePrev) - , simpleKey Delete +> change (modifySE deleteNext) + , simpleKey LeftKey `useKey` change (modifySE goLeft) + , simpleKey RightKey `useKey` change (modifySE goRight) + , simpleKey Backspace `useKey` change (modifySE deletePrev) + , simpleKey Delete `useKey` change (modifySE deleteNext) ] viSearchHist :: forall m . Monad m From 20ca01306a98eacca4c1a57ea323bbeef6da075a Mon Sep 17 00:00:00 2001 From: Enrico Maria De Angelis Date: Wed, 3 Sep 2025 20:55:01 +0100 Subject: [PATCH 3/4] Refactor f/t/F/T and enable ; and , Addressing issue #60. Reimplemented f/F/t/T, and added ;/, beside them. f/t/F/T store the searched-for characeter even when they are used for d/c/y commands, so ; and , behave accordingly in that case too. I'm using `baseGrapheme` out of its defining module, which the original author discouraged. This should be carefully reviewed. Not what's left is some thorough review and hopefully some cleanup. --- System/Console/Haskeline/LineState.hs | 3 +- System/Console/Haskeline/Vi.hs | 104 +++++++++++++++++++------- 2 files changed, 79 insertions(+), 28 deletions(-) diff --git a/System/Console/Haskeline/LineState.hs b/System/Console/Haskeline/LineState.hs index 00194384..969b08ae 100644 --- a/System/Console/Haskeline/LineState.hs +++ b/System/Console/Haskeline/LineState.hs @@ -5,6 +5,7 @@ module System.Console.Haskeline.LineState( -- * Graphemes Grapheme(), baseChar, + baseGrapheme, -- XXX The author says no! stringToGraphemes, graphemesToString, modifyBaseChar, @@ -74,7 +75,7 @@ import Data.Char -- can represent one grapheme; for example, an @a@ followed by the diacritic @\'\\768\'@ should -- be treated as one unit. data Grapheme = Grapheme {gBaseChar :: Char, - combiningChars :: [Char]} + combiningChars :: [Char]} deriving Eq instance Show Grapheme where diff --git a/System/Console/Haskeline/Vi.hs b/System/Console/Haskeline/Vi.hs index b8c13a54..188e1a51 100644 --- a/System/Console/Haskeline/Vi.hs +++ b/System/Console/Haskeline/Vi.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} #if __GLASGOW_HASKELL__ < 802 {-# OPTIONS_GHC -Wno-redundant-constraints #-} #endif @@ -21,15 +22,20 @@ type EitherMode = Either CommandMode InsertMode type SavedCommand m = Command (ViT m) (ArgMode CommandMode) EitherMode +data InlineSearch = F -- f | F + | T -- t | T + data ViState m = ViState { lastCommand :: SavedCommand m, - lastSearch :: [Grapheme] + lastSearch :: [Grapheme], + lastInlineSearch :: Maybe (Char, InlineSearch, Direction) } emptyViState :: Monad m => ViState m emptyViState = ViState { lastCommand = return . Left . argState, - lastSearch = [] + lastSearch = [], + lastInlineSearch = Nothing } type ViT m = StateT (ViState m) (InputCmdT m) @@ -134,6 +140,40 @@ simpleCmdActions = choiceCmd [ , simpleKey KillLine `useKey` (noArg >=> killAndStoreC (SimpleMove moveToStart)) ] +inlineSearchActions :: InputKeyCmd (ArgMode CommandMode) CommandMode +inlineSearchActions = choiceCmd + [ simpleChar 'f' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Forward c >>=) . viInlineSearch id) + , simpleChar 'F' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Reverse c >>=) . viInlineSearch id) + , simpleChar 't' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Forward c >>=) . viInlineSearch id) + , simpleChar 'T' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Reverse c >>=) . viInlineSearch id) + , simpleChar ';' `useKey` ((getLastInlineSearch >>=) . viInlineSearch id) + , simpleChar ',' `useKey` ((getLastInlineSearch >>=) . viInlineSearch flipDir) + ] + +viInlineSearch :: Monad m => (Direction -> Direction) + -> ArgMode CommandMode + -> (Maybe (Char, InlineSearch, Direction)) + -> CmdM (ViT m) CommandMode +viInlineSearch flipdir = \s -> \case + Nothing -> return $ argState s + Just (g, fOrT, dir) -> setState $ (applyArg . withCommandMode . search fOrT (flipdir dir)) (== g) s + where + search :: InlineSearch -> Direction -> (Char -> Bool) -> InsertMode -> InsertMode + search F Forward = goRightUntil . overChar + search F Reverse = goLeftUntil . overChar + search T Forward = goRightUntil . beforeChar + search T Reverse = goLeftUntil . afterChar + +getLastInlineSearch :: forall m. Monad m => CmdM (ViT m) (Maybe (Char, InlineSearch, Direction)) +getLastInlineSearch = lastInlineSearch <$> (get :: CmdM (ViT m) (ViState m)) -- TODO: ideally this is a usage of `gets` + +saveInlineSearch :: forall m. Monad m => InlineSearch -> Direction -> Char + -> CmdM (ViT m) (Maybe (Char, InlineSearch, Direction)) +saveInlineSearch fOrT dir char + = do let ret = Just (char, fOrT, dir) + modify $ \(vs :: ViState m) -> vs {lastInlineSearch = ret} + return ret + replaceOnce :: InputCmd CommandMode CommandMode replaceOnce = try $ changeFromChar replaceChar @@ -150,37 +190,38 @@ repeatedCommands = choiceCmd [argumented, doBefore noArg repeatableCommands] ] pureMovements :: InputKeyCmd (ArgMode CommandMode) CommandMode -pureMovements = choiceCmd $ charMovements ++ map mkSimpleCommand movements +pureMovements = choiceCmd $ map mkSimpleCommand movements where - charMovements = [ charMovement 'f' $ \c -> goRightUntil $ overChar (==c) - , charMovement 'F' $ \c -> goLeftUntil $ overChar (==c) - , charMovement 't' $ \c -> goRightUntil $ beforeChar (==c) - , charMovement 'T' $ \c -> goLeftUntil $ afterChar (==c) - ] - mkSimpleCommand (k,move) = k +> change (applyCmdArg move) - charMovement c move = simpleChar c +> keyChoiceCmd [ - useChar (change . applyCmdArg . move) - , withoutConsuming (change argState) - ] - -useMovementsForKill :: Command m s t -> (KillHelper -> Command m s t) -> KeyCommand m s t -useMovementsForKill alternate useHelper = choiceCmd $ + mkSimpleCommand (k, move) = k `useKey` change (applyCmdArg move) + +useMovementsForKill :: (KillHelper -> Command m s t) -> KeyCommand m s t +useMovementsForKill useHelper = choiceCmd $ specialCases ++ map (\(k,move) -> k `useKey` useHelper (SimpleMove move)) movements where specialCases = [ simpleChar 'e' `useKey` useHelper (SimpleMove goToWordDelEnd) , simpleChar 'E' `useKey` useHelper (SimpleMove goToBigWordDelEnd) , simpleChar '%' `useKey` useHelper (GenericKill deleteMatchingBrace) - -- Note 't' and 'f' behave differently than in pureMovements. - , charMovement 'f' $ \c -> goRightUntil $ afterChar (==c) - , charMovement 'F' $ \c -> goLeftUntil $ overChar (==c) - , charMovement 't' $ \c -> goRightUntil $ overChar (==c) - , charMovement 'T' $ \c -> goLeftUntil $ afterChar (==c) ] - charMovement c move = simpleChar c +> keyChoiceCmd [ - useChar (useHelper . SimpleMove . move) - , withoutConsuming alternate] +useInlineSearchForKill :: Monad m => Command (ViT m) s t -> (KillHelper -> Command (ViT m) s t) -> KeyMap (Command (ViT m) s t) +useInlineSearchForKill alternate killCmd = choiceCmd + [ simpleChar 'f' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Forward c >>=) . getSearchAndKill) + , simpleChar 'F' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Reverse c >>=) . getSearchAndKill) + , simpleChar 't' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Forward c >>=) . getSearchAndKill) + , simpleChar 'T' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Reverse c >>=) . getSearchAndKill) + , simpleChar ';' `useKey` ((getLastInlineSearch >>=) . getSearchAndKill) + , simpleChar ',' `useKey` ((reverseDir <$> getLastInlineSearch >>=) . getSearchAndKill) + ] + where + getSearchAndKill = \s + -> \case (Just (g, fOrT, forOrRev)) -> killCmd (SimpleMove $ moveForKill fOrT forOrRev $ (== g)) s + Nothing -> alternate s + + moveForKill F Forward = goRightUntil . afterChar + moveForKill F Reverse = goLeftUntil . overChar + moveForKill T Forward = goRightUntil . overChar + moveForKill T Reverse = goLeftUntil . afterChar repeatableCommands :: InputKeyCmd (ArgMode CommandMode) EitherMode repeatableCommands = choiceCmd @@ -201,6 +242,7 @@ repeatableCmdMode = choiceCmd , simpleChar 'd' `useKey` deletionCmd , simpleChar 'y' `useKey` yankCommand , ctrlChar 'w' `useKey` killAndStoreC wordErase + , inlineSearchActions , pureMovements ] where @@ -220,7 +262,8 @@ deletionCmd :: InputCmd (ArgMode CommandMode) CommandMode deletionCmd = keyChoiceCmd [ reinputArg >+> deletionCmd , simpleChar 'd' `useKey` killAndStoreC killAll - , useMovementsForKill (change argState) killAndStoreC + , useMovementsForKill killAndStoreC + , useInlineSearchForKill (change argState) killAndStoreC , withoutConsuming (change argState) ] @@ -232,7 +275,8 @@ deletionToInsertCmd = keyChoiceCmd -- readline does this too, so we should also. , simpleChar 'w' `useKey` killAndStoreE (SimpleMove goToWordDelEnd) , simpleChar 'W' `useKey` killAndStoreE (SimpleMove goToBigWordDelEnd) - , useMovementsForKill (fmap Left . change argState) killAndStoreE + , useMovementsForKill killAndStoreE + , useInlineSearchForKill (fmap Left . change argState) killAndStoreE , withoutConsuming (return . Left . argState) ] @@ -241,7 +285,8 @@ yankCommand :: InputCmd (ArgMode CommandMode) CommandMode yankCommand = keyChoiceCmd [ reinputArg >+> yankCommand , simpleChar 'y' `useKey` copyAndStore killAll - , useMovementsForKill (change argState) copyAndStore + , useMovementsForKill copyAndStore + , useInlineSearchForKill (change argState) copyAndStore , withoutConsuming (change argState) ] @@ -451,3 +496,8 @@ viSearchHist dir toSearch cm = do Right sm -> do put vstate {lastSearch = toSearch'} setState (restore (foundHistory sm)) + +reverseDir :: Maybe (a, b, Direction) -> Maybe (a, b, Direction) +reverseDir = (third3 flipDir <$>) + where + third3 f (a, b, c) = (a, b, f c) From 5a2f61f584ae5b198fd36aa2c65f7e7cdfa4f8d0 Mon Sep 17 00:00:00 2001 From: Enrico Maria De Angelis Date: Tue, 9 Sep 2025 08:43:27 +0100 Subject: [PATCH 4/4] Update Changelog --- Changelog | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/Changelog b/Changelog index 04f21190..daafb9c9 100644 --- a/Changelog +++ b/Changelog @@ -1,4 +1,9 @@ -Unreleased changes: +Changed in version 0.8.4.1: + + * Implemented ; and , movements and enabled them for d, c, and y actions. + + * Internal refactoring of f, F, t, T commands to allow implementation of ; + and , commands. Changed in version 0.8.4.0: @@ -43,6 +48,7 @@ Changed in version 0.8.1.0: Changed in version 0.8.0.1: * Add a Cabal flag to disable the example executable as well as the test that uses it. + Changed in version 0.8.0.0: * Breaking changes: * Add a `MonadFail` instance for `InputT`.