@@ -33,6 +33,9 @@ import Test.SmallCheck.Series
3333max_block_size :: Int
3434max_block_size = 16
3535
36+forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m
37+forEachOf l = over (generate (\n -> take n l))
38+
3639data InputEvent
3740 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
3841 | Delay Int -- | millisecond delay
@@ -78,34 +81,36 @@ write_input_spec_to_chan chan (Delay _t : input_spec') = do
7881 writeChan chan '\xFFFE'
7982 write_input_spec_to_chan chan input_spec'
8083
81−newtype EventBlock event = EventBlock ([(String,event)] -> [(String, event)])
84+newtype InputBlocksUsingTable event
85+ = InputBlocksUsingTable ([(String,event)] -> [(String, event)])
8286
83−instance Show (EventBlock event) where
84− show (EventBlock g) = "EventBlock(*->*)"
87+instance Show (InputBlocksUsingTable event) where
88+ show (InputBlocksUsingTable _g) = "InputBlocksUsingTable"
8589
86−instance Monad m => Serial m (EventBlock event) where
90+instance Monad m => Serial m (InputBlocksUsingTable event) where
8791 series = do
8892 n :: Int <- localDepth (max max_block_size) series -- what elements to select from the table
89− return $ EventBlock $ \table -> concat (take n (permutations table))
93+ return $ InputBlocksUsingTable $ \table -> concat (take n (permutations table))
9094
9195verify_simple_input_block_to_event :: Property IO
92−verify_simple_input_block_to_event = forAll $ \(EventBlock block_gen) -> do
93− let simple_input_seq = block_gen simple_chars
94− input = Bytes $ concat [s | (s,_) <- simple_input_seq]
95− events = [e | (_,(k,ms)) <- simple_input_seq, let e = EvKey k ms]
96+verify_simple_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do
97+ let input_seq = gen simple_chars
98+ input = Bytes $ concat [s | (s,_) <- input_seq]
99+ events = [e | (_,(k,ms)) <- input_seq, let e = EvKey k ms]
96100 monadic $ assert_events_from_input_block simple_chars [input] events
97101
98102verify_keys_from_caps_table_block_to_event :: Property IO
99−verify_keys_from_caps_table_block_to_event = forAll $ \(EventBlock block_gen) ->
100− over (generate (\n -> take n terminals_of_interest)) $ \term_name -> monadic $ do
101− terminal <- setupTerm term_name
102− let table = caps_classify_table terminal keys_from_caps_table
103− input_seq :: [(String, Event)] = block_gen table
104− input_bytes = [Bytes s | (s,_) <- input_seq]
105− input = intersperse (Delay defaultEscDelay) input_bytes
106− events = [e | (_,e) <- input_seq]
103+verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable gen) ->
104+ forEachOf terminals_of_interest $ \term_name -> monadic $ do
105+ term <- setupTerm term_name
106+ let table = caps_classify_table term keys_from_caps_table
107+ input_seq = gen table
108+ events = [e | (_,e) <- input_seq]
109+ keydowns = [Bytes s | (s,_) <- input_seq]
110+ input = intersperse (Delay defaultEscDelay) keydowns
107111 assert_events_from_input_block (map_to_legacy_table table) input events
108112
113+main :: IO ()
109114main = defaultMain
110115 [ testProperty "basic block generated from a single ansi chars to event translation"
111116 verify_simple_input_block_to_event