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

-- | This function may be used to debug Haskeline's input.
--
-- It loops indefinitely; every time a key is pressed, it will
-- print that key as it was recognized by Haskeline.
-- Pressing Ctrl-C will stop the loop.
--
-- Haskeline's behavior may be modified by editing your @~/.haskeline@
-- file.  For details, see: <https://github.com/judah/haskeline/wiki/CustomKeyBindings>
--
debugTerminalKeys :: IO a
debugTerminalKeys :: forall a. IO a
debugTerminalKeys = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT forall (m :: * -> *). MonadIO m => Settings m
defaultSettings forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). MonadIO m => String -> InputT m ()
outputStrLn
        String
"Press any keys to debug Haskeline's input, or ctrl-c to exit:"
    RunTerm
rterm <- forall (m :: * -> *) a.
ReaderT
  RunTerm
  (ReaderT
     (IORef History)
     (ReaderT
        (IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m))))
  a
-> InputT m a
InputT forall r (m :: * -> *). MonadReader r m => m r
ask
    case RunTerm -> Either TermOps FileOps
termOps RunTerm
rterm of
        Right FileOps
_ -> forall a. HasCallStack => String -> a
error String
"debugTerminalKeys: not run in terminal mode"
        Left TermOps
tops -> forall (m :: * -> *) a.
MonadIO m =>
TermOps -> InputCmdT m a -> InputT m a
runInputCmdT TermOps
tops forall a b. (a -> b) -> a -> b
$ 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
                                            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 = forall a. (Key -> Maybe (KeyConsumed a)) -> KeyMap a
KeyMap forall a b. (a -> b) -> a -> b
$ \Key
k -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> KeyConsumed a
Consumed forall a b. (a -> b) -> a -> b
$
            (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ do
                forall (m :: * -> *). Effect -> CmdM m ()
effect ((Prefix -> LineChars) -> Effect
LineChange forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ([],[]))
                forall (m :: * -> *). Effect -> CmdM m ()
effect ([String] -> Effect
PrintLines [forall a. Show a => a -> String
show Key
k])
                forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
setState InsertMode
emptyIM)
            forall (m :: * -> *) s t u.
Monad m =>
Command m s t -> Command m t u -> Command m s 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
"> "