git.iko.soy/vty
on f9619d0 help sign in
vty/test/VerifyUsingMockInput.hs
114 lines 4.4 kB history raw
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE FlexibleInstances #-}
3{- We setup the environment to envoke certain terminals of interest.
4 - This assumes appropriate definitions exist in the current environment for the terminals of
5 - interest.
6 -}
7module Main where
9import Verify.Graphics.Vty.Terminal
11import Data.List (intersperse, permutations)
13import Graphics.Vty hiding (resize)
14import Graphics.Vty.Input
15import Graphics.Vty.Input.Data
16import Graphics.Vty.Input.Internal
17import Graphics.Vty.Input.Terminfo
19import Control.Applicative
20import Control.Concurrent
21import Control.Exception
22import Control.Monad
24import System.Console.Terminfo
25import System.IO
27import Test.Framework.Providers.SmallCheck
28import Test.Framework
29import Test.SmallCheck
30import Test.SmallCheck.Series
32-- processing a block of 16 chars is the largest I can do without taking too long to run the test.
33max_bytes_size = 16
35data InputEvent
36 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
37 | Delay Int -- | millisecond delay
38 deriving Show
40type InputSpec = [InputEvent]
42type ExpectedSpec = [Event]
44exec_input_spec :: InputSpec -> Handle -> IO ()
45exec_input_spec input out_handle = forM_ input f
46 where
47 f (Bytes str) = hPutStr out_handle str >> hFlush out_handle
48 f (Delay t) = threadDelay (t*1000)
50assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool
51assert_events_from_input_block table input_spec expected_events = do
52 print input_spec
53 let classifier = classify table
54 input <- newChan
55 output <- newChan
56 read_complete <- newEmptyMVar
57 write_complete <- newEmptyMVar
58 _ <- forkIO $ write_input_spec_to_chan input input_spec
59 `finally` putMVar write_complete ()
60 _ <- forkIO $ inputToEventThread classifier input output
61 `finally` putMVar read_complete ()
62 () <- takeMVar write_complete
63 () <- takeMVar read_complete
64 -- TODO: use STM channel
65 -- assures the next line does not block.
66 writeList2Chan output $ replicate (length expected_events) undefined
67 out_events <- take (length expected_events) <$> getChanContents output
68 return $ out_events == expected_events
70write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
71write_input_spec_to_chan chan [] = do
72 writeChan chan '\xFFFD'
73write_input_spec_to_chan chan (Bytes str : input_spec') = do
74 writeList2Chan chan str
75 write_input_spec_to_chan chan input_spec'
76write_input_spec_to_chan chan (Delay _t : input_spec') = do
77 writeChan chan '\xFFFE'
78 write_input_spec_to_chan chan input_spec'
80newtype EventBlock event = EventBlock ([(String,event)] -> [(String, event)])
82instance Show (EventBlock event) where
83 show (EventBlock g) = "EventBlock(*->*)"
85instance Monad m => Serial m (EventBlock event) where
86 series = do
87 n :: Int <- localDepth (max 16) series -- what elements to select from the table
88 return $ EventBlock $ \table -> concat (take n (permutations table))
90verify_simple_input_block_to_event :: Property IO
91verify_simple_input_block_to_event = forAll $ \(EventBlock block_gen) -> do
92 let simple_input_seq = block_gen simple_chars
93 input = Bytes $ concat [s | (s,_) <- simple_input_seq]
94 events = [e | (_,(k,ms)) <- simple_input_seq, let e = EvKey k ms]
95 monadic $ assert_events_from_input_block simple_chars [input] events
97verify_keys_from_caps_table_block_to_event :: Property IO
98verify_keys_from_caps_table_block_to_event = forAll $ \(EventBlock block_gen) ->
99 over (generate (\n -> take n terminals_of_interest)) $ \term_name -> monadic $ do
100 terminal <- setupTerm term_name
101 let table = caps_classify_table terminal keys_from_caps_table
102 input_seq :: [(String, Event)] = block_gen table
103 input_bytes = [Bytes s | (s,_) <- input_seq]
104 input = intersperse (Delay defaultEscDelay) input_bytes
105 events = [e | (_,e) <- input_seq]
106 assert_events_from_input_block (map_to_legacy_table table) input events
108main = defaultMain
109 [ testProperty "basic block generated from a single ansi chars to event translation"
110 verify_simple_input_block_to_event
111 , testProperty "key sequences read from caps table map to expected events"
112 verify_keys_from_caps_table_block_to_event
113 ]