move some function keys to be read from caps. disambiguate some keys. expand input test

src/Graphics/Vty/Input/Data.hs

@@ -2,6 +2,8 @@
 module Graphics.Vty.Input.Data where
 
 -- | Representations of non-modifier keys.
+--
+-- KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.
 data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns
          | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin |  KNP5 | KUp | KMenu
          | KLeft | KDown | KRight | KEnter
@@ -41,7 +43,10 @@ keys_from_caps_table =
     , ("kcub1", EvKey KLeft     [])
     , ("kLFT",  EvKey KLeft     [MShift])
     , ("kRIT",  EvKey KRight    [MShift])
-    ]
+    ] ++ function_key_caps_table
+
+function_key_caps_table :: [(String, Event)]
+function_key_caps_table = flip map [0..63] $ \n -> ("key_f" ++ show n, EvKey (KFun n) [])
 
 nav_keys_0 :: ClassifyTable
 nav_keys_0 =
@@ -82,22 +87,41 @@ nav_keys_3 =
 -- Support for simple characters.
 -- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this
 -- classify table is reached.
+--
+-- TODO: resolve
+-- 1. start at ' '. The earlier characters are all ctrl_char_keys
 simple_chars :: ClassifyTable
-simple_chars = [ (x:[],(KASCII x,[])) | x <- map toEnum [0..0xC1] ]
+simple_chars = [(x:[],(KASCII x,[])) | x <- [' ' .. toEnum 0xC1]]
 
 -- TODO: Support for function keys (should use terminfo)
 -- 
 -- (corey): yes. This definitely should. On my terminal these keys do not operate as expected.
-function_keys_0 :: ClassifyTable
-function_keys_0 = [ ("\ESC[["++[toEnum(64+i)],(KFun i,[])) | i <- [1..5] ]
+-- function_keys_0 :: ClassifyTable
+-- function_keys_0 = [ ("\ESC[["++[toEnum(64+i)],(KFun i,[])) | i <- [1..5] ]
 
+-- TODO: I suspect this should be generated by interpretting the terminals use of meta mode:
+-- "If the terminal has a ``meta key'' which acts as a shift key, setting the 8th bit of any
+-- character transmitted, this fact can be indicated with  km.   Other- wise,  software  will
+-- assume that the 8th bit is parity and it will usually be cleared.  If strings exist to turn this
+-- ``meta mode'' on and off, they can be given as smm and rmm."
+--
+-- That is more complex that below. I cannot fault the original author for just hard coding a table
+-- ;-)
 function_keys_1 :: ClassifyTable
 function_keys_1 =
     let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in
-    concat [ f 6 [17..21] [], f 11 [23,24] [], f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]
+    concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]
 
+-- TODO: resolve -
+--
+-- 1. removed 'ESC' from second list due to duplication with "special_support_keys".
+-- 2. removed '[' from second list due to conflict with 7-bit encoding for ESC. Whether meta+[ is
+-- the same as ESC should examine km and current encoding.
+-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by
+-- special_support_keys.
 function_keys_2 :: ClassifyTable
-function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\ESC':'\t':[' ' .. '\DEL'] ]
+function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\t':[' ' .. '~'],
+                                                      x /= '[']
 
 -- Ctrl+Char
 ctrl_char_keys :: ClassifyTable
@@ -108,9 +132,13 @@ ctrl_char_keys =
     ]
 
 -- Ctrl+Meta+Char
+-- 
+-- TODO: CTRL-i is the same as tab thing
 ctrl_meta_keys :: ClassifyTable
 ctrl_meta_keys =
