git.iko.soy/vty
on a47320e help sign in
vty/test/VerifyUsingMockInput.hs
100 lines 3.5 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 Main where
7import Verify.Graphics.Vty.Terminal
9import Graphics.Vty hiding (resize)
10import Graphics.Vty.Input
11import Graphics.Vty.Input.Data
12import Graphics.Vty.Input.Internal
14import Control.Applicative
15import Control.Concurrent
16import Control.Exception
17import Control.Monad
19import System.Posix.Env
20import System.IO
22import Test.Framework.Providers.SmallCheck
23import Test.Framework
24import Test.SmallCheck
26-- processing a block of 16 chars is the largest I can do without taking too long to run the test.
27max_bytes_size = 16
29data InputEvent
30 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
31 | Delay Int -- | millisecond delay
33type InputSpec = [InputEvent]
35type ExpectedSpec = [Event]
37exec_input_spec :: InputSpec -> Handle -> IO ()
38exec_input_spec input out_handle = forM_ input f
39 where
40 f (Bytes str) = hPutStr out_handle str >> hFlush out_handle
41 f (Delay t) = threadDelay (t*1000)
43assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool
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 inputToEventThread classifier input output
50 -- H: all events are available in output channel
51 -- TODO: switch to using explicit control events. Currently the channel is passing around a
52 -- magic FFFX characters
53 -- TODO: use STM channel
54 let collect_events = handle (\(e :: BlockedIndefinitelyOnMVar) -> return [])
55 ((:) <$> readChan output <*> collect_events)
56 out_events <- collect_events
57 return $ out_events == expected_events
59write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
60write_input_spec_to_chan chan [] = writeChan chan '\xFFFD'
61write_input_spec_to_chan chan (Bytes str : input_spec')
62 = writeList2Chan chan str >> write_input_spec_to_chan chan input_spec'
63write_input_spec_to_chan chan (Delay t : input_spec')
64 = writeChan chan '\xFFFE' >> write_input_spec_to_chan chan input_spec'
66{-
68verify_keys_from_caps_table :: String -> Property
69verify_keys_from_caps_table = do
70 term_name <- elements terminals_of_interest
71 cap <- elements keys_from_caps_table
74tests :: IO [Test]
75tests = do
76 mappend
77 <$> pure [ verify "basic block generated from single ansi chars to event translation" ]
78 <*> mapM terminals_of_interest
79 verify_simple_input_block_to_event
80 , verify "keys from caps table are parsed to the same key"
81 verify_keys_from_caps_table
82 ]
85verify_simple_input_block_to_event :: Int -> IO (Property IO)
86verify_simple_input_block_to_event = do
87 -- Ouch! 16 is as high as this can go without taking far too long. :-\
88 Positive block_length <- resize 16 $ arbitrary
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
94main = defaultMain
95 [ testProperty "basic block generated from a single ansi chars to event translation"
96 verify_simple_input_block_to_event
97 ]
98-}
99main = defaultMain []