Implementation of ; and , for vi editing mode (#207)

Author: Aster89

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

System/Console/Haskeline/Command.hs

@@ -1,7 +1,7 @@
 module System.Console.Haskeline.Command(
                         -- * Commands
                         Effect(..),
-                        KeyMap(..), 
+                        KeyMap(..),
                         CmdM(..),
                         Command,
                         KeyCommand,
@@ -20,10 +20,12 @@ module System.Console.Haskeline.Command(
                         change,
                         changeFromChar,
                         (+>),
+                        useKey,
                         useChar,
                         choiceCmd,
                         keyChoiceCmd,
                         keyChoiceCmdM,
+                        doAfter,
                         doBefore
                         ) where
 
@@ -34,9 +36,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 +93,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
 
@@ -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 >=>)

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],
@@ -84,13 +84,17 @@ 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"
 
 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 +109,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)
 

System/Console/Haskeline/Command/KillRing.hs

@@ -38,55 +38,55 @@ 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
             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
 
 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)

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,12 +39,11 @@ 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
 
 commandUndo, commandRedo :: (MonadState Undo m, Save s) => Command m s s
 commandUndo = simpleCommand $ liftM Right . update . undoPast
 commandRedo = simpleCommand $ liftM Right . update . redoFuture
-

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
@@ -163,7 +164,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 +182,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 +195,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 +204,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 +213,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 +327,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 +343,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 +407,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)