@@ -1,3 +1,5 @@
1+{-# LANGUAGE MultiParamTypeClasses #-}
2+{-# LANGUAGE FlexibleInstances #-}
1{- We setup the environment to envoke certain terminals of interest.
3{- We setup the environment to envoke certain terminals of interest.
2 - This assumes appropriate definitions exist in the current environment for the terminals of
4 - This assumes appropriate definitions exist in the current environment for the terminals of
3 - interest.
5 - interest.
@@ -22,6 +24,7 @@ import System.IO
22import Test.Framework.Providers.SmallCheck
24import Test.Framework.Providers.SmallCheck
23import Test.Framework
25import Test.Framework
24import Test.SmallCheck
26import Test.SmallCheck
27+import Test.SmallCheck.Series
26-- processing a block of 16 chars is the largest I can do without taking too long to run the test.
29-- processing a block of 16 chars is the largest I can do without taking too long to run the test.
27max_bytes_size = 16
30max_bytes_size = 16
@@ -80,21 +83,22 @@ tests = do
80 , verify "keys from caps table are parsed to the same key"
83 , verify "keys from caps table are parsed to the same key"
81 verify_keys_from_caps_table
84 verify_keys_from_caps_table
88+data SimpleEvent = SimpleEvent (String, (Key, [Modifier]))
91+instance Monad m => Serial m SimpleEvent where
92+ series = generate (\n -> map SimpleEvent $ take n simple_chars)
85−verify_simple_input_block_to_event :: Int -> IO (Property IO)
94+verify_simple_input_block_to_event :: Property IO
86−verify_simple_input_block_to_event = do
95+verify_simple_input_block_to_event = forAll $ \input_spec -> do
87− -- Ouch! 16 is as high as this can go without taking far too long. :-\
96+ let input = Bytes $ concat [s | SimpleEvent (s,_) <- input_spec]
88− Positive block_length <- resize 16 $ arbitrary
97+ events = [e | SimpleEvent (_,(k,ms)) <- input_spec, let e = EvKey k ms]
89− block_event_pairs <- vectorOf block_length $ elements $ simple_chars
90− let input = [Bytes $ concatMap fst block_event_pairs]
91− events = map (\(k,ms) -> EvKey k ms) $ map snd block_event_pairs
92− morallyDubiousIOProperty $ assert_events_from_input_block simple_chars input events
98+ monadic $ assert_events_from_input_block simple_chars [input] events
94main = defaultMain
100main = defaultMain
95 [ testProperty "basic block generated from a single ansi chars to event translation"
101 [ testProperty "basic block generated from a single ansi chars to event translation"
96 verify_simple_input_block_to_event
102 verify_simple_input_block_to_event