mirror of
https://github.com/simplex-chat/haskell-terminal.git
synced 2026-06-03 09:17:32 +00:00
Lars Petersen
134 lines
8.2 KiB
Haskell
134 lines
8.2 KiB
Haskell
module Spec.Decoder where
|
|
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
|
|
import System.Terminal
|
|
import System.Terminal.Internal
|
|
|
|
tests :: TestTree
|
|
tests = testGroup "System.Terminal.Decoder"
|
|
[ testDecoderGeneric
|
|
, testDecoderWindowsConsole
|
|
, testDecoderXterm
|
|
, testDecoderGnomeTerminal
|
|
, testDecoderRxvtUnicode
|
|
]
|
|
|
|
testDecoderGeneric :: TestTree
|
|
testDecoderGeneric = testGroup "Generic Ansi"
|
|
[ testCase "NUL is skipped" $ f mempty "\NUL" []
|
|
, testCase "SOH is ctrl+A" $ f mempty "\SOH" [KeyEvent (CharKey 'A') ctrlKey]
|
|
, testCase "STX is ctrl+B" $ f mempty "\STX" [KeyEvent (CharKey 'B') ctrlKey]
|
|
, testCase "ETX is ctrl+C" $ f mempty "\ETX" [KeyEvent (CharKey 'C') ctrlKey]
|
|
, testCase "EOT is ctrl+D" $ f mempty "\EOT" [KeyEvent (CharKey 'D') ctrlKey]
|
|
, testCase "ENQ is ctrl+E" $ f mempty "\ENQ" [KeyEvent (CharKey 'E') ctrlKey]
|
|
, testCase "ACK is ctrl+F" $ f mempty "\ACK" [KeyEvent (CharKey 'F') ctrlKey]
|
|
, testCase "\\a is ctrl+G" $ f mempty "\a" [KeyEvent (CharKey 'G') ctrlKey]
|
|
, testCase "\\b is ctrl+H" $ f mempty "\b" [KeyEvent (CharKey 'H') ctrlKey]
|
|
, testCase "\\t is ctrl+I" $ f mempty "\t" [KeyEvent (CharKey 'I') ctrlKey]
|
|
, testCase "\\n is ctrl+J" $ f mempty "\n" [KeyEvent (CharKey 'J') ctrlKey]
|
|
, testCase "\\v is ctrl+K" $ f mempty "\v" [KeyEvent (CharKey 'K') ctrlKey]
|
|
, testCase "\\f is ctrl+L" $ f mempty "\f" [KeyEvent (CharKey 'L') ctrlKey]
|
|
, testCase "\\r is ctrl+M" $ f mempty "\r" [KeyEvent (CharKey 'M') ctrlKey]
|
|
, testCase "SO is ctrl+N" $ f mempty "\SO" [KeyEvent (CharKey 'N') ctrlKey]
|
|
, testCase "SI is ctrl+O" $ f mempty "\SI" [KeyEvent (CharKey 'O') ctrlKey]
|
|
, testCase "DLE is ctrl+P" $ f mempty "\DLE" [KeyEvent (CharKey 'P') ctrlKey]
|
|
, testCase "DC1 is ctrl+Q" $ f mempty "\DC1" [KeyEvent (CharKey 'Q') ctrlKey]
|
|
, testCase "DC2 is ctrl+R" $ f mempty "\DC2" [KeyEvent (CharKey 'R') ctrlKey]
|
|
, testCase "DC3 is ctrl+S" $ f mempty "\DC3" [KeyEvent (CharKey 'S') ctrlKey]
|
|
, testCase "DC4 is ctrl+T" $ f mempty "\DC4" [KeyEvent (CharKey 'T') ctrlKey]
|
|
, testCase "NAK is ctrl+U" $ f mempty "\NAK" [KeyEvent (CharKey 'U') ctrlKey]
|
|
, testCase "SYN is ctrl+V" $ f mempty "\SYN" [KeyEvent (CharKey 'V') ctrlKey]
|
|
, testCase "ETB is ctrl+W" $ f mempty "\ETB" [KeyEvent (CharKey 'W') ctrlKey]
|
|
, testCase "CAN is ctrl+X" $ f mempty "\CAN" [KeyEvent (CharKey 'X') ctrlKey]
|
|
, testCase "EM is ctrl+Y" $ f mempty "\EM" [KeyEvent (CharKey 'Y') ctrlKey]
|
|
, testCase "SUB is ctrl+Z" $ f mempty "\SUB" [KeyEvent (CharKey 'Z') ctrlKey]
|
|
, testCase "ESC cannot be decided" $ f mempty "\ESC" []
|
|
, testCase "ESC+NUL is ctrl+[ and escape key" $ f mempty "\ESC\NUL" [KeyEvent (CharKey '[') ctrlKey, KeyEvent EscapeKey mempty]
|
|
, testCase "FS is ctrl+\\" $ f mempty "\FS" [KeyEvent (CharKey '\\') ctrlKey]
|
|
, testCase "GS is ctrl+]" $ f mempty "\GS" [KeyEvent (CharKey ']') ctrlKey]
|
|
, testCase "RS is ctrl+^" $ f mempty "\RS" [KeyEvent (CharKey '^') ctrlKey]
|
|
, testCase "US is ctrl+_" $ f mempty "\US" [KeyEvent (CharKey '_') ctrlKey]
|
|
, testCase "'a' is character key 'a''" $ f mempty "a" [KeyEvent (CharKey 'a') mempty]
|
|
]
|
|
where
|
|
f = assertDecoding (\_ _ -> Nothing)
|
|
|
|
-- | Only change these tests after having validated the behavior
|
|
-- with the actual terminal emulator! This is the primary reason
|
|
-- for having duplicate tests for different terminal emulators.
|
|
testDecoderWindowsConsole :: TestTree
|
|
testDecoderWindowsConsole = testGroup "Windows Console"
|
|
[ testCase "tab key" $ f mempty "\t" [KeyEvent (CharKey 'I') ctrlKey, KeyEvent TabKey mempty]
|
|
, testCase "enter key" $ f mempty "\r" [KeyEvent (CharKey 'M') ctrlKey, KeyEvent EnterKey mempty]
|
|
, testCase "enter key (when pressed with ctrl)" $ f ctrlKey "\n" [KeyEvent (CharKey 'J') ctrlKey, KeyEvent EnterKey ctrlKey]
|
|
, testCase "delete key" $ f mempty "\ESC[3~" [KeyEvent DeleteKey mempty]
|
|
, testCase "space key" $ f mempty "\SP" [KeyEvent (CharKey ' ') mempty, KeyEvent SpaceKey mempty]
|
|
, testCase "space key, shift" $ f shiftKey "\SP" [KeyEvent (CharKey ' ') shiftKey, KeyEvent SpaceKey shiftKey]
|
|
, testCase "backspace key" $ f mempty "\DEL" [KeyEvent BackspaceKey mempty]
|
|
, testCase "backspace key, alt" $ f mempty "\ESC\b\NUL" [KeyEvent BackspaceKey altKey]
|
|
, testCase "function key 1" $ f mempty "\ESCOP" [KeyEvent (FunctionKey 1) mempty]
|
|
, testCase "function key 2" $ f mempty "\ESCOQ" [KeyEvent (FunctionKey 2) mempty]
|
|
, testCase "function key 3" $ f mempty "\ESCOR" [KeyEvent (FunctionKey 3) mempty]
|
|
, testCase "function key 4" $ f mempty "\ESCOS" [KeyEvent (FunctionKey 4) mempty]
|
|
, testCase "function key 5" $ f mempty "\ESC[15~" [KeyEvent (FunctionKey 5) mempty]
|
|
, testCase "function key 6" $ f mempty "\ESC[17~" [KeyEvent (FunctionKey 6) mempty]
|
|
, testCase "function key 7" $ f mempty "\ESC[18~" [KeyEvent (FunctionKey 7) mempty]
|
|
, testCase "function key 8" $ f mempty "\ESC[19~" [KeyEvent (FunctionKey 8) mempty]
|
|
, testCase "function key 9" $ f mempty "\ESC[20~" [KeyEvent (FunctionKey 9) mempty]
|
|
, testCase "function key 10" $ f mempty "\ESC[21~" [KeyEvent (FunctionKey 10) mempty]
|
|
, testCase "function key 11" $ f mempty "\ESC[23~" [KeyEvent (FunctionKey 11) mempty]
|
|
, testCase "function key 12" $ f mempty "\ESC[24~" [KeyEvent (FunctionKey 12) mempty]
|
|
, testCase "function key 12, shift" $ f mempty "\ESC[24;2~" [KeyEvent (FunctionKey 12) shiftKey]
|
|
, testCase "function key 12, alt" $ f mempty "\ESC[24;3~" [KeyEvent (FunctionKey 12) altKey]
|
|
, testCase "function key 12, shift+alt" $ f mempty "\ESC[24;4~" [KeyEvent (FunctionKey 12) (shiftKey <> altKey)]
|
|
, testCase "function key 12, ctrl" $ f mempty "\ESC[24;5~" [KeyEvent (FunctionKey 12) ctrlKey]
|
|
, testCase "function key 12, shift+ctrl" $ f mempty "\ESC[24;6~" [KeyEvent (FunctionKey 12) (shiftKey <> ctrlKey)]
|
|
, testCase "function key 12, alt+ctrl" $ f mempty "\ESC[24;7~" [KeyEvent (FunctionKey 12) (altKey <> ctrlKey)]
|
|
, testCase "function key 12, shift+alt+ctrl" $ f mempty "\ESC[24;8~" [KeyEvent (FunctionKey 12) (shiftKey <> altKey <> ctrlKey)]
|
|
]
|
|
where
|
|
-- The special chars are assumed to be constant on Windows.
|
|
f = assertDecoding sk
|
|
sk mods = \case
|
|
'\r' -> Just $ KeyEvent EnterKey mods
|
|
'\n' -> Just $ KeyEvent EnterKey mods
|
|
'\t' -> Just $ KeyEvent TabKey mods
|
|
'\b' -> Just $ KeyEvent BackspaceKey mods
|
|
'\SP' -> Just $ KeyEvent SpaceKey mods
|
|
'\DEL' -> Just $ KeyEvent BackspaceKey mods
|
|
_ -> Nothing
|
|
|
|
-- | Only change these tests after having validated the behavior
|
|
-- with the actual terminal emulator! This is the primary reason
|
|
-- for having duplicate tests for different terminal emulators.
|
|
testDecoderXterm :: TestTree
|
|
testDecoderXterm = testGroup "Xterm"
|
|
[]
|
|
|
|
-- | Only change these tests after having validated the behavior
|
|
-- with the actual terminal emulator! This is the primary reason
|
|
-- for having duplicate tests for different terminal emulators.
|
|
testDecoderGnomeTerminal :: TestTree
|
|
testDecoderGnomeTerminal = testGroup "Gnome Terminal"
|
|
[]
|
|
|
|
-- | Only change these tests after having validated the behavior
|
|
-- with the actual terminal emulator! This is the primary reason
|
|
-- for having duplicate tests for different terminal emulators.
|
|
testDecoderRxvtUnicode :: TestTree
|
|
testDecoderRxvtUnicode = testGroup "Rxvt Unicode"
|
|
[]
|
|
|
|
assertDecoding :: (Modifiers -> Char -> Maybe Event) -> Modifiers -> String -> [Event] -> Assertion
|
|
assertDecoding specialChars mods input expected
|
|
= expected @=? decode (defaultDecoder specialChars) input
|
|
where
|
|
decode :: Decoder -> String -> [Event]
|
|
decode decoder = \case
|
|
[] -> []
|
|
(x:xs) -> case feedDecoder decoder mods x of
|
|
Left decoder' -> decode decoder' xs
|
|
Right evs -> evs
|