mirror of
https://github.com/ilyakooo0/vty.git
synced 2024-10-04 11:17:08 +03:00
116 lines
4.3 KiB
Haskell
116 lines
4.3 KiB
Haskell
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{- We setup the environment to envoke certain terminals of interest.
|
|
- This assumes appropriate definitions exist in the current environment for the terminals of
|
|
- interest.
|
|
-}
|
|
module Main where
|
|
|
|
import Verify.Graphics.Vty.Terminal
|
|
|
|
import Data.List (intersperse, permutations)
|
|
|
|
import Graphics.Vty hiding (resize)
|
|
import Graphics.Vty.Input
|
|
import Graphics.Vty.Input.Data
|
|
import Graphics.Vty.Input.Internal
|
|
import Graphics.Vty.Input.Terminfo
|
|
|
|
import Control.Applicative
|
|
import Control.Concurrent
|
|
import Control.Exception
|
|
import Control.Monad
|
|
|
|
import System.Console.Terminfo
|
|
import System.IO
|
|
|
|
import Test.Framework.Providers.SmallCheck
|
|
import Test.Framework
|
|
import Test.SmallCheck
|
|
import Test.SmallCheck.Series
|
|
|
|
-- processing a block of 16 chars is the largest I can do without taking too long to run the test.
|
|
max_block_size :: Int
|
|
max_block_size = 16
|
|
|
|
data InputEvent
|
|
= Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
|
|
| Delay Int -- | millisecond delay
|
|
deriving Show
|
|
|
|
type InputSpec = [InputEvent]
|
|
|
|
type ExpectedSpec = [Event]
|
|
|
|
exec_input_spec :: InputSpec -> Handle -> IO ()
|
|
exec_input_spec input out_handle = forM_ input f
|
|
where
|
|
f (Bytes str) = hPutStr out_handle str >> hFlush out_handle
|
|
f (Delay t) = threadDelay (t*1000)
|
|
|
|
assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool
|
|
assert_events_from_input_block table input_spec expected_events = do
|
|
print input_spec
|
|
let classifier = classify table
|
|
input <- newChan
|
|
output <- newChan
|
|
read_complete <- newEmptyMVar
|
|
write_complete <- newEmptyMVar
|
|
_ <- forkIO $ write_input_spec_to_chan input input_spec
|
|
`finally` putMVar write_complete ()
|
|
_ <- forkIO $ inputToEventThread classifier input output
|
|
`finally` putMVar read_complete ()
|
|
() <- takeMVar write_complete
|
|
() <- takeMVar read_complete
|
|
-- TODO: use STM channel
|
|
-- assures the next line does not block.
|
|
writeList2Chan output $ replicate (length expected_events) undefined
|
|
out_events <- take (length expected_events) <$> getChanContents output
|
|
return $ out_events == expected_events
|
|
|
|
write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
|
|
write_input_spec_to_chan chan [] = do
|
|
writeChan chan '\xFFFD'
|
|
write_input_spec_to_chan chan (Bytes str : input_spec') = do
|
|
writeList2Chan chan str
|
|
write_input_spec_to_chan chan input_spec'
|
|
write_input_spec_to_chan chan (Delay _t : input_spec') = do
|
|
writeChan chan '\xFFFE'
|
|
write_input_spec_to_chan chan input_spec'
|
|
|
|
newtype EventBlock event = EventBlock ([(String,event)] -> [(String, event)])
|
|
|
|
instance Show (EventBlock event) where
|
|
show (EventBlock g) = "EventBlock(*->*)"
|
|
|
|
instance Monad m => Serial m (EventBlock event) where
|
|
series = do
|
|
n :: Int <- localDepth (max max_block_size) series -- what elements to select from the table
|
|
return $ EventBlock $ \table -> concat (take n (permutations table))
|
|
|
|
verify_simple_input_block_to_event :: Property IO
|
|
verify_simple_input_block_to_event = forAll $ \(EventBlock block_gen) -> do
|
|
let simple_input_seq = block_gen simple_chars
|
|
input = Bytes $ concat [s | (s,_) <- simple_input_seq]
|
|
events = [e | (_,(k,ms)) <- simple_input_seq, let e = EvKey k ms]
|
|
monadic $ assert_events_from_input_block simple_chars [input] events
|
|
|
|
verify_keys_from_caps_table_block_to_event :: Property IO
|
|
verify_keys_from_caps_table_block_to_event = forAll $ \(EventBlock block_gen) ->
|
|
over (generate (\n -> take n terminals_of_interest)) $ \term_name -> monadic $ do
|
|
terminal <- setupTerm term_name
|
|
let table = caps_classify_table terminal keys_from_caps_table
|
|
input_seq :: [(String, Event)] = block_gen table
|
|
input_bytes = [Bytes s | (s,_) <- input_seq]
|
|
input = intersperse (Delay defaultEscDelay) input_bytes
|
|
events = [e | (_,e) <- input_seq]
|
|
assert_events_from_input_block (map_to_legacy_table table) input events
|
|
|
|
main = defaultMain
|
|
[ testProperty "basic block generated from a single ansi chars to event translation"
|
|
verify_simple_input_block_to_event
|
|
, testProperty "key sequences read from caps table map to expected events"
|
|
verify_keys_from_caps_table_block_to_event
|
|
]
|
|
|