git.iko.soy/vty
on 424e6a8 help sign in
vty/test/VerifyUsingMockInput.hs
87 lines 3.3 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 Verify.Graphics.Vty.Terminal
10import Graphics.Vty hiding (resize)
11import Graphics.Vty.Input
12import Graphics.Vty.Input.Data
13import Graphics.Vty.Input.Internal
15import Control.Concurrent
16import Control.Exception
17import Control.Monad
19import System.Posix.Env
20import System.IO
22import Test.QuickCheck.Assertions
23import Test.QuickCheck.Property ( morallyDubiousIOProperty )
25-- processing a block of 16 chars is the largest I can do without taking too long to run the test.
26max_bytes_size = 16
28data InputEvent
29 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
30 | Delay Int -- | millisecond delay
32type InputSpec = [InputEvent]
34type ExpectedSpec = [Event]
36exec_input_spec :: InputSpec -> Handle -> IO ()
37exec_input_spec input out_handle = forM_ input f
38 where
39 f (Bytes str) = hPutStr out_handle str >> hFlush out_handle
40 f (Delay t) = threadDelay (t*1000)
42assert_events_from_IO_reads :: InputSpec -> ExpectedSpec -> IO Result
43assert_events_from_IO_reads input events = undefined
45assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Result
46assert_events_from_input_block table input_spec expected_events = do
47 let classifier = classify table
48 input <- newChan
49 output <- newChan
50 forkIO $ write_input_spec_to_chan input input_spec
51 inputToEventThread classifier input output
52 -- H: all events are available in output channel
53 -- TODO: switch to using explicit control events. Currently the channel is passing around a
54 -- magic FFFX characters
55 -- TODO: use STM channel
56 let collect_events = handle (\(e :: BlockedIndefinitelyOnMVar) -> return [])
57 ((:) <$> readChan output <*> collect_events)
58 out_events <- collect_events
59 return $ out_events ?== expected_events
61write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
62write_input_spec_to_chan chan [] = writeChan chan '\xFFFD'
63write_input_spec_to_chan chan (Bytes str : input_spec')
64 = writeList2Chan chan str >> write_input_spec_to_chan chan input_spec'
65write_input_spec_to_chan chan (Delay t : input_spec')
66 = writeChan chan '\xFFFE' >> write_input_spec_to_chan chan input_spec'
68verify_simple_input_block_to_event :: Property
69verify_simple_input_block_to_event = do
70 -- Ouch! 16 is as high as this can go without taking far too long. :-\
71 Positive block_length <- resize 16 $ arbitrary
72 block_event_pairs <- vectorOf block_length $ elements $ simple_chars
73 let input = [Bytes $ concatMap fst block_event_pairs]
74 events = map (\(k,ms) -> EvKey k ms) $ map snd block_event_pairs
75 morallyDubiousIOProperty $ assert_events_from_input_block simple_chars input events
77verify_keys_from_caps_table :: String -> Result
78verify_keys_from_caps_table term_name = succeeded
80tests :: IO [Test]
81tests = return
82 [ verify "basic block generated from single ansi chars to event translation"
83 verify_simple_input_block_to_event
84 , verify "keys from caps table are parsed to the same key"
85 verify_keys_from_caps_table
86 ]