-    [ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']) ]
+    [ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']),
+                                                     y /= 'i'
+    ]
 
 -- Special support
 special_support_keys :: ClassifyTable
@@ -131,7 +159,6 @@ ansi_classify_table =
     , nav_keys_2
     , nav_keys_3
     , simple_chars
-    , function_keys_0
     , function_keys_1
     , function_keys_2
     , ctrl_char_keys

src/Graphics/Vty/Input/Internal.hs

@@ -4,7 +4,7 @@ import Graphics.Vty.Input.Data
 
 import Codec.Binary.UTF8.Generic (decode)
 import Control.Concurrent
-import Control.Exception (try, IOException(..))
+import Control.Exception (try, IOException)
 import Control.Monad (when, void)
 
 import Data.Char

test/VerifyUsingMockInput.hs

@@ -8,7 +8,7 @@ module Main where
 
 import Verify.Graphics.Vty.Terminal
 
-import Data.List (intersperse, permutations)
+import Data.List (intersperse)
 
 import Graphics.Vty hiding (resize)
 import Graphics.Vty.Input.Data
@@ -36,6 +36,9 @@ import Test.SmallCheck.Series
 max_block_size :: Int
 max_block_size = 16
 
+max_table_size :: Int
+max_table_size = 28
+
 forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m
 forEachOf l = over (generate (\n -> take n l))
 
@@ -81,7 +84,6 @@ assert_events_from_syn_input :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO
 assert_events_from_syn_input table input_spec expected_events = do
     let max_duration = sum [t | Delay t <- input_spec] + min_detectable_delay
         event_count = length expected_events
-    -- create pipe
     (output_fd, input_fd) <- createPipe
     (output, shutdown_input) <- initInputForFd test_esc_sample_delay table output_fd
     events_ref <- newIORef []
@@ -93,13 +95,13 @@ assert_events_from_syn_input table input_spec expected_events = do
             closeFd input_fd
             closeFd output_fd
     -- drain output pipe
-    let read_all_events = read_loop event_count
+    let read_events = read_loop event_count
         read_loop 0 = return ()
         read_loop n = do
             e <- readChan output
             modifyIORef events_ref ((:) e)
             read_loop (n - 1)
-    gen_events_using_io_actions max_duration write_wait_close read_all_events
+    gen_events_using_io_actions max_duration write_wait_close read_events
     out_events <- reverse <$> readIORef events_ref
     print (input_spec, expected_events, out_events)
     return $ out_events == expected_events
@@ -139,8 +141,11 @@ instance Show (InputBlocksUsingTable event) where
 
 instance Monad m => Serial m (InputBlocksUsingTable event) where
     series = do
-        n :: Int <- localDepth (max max_block_size) series -- what elements to select from the table
-        return $ InputBlocksUsingTable $ \table -> concat (take n (permutations table))
+        n :: Int <- localDepth (const max_table_size) series
+        return $ InputBlocksUsingTable $ \table -> concat (take n (selections table))
+        where
+            selections []     = []
+            selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z)
 
 verify_simple_input_block_to_event :: Property IO
 verify_simple_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do
@@ -161,7 +166,16 @@ verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable ge
         assert_events_from_input_block (map_to_legacy_table table) input events
 
 verify_simple_syn_input_to_event :: Property IO
-verify_simple_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->
+verify_simple_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do
+    let table         = simple_chars
+        input_seq     = gen table
+        events        = [EvKey k ms | (_,(k,ms)) <- input_seq]
+        keydowns      = [Bytes s    | (s,_) <- input_seq]
+        input         = intersperse (Delay test_key_delay) keydowns
+    assert_events_from_syn_input (concat ansi_classify_table) input events
+
+verify_caps_syn_input_to_event :: Property IO
+verify_caps_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->
     forEachOf terminals_of_interest $ \term_name -> monadic $ do
         term <- setupTerm term_name
         let table         = caps_classify_table term keys_from_caps_table
@@ -171,9 +185,9 @@ verify_simple_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->
             input         = intersperse (Delay test_key_delay) keydowns
         assert_events_from_syn_input (map_to_legacy_table table) input events
 
-verify_fkeys_syn_input_to_event :: Property IO
-verify_fkeys_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do
-    let table         = function_keys_0
+verify_special_syn_input_to_event :: Property IO
+verify_special_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do
+    let table         = function_keys_1 ++ function_keys_2
         input_seq     = gen table
         events        = [EvKey k ms | (_,(k,ms)) <- input_seq]
         keydowns      = [Bytes s    | (s,_) <- input_seq]
@@ -182,13 +196,15 @@ verify_fkeys_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monad
 
 main :: IO ()
 main = defaultMain
-    [ testProperty "basic block generated from a single ansi chars to event translation"
+    [ testProperty "basic block generated from a single visible chars to event translation"
         verify_simple_input_block_to_event
     , testProperty "key sequences read from caps table map to expected events"
         verify_keys_from_caps_table_block_to_event
-    , testProperty "synthesized typing from basic blocks translates to expected events"
+    , testProperty "synthesized typing from single visible chars translates to expected events"
         verify_simple_syn_input_to_event
-    , testProperty "synthesized typing from function keys translates to expected events"
-        verify_fkeys_syn_input_to_event
+    , testProperty "synthesized typing from keys from capabilities tables translates to expected events"
+        verify_caps_syn_input_to_event
+    , testProperty "synthesized typing from hard coded special keys translates to expected events"
+        verify_special_syn_input_to_event
     ]