module System.Console.Haskeline.Internal
( debugTerminalKeys ) where
import System.Console.Haskeline (defaultSettings, outputStrLn)
import System.Console.Haskeline.Command
import System.Console.Haskeline.InputT
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Monads
import System.Console.Haskeline.RunCommand
import System.Console.Haskeline.Term
debugTerminalKeys :: IO a
debugTerminalKeys :: forall a. IO a
debugTerminalKeys = Settings IO -> InputT IO a -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT Settings IO
forall (m :: * -> *). MonadIO m => Settings m
defaultSettings (InputT IO a -> IO a) -> InputT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
outputStrLn
String
"Press any keys to debug Haskeline's input, or ctrl-c to exit:"
rterm <- ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))
RunTerm
-> InputT IO RunTerm
forall (m :: * -> *) a.
ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
a
-> InputT m a
InputT ReaderT
RunTerm
(ReaderT
(IORef History)
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))
RunTerm
forall r (m :: * -> *). MonadReader r m => m r
ask
case termOps rterm of
Right FileOps
_ -> String -> InputT IO a
forall a. HasCallStack => String -> a
error String
"debugTerminalKeys: not run in terminal mode"
Left TermOps
tops -> TermOps -> InputCmdT IO a -> InputT IO a
forall (m :: * -> *) a.
MonadIO m =>
TermOps -> InputCmdT m a -> InputT m a
runInputCmdT TermOps
tops (InputCmdT IO a -> InputT IO a) -> InputCmdT IO a -> InputT IO a
forall a b. (a -> b) -> a -> b
$ TermOps
-> Prefix
-> KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
a
-> InsertMode
-> InputCmdT IO a
forall (m :: * -> *) s a.
(CommandMonad m, MonadState Layout m, LineState s) =>
TermOps -> Prefix -> KeyCommand m s a -> s -> m a
runCommandLoop TermOps
tops Prefix
prompt
KeyCommand
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
a
forall {u}.
KeyMap
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
loop InsertMode
emptyIM
where
loop :: KeyMap
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
loop = (Key
-> Maybe
(KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)))
-> KeyMap
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
forall a. (Key -> Maybe (KeyConsumed a)) -> KeyMap a
KeyMap ((Key
-> Maybe
(KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)))
-> KeyMap
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u))
-> (Key
-> Maybe
(KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)))
-> KeyMap
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
forall a b. (a -> b) -> a -> b
$ \Key
k -> KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
-> Maybe
(KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u))
forall a. a -> Maybe a
Just (KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
-> Maybe
(KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)))
-> KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
-> Maybe
(KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u))
forall a b. (a -> b) -> a -> b
$ Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u
-> KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
forall a. a -> KeyConsumed a
Consumed (Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u
-> KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u))
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u
-> KeyConsumed
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
forall a b. (a -> b) -> a -> b
$
(CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
-> InsertMode
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
forall a b. a -> b -> a
const (CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
-> InsertMode
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode)
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
-> InsertMode
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
forall a b. (a -> b) -> a -> b
$ do
Effect
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
()
forall (m :: * -> *). Effect -> CmdM m ()
effect ((Prefix -> LineChars) -> Effect
LineChange ((Prefix -> LineChars) -> Effect)
-> (Prefix -> LineChars) -> Effect
forall a b. (a -> b) -> a -> b
$ LineChars -> Prefix -> LineChars
forall a b. a -> b -> a
const ([],[]))
Effect
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
()
forall (m :: * -> *). Effect -> CmdM m ()
effect ([String] -> Effect
PrintLines [Key -> String
forall a. Show a => a -> String
show Key
k])
InsertMode
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState InsertMode
emptyIM)
(InsertMode
-> CmdM
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode)
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u
forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s u
>|> KeyMap
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
-> Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u
forall (m :: * -> *) s t. KeyCommand m s t -> Command m s t
keyCommand KeyMap
(Command
(StateT
Layout
(UndoT
(StateT
HistLog
(ReaderT
(IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
InsertMode
u)
loop
prompt :: Prefix
prompt = String -> Prefix
stringToGraphemes String
"> "