haskeline 0.8.4.0 → 0.8.4.1
raw patch · 8 files changed
+243/−178 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Changelog +8/−0
- System/Console/Haskeline/Command.hs +14/−9
- System/Console/Haskeline/Command/History.hs +10/−6
- System/Console/Haskeline/Command/KillRing.hs +10/−10
- System/Console/Haskeline/Command/Undo.hs +2/−3
- System/Console/Haskeline/LineState.hs +15/−16
- System/Console/Haskeline/Vi.hs +183/−133
- haskeline.cabal +1/−1
Changelog view
@@ -1,3 +1,10 @@+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: * On Windows, when terminal-style and printing output, no longer skips@@ -41,6 +48,7 @@ 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 view
@@ -1,7 +1,7 @@ module System.Console.Haskeline.Command( -- * Commands Effect(..),- KeyMap(..), + KeyMap(..), CmdM(..), Command, KeyCommand,@@ -20,10 +20,12 @@ change, changeFromChar, (+>),+ useKey, useChar, choiceCmd, keyChoiceCmd, keyChoiceCmdM,+ doAfter, doBefore ) where @@ -34,9 +36,9 @@ 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 @@ -- 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 @@ 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 @@ 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 view
@@ -17,7 +17,7 @@ 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 @@ 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 @@ 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 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 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 view
@@ -38,17 +38,17 @@ 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 @@ -56,37 +56,37 @@ 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 view
@@ -19,7 +19,7 @@ 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 @@ 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 @@ 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 view
@@ -74,7 +74,7 @@ -- 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 +163,7 @@ 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 @@ 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 = 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 @@ 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 (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 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 @@ 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 @@ 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)
System/Console/Haskeline/Vi.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} #if __GLASGOW_HASKELL__ < 802 {-# OPTIONS_GHC -Wno-redundant-constraints #-} #endif@@ -14,22 +15,27 @@ 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 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)@@ -38,12 +44,11 @@ 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- , ctrlChar 'd' +> eofIfEmpty+viKeyCommands = choiceCmd+ [ 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)@@ -51,34 +56,35 @@ 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 `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' `useKey` clearScreenCmd+ , simpleKey UpKey `useKey` historyBack+ , simpleKey DownKey `useKey` historyForward+ , simpleKey SearchReverse `useKey` searchForPrefix Reverse+ , simpleKey SearchForward `useKey` searchForPrefix Forward+ , searchHistory+ , simpleKey KillLine `useKey` killFromHelper (SimpleMove moveToStart)+ , ctrlChar 'w' `useKey` 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)@@ -89,8 +95,8 @@ 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@@ -101,39 +107,73 @@ chooseEitherMode (Right im) = viCommands im 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)+exitingCommands = choiceCmd [+ 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)) ] +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,57 +190,59 @@ ] 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)- ]+ mkSimpleCommand (k, move) = k `useKey` change (applyCmdArg move) -useMovementsForKill :: Command m s t -> (KillHelper -> Command m s t) -> KeyCommand m s t-useMovementsForKill alternate useHelper = choiceCmd $+useMovementsForKill :: (KillHelper -> Command m s t) -> KeyCommand m s t+useMovementsForKill 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)- -- 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)+ specialCases = [ simpleChar 'e' `useKey` useHelper (SimpleMove goToWordDelEnd)+ , simpleChar 'E' `useKey` useHelper (SimpleMove goToBigWordDelEnd)+ , simpleChar '%' `useKey` useHelper (GenericKill deleteMatchingBrace) ]- 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 [ 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+ , inlineSearchActions , pureMovements ] where@@ -214,38 +256,39 @@ | 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- , withoutConsuming (change argState)- ]+ [ reinputArg >+> deletionCmd+ , simpleChar 'd' `useKey` killAndStoreC killAll+ , useMovementsForKill killAndStoreC+ , useInlineSearchForKill (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 killAndStoreE+ , useInlineSearchForKill (fmap Left . change argState) killAndStoreE , withoutConsuming (return . Left . argState) ] yankCommand :: InputCmd (ArgMode CommandMode) CommandMode yankCommand = keyChoiceCmd- [ reinputArg >+> yankCommand- , simpleChar 'y' +> copyAndStore killAll- , useMovementsForKill (change argState) copyAndStore- , withoutConsuming (change argState)- ]- where- copyAndStore = storedCmdAction . copyFromArgHelper+ [ reinputArg >+> yankCommand+ , simpleChar 'y' `useKey` copyAndStore killAll+ , useMovementsForKill copyAndStore+ , useInlineSearchForKill (change argState) copyAndStore+ , withoutConsuming (change argState)+ ] reinputArg :: LineState s => InputKeyCmd (ArgMode s) (ArgMode s) reinputArg = foreachDigit restartArg ['1'..'9'] >+> loop@@ -262,7 +305,7 @@ goToBigWordDelEnd = goRightUntil $ atStart (not . isBigWordChar) -movements :: [(Key,InsertMode -> InsertMode)]+movements :: [(Key, InsertMode -> InsertMode)] movements = [ (simpleChar 'h', goLeft) , (simpleChar 'l', goRight) , (simpleChar ' ', goRight)@@ -302,12 +345,12 @@ 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 +406,8 @@ 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 ] @@ -381,22 +424,25 @@ 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+ -> Command (ViT m) (ArgMode CommandMode) CommandMode+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+ -> Command (ViT m) (ArgMode CommandMode) InsertMode+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 @@ -421,18 +467,17 @@ 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' `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)+ editEntry = choiceCmd+ [ useChar (change . modifySE . insertChar)+ , 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@@ -451,3 +496,8 @@ 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)
haskeline.cabal view
@@ -1,6 +1,6 @@ Name: haskeline Cabal-Version: >=1.10-Version: 0.8.4.0+Version: 0.8.4.1 Category: User Interfaces License: BSD3 License-File: LICENSE