Commit e9f3e394 authored by Judah Jacobson's avatar Judah Jacobson
Browse files

Add `debugTerminalKeys`.

parent 788a4f45
......@@ -3,6 +3,7 @@ Changed in version 0.7.5.0:
multiple `CompletionFunc`s
* Fix warnings
* Bump the lower bound to ghc-8.0
* Add `debugTerminalKeys` to help debug input problems
Changed in version 0.7.4.3:
* Bump upper bounds on base, containers, stm and unix
......
module System.Console.Haskeline.Internal
( debugTerminalKeys ) where
import Control.Monad (forever)
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 ()
debugTerminalKeys = runInputT defaultSettings $ do
outputStrLn
"Press any keys to debug Haskeline's input, or ctrl-c to exit:"
rterm <- InputT ask
case termOps rterm of
Right _ -> error "debugTerminalKeys: not run in terminal mode"
Left tops -> forever $ getKey tops >>= outputStrLn . show
where
getKey tops = runInputCmdT tops
$ runCommandLoop tops prompt getKeyCmd emptyIM
getKeyCmd = KeyMap $ \k -> Just $ Consumed $ const $ return k
prompt = stringToGraphemes "> "
......@@ -11,19 +11,26 @@ module System.Console.Haskeline.Key(Key(..),
parseKey
) where
import Data.Bits
import Data.Char
import Control.Monad
import Data.Maybe
import Data.Bits
import Data.List (intercalate)
import Control.Monad
data Key = Key Modifier BaseKey
deriving (Show,Eq,Ord)
deriving (Eq,Ord)
instance Show Key where
show (Key modifier base)
| modifier == noModifier = show base
| otherwise = show modifier ++ "-" ++ show base
data Modifier = Modifier {hasControl, hasMeta, hasShift :: Bool}
deriving (Eq,Ord)
instance Show Modifier where
show m = show $ catMaybes [maybeUse hasControl "ctrl"
show m = intercalate "-"
$ catMaybes [maybeUse hasControl "ctrl"
, maybeUse hasMeta "meta"
, maybeUse hasShift "shift"
]
......@@ -41,7 +48,32 @@ data BaseKey = KeyChar Char
| KillLine | Home | End | PageDown | PageUp
| Backspace | Delete
| SearchReverse | SearchForward
deriving (Show,Eq,Ord)
deriving (Eq, Ord)
instance Show BaseKey where
show (KeyChar '\n') = "Return"
show (KeyChar '\t') = "Tab"
show (KeyChar '\ESC') = "Esc"
show (KeyChar c)
| isPrint c = [c]
| isPrint unCtrld = "ctrl-" ++ [unCtrld]
| otherwise = show c
where
unCtrld = toEnum (fromEnum c .|. ctrlBits)
show (FunKey n) = 'f' : show n
show LeftKey = "Left"
show RightKey = "Right"
show DownKey = "Down"
show UpKey = "Up"
show KillLine = "KillLine"
show Home = "Home"
show End = "End"
show PageDown = "PageDown"
show PageUp = "PageUp"
show Backspace = "Backspace"
show Delete = "Delete"
show SearchReverse = "SearchReverse"
show SearchForward = "SearchForward"
simpleKey :: BaseKey -> Key
simpleKey = Key noModifier
......@@ -60,7 +92,10 @@ ctrlChar = simpleChar . setControlBits
setControlBits :: Char -> Char
setControlBits '?' = toEnum 127
setControlBits c = toEnum $ fromEnum c .&. complement (bit 5 .|. bit 6)
setControlBits c = toEnum $ fromEnum c .&. complement ctrlBits
ctrlBits :: Int
ctrlBits = bit 5 .|. bit 6
specialKeys :: [(String,BaseKey)]
specialKeys = [("left",LeftKey)
......
......@@ -63,6 +63,7 @@ Library
System.Console.Haskeline.Completion
System.Console.Haskeline.History
System.Console.Haskeline.IO
System.Console.Haskeline.Internal
Other-Modules:
System.Console.Haskeline.Backend
System.Console.Haskeline.Backend.WCWidth
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment