on dc74901 help sign in
vty/test/VerifyUsingMockInput.hs
76 lines 2.9 kB history raw
1{- We setup the environment to envoke certain terminals of interest.
2 - This assumes appropriate definitions exist in the current environment for the terminals of
3 - interest.
4 -}
5module VerifyUsingMockInput where
6import Verify hiding (classify)
8import Graphics.Vty hiding (resize)
9import Graphics.Vty.Input
10import Graphics.Vty.Input.Data
11import Graphics.Vty.Input.Internal
13import Control.Concurrent
14import Control.Exception
15import Control.Monad
17import System.Posix.Env
18import System.IO
20import Test.QuickCheck.Assertions
21import Test.QuickCheck.Property ( morallyDubiousIOProperty )
23-- processing a block of 16 chars is the largest I can do without taking too long to run the test.
24max_bytes_size = 16
26data InputEvent
27 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
28 | Delay Int -- | millisecond delay
30type InputSpec = [InputEvent]
32type ExpectedSpec = [Event]
34exec_input_spec :: InputSpec -> Handle -> IO ()
35exec_input_spec input out_handle = forM_ input f
36 where
37 f (Bytes str) = hPutStr out_handle str >> hFlush out_handle
38 f (Delay t) = threadDelay (t*1000)
40assert_events_from_IO_reads :: InputSpec -> ExpectedSpec -> IO Result
41assert_events_from_IO_reads input events = undefined
43assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Result
44assert_events_from_input_block table input_spec expected_events = do
45 let classifier = classify table
46 input <- newChan
47 output <- newChan
48 forkIO $ write_input_spec_to_chan input input_spec
49 handle (\(e :: BlockedIndefinitelyOnMVar) ->
50 return $ failed { reason = show expected_events ++ " -> " ++ show e }
51 ) $ do
52 inputToEventThread classifier input output
53 out_events <- replicateM (length expected_events) (readChan output)
54 return $ out_events ?== expected_events
56write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
57write_input_spec_to_chan chan [] = writeChan chan '\xFFFD'
58write_input_spec_to_chan chan (Bytes str : input_spec')
59 = writeList2Chan chan str >> write_input_spec_to_chan chan input_spec'
60write_input_spec_to_chan chan (Delay t : input_spec')
61 = writeChan chan '\xFFFE' >> write_input_spec_to_chan chan input_spec'
63verify_simple_input_block_to_event :: Property
64verify_simple_input_block_to_event = do
65 Positive block_length <- resize 16 $ arbitrary
66 block_event_pairs <- vectorOf block_length $ elements $ simple_chars
67 let input = [Bytes $ concatMap fst block_event_pairs]
68 events = map (\(k,ms) -> EvKey k ms) $ map snd block_event_pairs
69 morallyDubiousIOProperty $ assert_events_from_input_block simple_chars input events
71tests :: IO [Test]
72tests = return
73 [ verify "basic block generated from ansi table to event translation"
74 verify_simple_input_block_to_event
75 ]