@@ -33,6 +33,9 @@ import Test.SmallCheck.Series
33max_block_size :: Int
33max_block_size :: Int
34max_block_size = 16
34max_block_size = 16
36+forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m
37+forEachOf l = over (generate (\n -> take n l))
36data InputEvent
39data InputEvent
37 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
40 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
38 | Delay Int -- | millisecond delay
41 | Delay Int -- | millisecond delay
@@ -78,34 +81,36 @@ write_input_spec_to_chan chan (Delay _t : input_spec') = do
78 writeChan chan '\xFFFE'
81 writeChan chan '\xFFFE'
79 write_input_spec_to_chan chan input_spec'
82 write_input_spec_to_chan chan input_spec'
84+newtype InputBlocksUsingTable event
81−newtype EventBlock event = EventBlock ([(String,event)] -> [(String, event)])
85+ = InputBlocksUsingTable ([(String,event)] -> [(String, event)])
83−instance Show (EventBlock event) where
87+instance Show (InputBlocksUsingTable event) where
84− show (EventBlock g) = "EventBlock(*->*)"
88+ show (InputBlocksUsingTable _g) = "InputBlocksUsingTable"
86−instance Monad m => Serial m (EventBlock event) where
90+instance Monad m => Serial m (InputBlocksUsingTable event) where
87 series = do
91 series = do
88 n :: Int <- localDepth (max max_block_size) series -- what elements to select from the table
92 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))
91verify_simple_input_block_to_event :: Property IO
95verify_simple_input_block_to_event :: Property IO
92−verify_simple_input_block_to_event = forAll $ \(EventBlock block_gen) -> do
96+verify_simple_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do
93− let simple_input_seq = block_gen simple_chars
97+ let input_seq = gen simple_chars
94− input = Bytes $ concat [s | (s,_) <- simple_input_seq]
98+ input = Bytes $ concat [s | (s,_) <- input_seq]
95− events = [e | (_,(k,ms)) <- simple_input_seq, let e = EvKey k ms]
99+ events = [e | (_,(k,ms)) <- input_seq, let e = EvKey k ms]
96 monadic $ assert_events_from_input_block simple_chars [input] events
100 monadic $ assert_events_from_input_block simple_chars [input] events
98verify_keys_from_caps_table_block_to_event :: Property IO
102verify_keys_from_caps_table_block_to_event :: Property IO
99−verify_keys_from_caps_table_block_to_event = forAll $ \(EventBlock block_gen) ->
103+verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable gen) ->
100− over (generate (\n -> take n terminals_of_interest)) $ \term_name -> monadic $ do
104+ forEachOf terminals_of_interest $ \term_name -> monadic $ do
101− terminal <- setupTerm term_name
105+ term <- setupTerm term_name
102− let table = caps_classify_table terminal keys_from_caps_table
106+ let table = caps_classify_table term keys_from_caps_table
103− input_seq :: [(String, Event)] = block_gen table
107+ input_seq = gen table
108+ events = [e | (_,e) <- input_seq]
104− input_bytes = [Bytes s | (s,_) <- input_seq]
109+ keydowns = [Bytes s | (s,_) <- input_seq]
105− input = intersperse (Delay defaultEscDelay) input_bytes
110+ input = intersperse (Delay defaultEscDelay) keydowns
106− events = [e | (_,e) <- input_seq]
107 assert_events_from_input_block (map_to_legacy_table table) input events
111 assert_events_from_input_block (map_to_legacy_table table) input events
109main = defaultMain
114main = defaultMain
110 [ testProperty "basic block generated from a single ansi chars to event translation"
115 [ testProperty "basic block generated from a single ansi chars to event translation"
111 verify_simple_input_block_to_event
116 verify_simple_input_block_to_event