git.iko.soy/vty
on 4726c74 help sign in
vty/test/VerifyUsingMockInput.hs
104 lines 3.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 Graphics.Vty hiding (resize)
12import Graphics.Vty.Input
13import Graphics.Vty.Input.Data
14import Graphics.Vty.Input.Internal
16import Control.Applicative
17import Control.Concurrent
18import Control.Exception
19import Control.Monad
21import System.Posix.Env
22import System.IO
24import Test.Framework.Providers.SmallCheck
25import Test.Framework
26import Test.SmallCheck
27import Test.SmallCheck.Series
29-- processing a block of 16 chars is the largest I can do without taking too long to run the test.
30max_bytes_size = 16
32data InputEvent
33 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
34 | Delay Int -- | millisecond delay
36type InputSpec = [InputEvent]
38type ExpectedSpec = [Event]
40exec_input_spec :: InputSpec -> Handle -> IO ()
41exec_input_spec input out_handle = forM_ input f
42 where
43 f (Bytes str) = hPutStr out_handle str >> hFlush out_handle
44 f (Delay t) = threadDelay (t*1000)
46assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool
47assert_events_from_input_block table input_spec expected_events = do
48 let classifier = classify table
49 input <- newChan
50 output <- newChan
51 forkIO $ write_input_spec_to_chan input input_spec
52 inputToEventThread classifier input output
53 -- H: all events are available in output channel
54 -- TODO: switch to using explicit control events. Currently the channel is passing around a
55 -- magic FFFX characters
56 -- TODO: use STM channel
57 let collect_events = handle (\(e :: BlockedIndefinitelyOnMVar) -> return [])
58 ((:) <$> readChan output <*> collect_events)
59 out_events <- collect_events
60 return $ out_events == expected_events
62write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
63write_input_spec_to_chan chan [] = writeChan chan '\xFFFD'
64write_input_spec_to_chan chan (Bytes str : input_spec')
65 = writeList2Chan chan str >> write_input_spec_to_chan chan input_spec'
66write_input_spec_to_chan chan (Delay t : input_spec')
67 = writeChan chan '\xFFFE' >> write_input_spec_to_chan chan input_spec'
69{-
71verify_keys_from_caps_table :: String -> Property
72verify_keys_from_caps_table = do
73 term_name <- elements terminals_of_interest
74 cap <- elements keys_from_caps_table
77tests :: IO [Test]
78tests = do
79 mappend
80 <$> pure [ verify "basic block generated from single ansi chars to event translation" ]
81 <*> mapM terminals_of_interest
82 verify_simple_input_block_to_event
83 , verify "keys from caps table are parsed to the same key"
84 verify_keys_from_caps_table
85 ]
86-}
88data SimpleEvent = SimpleEvent (String, (Key, [Modifier]))
89 deriving (Show)
91instance Monad m => Serial m SimpleEvent where
92 series = generate (\n -> map SimpleEvent $ take n simple_chars)
94verify_simple_input_block_to_event :: Property IO
95verify_simple_input_block_to_event = forAll $ \input_spec -> do
96 let input = Bytes $ concat [s | SimpleEvent (s,_) <- input_spec]
97 events = [e | SimpleEvent (_,(k,ms)) <- input_spec, let e = EvKey k ms]
98 monadic $ assert_events_from_input_block simple_chars [input] events
100main = defaultMain
101 [ testProperty "basic block generated from a single ansi chars to event translation"
102 verify_simple_input_block_to_event
103 ]