git.iko.soy/vty
on 12cd6e5 help sign in
vty/test/VerifyUsingMockInput.hs
120 lines 4.6 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_block_size :: Int
34max_block_size = 16
36forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m
37forEachOf l = over (generate (\n -> take n l))
39data InputEvent
40 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
41 | Delay Int -- | millisecond delay
42 deriving Show
44type InputSpec = [InputEvent]
46type ExpectedSpec = [Event]
48exec_input_spec :: InputSpec -> Handle -> IO ()
49exec_input_spec input out_handle = forM_ input f
50 where
51 f (Bytes str) = hPutStr out_handle str >> hFlush out_handle
52 f (Delay t) = threadDelay (t*1000)
54assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool
55assert_events_from_input_block table input_spec expected_events = do
56 print input_spec
57 let classifier = classify table
58 input <- newChan
59 output <- newChan
60 read_complete <- newEmptyMVar
61 write_complete <- newEmptyMVar
62 _ <- forkIO $ write_input_spec_to_chan input input_spec
63 `finally` putMVar write_complete ()
64 _ <- forkIO $ inputToEventThread classifier input output
65 `finally` putMVar read_complete ()
66 () <- takeMVar write_complete
67 () <- takeMVar read_complete
68 -- TODO: use STM channel
69 -- assures the next line does not block.
70 writeList2Chan output $ replicate (length expected_events) undefined
71 out_events <- take (length expected_events) <$> getChanContents output
72 return $ out_events == expected_events
74write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
75write_input_spec_to_chan chan [] = do
76 writeChan chan '\xFFFD'
77write_input_spec_to_chan chan (Bytes str : input_spec') = do
78 writeList2Chan chan str
79 write_input_spec_to_chan chan input_spec'
80write_input_spec_to_chan chan (Delay _t : input_spec') = do
81 writeChan chan '\xFFFE'
82 write_input_spec_to_chan chan input_spec'
84newtype InputBlocksUsingTable event
85 = InputBlocksUsingTable ([(String,event)] -> [(String, event)])
87instance Show (InputBlocksUsingTable event) where
88 show (InputBlocksUsingTable _g) = "InputBlocksUsingTable"
90instance Monad m => Serial m (InputBlocksUsingTable event) where
91 series = do
92 n :: Int <- localDepth (max max_block_size) series -- what elements to select from the table
93 return $ InputBlocksUsingTable $ \table -> concat (take n (permutations table))
95verify_simple_input_block_to_event :: Property IO
96verify_simple_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do
97 let input_seq = gen simple_chars
98 input = Bytes $ concat [s | (s,_) <- input_seq]
99 events = [e | (_,(k,ms)) <- input_seq, let e = EvKey k ms]
100 monadic $ assert_events_from_input_block simple_chars [input] events
102verify_keys_from_caps_table_block_to_event :: Property IO
103verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable gen) ->
104 forEachOf terminals_of_interest $ \term_name -> monadic $ do
105 term <- setupTerm term_name
106 let table = caps_classify_table term keys_from_caps_table
107 input_seq = gen table
108 events = [e | (_,e) <- input_seq]
109 keydowns = [Bytes s | (s,_) <- input_seq]
110 input = intersperse (Delay defaultEscDelay) keydowns
111 assert_events_from_input_block (map_to_legacy_table table) input events
113main :: IO ()
114main = defaultMain
115 [ testProperty "basic block generated from a single ansi chars to event translation"
116 verify_simple_input_block_to_event
117 , testProperty "key sequences read from caps table map to expected events"
118 verify_keys_from_caps_table_block_to_event
119 ]