on master help sign in
abstract event block generation from source table. initial terminfo caps based input block test
22774a9Corey O'Connor
src/Graphics/Vty.hs+1−1
@@ -73,7 +73,7 @@ data Vty = Vty
73-- | Set up the state object for using vty. At most one state object should be
73-- | Set up the state object for using vty. At most one state object should be
74-- created at a time.
74-- created at a time.
75mkVty :: IO Vty
75mkVty :: IO Vty
76−mkVty = mkVtyEscDelay 0
76+mkVty = mkVtyEscDelay defaultEscDelay
77
77
78-- | Set up the state object for using vty. At most one state object should be
78-- | Set up the state object for using vty. At most one state object should be
79-- created at a time. The delay, in microseconds, specifies the period of time to wait for a key
79-- created at a time. The delay, in microseconds, specifies the period of time to wait for a key
src/Graphics/Vty/Input.hs+7−3
@@ -4,11 +4,13 @@ module Graphics.Vty.Input ( Key(..)
4 , Button(..)
4 , Button(..)
5 , Event(..)
5 , Event(..)
6 , initTermInput
6 , initTermInput
7+ , defaultEscDelay
7 )
8 )
8 where
9 where
9
10
10import Graphics.Vty.Input.Data
11import Graphics.Vty.Input.Data
11import Graphics.Vty.Input.Internal
12import Graphics.Vty.Input.Internal
13+import Graphics.Vty.Input.Terminfo
12
14
13import Data.Char
15import Data.Char
14import Data.Word
16import Data.Word
@@ -29,6 +31,9 @@ import System.Posix.IO ( stdInput
29
31
30import Foreign ( alloca, poke, peek, Ptr )
32import Foreign ( alloca, poke, peek, Ptr )
31
33
34+defaultEscDelay :: Int
35+defaultEscDelay = 0
36+
32-- | Set up the terminal for input. Returns a function which reads key
37-- | Set up the terminal for input. Returns a function which reads key
33-- events, and a function for shutting down the terminal access.
38-- events, and a function for shutting down the terminal access.
34initTermInput :: Int -> Terminal -> IO (IO Event, IO ())
39initTermInput :: Int -> Terminal -> IO (IO Event, IO ())
@@ -76,9 +81,8 @@ initTermInput escDelay terminal = do
76 finishAtomicInput
81 finishAtomicInput
77 loop
82 loop
78
83
79− extract_cap = first (getCapability terminal . tiGetStr)
80− caps_classify_table = map_to_legacy_table [(x,y) | (Just x,y) <- map extract_cap keys_from_caps_table]
84+ caps_legacy_table = map_to_legacy_table $ caps_classify_table terminal keys_from_caps_table
81− term_event_classify_table = concat $ caps_classify_table : ansi_classify_table
85+ term_event_classify_table = concat $ caps_legacy_table : ansi_classify_table
82 term_event_classifier = classify term_event_classify_table
86 term_event_classifier = classify term_event_classify_table
83
87
84 eventThreadId <- forkIO $ inputToEventThread term_event_classifier inputChannel eventChannel
88 eventThreadId <- forkIO $ inputToEventThread term_event_classifier inputChannel eventChannel
test/VerifyUsingMockInput.hs+32−14
@@ -8,18 +8,22 @@ module Main where
8
8
9import Verify.Graphics.Vty.Terminal
9import Verify.Graphics.Vty.Terminal
10
10
11+import Data.List (intersperse, permutations)
12+
11import Graphics.Vty hiding (resize)
13import Graphics.Vty hiding (resize)
12import Graphics.Vty.Input
14import Graphics.Vty.Input
13import Graphics.Vty.Input.Data
15import Graphics.Vty.Input.Data
14import Graphics.Vty.Input.Internal
16import Graphics.Vty.Input.Internal
17+import Graphics.Vty.Input.Terminfo
15
18
16import Control.Applicative
19import Control.Applicative
17import Control.Concurrent
20import Control.Concurrent
18import Control.Exception
21import Control.Exception
19import Control.Monad
22import Control.Monad
20
23
21−import System.Posix.Env
24+import System.Console.Terminfo
22import System.IO
25import System.IO
26+import System.Posix.Env
23
27
24import Test.Framework.Providers.SmallCheck
28import Test.Framework.Providers.SmallCheck
25import Test.Framework
29import Test.Framework
@@ -68,12 +72,6 @@ write_input_spec_to_chan chan (Delay t : input_spec')
68
72
69{-
73{-
70
74
71−verify_keys_from_caps_table :: String -> Property
72−verify_keys_from_caps_table = do
73− term_name <- elements terminals_of_interest
74− cap <- elements keys_from_caps_table
75−
76−
77tests :: IO [Test]
75tests :: IO [Test]
78tests = do
76tests = do
79 mappend
77 mappend
@@ -85,20 +83,40 @@ tests = do
85 ]
83 ]
86-}
84-}
87
85
88−data SimpleEvent = SimpleEvent (String, (Key, [Modifier]))
86+-- how to make this data dependent?
89− deriving (Show)
90
87
88+newtype EventBlock event = EventBlock ([(String,event)] -> [(String, event)])
89+
90+instance Show (EventBlock event) where
91+ show (EventBlock g) = "EventBlock(* -> *)"
92+
91−instance Monad m => Serial m SimpleEvent where
93+instance Monad m => Serial m (EventBlock event) where
92− series = generate (\n -> map SimpleEvent $ take n simple_chars)
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))
93
97
94verify_simple_input_block_to_event :: Property IO
98verify_simple_input_block_to_event :: Property IO
95−verify_simple_input_block_to_event = forAll $ \input_spec -> do
99+verify_simple_input_block_to_event = forAll $ \(EventBlock block_gen) -> do
100+ let simple_input_seq = block_gen simple_chars
96− let input = Bytes $ concat [s | SimpleEvent (s,_) <- input_spec]
101+ input = Bytes $ concat [s | (s,_) <- simple_input_seq]
97− events = [e | SimpleEvent (_,(k,ms)) <- input_spec, let e = EvKey k ms]
102+ events = [e | (_,(k,ms)) <- simple_input_seq, let e = EvKey k ms]
98 monadic $ assert_events_from_input_block simple_chars [input] events
103 monadic $ assert_events_from_input_block simple_chars [input] events
99
104
105+verify_keys_from_caps_table_block_to_event :: Property IO
106+verify_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
115+
100main = defaultMain
116main = defaultMain
101 [ testProperty "basic block generated from a single ansi chars to event translation"
117 [ testProperty "basic block generated from a single ansi chars to event translation"
102 verify_simple_input_block_to_event
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
103 ]
121 ]
104
122
vty.cabal+2
@@ -62,6 +62,7 @@ library
62 Graphics.Vty.Input
62 Graphics.Vty.Input
63 Graphics.Vty.Input.Data
63 Graphics.Vty.Input.Data
64 Graphics.Vty.Input.Internal
64 Graphics.Vty.Input.Internal
65+ Graphics.Vty.Input.Terminfo
65 Graphics.Vty.Picture
66 Graphics.Vty.Picture
66 Graphics.Vty.Terminal
67 Graphics.Vty.Terminal
67 Graphics.Text.Width
68 Graphics.Text.Width
@@ -527,6 +528,7 @@ test-suite verify-using-mock-input
527 containers,
528 containers,
528 deepseq >= 1.1 && < 1.4,
529 deepseq >= 1.1 && < 1.4,
529 mtl >= 1.1.1.0 && < 2.2,
530 mtl >= 1.1.1.0 && < 2.2,
531+ terminfo >= 0.3 && < 0.4,
530 text >= 0.11.3,
532 text >= 0.11.3,
531 unix,
533 unix,
532 utf8-string >= 0.3 && < 0.4,
534 utf8-string >= 0.3 && < 0.4,