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)
(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))
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)
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
(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
"> "