Skip to content

Commit ed961ad

Browse files
Aster89Aster89
committed
Refactor f/t/F/T and enable ; and ,
 Addressing issue #60. Reimplemented <kbd>f</kbd>/<kbd>F</kbd>/<kbd>t</kbd>/<kbd>T</kbd>, and added <kbd>;</kbd>/<kbd>,</kbd> 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.
1 parent 2976f43 commit ed961ad

File tree

2 files changed

+79
-27
lines changed

2 files changed

+79
-27
lines changed

‎System/Console/Haskeline/LineState.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ module System.Console.Haskeline.LineState(
55
-- * Graphemes
66
Grapheme(),
77
baseChar,
8+
baseGrapheme, -- XXX The author says no!
89
stringToGraphemes,
910
graphemesToString,
1011
modifyBaseChar,

‎System/Console/Haskeline/Vi.hs‎

Lines changed: 78 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE LambdaCase #-}
12
#if __GLASGOW_HASKELL__ < 802
23
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
34
#endif
@@ -21,15 +22,20 @@ type EitherMode = Either CommandMode InsertMode
2122

2223
type SavedCommand m = Command (ViT m) (ArgMode CommandMode) EitherMode
2324

25+
data InlineSearch = F -- f | F
26+
| T -- t | T
27+
2428
data ViState m = ViState {
2529
lastCommand :: SavedCommand m,
26-
lastSearch :: [Grapheme]
30+
lastSearch :: [Grapheme],
31+
lastInlineSearch :: Maybe (Grapheme, InlineSearch, Direction)
2732
}
2833

2934
emptyViState :: Monad m => ViState m
3035
emptyViState = ViState {
3136
lastCommand = return . Left . argState,
32-
lastSearch = []
37+
lastSearch = [],
38+
lastInlineSearch = Nothing
3339
}
3440

3541
type ViT m = StateT (ViState m) (InputCmdT m)
@@ -134,6 +140,43 @@ simpleCmdActions = choiceCmd [
134140
, simpleKey KillLine `useKey` (noArg >=> killAndStoreC (SimpleMove moveToStart))
135141
]
136142

143+
inlineSearchActions :: InputKeyCmd (ArgMode CommandMode) CommandMode
144+
inlineSearchActions = choiceCmd
145+
[ simpleChar 'f' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Forward c >>=) . viInlineSearch id)
146+
, simpleChar 'F' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Reverse c >>=) . viInlineSearch id)
147+
, simpleChar 't' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Forward c >>=) . viInlineSearch id)
148+
, simpleChar 'T' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Reverse c >>=) . viInlineSearch id)
149+
, simpleChar ';' `useKey` ((getLastInlineSearch >>=) . viInlineSearch id)
150+
, simpleChar ',' `useKey` ((getLastInlineSearch >>=) . viInlineSearch flipDir)
151+
]
152+
153+
viInlineSearch :: forall m. Monad m => (Direction -> Direction)
154+
-> ArgMode CommandMode
155+
-> (Maybe (Grapheme, InlineSearch, Direction))
156+
-> CmdM (ViT m) CommandMode
157+
viInlineSearch flipdir = \s -> \case
158+
Nothing -> return $ argState s
159+
Just (g, fOrT, dir) -> setState $ search fOrT (flipdir dir) (== baseChar g) s
160+
where
161+
search :: InlineSearch -> Direction -> (Char -> Bool) -> (ArgMode CommandMode) -> CommandMode
162+
search F Forward = applyArgToInsMode . goRightUntil . overChar
163+
search F Reverse = applyArgToInsMode . goLeftUntil . overChar
164+
search T Forward = applyArgToInsMode . goRightUntil . beforeChar
165+
search T Reverse = applyArgToInsMode . goLeftUntil . afterChar
166+
applyArgToInsMode = applyArg . withCommandMode
167+
168+
getLastInlineSearch :: forall m. Monad m => CmdM (ViT m) (Maybe (Grapheme, InlineSearch, Direction))
169+
getLastInlineSearch = do
170+
(vs :: ViState m) <- get -- TODO: ideally this is a usage of `gets`
171+
return $ lastInlineSearch vs
172+
173+
saveInlineSearch :: forall m. Monad m => InlineSearch -> Direction -> Char
174+
-> CmdM (ViT m) (Maybe (Grapheme, InlineSearch, Direction))
175+
saveInlineSearch fOrT dir char
176+
= do let ret = Just (baseGrapheme char, fOrT, dir)
177+
modify $ \(vs :: ViState m) -> vs {lastInlineSearch = ret}
178+
return ret
179+
137180
replaceOnce :: InputCmd CommandMode CommandMode
138181
replaceOnce = try $ changeFromChar replaceChar
139182

@@ -150,37 +193,38 @@ repeatedCommands = choiceCmd [argumented, doBefore noArg repeatableCommands]
150193
]
151194

