@@ -18,12 +18,15 @@ import Graphics.Vty.Input.Terminfo
1818import Control.Applicative
1919import Control.Concurrent
2020import Control.Exception
21+import Control.Lens ((^.))
2122import Control.Monad
2223
24+import Data.Default
2325import Data.IORef
2426
2527import System.Console.Terminfo
2628import System.Posix.IO
29+import System.Posix.Terminal (openPseudoTerminal)
2730import System.Posix.Types
2831import System.Timeout
2932
@@ -76,8 +79,8 @@ gen_events_using_io_actions max_duration input_action output_action = do
7679 let max_duration' = max min_timout max_duration
7780 read_complete <- newEmptyMVar
7881 write_complete <- newEmptyMVar
79− _ <- forkIO $ input_action `finally` putMVar write_complete ()
80− _ <- forkIO $ output_action `finally` putMVar read_complete ()
82+ _ <- forkOS $ input_action `finally` putMVar write_complete ()
83+ _ <- forkOS $ output_action `finally` putMVar read_complete ()
8184 Just () <- timeout max_duration' $ takeMVar write_complete
8285 Just () <- timeout max_duration' $ takeMVar read_complete
8386 return ()
@@ -106,54 +109,29 @@ assert_events_from_syn_input :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO
106109assert_events_from_syn_input table input_spec expected_events = do
107110 let max_duration = sum [t | Delay t <- input_spec] + min_detectable_delay
108111 event_count = length expected_events
109− (output_fd, input_fd) <- createPipe
110− (output, shutdown_event_processing) <- initInputForFd test_esc_sample_delay table output_fd
112+ (write_fd, read_fd) <- openPseudoTerminal
113+ (set_term_attr,_) <- attributeControl read_fd
114+ set_term_attr
115+ input <- initInputForFd def table read_fd
111116 events_ref <- newIORef []
112117 let write_wait_close = do
113− synthesize_input input_spec input_fd
118+ synthesize_input input_spec write_fd
114119 threadDelay min_detectable_delay
115− shutdown_event_processing
120+ shutdown_input input
116121 threadDelay min_detectable_delay
117− closeFd input_fd
118− closeFd output_fd
122+ closeFd write_fd
123+ closeFd read_fd
119124 -- drain output pipe
120125 let read_events = read_loop event_count
121126 read_loop 0 = return ()
122127 read_loop n = do
123− e <- readChan output
128+ e <- readChan $ input^.event_channel
124129 modifyIORef events_ref ((:) e)
125130 read_loop (n - 1)
126131 gen_events_using_io_actions max_duration write_wait_close read_events
127132 out_events <- reverse <$> readIORef events_ref
128133 compare_events input_spec expected_events out_events
129134
130−assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool
131−assert_events_from_input_block table input_spec expected_events = do
132− let classifier = classify table
133− max_duration = sum [t | Delay t <- input_spec] + min_detectable_delay
134− input <- newChan
135− output <- newChan
136− gen_events_using_io_actions
137− max_duration
138− (write_input_spec_to_chan input_spec input)
139− (inputToEventThread classifier input output)
140− -- TODO: use STM TChan?
141− -- assures reading "length expected_events" from the channel does not block.
142− let min_event_count = length expected_events
143− writeList2Chan output $ replicate min_event_count undefined
144− out_events <- take min_event_count <$> getChanContents output
145− return $ out_events == expected_events
146−
147−write_input_spec_to_chan :: InputSpec -> Chan Char -> IO ()
148−write_input_spec_to_chan [] chan = do
149− writeChan chan '\xFFFD'
150−write_input_spec_to_chan (Bytes str : input_spec') chan = do
151− writeList2Chan chan str
152− write_input_spec_to_chan input_spec' chan
153−write_input_spec_to_chan (Delay _t : input_spec') chan = do
154− writeChan chan '\xFFFE'
155− write_input_spec_to_chan input_spec' chan
156−
157135newtype InputBlocksUsingTable event
158136 = InputBlocksUsingTable ([(String,event)] -> [(String, event)])
159137
@@ -168,24 +146,6 @@ instance Monad m => Serial m (InputBlocksUsingTable event) where
168146 selections [] = []
169147 selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z)
170148
171−verify_visible_input_block_to_event :: Property IO
172−verify_visible_input_block_to_event = forAll $ \(InputBlocksUsingTable gen) -> do
173− let input_seq = gen visible_chars
174− input = Bytes $ concat [s | (s,_) <- input_seq]
175− events = map snd input_seq
176− monadic $ assert_events_from_input_block visible_chars [input] events
177−
178−verify_keys_from_caps_table_block_to_event :: Property IO
179−verify_keys_from_caps_table_block_to_event = forAll $ \(InputBlocksUsingTable gen) ->
180− forEachOf terminals_of_interest $ \term_name -> monadic $ do
181− term <- setupTerm term_name
182− let table = caps_classify_table term keys_from_caps_table
183− input_seq = gen table
184− events = map snd input_seq
185− keydowns = map (Bytes . fst) input_seq
186− input = intersperse (Delay test_key_delay) keydowns ++ [Delay test_key_delay]
187− assert_events_from_input_block table input events
188−
189149verify_visible_syn_input_to_event :: Property IO
190150verify_visible_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do
191151 let table = visible_chars
@@ -228,11 +188,7 @@ verify_full_syn_input_to_event = forAll $ \(InputBlocksUsingTable gen) ->
228188
229189main :: IO ()
230190main = defaultMain
231− [ testProperty "basic block generated from a single visible chars to event translation"
232− verify_visible_input_block_to_event
233− , testProperty "key sequences read from caps table map to expected events"
234− verify_keys_from_caps_table_block_to_event
235− , testProperty "synthesized typing from single visible chars translates to expected events"
191+ [ testProperty "synthesized typing from single visible chars translates to expected events"
236192 verify_visible_syn_input_to_event
237193 , testProperty "synthesized typing from keys from capabilities tables translates to expected events"
238194 verify_caps_syn_input_to_event