    module System.Console.Haskeline.LineState where

    class LineState s where
        beforeCursor :: String -> s -> String -- text to left of cursor
        afterCursor :: s -> String -- text under and to right of cursor
        isTemporary :: s -> Bool
        isTemporary _ = False

    type LineChars = (String,String)

    lineChars :: LineState s => String -> s -> LineChars
    lineChars prefix s = (beforeCursor prefix s, afterCursor s)

    lengthToEnd :: LineChars -> Int
    lengthToEnd = length . snd

    class LineState s => Result s where
        toResult :: s -> String

    class (Result s) => FromString s where
        fromString :: String -> s

    class Move s where
        goLeft, goRight, moveToStart, moveToEnd :: s -> s

    data InsertMode = IMode String String
                        deriving (Show, Eq)

    instance LineState InsertMode where
        beforeCursor prefix (IMode xs _) = prefix ++ reverse xs
        afterCursor (IMode _ ys) = ys

    instance Result InsertMode where
        toResult (IMode xs ys) = reverse xs ++ ys

    instance Move InsertMode where
        goLeft im@(IMode [] _) = im
        goLeft (IMode (x:xs) ys) = IMode xs (x:ys)

        goRight im@(IMode _ []) = im
        goRight (IMode ys (x:xs)) = IMode (x:ys) xs

        moveToStart (IMode xs ys) = IMode [] (reverse xs ++ ys)
        moveToEnd (IMode xs ys) = IMode (reverse ys ++ xs) []

    instance FromString InsertMode where
        fromString s = IMode (reverse s) []

    emptyIM :: InsertMode
    emptyIM = IMode "" ""

    insertChar :: Char -> InsertMode -> InsertMode
    insertChar c (IMode xs ys) = IMode (c:xs) ys

    insertString :: String -> InsertMode -> InsertMode
    insertString s (IMode xs ys) = IMode (reverse s ++ xs) ys

    deleteNext, deletePrev :: InsertMode -> InsertMode
    deleteNext im@(IMode _ []) = im
    deleteNext (IMode xs (_:ys)) = IMode xs ys

    deletePrev im@(IMode [] _) = im
    deletePrev (IMode (_:xs) ys) = IMode xs ys

    skipLeft, skipRight :: (Char -> Bool) -> InsertMode -> InsertMode
    skipLeft f (IMode xs ys) = let (ws,zs) = span f xs
                               in IMode zs (reverse ws ++ ys)
    skipRight f (IMode xs ys) = let (ws,zs) = span f ys
                                in IMode (reverse ws ++ xs) zs

    data CommandMode = CMode String Char String | CEmpty
                        deriving Show

    instance LineState CommandMode where
        beforeCursor prefix CEmpty = prefix
        beforeCursor prefix (CMode xs _ _) = prefix ++ reverse xs
        afterCursor CEmpty = ""
        afterCursor (CMode _ c ys) = c:ys

    instance Result CommandMode where
        toResult CEmpty = ""
        toResult (CMode xs c ys) = reverse xs ++ (c:ys)

    instance Move CommandMode where
        goLeft (CMode (x:xs) c ys) = CMode xs x (c:ys)
        goLeft cm = cm

        goRight (CMode xs c (y:ys)) = CMode (c:xs) y ys
        goRight cm = cm

        moveToStart (CMode xs c ys) = let zs = reverse xs ++ (c:ys) in CMode [] (head zs) (tail zs)
        moveToStart CEmpty = CEmpty

        moveToEnd (CMode xs c ys) = let zs = reverse ys ++ (c:xs) in CMode (tail zs) (head zs) []
        moveToEnd CEmpty = CEmpty

    instance FromString CommandMode where
        fromString s = case reverse s of
                        [] -> CEmpty
                        (c:cs) -> CMode cs c []

    deleteChar :: CommandMode -> CommandMode
    deleteChar (CMode xs _ (y:ys)) = CMode xs y ys
    deleteChar (CMode (x:xs) _ []) = CMode xs x []
    deleteChar _ = CEmpty

    replaceChar :: Char -> CommandMode -> CommandMode
    replaceChar c (CMode xs _ ys) = CMode xs c ys
    replaceChar _ CEmpty = CEmpty

    ------------------------
    -- Transitioning between modes

    enterCommandMode, enterCommandModeRight :: InsertMode -> CommandMode
    enterCommandMode (IMode (x:xs) ys) = CMode xs x ys
    enterCommandMode (IMode [] (y:ys)) = CMode [] y ys
    enterCommandMode _ = CEmpty

    enterCommandModeRight (IMode xs (y:ys)) = CMode xs y ys
    enterCommandModeRight (IMode (x:xs) []) = CMode xs x []
    enterCommandModeRight _ = CEmpty

    insertFromCommandMode, appendFromCommandMode :: CommandMode -> InsertMode

    insertFromCommandMode CEmpty = emptyIM
    insertFromCommandMode (CMode xs c ys) = IMode xs (c:ys)

    appendFromCommandMode CEmpty = emptyIM
    appendFromCommandMode (CMode xs c ys) = IMode (c:xs) ys

    withCommandMode :: (InsertMode -> InsertMode) -> CommandMode -> CommandMode
    withCommandMode f = enterCommandModeRight . f . insertFromCommandMode

    ----------------------
    -- Supplementary modes

    data ArgMode s = ArgMode {arg :: Int, argState :: s}

    instance Functor ArgMode where
        fmap f (ArgMode n s) = ArgMode n (f s)

    instance LineState s => LineState (ArgMode s) where
        beforeCursor _ am = beforeCursor ("(arg: " ++ show (arg am) ++ ") ")
                                (argState am)
        afterCursor = afterCursor . argState

    instance Result s => Result (ArgMode s) where
        toResult = toResult . argState

    startArg :: Int -> s -> ArgMode s
    startArg = ArgMode

    addNum :: Int -> ArgMode s -> ArgMode s
    addNum n am
        | arg am >= 1000 = am -- shouldn't ever need more than 4 digits
        | otherwise = am {arg = arg am * 10 + n}

    -- todo: negatives
    applyArg :: (s -> s) -> ArgMode s -> s
    applyArg f am = repeatN (arg am) (argState am)
        where
            repeatN n | n <= 1 = f
                        | otherwise = f . repeatN (n-1)

    ---------------
    data Cleared = Cleared

    instance LineState Cleared where
        beforeCursor _ Cleared = ""
        afterCursor Cleared = ""

    data Message s = Message {messageState :: s, messageText :: String}

    instance LineState s => LineState (Message s) where
        beforeCursor _ = messageText
        afterCursor _ = ""
        isTemporary _ = True

    -----------------
    deleteFromDiff :: InsertMode -> InsertMode -> InsertMode
    deleteFromDiff (IMode xs1 ys1) (IMode xs2 ys2)
        | length xs1 < length xs2 = IMode xs1 ys2
        | otherwise = IMode xs2 ys1

    deleteFromMove :: (InsertMode -> InsertMode) -> InsertMode -> InsertMode
    deleteFromMove f = \x -> deleteFromDiff x (f x)