{- | This module contains the various datatypes which model the state of the line; that is, the characters displayed and the position of the cursor. -} module System.Console.Haskeline.LineState( -- * Graphemes Grapheme(), baseChar, stringToGraphemes, graphemesToString, modifyBaseChar, mapBaseChars, -- * Line State class LineState(..), Prefix, -- ** Convenience functions for the drawing backends LineChars, lineChars, lengthToEnd, -- ** Supplementary classes Result(..), Save(..), listSave, listRestore, Move(..), -- * Instances -- ** InsertMode InsertMode(..), emptyIM, insertChar, insertString, replaceCharIM, insertGraphemes, deleteNext, deletePrev, skipLeft, skipRight, transposeChars, -- *** Moving to word boundaries goRightUntil, goLeftUntil, atStart, atEnd, beforeChar, afterChar, overChar, -- ** CommandMode CommandMode(..), deleteChar, replaceChar, pasteGraphemesBefore, pasteGraphemesAfter, -- *** Transitioning between modes enterCommandMode, enterCommandModeRight, insertFromCommandMode, appendFromCommandMode, withCommandMode, -- ** ArgMode ArgMode(..), startArg, addNum, applyArg, applyCmdArg, -- ** Other line state types Message(..), Password(..), addPasswordChar, deletePasswordChar, ) where import Data.Char -- | A 'Grapheme' is a fundamental unit of display for the UI. Several characters in sequence -- can represent one grapheme; for example, an @a@ followed by the diacritic @\'\\768\'@ should -- be treated as one unit. data Grapheme = Grapheme {Grapheme -> Char gBaseChar :: Char, Grapheme -> [Char] combiningChars :: [Char]} deriving Grapheme -> Grapheme -> Bool (Grapheme -> Grapheme -> Bool) -> (Grapheme -> Grapheme -> Bool) -> Eq Grapheme forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Grapheme -> Grapheme -> Bool == :: Grapheme -> Grapheme -> Bool $c/= :: Grapheme -> Grapheme -> Bool /= :: Grapheme -> Grapheme -> Bool Eq instance Show Grapheme where show :: Grapheme -> [Char] show Grapheme g = ShowS forall a. Show a => a -> [Char] show (Grapheme -> Char gBaseChar Grapheme g Char -> ShowS forall a. a -> [a] -> [a] : Grapheme -> [Char] combiningChars Grapheme g) baseChar :: Grapheme -> Char baseChar :: Grapheme -> Char baseChar = Grapheme -> Char gBaseChar modifyBaseChar :: (Char -> Char) -> Grapheme -> Grapheme modifyBaseChar :: (Char -> Char) -> Grapheme -> Grapheme modifyBaseChar Char -> Char f Grapheme g = Grapheme g {gBaseChar = f (gBaseChar g)} mapBaseChars :: (Char -> Char) -> [Grapheme] -> [Grapheme] mapBaseChars :: (Char -> Char) -> [Grapheme] -> [Grapheme] mapBaseChars Char -> Char f = (Grapheme -> Grapheme) -> [Grapheme] -> [Grapheme] forall a b. (a -> b) -> [a] -> [b] map ((Char -> Char) -> Grapheme -> Grapheme modifyBaseChar Char -> Char f) -- | Create a 'Grapheme' from a single base character. -- -- NOTE: Careful, don't use outside this module; and inside, make sure this is only -- ever called on non-combining characters. baseGrapheme :: Char -> Grapheme baseGrapheme :: Char -> Grapheme baseGrapheme Char c = Grapheme {gBaseChar :: Char gBaseChar = Char c, combiningChars :: [Char] combiningChars = []} -- | Add a combining character to the given 'Grapheme'. addCombiner :: Grapheme -> Char -> Grapheme addCombiner :: Grapheme -> Char -> Grapheme addCombiner Grapheme g Char c = Grapheme g {combiningChars = combiningChars g ++ [c]} isCombiningChar :: Char -> Bool isCombiningChar :: Char -> Bool isCombiningChar Char c = Char -> GeneralCategory generalCategory Char c GeneralCategory -> GeneralCategory -> Bool forall a. Eq a => a -> a -> Bool == GeneralCategory NonSpacingMark -- | Converts a string into a sequence of graphemes. -- -- NOTE: Drops any initial, unattached combining characters. stringToGraphemes :: String -> [Grapheme] stringToGraphemes :: [Char] -> [Grapheme] stringToGraphemes = [Char] -> [Grapheme] mkString ([Char] -> [Grapheme]) -> ShowS -> [Char] -> [Grapheme] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Char -> Bool) -> ShowS forall a. (a -> Bool) -> [a] -> [a] dropWhile Char -> Bool isCombiningChar where mkString :: [Char] -> [Grapheme] mkString [] = [] -- Minor hack: "\ESC...\STX" or "\SOH\ESC...\STX", where "\ESC..." is some -- control sequence (e.g., ANSI colors), is represented as a grapheme -- of zero length with '\ESC' as the base character. -- Note that this won't round-trip correctly with graphemesToString. -- In practice, however, that's fine since control characters can only occur -- in the prompt. mkString (Char '\SOH':[Char] cs) = [Char] -> [Grapheme] stringToGraphemes [Char] cs mkString (Char '\ESC':[Char] cs) | ([Char] ctrl,Char '\STX':[Char] rest) <- (Char -> Bool) -> [Char] -> ([Char], [Char]) forall a. (a -> Bool) -> [a] -> ([a], [a]) break (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool ==Char '\STX') [Char] cs = Char -> [Char] -> Grapheme Grapheme Char '\ESC' [Char] ctrl Grapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] : [Char] -> [Grapheme] stringToGraphemes [Char] rest mkString (Char c:[Char] cs) = Char -> [Char] -> Grapheme Grapheme Char c ((Char -> Bool) -> ShowS forall a. (a -> Bool) -> [a] -> [a] takeWhile Char -> Bool isCombiningChar [Char] cs) Grapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] : [Char] -> [Grapheme] mkString ((Char -> Bool) -> ShowS forall a. (a -> Bool) -> [a] -> [a] dropWhile Char -> Bool isCombiningChar [Char] cs) graphemesToString :: [Grapheme] -> String graphemesToString :: [Grapheme] -> [Char] graphemesToString = (Grapheme -> [Char]) -> [Grapheme] -> [Char] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (\Grapheme g -> (Grapheme -> Char baseChar Grapheme g Char -> ShowS forall a. a -> [a] -> [a] : Grapheme -> [Char] combiningChars Grapheme g)) -- | This class abstracts away the internal representations of the line state, -- for use by the drawing actions. Line state is generally stored in a zipper format. class LineState s where beforeCursor :: Prefix -- ^ The input prefix. -> s -- ^ The current line state. -> [Grapheme] -- ^ The text to the left of the cursor -- (including the prefix). afterCursor :: s -> [Grapheme] -- ^ The text under and to the right of the cursor. type Prefix = [Grapheme] -- | The characters in the line (with the cursor in the middle). NOT in a zippered format; -- both lists are in the order left->right that appears on the screen. type LineChars = ([Grapheme],[Grapheme]) -- | Accessor function for the various backends. lineChars :: LineState s => Prefix -> s -> LineChars lineChars :: forall s. LineState s => [Grapheme] -> s -> LineChars lineChars [Grapheme] prefix s s = ([Grapheme] -> s -> [Grapheme] forall s. LineState s => [Grapheme] -> s -> [Grapheme] beforeCursor [Grapheme] prefix s s, s -> [Grapheme] forall s. LineState s => s -> [Grapheme] afterCursor s s) -- | Compute the number of characters under and to the right of the cursor. lengthToEnd :: LineChars -> Int lengthToEnd :: LineChars -> Int lengthToEnd = [Grapheme] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([Grapheme] -> Int) -> (LineChars -> [Grapheme]) -> LineChars -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . LineChars -> [Grapheme] forall a b. (a, b) -> b snd class LineState s => Result s where toResult :: s -> String class LineState s => Save s where save :: s -> InsertMode restore :: InsertMode -> s listSave :: Save s => s -> [Grapheme] listSave :: forall s. Save s => s -> [Grapheme] listSave s s = case s -> InsertMode forall s. Save s => s -> InsertMode save s s of IMode [Grapheme] xs [Grapheme] ys -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] xs [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] ys listRestore :: Save s => [Grapheme] -> s listRestore :: forall s. Save s => [Grapheme] -> s listRestore [Grapheme] xs = InsertMode -> s forall s. Save s => InsertMode -> s restore (InsertMode -> s) -> InsertMode -> s forall a b. (a -> b) -> a -> b $ [Grapheme] -> [Grapheme] -> InsertMode IMode ([Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] 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] deriving (Int -> InsertMode -> ShowS [InsertMode] -> ShowS InsertMode -> [Char] (Int -> InsertMode -> ShowS) -> (InsertMode -> [Char]) -> ([InsertMode] -> ShowS) -> Show InsertMode forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> InsertMode -> ShowS showsPrec :: Int -> InsertMode -> ShowS $cshow :: InsertMode -> [Char] show :: InsertMode -> [Char] $cshowList :: [InsertMode] -> ShowS showList :: [InsertMode] -> ShowS Show, InsertMode -> InsertMode -> Bool (InsertMode -> InsertMode -> Bool) -> (InsertMode -> InsertMode -> Bool) -> Eq InsertMode forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: InsertMode -> InsertMode -> Bool == :: InsertMode -> InsertMode -> Bool $c/= :: InsertMode -> InsertMode -> Bool /= :: InsertMode -> InsertMode -> Bool Eq) instance LineState InsertMode where beforeCursor :: [Grapheme] -> InsertMode -> [Grapheme] beforeCursor [Grapheme] prefix (IMode [Grapheme] xs [Grapheme] _) = [Grapheme] prefix [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] xs afterCursor :: InsertMode -> [Grapheme] afterCursor (IMode [Grapheme] _ [Grapheme] ys) = [Grapheme] ys instance Result InsertMode where toResult :: InsertMode -> [Char] toResult (IMode [Grapheme] xs [Grapheme] ys) = [Grapheme] -> [Char] graphemesToString ([Grapheme] -> [Char]) -> [Grapheme] -> [Char] forall a b. (a -> b) -> a -> b $ [Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] xs [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] ys instance Save InsertMode where save :: InsertMode -> InsertMode save = InsertMode -> InsertMode forall a. a -> a id restore :: InsertMode -> InsertMode restore = InsertMode -> InsertMode forall a. a -> a id instance Move InsertMode where goLeft :: InsertMode -> InsertMode goLeft im :: InsertMode im@(IMode [] [Grapheme] _) = InsertMode im goLeft (IMode (Grapheme x:[Grapheme] xs) [Grapheme] ys) = [Grapheme] -> [Grapheme] -> InsertMode IMode [Grapheme] xs (Grapheme xGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] ys) goRight :: InsertMode -> InsertMode goRight im :: InsertMode im@(IMode [Grapheme] _ []) = InsertMode im goRight (IMode [Grapheme] ys (Grapheme x:[Grapheme] xs)) = [Grapheme] -> [Grapheme] -> InsertMode IMode (Grapheme xGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] ys) [Grapheme] xs moveToStart :: InsertMode -> InsertMode moveToStart (IMode [Grapheme] xs [Grapheme] ys) = [Grapheme] -> [Grapheme] -> InsertMode IMode [] ([Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] xs [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] ys) moveToEnd :: InsertMode -> InsertMode moveToEnd (IMode [Grapheme] xs [Grapheme] ys) = [Grapheme] -> [Grapheme] -> InsertMode IMode ([Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] ys [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] xs) [] emptyIM :: InsertMode emptyIM :: InsertMode emptyIM = [Grapheme] -> [Grapheme] -> InsertMode IMode [] [] -- | Insert one character, which may be combining, to the left of the cursor. -- insertChar :: Char -> InsertMode -> InsertMode insertChar :: Char -> InsertMode -> InsertMode insertChar Char c im :: InsertMode im@(IMode [Grapheme] xs [Grapheme] ys) | Char -> Bool isCombiningChar Char c = case [Grapheme] xs of [] -> InsertMode im -- drop a combining character if it -- appears at the start of the line. Grapheme z:[Grapheme] zs -> [Grapheme] -> [Grapheme] -> InsertMode IMode (Grapheme -> Char -> Grapheme addCombiner Grapheme z Char c Grapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] : [Grapheme] zs) [Grapheme] ys | Bool otherwise = [Grapheme] -> [Grapheme] -> InsertMode IMode (Char -> Grapheme baseGrapheme Char c Grapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] : [Grapheme] xs) [Grapheme] ys -- | Insert a sequence of characters to the left of the cursor. insertString :: String -> InsertMode -> InsertMode insertString :: [Char] -> InsertMode -> InsertMode insertString [Char] s (IMode [Grapheme] xs [Grapheme] ys) = [Grapheme] -> [Grapheme] -> InsertMode IMode ([Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse ([Char] -> [Grapheme] stringToGraphemes [Char] s) [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] xs) [Grapheme] ys deleteNext, deletePrev :: InsertMode -> InsertMode deleteNext :: InsertMode -> InsertMode deleteNext im :: InsertMode im@(IMode [Grapheme] _ []) = InsertMode im deleteNext (IMode [Grapheme] xs (Grapheme _:[Grapheme] ys)) = [Grapheme] -> [Grapheme] -> InsertMode IMode [Grapheme] xs [Grapheme] ys deletePrev :: InsertMode -> InsertMode deletePrev im :: InsertMode im@(IMode [] [Grapheme] _) = InsertMode im deletePrev (IMode (Grapheme _:[Grapheme] xs) [Grapheme] ys) = [Grapheme] -> [Grapheme] -> InsertMode IMode [Grapheme] xs [Grapheme] ys skipLeft, skipRight :: (Char -> Bool) -> InsertMode -> InsertMode skipLeft :: (Char -> Bool) -> InsertMode -> InsertMode skipLeft Char -> Bool f (IMode [Grapheme] xs [Grapheme] ys) = let ([Grapheme] ws,[Grapheme] zs) = (Grapheme -> Bool) -> [Grapheme] -> LineChars forall a. (a -> Bool) -> [a] -> ([a], [a]) span (Char -> Bool f (Char -> Bool) -> (Grapheme -> Char) -> Grapheme -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Grapheme -> Char baseChar) [Grapheme] xs in [Grapheme] -> [Grapheme] -> InsertMode IMode [Grapheme] zs ([Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] ws [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] ys) skipRight :: (Char -> Bool) -> InsertMode -> InsertMode skipRight Char -> Bool f (IMode [Grapheme] xs [Grapheme] ys) = let ([Grapheme] ws,[Grapheme] zs) = (Grapheme -> Bool) -> [Grapheme] -> LineChars forall a. (a -> Bool) -> [a] -> ([a], [a]) span (Char -> Bool f (Char -> Bool) -> (Grapheme -> Char) -> Grapheme -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Grapheme -> Char baseChar) [Grapheme] ys in [Grapheme] -> [Grapheme] -> InsertMode IMode ([Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] ws [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] xs) [Grapheme] zs transposeChars :: InsertMode -> InsertMode transposeChars :: InsertMode -> InsertMode transposeChars (IMode (Grapheme x:[Grapheme] xs) (Grapheme y:[Grapheme] ys)) = [Grapheme] -> [Grapheme] -> InsertMode IMode (Grapheme xGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :Grapheme yGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] xs) [Grapheme] ys transposeChars (IMode (Grapheme y:Grapheme x:[Grapheme] xs) []) = [Grapheme] -> [Grapheme] -> InsertMode IMode (Grapheme xGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :Grapheme yGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] xs) [] transposeChars InsertMode im = InsertMode im insertGraphemes :: [Grapheme] -> InsertMode -> InsertMode insertGraphemes :: [Grapheme] -> InsertMode -> InsertMode insertGraphemes [Grapheme] s (IMode [Grapheme] xs [Grapheme] ys) = [Grapheme] -> [Grapheme] -> InsertMode IMode ([Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] s [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] xs) [Grapheme] ys -- For the 'R' command. replaceCharIM :: Char -> InsertMode -> InsertMode replaceCharIM :: Char -> InsertMode -> InsertMode replaceCharIM Char c InsertMode im | Char -> Bool isCombiningChar Char c = case InsertMode im of IMode [] [] -> InsertMode im IMode [] (Grapheme y:[Grapheme] ys) -> [Grapheme] -> [Grapheme] -> InsertMode IMode [] (Grapheme -> Char -> Grapheme addCombiner Grapheme y Char cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] ys) IMode (Grapheme x:[Grapheme] xs) [Grapheme] ys -> [Grapheme] -> [Grapheme] -> InsertMode IMode (Grapheme -> Char -> Grapheme addCombiner Grapheme x Char cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] xs) [Grapheme] ys | Bool otherwise = let g :: Grapheme g = Char -> Grapheme baseGrapheme Char c in case InsertMode im of IMode [Grapheme] xs [] -> [Grapheme] -> [Grapheme] -> InsertMode IMode (Grapheme gGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] xs) [] IMode [Grapheme] xs (Grapheme _:[Grapheme] ys) -> [Grapheme] -> [Grapheme] -> InsertMode IMode (Grapheme gGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] xs) [Grapheme] ys -- | Used by vi mode. Considers the cursor to be located over some specific character. -- The first list is reversed. data CommandMode = CMode [Grapheme] Grapheme [Grapheme] | CEmpty deriving Int -> CommandMode -> ShowS [CommandMode] -> ShowS CommandMode -> [Char] (Int -> CommandMode -> ShowS) -> (CommandMode -> [Char]) -> ([CommandMode] -> ShowS) -> Show CommandMode forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> CommandMode -> ShowS showsPrec :: Int -> CommandMode -> ShowS $cshow :: CommandMode -> [Char] show :: CommandMode -> [Char] $cshowList :: [CommandMode] -> ShowS showList :: [CommandMode] -> ShowS Show instance LineState CommandMode where beforeCursor :: [Grapheme] -> CommandMode -> [Grapheme] beforeCursor [Grapheme] prefix CommandMode CEmpty = [Grapheme] prefix beforeCursor [Grapheme] prefix (CMode [Grapheme] xs Grapheme _ [Grapheme] _) = [Grapheme] prefix [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ [Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] xs afterCursor :: CommandMode -> [Grapheme] afterCursor CommandMode CEmpty = [] afterCursor (CMode [Grapheme] _ Grapheme c [Grapheme] ys) = Grapheme cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] ys instance Result CommandMode where toResult :: CommandMode -> [Char] toResult CommandMode CEmpty = [Char] "" toResult (CMode [Grapheme] xs Grapheme c [Grapheme] ys) = [Grapheme] -> [Char] graphemesToString ([Grapheme] -> [Char]) -> [Grapheme] -> [Char] forall a b. (a -> b) -> a -> b $ [Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] xs [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ (Grapheme cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] ys) instance Save CommandMode where save :: CommandMode -> InsertMode save = CommandMode -> InsertMode insertFromCommandMode restore :: InsertMode -> CommandMode restore = InsertMode -> CommandMode enterCommandModeRight instance Move CommandMode where goLeft :: CommandMode -> CommandMode goLeft (CMode (Grapheme x:[Grapheme] xs) Grapheme c [Grapheme] ys) = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [Grapheme] xs Grapheme x (Grapheme cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] ys) goLeft CommandMode cm = CommandMode cm goRight :: CommandMode -> CommandMode goRight (CMode [Grapheme] xs Grapheme c (Grapheme y:[Grapheme] ys)) = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode (Grapheme cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] xs) Grapheme y [Grapheme] ys goRight CommandMode cm = CommandMode cm moveToStart :: CommandMode -> CommandMode moveToStart (CMode [Grapheme] xs Grapheme c [Grapheme] ys) = let zs :: [Grapheme] zs = [Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] xs [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ (Grapheme cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] ys) in [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [] ([Grapheme] -> Grapheme forall a. HasCallStack => [a] -> a head [Grapheme] zs) ([Grapheme] -> [Grapheme] forall a. HasCallStack => [a] -> [a] tail [Grapheme] zs) moveToStart CommandMode CEmpty = CommandMode CEmpty moveToEnd :: CommandMode -> CommandMode moveToEnd (CMode [Grapheme] xs Grapheme c [Grapheme] ys) = let zs :: [Grapheme] zs = [Grapheme] -> [Grapheme] forall a. [a] -> [a] reverse [Grapheme] ys [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ (Grapheme cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] xs) in [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode ([Grapheme] -> [Grapheme] forall a. HasCallStack => [a] -> [a] tail [Grapheme] zs) ([Grapheme] -> Grapheme forall a. HasCallStack => [a] -> a head [Grapheme] zs) [] moveToEnd CommandMode CEmpty = CommandMode CEmpty deleteChar :: CommandMode -> CommandMode deleteChar :: CommandMode -> CommandMode deleteChar (CMode [Grapheme] xs Grapheme _ (Grapheme y:[Grapheme] ys)) = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [Grapheme] xs Grapheme y [Grapheme] ys deleteChar (CMode (Grapheme x:[Grapheme] xs) Grapheme _ []) = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [Grapheme] xs Grapheme x [] deleteChar CommandMode _ = CommandMode CEmpty replaceChar :: Char -> CommandMode -> CommandMode replaceChar :: Char -> CommandMode -> CommandMode replaceChar Char c (CMode [Grapheme] xs Grapheme d [Grapheme] ys) | Bool -> Bool not (Char -> Bool isCombiningChar Char c) = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [Grapheme] xs (Char -> Grapheme baseGrapheme Char c) [Grapheme] ys | Bool otherwise = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [Grapheme] xs (Grapheme -> Char -> Grapheme addCombiner Grapheme d Char c) [Grapheme] ys replaceChar Char _ CommandMode CEmpty = CommandMode CEmpty pasteGraphemesBefore, pasteGraphemesAfter :: [Grapheme] -> CommandMode -> CommandMode pasteGraphemesBefore :: [Grapheme] -> CommandMode -> CommandMode pasteGraphemesBefore [] = CommandMode -> CommandMode forall a. a -> a id pasteGraphemesBefore [Grapheme] s = InsertMode -> CommandMode enterCommandMode (InsertMode -> CommandMode) -> (CommandMode -> InsertMode) -> CommandMode -> CommandMode forall b c a. (b -> c) -> (a -> b) -> a -> c . [Grapheme] -> InsertMode -> InsertMode insertGraphemes [Grapheme] s (InsertMode -> InsertMode) -> (CommandMode -> InsertMode) -> CommandMode -> InsertMode forall b c a. (b -> c) -> (a -> b) -> a -> c . CommandMode -> InsertMode insertFromCommandMode pasteGraphemesAfter :: [Grapheme] -> CommandMode -> CommandMode pasteGraphemesAfter [] = CommandMode -> CommandMode forall a. a -> a id pasteGraphemesAfter [Grapheme] s = InsertMode -> CommandMode enterCommandMode (InsertMode -> CommandMode) -> (CommandMode -> InsertMode) -> CommandMode -> CommandMode forall b c a. (b -> c) -> (a -> b) -> a -> c . [Grapheme] -> InsertMode -> InsertMode insertGraphemes [Grapheme] s (InsertMode -> InsertMode) -> (CommandMode -> InsertMode) -> CommandMode -> InsertMode forall b c a. (b -> c) -> (a -> b) -> a -> c . CommandMode -> InsertMode appendFromCommandMode ------------------------ -- Transitioning between modes enterCommandMode, enterCommandModeRight :: InsertMode -> CommandMode enterCommandMode :: InsertMode -> CommandMode enterCommandMode (IMode (Grapheme x:[Grapheme] xs) [Grapheme] ys) = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [Grapheme] xs Grapheme x [Grapheme] ys enterCommandMode (IMode [] (Grapheme y:[Grapheme] ys)) = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [] Grapheme y [Grapheme] ys enterCommandMode InsertMode _ = CommandMode CEmpty enterCommandModeRight :: InsertMode -> CommandMode enterCommandModeRight (IMode [Grapheme] xs (Grapheme y:[Grapheme] ys)) = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [Grapheme] xs Grapheme y [Grapheme] ys enterCommandModeRight (IMode (Grapheme x:[Grapheme] xs) []) = [Grapheme] -> Grapheme -> [Grapheme] -> CommandMode CMode [Grapheme] xs Grapheme x [] enterCommandModeRight InsertMode _ = CommandMode CEmpty insertFromCommandMode, appendFromCommandMode :: CommandMode -> InsertMode insertFromCommandMode :: CommandMode -> InsertMode insertFromCommandMode CommandMode CEmpty = InsertMode emptyIM insertFromCommandMode (CMode [Grapheme] xs Grapheme c [Grapheme] ys) = [Grapheme] -> [Grapheme] -> InsertMode IMode [Grapheme] xs (Grapheme cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] ys) appendFromCommandMode :: CommandMode -> InsertMode appendFromCommandMode CommandMode CEmpty = InsertMode emptyIM appendFromCommandMode (CMode [Grapheme] xs Grapheme c [Grapheme] ys) = [Grapheme] -> [Grapheme] -> InsertMode IMode (Grapheme cGrapheme -> [Grapheme] -> [Grapheme] forall a. a -> [a] -> [a] :[Grapheme] xs) [Grapheme] ys withCommandMode :: (InsertMode -> InsertMode) -> CommandMode -> CommandMode withCommandMode :: (InsertMode -> InsertMode) -> CommandMode -> CommandMode withCommandMode InsertMode -> InsertMode f = InsertMode -> CommandMode enterCommandModeRight (InsertMode -> CommandMode) -> (CommandMode -> InsertMode) -> CommandMode -> CommandMode forall b c a. (b -> c) -> (a -> b) -> a -> c . InsertMode -> InsertMode f (InsertMode -> InsertMode) -> (CommandMode -> InsertMode) -> CommandMode -> InsertMode forall b c a. (b -> c) -> (a -> b) -> a -> c . CommandMode -> InsertMode insertFromCommandMode ---------------------- -- Supplementary modes -- | Used for commands which take an integer argument. data ArgMode s = ArgMode {forall s. ArgMode s -> Int arg :: Int, forall s. ArgMode s -> s argState :: s} instance Functor ArgMode where fmap :: forall a b. (a -> b) -> ArgMode a -> ArgMode b fmap a -> b f ArgMode a am = ArgMode a am {argState = f (argState am)} instance LineState s => LineState (ArgMode s) where beforeCursor :: [Grapheme] -> ArgMode s -> [Grapheme] beforeCursor [Grapheme] _ ArgMode s am = let pre :: [Grapheme] pre = (Char -> Grapheme) -> [Char] -> [Grapheme] forall a b. (a -> b) -> [a] -> [b] map Char -> Grapheme baseGrapheme ([Char] -> [Grapheme]) -> [Char] -> [Grapheme] forall a b. (a -> b) -> a -> b $ [Char] "(arg: " [Char] -> ShowS forall a. [a] -> [a] -> [a] ++ Int -> [Char] forall a. Show a => a -> [Char] show (ArgMode s -> Int forall s. ArgMode s -> Int arg ArgMode s am) [Char] -> ShowS forall a. [a] -> [a] -> [a] ++ [Char] ") " in [Grapheme] -> s -> [Grapheme] forall s. LineState s => [Grapheme] -> s -> [Grapheme] beforeCursor [Grapheme] pre (ArgMode s -> s forall s. ArgMode s -> s argState ArgMode s am) afterCursor :: ArgMode s -> [Grapheme] afterCursor = s -> [Grapheme] forall s. LineState s => s -> [Grapheme] afterCursor (s -> [Grapheme]) -> (ArgMode s -> s) -> ArgMode s -> [Grapheme] forall b c a. (b -> c) -> (a -> b) -> a -> c . ArgMode s -> s forall s. ArgMode s -> s argState instance Result s => Result (ArgMode s) where toResult :: ArgMode s -> [Char] toResult = s -> [Char] forall s. Result s => s -> [Char] toResult (s -> [Char]) -> (ArgMode s -> s) -> ArgMode s -> [Char] forall b c a. (b -> c) -> (a -> b) -> a -> c . ArgMode s -> s forall s. ArgMode s -> s argState instance Save s => Save (ArgMode s) where save :: ArgMode s -> InsertMode save = s -> InsertMode forall s. Save s => s -> InsertMode save (s -> InsertMode) -> (ArgMode s -> s) -> ArgMode s -> InsertMode forall b c a. (b -> c) -> (a -> b) -> a -> c . ArgMode s -> s forall s. ArgMode s -> s argState restore :: InsertMode -> ArgMode s restore = Int -> s -> ArgMode s forall s. Int -> s -> ArgMode s startArg Int 0 (s -> ArgMode s) -> (InsertMode -> s) -> InsertMode -> ArgMode s forall b c a. (b -> c) -> (a -> b) -> a -> c . InsertMode -> s forall s. Save s => InsertMode -> s restore startArg :: Int -> s -> ArgMode s startArg :: forall s. Int -> s -> ArgMode s startArg = Int -> s -> ArgMode s forall s. Int -> s -> ArgMode s ArgMode addNum :: Int -> ArgMode s -> ArgMode s addNum :: forall s. Int -> ArgMode s -> ArgMode s addNum Int n ArgMode s am | ArgMode s -> Int forall s. ArgMode s -> Int arg ArgMode s am Int -> Int -> Bool forall a. Ord a => a -> a -> Bool >= Int 1000 = ArgMode s am -- shouldn't ever need more than 4 digits | Bool otherwise = ArgMode s am {arg = arg am * 10 + n} -- todo: negatives applyArg :: (s -> s) -> ArgMode s -> s applyArg :: forall s. (s -> s) -> ArgMode s -> s applyArg s -> s f ArgMode s am = Int -> (s -> s) -> s -> s forall a. Int -> (a -> a) -> a -> a repeatN (ArgMode s -> Int forall s. ArgMode s -> Int arg ArgMode s am) s -> s f (ArgMode s -> s forall s. ArgMode s -> s argState ArgMode s am) repeatN :: Int -> (a -> a) -> a -> a repeatN :: forall a. Int -> (a -> a) -> a -> a repeatN Int n a -> a f | Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 1 = a -> a f | Bool otherwise = a -> a f (a -> a) -> (a -> a) -> a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> (a -> a) -> a -> a forall a. Int -> (a -> a) -> a -> a repeatN (Int nInt -> Int -> Int forall a. Num a => a -> a -> a -Int 1) a -> a f applyCmdArg :: (InsertMode -> InsertMode) -> ArgMode CommandMode -> CommandMode applyCmdArg :: (InsertMode -> InsertMode) -> ArgMode CommandMode -> CommandMode applyCmdArg InsertMode -> InsertMode f ArgMode CommandMode am = (InsertMode -> InsertMode) -> CommandMode -> CommandMode withCommandMode (Int -> (InsertMode -> InsertMode) -> InsertMode -> InsertMode forall a. Int -> (a -> a) -> a -> a repeatN (ArgMode CommandMode -> Int forall s. ArgMode s -> Int arg ArgMode CommandMode am) InsertMode -> InsertMode f) (ArgMode CommandMode -> CommandMode forall s. ArgMode s -> s argState ArgMode CommandMode am) --------------- newtype Message = Message {Message -> [Char] messageText :: String} instance LineState Message where beforeCursor :: [Grapheme] -> Message -> [Grapheme] beforeCursor [Grapheme] _ = [Char] -> [Grapheme] stringToGraphemes ([Char] -> [Grapheme]) -> (Message -> [Char]) -> Message -> [Grapheme] forall b c a. (b -> c) -> (a -> b) -> a -> c . Message -> [Char] messageText afterCursor :: Message -> [Grapheme] afterCursor Message _ = [] ---------------- data Password = Password {Password -> [Char] passwordState :: [Char], -- ^ reversed Password -> Maybe Char passwordChar :: Maybe Char} instance LineState Password where beforeCursor :: [Grapheme] -> Password -> [Grapheme] beforeCursor [Grapheme] prefix Password p = [Grapheme] prefix [Grapheme] -> [Grapheme] -> [Grapheme] forall a. [a] -> [a] -> [a] ++ ([Char] -> [Grapheme] stringToGraphemes ([Char] -> [Grapheme]) -> [Char] -> [Grapheme] forall a b. (a -> b) -> a -> b $ case Password -> Maybe Char passwordChar Password p of Maybe Char Nothing -> [] Just Char c -> Int -> Char -> [Char] forall a. Int -> a -> [a] replicate ([Char] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([Char] -> Int) -> [Char] -> Int forall a b. (a -> b) -> a -> b $ Password -> [Char] passwordState Password p) Char c) afterCursor :: Password -> [Grapheme] afterCursor Password _ = [] instance Result Password where toResult :: Password -> [Char] toResult = ShowS forall a. [a] -> [a] reverse ShowS -> (Password -> [Char]) -> Password -> [Char] forall b c a. (b -> c) -> (a -> b) -> a -> c . Password -> [Char] passwordState addPasswordChar :: Char -> Password -> Password addPasswordChar :: Char -> Password -> Password addPasswordChar Char c Password p = Password p {passwordState = c : passwordState p} deletePasswordChar :: Password -> Password deletePasswordChar :: Password -> Password deletePasswordChar (Password (Char _:[Char] cs) Maybe Char m) = [Char] -> Maybe Char -> Password Password [Char] cs Maybe Char m deletePasswordChar Password p = Password p ----------------- atStart, atEnd :: (Char -> Bool) -> InsertMode -> Bool atStart :: (Char -> Bool) -> InsertMode -> Bool atStart Char -> Bool f (IMode (Grapheme x:[Grapheme] _) (Grapheme y:[Grapheme] _)) = Bool -> Bool not (Char -> Bool f (Grapheme -> Char baseChar Grapheme x)) Bool -> Bool -> Bool && Char -> Bool f (Grapheme -> Char baseChar Grapheme y) atStart Char -> Bool _ InsertMode _ = Bool False atEnd :: (Char -> Bool) -> InsertMode -> Bool atEnd Char -> Bool f (IMode [Grapheme] _ (Grapheme y1:Grapheme y2:[Grapheme] _)) = Char -> Bool f (Grapheme -> Char baseChar Grapheme y1) Bool -> Bool -> Bool && Bool -> Bool not (Char -> Bool f (Grapheme -> Char baseChar Grapheme y2)) atEnd Char -> Bool _ InsertMode _ = Bool False overChar, beforeChar, afterChar :: (Char -> Bool) -> InsertMode -> Bool overChar :: (Char -> Bool) -> InsertMode -> Bool overChar Char -> Bool f (IMode [Grapheme] _ (Grapheme y:[Grapheme] _)) = Char -> Bool f (Grapheme -> Char baseChar Grapheme y) overChar Char -> Bool _ InsertMode _ = Bool False beforeChar :: (Char -> Bool) -> InsertMode -> Bool beforeChar Char -> Bool f (IMode [Grapheme] _ (Grapheme _:Grapheme y:[Grapheme] _)) = Char -> Bool f (Grapheme -> Char baseChar Grapheme y) beforeChar Char -> Bool _ InsertMode _ = Bool False afterChar :: (Char -> Bool) -> InsertMode -> Bool afterChar Char -> Bool f (IMode (Grapheme x:[Grapheme] _) [Grapheme] _) = Char -> Bool f (Grapheme -> Char baseChar Grapheme x) afterChar Char -> Bool _ InsertMode _ = Bool False goRightUntil, goLeftUntil :: (InsertMode -> Bool) -> InsertMode -> InsertMode goRightUntil :: (InsertMode -> Bool) -> InsertMode -> InsertMode goRightUntil InsertMode -> Bool f = InsertMode -> InsertMode loop (InsertMode -> InsertMode) -> (InsertMode -> InsertMode) -> InsertMode -> InsertMode forall b c a. (b -> c) -> (a -> b) -> a -> c . InsertMode -> InsertMode forall s. Move s => s -> s goRight where loop :: InsertMode -> InsertMode loop im :: InsertMode im@(IMode [Grapheme] _ [Grapheme] ys) | [Grapheme] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Grapheme] ys Bool -> Bool -> Bool || InsertMode -> Bool f InsertMode im = InsertMode im | Bool otherwise = InsertMode -> InsertMode loop (InsertMode -> InsertMode forall s. Move s => s -> s goRight InsertMode im) goLeftUntil :: (InsertMode -> Bool) -> InsertMode -> InsertMode goLeftUntil InsertMode -> Bool f = InsertMode -> InsertMode loop (InsertMode -> InsertMode) -> (InsertMode -> InsertMode) -> InsertMode -> InsertMode forall b c a. (b -> c) -> (a -> b) -> a -> c . InsertMode -> InsertMode forall s. Move s => s -> s goLeft where loop :: InsertMode -> InsertMode loop im :: InsertMode im@(IMode [Grapheme] xs [Grapheme] _) | [Grapheme] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Grapheme] xs Bool -> Bool -> Bool || InsertMode -> Bool f InsertMode im = InsertMode im | Bool otherwise = InsertMode -> InsertMode loop (InsertMode -> InsertMode forall s. Move s => s -> s goLeft InsertMode im)