{- |
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
/= :: Grapheme -> Grapheme -> Bool
$c/= :: Grapheme -> Grapheme -> Bool
== :: Grapheme -> Grapheme -> Bool
$c== :: 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 :: Char
gBaseChar = Char -> Char
f (Grapheme -> Char
gBaseChar Grapheme
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 :: [Char]
combiningChars = Grapheme -> [Char]
combiningChars Grapheme
g [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
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 (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
showList :: [InsertMode] -> ShowS
$cshowList :: [InsertMode] -> ShowS
show :: InsertMode -> [Char]
$cshow :: InsertMode -> [Char]
showsPrec :: Int -> InsertMode -> ShowS
$cshowsPrec :: Int -> InsertMode -> ShowS
Show, InsertMode -> InsertMode -> Bool
(InsertMode -> InsertMode -> Bool)
-> (InsertMode -> InsertMode -> Bool) -> Eq InsertMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsertMode -> InsertMode -> Bool
$c/= :: InsertMode -> InsertMode -> Bool
== :: InsertMode -> InsertMode -> Bool
$c== :: 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
showList :: [CommandMode] -> ShowS
$cshowList :: [CommandMode] -> ShowS
show :: CommandMode -> [Char]
$cshow :: CommandMode -> [Char]
showsPrec :: Int -> CommandMode -> ShowS
$cshowsPrec :: Int -> 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. [a] -> a
head [Grapheme]
zs) ([Grapheme] -> [Grapheme]
forall a. [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. [a] -> [a]
tail [Grapheme]
zs) ([Grapheme] -> Grapheme
forall a. [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 :: b
argState = a -> b
f (ArgMode a -> a
forall s. ArgMode s -> s
argState ArgMode a
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 :: Int
arg = ArgMode s -> Int
forall s. ArgMode s -> Int
arg ArgMode s
am Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 (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 :: [Char]
passwordState = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Password -> [Char]
passwordState Password
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 (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 (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)