    module System.Console.Haskeline.Emacs where

    import System.Console.Haskeline.Command
    import System.Console.Haskeline.Key
    import System.Console.Haskeline.Command.Completion
    import System.Console.Haskeline.Command.History
    import System.Console.Haskeline.Command.Undo
    import System.Console.Haskeline.LineState
    import System.Console.Haskeline.InputT

    import Data.Char

    type InputCmd s t = forall m . Monad m => Command (InputCmdT m) s t

    emacsCommands :: Monad m => KeyMap (InputCmdT m) InsertMode
    emacsCommands = runCommand $ choiceCmd [simpleActions, controlActions]

    simpleActions, controlActions :: InputCmd InsertMode InsertMode
    simpleActions = choiceCmd
                [ simpleChar '\n' +> finish
                , simpleKey LeftKey +> change goLeft
                , simpleKey RightKey +> change goRight
                , simpleKey Backspace +> change deletePrev
                , simpleKey Delete +> change deleteNext
                , changeFromChar insertChar
                , saveForUndo $ simpleChar '\t' +> completionCmd
                , simpleKey UpKey +> historyBack
                , simpleKey DownKey +> historyForward
                , searchHistory
                ]

    controlActions = choiceCmd
                [ ctrlChar 'a' +> change moveToStart
                , ctrlChar 'e' +> change moveToEnd
                , ctrlChar 'b' +> change goLeft
                , ctrlChar 'f' +> change goRight
                , ctrlChar 'd' +> deleteCharOrEOF
                , ctrlChar 'l' +> clearScreenCmd
                , metaChar 'f' +> change wordRight
                , metaChar 'b' +> change wordLeft
                , ctrlChar '_' +> commandUndo
                , ctrlChar 'x' +> change id
                , simpleKey Home +> change moveToStart
                , simpleKey End +> change moveToEnd
                    >|> choiceCmd [ctrlChar 'u' +> commandUndo
                                  , continue]
                , saveForUndo $ choiceCmd
                    [ ctrlChar 'w' +> change (deleteFromMove bigWordLeft)
                    , metaKey (simpleKey Backspace) +> change (deleteFromMove wordLeft)
                    , metaChar 'd' +> change (deleteFromMove wordRight)
                    , ctrlChar 'k' +> change (deleteFromMove moveToEnd)
                    , simpleKey KillLine +> change (deleteFromMove moveToStart)
                    ]
                ]

    deleteCharOrEOF :: Key -> InputCmd InsertMode InsertMode
    deleteCharOrEOF k = k +> acceptKeyOrFail (\s -> if s == emptyIM
                then Nothing
                else Just $ Change (deleteNext s) >=> justDelete)
        where
            justDelete = try (change deleteNext k >|> justDelete)

    wordRight, wordLeft, bigWordLeft :: InsertMode -> InsertMode
    wordRight = skipRight isAlphaNum . skipRight (not . isAlphaNum)
    wordLeft = skipLeft isAlphaNum . skipLeft (not . isAlphaNum)
    bigWordLeft = skipLeft (not . isSpace) . skipLeft isSpace