152195
pureMovements :: InputKeyCmd (ArgMode CommandMode) CommandMode
153-
pureMovements = choiceCmd $ charMovements ++ map mkSimpleCommand movements
196+
pureMovements = choiceCmd $ map mkSimpleCommand movements
154197
where
155-
charMovements = [ charMovement 'f' $ \c -> goRightUntil $ overChar (==c)
156-
, charMovement 'F' $ \c -> goLeftUntil $ overChar (==c)
157-
, charMovement 't' $ \c -> goRightUntil $ beforeChar (==c)
158-
, charMovement 'T' $ \c -> goLeftUntil $ afterChar (==c)
159-
]
160-
mkSimpleCommand (k,move) = k +> change (applyCmdArg move)
161-
charMovement c move = simpleChar c +> keyChoiceCmd [
162-
useChar (change . applyCmdArg . move)
163-
, withoutConsuming (change argState)
164-
]
165-
166-
useMovementsForKill :: Command m s t -> (KillHelper -> Command m s t) -> KeyCommand m s t
167-
useMovementsForKill alternate useHelper = choiceCmd $
198+
mkSimpleCommand (k, move) = k `useKey` change (applyCmdArg move)
199+
200+
useMovementsForKill :: (KillHelper -> Command m s t) -> KeyCommand m s t
201+
useMovementsForKill useHelper = choiceCmd $
168202
specialCases
169203
++ map (\(k,move) -> k `useKey` useHelper (SimpleMove move)) movements
170204
where
171205
specialCases = [ simpleChar 'e' `useKey` useHelper (SimpleMove goToWordDelEnd)
172206
, simpleChar 'E' `useKey` useHelper (SimpleMove goToBigWordDelEnd)
173207
, simpleChar '%' `useKey` useHelper (GenericKill deleteMatchingBrace)
174-
-- Note 't' and 'f' behave differently than in pureMovements.
175-
, charMovement 'f' $ \c -> goRightUntil $ afterChar (==c)
176-
, charMovement 'F' $ \c -> goLeftUntil $ overChar (==c)
177-
, charMovement 't' $ \c -> goRightUntil $ overChar (==c)
178-
, charMovement 'T' $ \c -> goLeftUntil $ afterChar (==c)
179208
]
180-
charMovement c move = simpleChar c +> keyChoiceCmd [
181-
useChar (useHelper . SimpleMove . move)
182-
, withoutConsuming alternate]
183209

210+
useInlineSearchForKill :: Monad m => Command (ViT m) s t -> (KillHelper -> Command (ViT m) s t) -> KeyMap (Command (ViT m) s t)
211+
useInlineSearchForKill alternate killCmd = choiceCmd
212+
[ simpleChar 'f' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Forward c >>=) . getSearchAndKill)
213+
, simpleChar 'F' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch F Reverse c >>=) . getSearchAndKill)
214+
, simpleChar 't' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Forward c >>=) . getSearchAndKill)
215+
, simpleChar 'T' `useKey` keyCommand (useChar $ \c -> (saveInlineSearch T Reverse c >>=) . getSearchAndKill)
216+
, simpleChar ';' `useKey` ((getLastInlineSearch >>=) . getSearchAndKill)
217+
, simpleChar ',' `useKey` ((reverseDir <$> getLastInlineSearch >>=) . getSearchAndKill)
218+
]
219+
where
220+
getSearchAndKill = \s
221+
-> \case (Just (g, fOrT, forOrRev)) -> killCmd (SimpleMove $ moveForKill fOrT forOrRev $ (== baseChar g)) s
222+
Nothing -> alternate s
223+
224+
moveForKill F Forward = goRightUntil . afterChar
225+
moveForKill F Reverse = goLeftUntil . overChar
226+
moveForKill T Forward = goRightUntil . overChar
227+
moveForKill T Reverse = goLeftUntil . afterChar
184228

185229
repeatableCommands :: InputKeyCmd (ArgMode CommandMode) EitherMode
186230
repeatableCommands = choiceCmd
@@ -201,6 +245,7 @@ repeatableCmdMode = choiceCmd
201245
, simpleChar 'd' `useKey` deletionCmd
202246
, simpleChar 'y' `useKey` yankCommand
203247
, ctrlChar 'w' `useKey` killAndStoreC wordErase
248+
, inlineSearchActions
204249
, pureMovements
205250
]
206251
where
@@ -220,7 +265,8 @@ deletionCmd :: InputCmd (ArgMode CommandMode) CommandMode
220265
deletionCmd = keyChoiceCmd
221266
[ reinputArg >+> deletionCmd
222267
, simpleChar 'd' `useKey` killAndStoreC killAll
223-
, useMovementsForKill (change argState) killAndStoreC
268+
, useMovementsForKill killAndStoreC
269+
, useInlineSearchForKill (change argState) killAndStoreC
224270
, withoutConsuming (change argState)
225271
]
226272

@@ -232,7 +278,8 @@ deletionToInsertCmd = keyChoiceCmd
232278
-- readline does this too, so we should also.
233279
, simpleChar 'w' `useKey` killAndStoreE (SimpleMove goToWordDelEnd)
234280
, simpleChar 'W' `useKey` killAndStoreE (SimpleMove goToBigWordDelEnd)
235-
, useMovementsForKill (fmap Left . change argState) killAndStoreE
281+
, useMovementsForKill killAndStoreE
282+
, useInlineSearchForKill (fmap Left . change argState) killAndStoreE
236283
, withoutConsuming (return . Left . argState)
237284
]
238285

@@ -241,7 +288,8 @@ yankCommand :: InputCmd (ArgMode CommandMode) CommandMode
241288
yankCommand = keyChoiceCmd
242289
[ reinputArg >+> yankCommand
243290
, simpleChar 'y' `useKey` copyAndStore killAll
244-
, useMovementsForKill (change argState) copyAndStore
291+
, useMovementsForKill copyAndStore
292+
, useInlineSearchForKill (change argState) copyAndStore
245293
, withoutConsuming (change argState)
246294
]
247295

@@ -451,3 +499,6 @@ viSearchHist dir toSearch cm = do
451499
Right sm -> do
452500
put vstate {lastSearch = toSearch'}
453501
setState (restore (foundHistory sm))
502+
503+
reverseDir :: Maybe (a, b, Direction) -> Maybe (a, b, Direction)
504+
reverseDir = (fmap . fmap) flipDir

0 commit comments

Comments
 (0)