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 :: 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:"
    RunTerm
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 RunTerm -> Either TermOps FileOps
termOps RunTerm
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.
KeyCommand
  (StateT
     Layout
     (UndoT
        (StateT
           HistLog
           (ReaderT
              (IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
  InsertMode
  u
loop InsertMode
emptyIM
  where
    loop :: KeyCommand
  (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)))
-> KeyCommand
     (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)))
 -> KeyCommand
      (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)))
-> KeyCommand
     (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
>|> KeyCommand
  (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 KeyCommand
  (StateT
     Layout
     (UndoT
        (StateT
           HistLog
           (ReaderT
              (IORef KillRing) (ReaderT Prefs (ReaderT (Settings IO) IO))))))
  InsertMode
  u
loop
    prompt :: Prefix
prompt = String -> Prefix
stringToGraphemes String
"> "