#if __GLASGOW_HASKELL__ < 802 {-# OPTIONS_GHC -Wno-redundant-constraints #-} #endif module System.Console.Haskeline.Emacs where import System.Console.Haskeline.Command import System.Console.Haskeline.Monads 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.Command.KillRing import System.Console.Haskeline.LineState import System.Console.Haskeline.InputT import Control.Monad.Catch (MonadMask) import Data.Char type InputCmd s t = forall m . (MonadIO m, MonadMask m) => Command (InputCmdT m) s t type InputKeyCmd s t = forall m . (MonadIO m, MonadMask m) => KeyCommand (InputCmdT m) s t emacsCommands :: InputKeyCmd InsertMode (Maybe String) emacsCommands :: InputKeyCmd InsertMode (Maybe String) emacsCommands = forall a. [KeyMap a] -> KeyMap a choiceCmd [ forall a. [KeyMap a] -> KeyMap a choiceCmd [InputKeyCmd InsertMode InsertMode simpleActions, InputKeyCmd InsertMode InsertMode controlActions] forall (m :: * -> *) s t u. Monad m => KeyCommand m s t -> Command m t u -> KeyCommand m s u >+> forall (m :: * -> *) s t. KeyCommand m s t -> Command m s t keyCommand InputKeyCmd InsertMode (Maybe String) emacsCommands , InputKeyCmd InsertMode (Maybe String) enders] enders :: InputKeyCmd InsertMode (Maybe String) enders :: InputKeyCmd InsertMode (Maybe String) enders = forall a. [KeyMap a] -> KeyMap a choiceCmd [Char -> Key simpleChar Char '\n' forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s. (Monad m, Result s) => Command m s (Maybe String) finish, Key eotKey forall a. Key -> a -> KeyMap a +> Command (InputCmdT m) InsertMode (Maybe String) deleteCharOrEOF] where eotKey :: Key eotKey = Char -> Key ctrlChar Char 'd' deleteCharOrEOF :: Command (InputCmdT m) InsertMode (Maybe String) deleteCharOrEOF InsertMode s | InsertMode s forall a. Eq a => a -> a -> Bool == InsertMode emptyIM = forall (m :: * -> *) a. Monad m => a -> m a return forall a. Maybe a Nothing | Bool otherwise = forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change InsertMode -> InsertMode deleteNext InsertMode s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Command (InputCmdT m) InsertMode (Maybe String) justDelete justDelete :: Command (InputCmdT m) InsertMode (Maybe String) justDelete = forall (m :: * -> *) s t. [KeyCommand m s t] -> Command m s t keyChoiceCmd [Key eotKey forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change InsertMode -> InsertMode deleteNext forall (m :: * -> *) s t u. Monad m => Command m s t -> Command m t u -> Command m s u >|> Command (InputCmdT m) InsertMode (Maybe String) justDelete , InputKeyCmd InsertMode (Maybe String) emacsCommands] simpleActions, controlActions :: InputKeyCmd InsertMode InsertMode simpleActions :: InputKeyCmd InsertMode InsertMode simpleActions = forall a. [KeyMap a] -> KeyMap a choiceCmd [ BaseKey -> Key simpleKey BaseKey LeftKey forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change forall s. Move s => s -> s goLeft , BaseKey -> Key simpleKey BaseKey RightKey forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change forall s. Move s => s -> s goRight , BaseKey -> Key simpleKey BaseKey Backspace forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change InsertMode -> InsertMode deletePrev , BaseKey -> Key simpleKey BaseKey Delete forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change InsertMode -> InsertMode deleteNext , forall t (m :: * -> *) s. (LineState t, Monad m) => (Char -> s -> t) -> KeyCommand m s t changeFromChar Char -> InsertMode -> InsertMode insertChar , forall (m :: * -> *). (MonadState Undo m, CommandMonad m) => Key -> KeyCommand m InsertMode InsertMode completionCmd (Char -> Key simpleChar Char '\t') , BaseKey -> Key simpleKey BaseKey UpKey forall a. Key -> a -> KeyMap a +> forall s (m :: * -> *). (Save s, MonadState HistLog m) => Command m s s historyBack , BaseKey -> Key simpleKey BaseKey DownKey forall a. Key -> a -> KeyMap a +> forall s (m :: * -> *). (Save s, MonadState HistLog m) => Command m s s historyForward , BaseKey -> Key simpleKey BaseKey SearchReverse forall a. Key -> a -> KeyMap a +> forall (m :: * -> *). MonadState HistLog m => Direction -> Command m InsertMode InsertMode searchForPrefix Direction Reverse , BaseKey -> Key simpleKey BaseKey SearchForward forall a. Key -> a -> KeyMap a +> forall (m :: * -> *). MonadState HistLog m => Direction -> Command m InsertMode InsertMode searchForPrefix Direction Forward , forall (m :: * -> *). MonadState HistLog m => KeyCommand m InsertMode InsertMode searchHistory ] controlActions :: InputKeyCmd InsertMode InsertMode controlActions = forall a. [KeyMap a] -> KeyMap a choiceCmd [ Char -> Key ctrlChar Char 'a' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change forall s. Move s => s -> s moveToStart , Char -> Key ctrlChar Char 'e' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change forall s. Move s => s -> s moveToEnd , Char -> Key ctrlChar Char 'b' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change forall s. Move s => s -> s goLeft , Char -> Key ctrlChar Char 'f' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change forall s. Move s => s -> s goRight , Char -> Key ctrlChar Char 'l' forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s. Command m s s clearScreenCmd , Char -> Key metaChar Char 'f' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change InsertMode -> InsertMode wordRight , Char -> Key metaChar Char 'b' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change InsertMode -> InsertMode wordLeft , Key -> Key ctrlKey (BaseKey -> Key simpleKey BaseKey LeftKey) forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change InsertMode -> InsertMode wordLeft , Key -> Key ctrlKey (BaseKey -> Key simpleKey BaseKey RightKey) forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change InsertMode -> InsertMode wordRight , Char -> Key metaChar Char 'c' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change (([Grapheme] -> [Grapheme]) -> InsertMode -> InsertMode modifyWord [Grapheme] -> [Grapheme] capitalize) , Char -> Key metaChar Char 'l' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change (([Grapheme] -> [Grapheme]) -> InsertMode -> InsertMode modifyWord ((Char -> Char) -> [Grapheme] -> [Grapheme] mapBaseChars Char -> Char toLower)) , Char -> Key metaChar Char 'u' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change (([Grapheme] -> [Grapheme]) -> InsertMode -> InsertMode modifyWord ((Char -> Char) -> [Grapheme] -> [Grapheme] mapBaseChars Char -> Char toUpper)) , Char -> Key ctrlChar Char '_' forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s. (MonadState Undo m, Save s) => Command m s s commandUndo , Char -> Key ctrlChar Char 'x' forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s. Monad m => KeyCommand m s s -> Command m s s try (Char -> Key ctrlChar Char 'u' forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s. (MonadState Undo m, Save s) => Command m s s commandUndo) , Char -> Key ctrlChar Char 't' forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change InsertMode -> InsertMode transposeChars , Char -> Key ctrlChar Char 'p' forall a. Key -> a -> KeyMap a +> forall s (m :: * -> *). (Save s, MonadState HistLog m) => Command m s s historyBack , Char -> Key ctrlChar Char 'n' forall a. Key -> a -> KeyMap a +> forall s (m :: * -> *). (Save s, MonadState HistLog m) => Command m s s historyForward , Char -> Key metaChar Char '<' forall a. Key -> a -> KeyMap a +> forall s (m :: * -> *). (Save s, MonadState HistLog m) => Command m s s historyStart , Char -> Key metaChar Char '>' forall a. Key -> a -> KeyMap a +> forall s (m :: * -> *). (Save s, MonadState HistLog m) => Command m s s historyEnd , BaseKey -> Key simpleKey BaseKey Home forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change forall s. Move s => s -> s moveToStart , BaseKey -> Key simpleKey BaseKey End forall a. Key -> a -> KeyMap a +> forall t (m :: * -> *) s. (LineState t, Monad m) => (s -> t) -> Command m s t change forall s. Move s => s -> s moveToEnd , forall a. [KeyMap a] -> KeyMap a choiceCmd [ Char -> Key ctrlChar Char 'w' forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s t. (MonadState KillRing m, MonadState Undo m, Save s, Save t) => KillHelper -> Command m s t killFromHelper ((InsertMode -> InsertMode) -> KillHelper SimpleMove InsertMode -> InsertMode bigWordLeft) , Key -> Key metaKey (BaseKey -> Key simpleKey BaseKey Backspace) forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s t. (MonadState KillRing m, MonadState Undo m, Save s, Save t) => KillHelper -> Command m s t killFromHelper ((InsertMode -> InsertMode) -> KillHelper SimpleMove InsertMode -> InsertMode wordLeft) , Char -> Key metaChar Char 'd' forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s t. (MonadState KillRing m, MonadState Undo m, Save s, Save t) => KillHelper -> Command m s t killFromHelper ((InsertMode -> InsertMode) -> KillHelper SimpleMove InsertMode -> InsertMode wordRight) , Char -> Key ctrlChar Char 'k' forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s t. (MonadState KillRing m, MonadState Undo m, Save s, Save t) => KillHelper -> Command m s t killFromHelper ((InsertMode -> InsertMode) -> KillHelper SimpleMove forall s. Move s => s -> s moveToEnd) , BaseKey -> Key simpleKey BaseKey KillLine forall a. Key -> a -> KeyMap a +> forall (m :: * -> *) s t. (MonadState KillRing m, MonadState Undo m, Save s, Save t) => KillHelper -> Command m s t killFromHelper ((InsertMode -> InsertMode) -> KillHelper SimpleMove forall s. Move s => s -> s moveToStart) ] , Char -> Key ctrlChar Char 'y' forall a. Key -> a -> KeyMap a +> InputCmd InsertMode InsertMode rotatePaste ] rotatePaste :: InputCmd InsertMode InsertMode rotatePaste :: InputCmd InsertMode InsertMode rotatePaste InsertMode im = forall s (m :: * -> *). MonadState s m => m s get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall {m :: * -> *}. Monad m => KillRing -> CmdM m InsertMode loop where loop :: KillRing -> CmdM m InsertMode loop KillRing kr = case forall a. Stack a -> Maybe a peek KillRing kr of Maybe [Grapheme] Nothing -> forall (m :: * -> *) a. Monad m => a -> m a return InsertMode im Just [Grapheme] s -> forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s setState ([Grapheme] -> InsertMode -> InsertMode insertGraphemes [Grapheme] s InsertMode im) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *) s. Monad m => KeyCommand m s s -> Command m s s try (Char -> Key metaChar Char 'y' forall a. Key -> a -> KeyMap a +> \InsertMode _ -> KillRing -> CmdM m InsertMode loop (forall a. Stack a -> Stack a rotate KillRing kr)) wordRight, wordLeft, bigWordLeft :: InsertMode -> InsertMode wordRight :: InsertMode -> InsertMode wordRight = (InsertMode -> Bool) -> InsertMode -> InsertMode goRightUntil ((Char -> Bool) -> InsertMode -> Bool atStart (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . Char -> Bool isAlphaNum)) wordLeft :: InsertMode -> InsertMode wordLeft = (InsertMode -> Bool) -> InsertMode -> InsertMode goLeftUntil ((Char -> Bool) -> InsertMode -> Bool atStart Char -> Bool isAlphaNum) bigWordLeft :: InsertMode -> InsertMode bigWordLeft = (InsertMode -> Bool) -> InsertMode -> InsertMode goLeftUntil ((Char -> Bool) -> InsertMode -> Bool atStart (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . Char -> Bool isSpace)) modifyWord :: ([Grapheme] -> [Grapheme]) -> InsertMode -> InsertMode modifyWord :: ([Grapheme] -> [Grapheme]) -> InsertMode -> InsertMode modifyWord [Grapheme] -> [Grapheme] f InsertMode im = [Grapheme] -> [Grapheme] -> InsertMode IMode (forall a. [a] -> [a] reverse ([Grapheme] -> [Grapheme] f [Grapheme] ys1) forall a. [a] -> [a] -> [a] ++ [Grapheme] xs) [Grapheme] ys2 where IMode [Grapheme] xs [Grapheme] ys = (Char -> Bool) -> InsertMode -> InsertMode skipRight (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . Char -> Bool isAlphaNum) InsertMode im ([Grapheme] ys1,[Grapheme] ys2) = forall a. (a -> Bool) -> [a] -> ([a], [a]) span (Char -> Bool isAlphaNum forall b c a. (b -> c) -> (a -> b) -> a -> c . Grapheme -> Char baseChar) [Grapheme] ys capitalize :: [Grapheme] -> [Grapheme] capitalize :: [Grapheme] -> [Grapheme] capitalize [] = [] capitalize (Grapheme c:[Grapheme] cs) = (Char -> Char) -> Grapheme -> Grapheme modifyBaseChar Char -> Char toUpper Grapheme c forall a. a -> [a] -> [a] : [Grapheme] cs