git.iko.soy/vty
on 22774a9 help sign in
vty/test/VerifyUsingMockInput.hs
122 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
26import System.Posix.Env
28import Test.Framework.Providers.SmallCheck
29import Test.Framework
30import Test.SmallCheck
31import Test.SmallCheck.Series
33-- processing a block of 16 chars is the largest I can do without taking too long to run the test.
34max_bytes_size = 16
36data InputEvent
37 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
38 | Delay Int -- | millisecond delay
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 let classifier = classify table
53 input <- newChan
54 output <- newChan
55 forkIO $ write_input_spec_to_chan input input_spec
56 inputToEventThread classifier input output
57 -- H: all events are available in output channel
58 -- TODO: switch to using explicit control events. Currently the channel is passing around a
59 -- magic FFFX characters
60 -- TODO: use STM channel
61 let collect_events = handle (\(e :: BlockedIndefinitelyOnMVar) -> return [])
62 ((:) <$> readChan output <*> collect_events)
63 out_events <- collect_events
64 return $ out_events == expected_events
66write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
67write_input_spec_to_chan chan [] = writeChan chan '\xFFFD'
68write_input_spec_to_chan chan (Bytes str : input_spec')
69 = writeList2Chan chan str >> write_input_spec_to_chan chan input_spec'
70write_input_spec_to_chan chan (Delay t : input_spec')
71 = writeChan chan '\xFFFE' >> write_input_spec_to_chan chan input_spec'
73{-
75tests :: IO [Test]
76tests = do
77 mappend
78 <$> pure [ verify "basic block generated from single ansi chars to event translation" ]
79 <*> mapM terminals_of_interest
80 verify_simple_input_block_to_event
81 , verify "keys from caps table are parsed to the same key"
82 verify_keys_from_caps_table
83 ]
84-}
86-- how to make this data dependent?
88newtype EventBlock event = EventBlock ([(String,event)] -> [(String, event)])
90instance Show (EventBlock event) where
91 show (EventBlock g) = "EventBlock(* -> *)"
93instance Monad m => Serial m (EventBlock event) where
94 series = do
95 n :: Int <- localDepth (max 16) series -- what elements to select from the table
96 return $ EventBlock $ \table -> concat (take n (permutations table))
98verify_simple_input_block_to_event :: Property IO
99verify_simple_input_block_to_event = forAll $ \(EventBlock block_gen) -> do
100 let simple_input_seq = block_gen simple_chars
101 input = Bytes $ concat [s | (s,_) <- simple_input_seq]
102 events = [e | (_,(k,ms)) <- simple_input_seq, let e = EvKey k ms]
103 monadic $ assert_events_from_input_block simple_chars [input] events
105verify_keys_from_caps_table_block_to_event :: Property IO
106verify_keys_from_caps_table_block_to_event = forAll $ \(EventBlock block_gen) ->
107 over (generate (\n -> take n terminals_of_interest)) $ \term_name -> monadic $ do
108 terminal <- setupTerm term_name
109 let caps_seq :: [(String, Event)] = block_gen keys_from_caps_table
110 let bytes_seq = caps_classify_table terminal caps_seq
111 input = [Bytes s | (s,_) <- bytes_seq]
112 escaped_sequence = intersperse (Delay defaultEscDelay) input
113 return True :: IO Bool
114 -- cap <- elements keys_from_caps_table
116main = defaultMain
117 [ testProperty "basic block generated from a single ansi chars to event translation"
118 verify_simple_input_block_to_event
119 , testProperty "key sequences read from caps table map to expected events"
120 verify_keys_from_caps_table_block_to_event
121 ]