Skip to content

Commit c7d0a7c

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 c7d0a7c

File tree

2 files changed

+77
-27
lines changed

2 files changed

+77
-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: 76 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,36 @@ 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, F, Forward)) -> killCmd (SimpleMove $ goRightUntil $ afterChar (== baseChar g)) s
222+
(Just (g, F, Reverse)) -> killCmd (SimpleMove $ goLeftUntil $ overChar (== baseChar g)) s
223+
(Just (g, T, Forward)) -> killCmd (SimpleMove $ goRightUntil $ overChar (== baseChar g)) s
224+
(Just (g, T, Reverse)) -> killCmd (SimpleMove $ goLeftUntil $ afterChar (== baseChar g)) s
225+
Nothing -> alternate s
184226

185227
repeatableCommands :: InputKeyCmd (ArgMode CommandMode) EitherMode
186228
repeatableCommands = choiceCmd
@@ -201,6 +243,7 @@ repeatableCmdMode = choiceCmd
201243
, simpleChar 'd' `useKey` deletionCmd
202244
, simpleChar 'y' `useKey` yankCommand
203245
, ctrlChar 'w' `useKey` killAndStoreC wordErase
246+
, inlineSearchActions
204247
, pureMovements
205248
]
206249
where
@@ -220,7 +263,8 @@ deletionCmd :: InputCmd (ArgMode CommandMode) CommandMode
220263
deletionCmd = keyChoiceCmd
221264
[ reinputArg >+> deletionCmd
222265
, simpleChar 'd' `useKey` killAndStoreC killAll
223-
, useMovementsForKill (change argState) killAndStoreC
266+
, useMovementsForKill killAndStoreC
267+
, useInlineSearchForKill (change argState) killAndStoreC
224268
, withoutConsuming (change argState)
225269
]
226270

@@ -232,7 +276,8 @@ deletionToInsertCmd = keyChoiceCmd
232276
-- readline does this too, so we should also.
233277
, simpleChar 'w' `useKey` killAndStoreE (SimpleMove goToWordDelEnd)
234278
, simpleChar 'W' `useKey` killAndStoreE (SimpleMove goToBigWordDelEnd)
235-
, useMovementsForKill (fmap Left . change argState) killAndStoreE
279+
, useMovementsForKill killAndStoreE
280+
, useInlineSearchForKill (fmap Left . change argState) killAndStoreE
236281
, withoutConsuming (return . Left . argState)
237282
]
238283

@@ -241,7 +286,8 @@ yankCommand :: InputCmd (ArgMode CommandMode) CommandMode
241286
yankCommand = keyChoiceCmd
242287
[ reinputArg >+> yankCommand
243288
, simpleChar 'y' `useKey` copyAndStore killAll
244-
, useMovementsForKill (change argState) copyAndStore
289+
, useMovementsForKill copyAndStore
290+
, useInlineSearchForKill (change argState) copyAndStore
245291
, withoutConsuming (change argState)
246292
]
247293

@@ -451,3 +497,6 @@ viSearchHist dir toSearch cm = do
451497
Right sm -> do
452498
put vstate {lastSearch = toSearch'}
453499
setState (restore (foundHistory sm))
500+
501+
reverseDir :: Maybe (a, b, Direction) -> Maybe (a, b, Direction)
502+
reverseDir = (fmap . fmap) flipDir

0 commit comments

Comments
 (0)