git.iko.soy/vty
on master help sign in
derive new input loop
87e09a1Corey O'Connor
cbits/set_term_timing.c+3−3
compare with master
unifiedsplit
@@ -3,11 +3,11 @@
3#include <unistd.h>
3#include <unistd.h>
4#include <stdlib.h>
4#include <stdlib.h>
5
5
6−void vty_set_term_timing(int fd)
6+void vty_set_term_timing(int fd, int vmin, int vtime)
7{
7{
8 struct termios trm;
8 struct termios trm;
9 tcgetattr(fd, &trm);
9 tcgetattr(fd, &trm);
10− trm.c_cc[VMIN] = 0;
10+ trm.c_cc[VMIN] = vmin;
11− trm.c_cc[VTIME] = 0;
11+ trm.c_cc[VTIME] = vtime;
12 tcsetattr(fd, TCSANOW, &trm);
12 tcsetattr(fd, TCSANOW, &trm);
13}
13}
src/Graphics/Vty/Input.hs+41−30
@@ -1,5 +1,36 @@
1-- | The input layer for VTY. This provides methods for initializing an 'Input' structure which can
1-- | The input layer for VTY. This provides methods for initializing an 'Input' structure which can
2-- then be used to read 'Event's from the terminal.
2-- then be used to read 'Event's from the terminal.
3+--
4+-- Right, brain rot trying to figure this out exactly. So, as far as I can care:
5+--
6+-- There are two input modes for control sequences:
7+--
8+-- 1. 7 bit
9+--
10+-- 2. 8 bit
11+--
12+-- Which should be used depends on the need to enter Unicode as UTF-8 or not.
13+--
14+-- * 7 bit mode: UTF-8 can be input unambiguiously. The timing of ESC in the input sequence
15+-- determines whether the ESC is: Individual, part of a control key sequence, part of a meta key
16+-- combination.
17+--
18+-- * 8 bit mode: UTF-8 cannot be input unamboguiously AFAIK. Does not require an escape delay.
19+--
20+-- vty assumes 7 bit mode. Which is the default AFAIK.
21+--
22+-- 1. ESC individually: ESC byte, no bytes for control-seq-period,
23+-- no bytes for meta-combo-period.
24+--
25+-- 2. control keys that contain ESC in their byte sequence: ESC byte, bytes read within
26+-- control-seq-period are part of the sequence. Up until the next valid input block.
27+--
28+-- 3. ESC used as meta in a key combination: ESC byte, no other bytes read within
29+-- control-seq-period. Bytes up until next valid input block are the input events plus meta.
30+--
31+-- This, as best I can figure, is what VMIN and VTIME are supposed to be for. For some reason vty
32+-- implements the timing in the library. I'm not sure if this is an advantage or not. Getting this
33+-- right has provided a strangely interesting task so I haven't cared to determine.
3module Graphics.Vty.Input ( Key(..)
34module Graphics.Vty.Input ( Key(..)
4 , Modifier(..)
35 , Modifier(..)
5 , Button(..)
36 , Button(..)
@@ -17,6 +48,8 @@ import Graphics.Vty.Input.Terminfo
17
48
18import Control.Concurrent
49import Control.Concurrent
19
50
51+import Data.IORef
52+
20import qualified System.Console.Terminfo as Terminfo
53import qualified System.Console.Terminfo as Terminfo
21import System.Environment
54import System.Environment
22import System.Posix.Signals.Exts
55import System.Posix.Signals.Exts
@@ -24,36 +57,12 @@ import System.Posix.Terminal
24import System.Posix.IO (stdInput)
57import System.Posix.IO (stdInput)
25import System.Posix.Types (Fd)
58import System.Posix.Types (Fd)
26
59
27−-- Right, I'm mostly guessing on these details. So, as far as I can figure:
28−--
29−-- There are two input modes:
30−-- 1. 7 bit
31−-- 2. 8 bit
32−--
33−-- Which is better? Well, depends on if you want to enter Unicode as UTF-8 or not.
34−--
35−-- * 7 bit mode: UTF-8 can be input unambiguiously.
36−-- * 8 bit mode: UTF-8 cannot be input. Does not require an escape delay.
37−--
38−-- vty uses 7 bit mode.
39−--
40−-- To differentiate between ESC and control keys that contain ESC:
41−-- vty using the timing of the input to differentiate.
42−-- This, I best I can figure, is what VMIN and VTIME are supposed to be for.
43−-- For some reason, I don't yet know, vty implements the timing in the library.
44−-- I'm not sure if this is an advantage or not!
45−
46−-- | By default, the escape delay is 10000 microseconds. Which is assumed to be well above the
47−-- sampling rate required to detect a keyup for a person typing 200 wpm.
48−defaultEscDelay :: Int
49−defaultEscDelay = 10000
50−
51-- | Set up the current terminal for input.
60-- | Set up the current terminal for input.
52-- This determines the current terminal then invokes 'input_for_name_and_io'
61-- This determines the current terminal then invokes 'input_for_name_and_io'
53−input_for_current_terminal :: Int -> IO Input
62+input_for_current_terminal :: Config -> IO Input
54−input_for_current_terminal escDelay = do
63+input_for_current_terminal config = do
55 term_name <- getEnv "TERM"
64 term_name <- getEnv "TERM"
56− input_for_name_and_io escDelay term_name stdInput
65+ input_for_name_and_io config term_name stdInput
57
66
58-- | Set up the terminal attached to the given Fd for input. Returns a 'Input'.
67-- | Set up the terminal attached to the given Fd for input. Returns a 'Input'.
59--
68--
@@ -80,8 +89,8 @@ input_for_current_terminal escDelay = do
80-- * IEXTEN disabled
89-- * IEXTEN disabled
81-- - extended functions are disabled. Uh. Whatever these are.
90-- - extended functions are disabled. Uh. Whatever these are.
82--
91--
83−input_for_name_and_io :: Int -> String -> Fd -> IO Input
92+input_for_name_and_io :: Config -> String -> Fd -> IO Input
84−input_for_name_and_io escDelay term_name term_in = do
93+input_for_name_and_io config term_name term_in = do
85 terminal <- Terminfo.setupTerm term_name
94 terminal <- Terminfo.setupTerm term_name
86 attr <- getTerminalAttributes term_in
95 attr <- getTerminalAttributes term_in
87 let attr' = foldl withoutMode attr [ StartStopOutput, KeyboardInterrupts
96 let attr' = foldl withoutMode attr [ StartStopOutput, KeyboardInterrupts
@@ -90,7 +99,8 @@ input_for_name_and_io escDelay term_name term_in = do
90 setTerminalAttributes term_in attr' Immediately
99 setTerminalAttributes term_in attr' Immediately
91 set_term_timing term_in
100 set_term_timing term_in
92 let classify_table = classify_table_for_term term_name terminal
101 let classify_table = classify_table_for_term term_name terminal
102+ config_ref <- newIORef config
93− (eventChannel, shutdown_event_processing) <- initInputForFd escDelay classify_table term_in
103+ (eventChannel, shutdown_event_processing) <- initInputForFd config_ref classify_table term_in
94 let pokeIO = Catch $ do
104 let pokeIO = Catch $ do
95 let e = error "(getsize in input layer)"
105 let e = error "(getsize in input layer)"
96 setTerminalAttributes term_in attr' Immediately
106 setTerminalAttributes term_in attr' Immediately
@@ -104,4 +114,5 @@ input_for_name_and_io escDelay term_name term_in = do
104 _ <- installHandler windowChange Ignore Nothing
114 _ <- installHandler windowChange Ignore Nothing
105 _ <- installHandler continueProcess Ignore Nothing
115 _ <- installHandler continueProcess Ignore Nothing
106 setTerminalAttributes term_in attr Immediately
116 setTerminalAttributes term_in attr Immediately
117+ , config_ref = config_ref
107 }
118 }
src/Graphics/Vty/Input/Internal.hs+164−34
@@ -1,3 +1,6 @@
1+{-# LANGUAGE NoMonomorphismRestriction #-}
2+{-# LANGUAGE TemplateHaskell #-}
3+{-# LANGUAGE CPP #-}
1-- Much of the input layer used to be in a single module with a few large functions. I've refactored
4-- Much of the input layer used to be in a single module with a few large functions. I've refactored
2-- the input layer into many small bits. Now, I think, the code is a better position to be
5-- the input layer into many small bits. Now, I think, the code is a better position to be
3-- incrementally refined. Still, until there are proper tests in place much of the refinement must
6-- incrementally refined. Still, until there are proper tests in place much of the refinement must
@@ -7,18 +10,25 @@ module Graphics.Vty.Input.Internal where
7import Graphics.Vty.Input.Events
10import Graphics.Vty.Input.Events
8
11
9import Codec.Binary.UTF8.Generic (decode)
12import Codec.Binary.UTF8.Generic (decode)
13+import Control.Applicative
10import Control.Concurrent
14import Control.Concurrent
15+import Control.Lens
11import Control.Exception (try, IOException)
16import Control.Exception (try, IOException)
12−import Control.Monad (when, void)
17+import Control.Monad (when, void, mzero)
18+import Control.Monad.IO.Class (liftIO)
19+import Control.Monad.Trans.State (StateT(..))
20+import Control.Monad.Trans.Reader (ReaderT(..))
13
21
14import Data.Char
22import Data.Char
23+import Data.Default
24+import Data.IORef
15import Data.List( inits )
25import Data.List( inits )
16import qualified Data.Map as M( fromList, lookup )
26import qualified Data.Map as M( fromList, lookup )
17import Data.Maybe ( mapMaybe )
27import Data.Maybe ( mapMaybe )
18import qualified Data.Set as S( fromList, member )
28import qualified Data.Set as S( fromList, member )
19import Data.Word
29import Data.Word
20
30
21−import Foreign ( alloca, poke, peek, Ptr )
31+import Foreign ( alloca, poke, peek, peekArray, Ptr )
22import Foreign.C.Types (CInt(..))
32import Foreign.C.Types (CInt(..))
23
33
24import System.Posix.IO ( fdReadBuf
34import System.Posix.IO ( fdReadBuf
@@ -27,48 +37,164 @@ import System.Posix.IO ( fdReadBuf
27 )
37 )
28import System.Posix.Types (Fd(..))
38import System.Posix.Types (Fd(..))
29
39
40+data Config = Config
41+ { controlSeqPeriod :: Int -- ^ default control sequence period is 10000 microseconds. Which is
42+ -- assumed to be well above the sampling rate required to detect a
43+ -- keyup for a person typing 200 wpm.
44+ , metaComboPeriod :: Int -- ^ The default meta combo period is 100000 microseconds.
45+ } deriving (Show, Eq)
46+
47+instance Default Config where
48+ def = Config
49+ { controlSeqPeriod = 10000
50+ , metaComboPeriod = 100000
51+ }
52+
30data Input = Input
53data Input = Input
31 { -- | Channel of events direct from input processing. Unlike 'next_event' this will not refresh
54 { -- | Channel of events direct from input processing. Unlike 'next_event' this will not refresh
32 -- the display if the next event is an 'EvResize'.
55 -- the display if the next event is an 'EvResize'.
33− event_channel :: Chan Event
56+ _event_channel :: Chan Event
34 -- | Shuts down the input processing. This should return the terminal input state to before
57 -- | Shuts down the input processing. This should return the terminal input state to before
35 -- the input initialized.
58 -- the input initialized.
36 , shutdown_input :: IO ()
59 , shutdown_input :: IO ()
60+ -- | Changes to this value are reflected after the next event.
61+ , _config_ref :: IORef Config
62+ -- | File descriptor used for input.
63+ , _input_fd :: Fd
37 }
64 }
38
65
66+makeLenses ''Input
67+
39data KClass
68data KClass
40− = Valid Key [Modifier]
69+ = Valid Key [Modifier] [Char]
41 | Invalid
70 | Invalid
42− | EndLoop
43 | Prefix
71 | Prefix
44− | MisPfx Key [Modifier] [Char]
45− deriving(Show)
72+ deriving(Show, Eq)
73+
74+data InputBuffer = InputBuffer
75+ { _ptr :: Ptr Word8
76+ , _size :: Int
77+ }
78+
79+makeLenses ''InputBuffer
80+
81+data InputState = InputState
82+ { _unprocessed_bytes :: String
83+ , _applied_config :: Config
84+ , _input_buffer :: InputBuffer
85+ , _stop_request_ref :: IORef Bool
86+ , _classifier :: String -> KClass
87+ }
88+
89+makeLenses ''InputState
90+
91+type InputM a = StateT InputState (ReaderT Input IO) a
92+
93+loop_input_processor :: InputM ()
94+loop_input_processor = do
95+ read_from_device >>= add_bytes_to_process
96+ _ <- many $ parse_event >>= emit
97+ drop_invalid
98+ stop_requested <|> loop_input_processor
99+
100+add_bytes_to_process :: String -> InputM ()
101+add_bytes_to_process block = unprocessed_bytes <>= block
102+
103+emit :: Event -> InputM ()
104+emit event = view event_channel >>= liftIO . flip writeChan event
105+
106+read_from_device :: InputM String
107+read_from_device = do
108+ new_config <- view config_ref >>= liftIO . readIORef
109+ old_config <- use applied_config
110+ fd <- view input_fd
111+ when (new_config /= old_config) $ do
112+ let vtime = min 255 $ metaComboPeriod new_config `div` 100000
113+ liftIO $ set_term_timing fd 0 vtime
114+ applied_config .= new_config
115+ buffer_ptr <- use $ input_buffer.ptr
116+ max_bytes <- use $ input_buffer.size
117+ liftIO $ do
118+ bytes_read <- fdReadBuf fd buffer_ptr (fromIntegral max_bytes)
119+ fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytes_read) buffer_ptr
120+
121+parse_event :: InputM Event
122+parse_event = do
123+ c <- use classifier
124+ b <- use unprocessed_bytes
125+ case c b of
126+ Valid k m remaining -> do
127+ unprocessed_bytes .= remaining
128+ return $ EvKey k m
129+ _ -> mzero
130+
131+drop_invalid :: InputM ()
132+drop_invalid = do
133+ c <- use classifier
134+ b <- use unprocessed_bytes
135+ when (c b == Invalid) $ unprocessed_bytes .= []
136+
137+stop_requested :: InputM ()
138+stop_requested = do
139+ True <- (liftIO . readIORef) =<< use stop_request_ref
140+ return ()
141+
142+#if 0
143+data InputChunk
144+ = StopInput
145+ | InputChunk String
146+ | InputBreak
46
147
47-- The input uses two magic character:
148-- The input uses two magic character:
48--
149--
49-- * '\xFFFD' for "stop processing"
150-- * '\xFFFD' for "stop processing"
50-- * '\xFFFE' for "previous input chunk is complete" Which is used to differentiate a single ESC
151-- * '\xFFFE' for "previous input chunk is complete" Which is used to differentiate a single ESC
51-- from using ESC as meta or to indicate a control sequence.
152-- from using ESC as meta or to indicate a control sequence.
153+--
154+-- | Read 'InputChunk' from the input channel, parse into one or more 'Event's, output to event
155+-- channel.
156+--
157+-- Each input chunk is added to the current chunk being processed. The current chunk is processed
158+-- with the provided function to determine events.
52−inputToEventThread :: (String -> KClass) -> Chan Char -> Chan Event -> IO ()
159+inputToEventThread :: (String -> KClass) -> Chan InputChunk -> Chan Event -> IO ()
53inputToEventThread classifier inputChannel eventChannel = loop []
160inputToEventThread classifier inputChannel eventChannel = loop []
161+ where
162+ loop current =
163+ c <- readChan inputChannel
164+ case c of
165+ StopInput -> return ()
166+ -- the prefix is missing bytes and there are bytes available.
167+ InputChunk chunk -> parse_until_prefix (current ++ chunk)
168+ >>= loop
169+ -- if there are bytes remaining after all events are parsed then the spacing after
170+ InputBreak -> parse_until_prefix current
171+ >> loop []
54− where loop kb = case classifier kb of
172+ parse_until_prefix current = case classifier current of
173+ Prefix -> return current
174+ Invalid -> return []
175+ Valid k m remaining -> do
176+ writeChan eventChannel (EvKey k m)
177+ parse_until_prefix remaining
178+
55 Prefix -> do
179 Prefix -> do
56 c <- readChan inputChannel
180 c <- readChan inputChannel
57− if c == '\xFFFD'
181+ case c of
58− then return ()
182+ StopInput -> return ()
59− else loop (kb ++ [c])
183+ -- the prefix is missing bytes and there are bytes available.
184+ InputChunk chunk -> loop (current ++ chunk)
185+ -- the prefix is a control sequence that is unknown. Drop and move on to the next
186+ MetaShiftChunk chunk -> loop chunk
60 -- drop the entirety of invalid sequences. Probably better to drop only the first
187 -- drop the entirety of invalid sequences. Probably better to drop only the first
61 -- character. However, the read behavior of terminals (a single read corresponds to the
188 -- character. However, the read behavior of terminals (a single read corresponds to the
62 -- bytes of a single event) might mean this results in quicker error recovery from a
189 -- bytes of a single event) might mean this results in quicker error recovery from a
63 -- users perspective.
190 -- users perspective.
64 Invalid -> do
191 Invalid -> do
65 c <- readChan inputChannel
192 c <- readChan inputChannel
66− if c == '\xFFFD'
193+ case c of
67− then return ()
194+ EndChunk -> return ()
68− else loop [c]
195+ InputChunk chunk -> loop chunk
69− EndLoop -> return ()
70− MisPfx k m s -> writeChan eventChannel (EvKey k m) >> loop s
71− Valid k m -> writeChan eventChannel (EvKey k m) >> loop ""
196+ Valid k m remaining -> writeChan eventChannel (EvKey k m) >> loop remaining
197+#endif
72
198
73-- This makes a kind of tri. Has space efficiency issues with large input blocks.
199-- This makes a kind of tri. Has space efficiency issues with large input blocks.
74-- Likely building a parser and just applying that would be better.
200-- Likely building a parser and just applying that would be better.
@@ -87,22 +213,20 @@ compile table = cl' where
87 -- if the input_block is exactly what is expected for an event then consume the whole
213 -- if the input_block is exactly what is expected for an event then consume the whole
88 -- block and return the event
214 -- block and return the event
89 False -> case event_for_input input_block of
215 False -> case event_for_input input_block of
90− Just (EvKey k m) -> Valid k m
216+ Just (EvKey k m) -> Valid k m []
91 -- look up progressively large prefixes of the input block until an event is found
217 -- look up progressively large prefixes of the input block until an event is found
92 -- H: There will always be one match. The prefix_set contains, by definition, all
218 -- H: There will always be one match. The prefix_set contains, by definition, all
93 -- prefixes of an event.
219 -- prefixes of an event.
94 Nothing ->
220 Nothing ->
95 let input_prefixes = init $ inits input_block
221 let input_prefixes = init $ inits input_block
96 in case mapMaybe (\s -> (,) s `fmap` event_for_input s) input_prefixes of
222 in case mapMaybe (\s -> (,) s `fmap` event_for_input s) input_prefixes of
97− (s,EvKey k m) : _ -> MisPfx k m (drop (length s) input_block)
223+ (s,EvKey k m) : _ -> Valid k m (drop (length s) input_block)
98 -- neither a prefix or a full event. Might be interesting to log.
224 -- neither a prefix or a full event. Might be interesting to log.
99− [] -> error $ show input_block
225+ [] -> Invalid
100
226
101classify, classifyTab :: ClassifyTable -> [Char] -> KClass
227classify, classifyTab :: ClassifyTable -> [Char] -> KClass
102
228
103-- As soon as
229-- As soon as
104−classify _table "\xFFFD" = EndLoop
105−classify _table "\xFFFE" = Invalid
106classify _table s@(c:_) | ord c >= 0xC2
230classify _table s@(c:_) | ord c >= 0xC2
107 = if utf8Length (ord c) > length s then Prefix else classifyUtf8 s -- beginning of an utf8 sequence
231 = if utf8Length (ord c) > length s then Prefix else classifyUtf8 s -- beginning of an utf8 sequence
108classify table other
232classify table other
@@ -110,7 +234,7 @@ classify table other
110
234
111classifyUtf8 :: [Char] -> KClass
235classifyUtf8 :: [Char] -> KClass
112classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of
236classifyUtf8 s = case decode ((map (fromIntegral . ord) s) :: [Word8]) of
113− Just (unicodeChar, _) -> Valid (KChar unicodeChar) []
237+ Just (unicodeChar, _) -> Valid (KChar unicodeChar) [] []
114 _ -> Invalid -- something bad happened; just ignore and continue.
238 _ -> Invalid -- something bad happened; just ignore and continue.
115
239
116classifyTab table = compile table
240classifyTab table = compile table
@@ -133,15 +257,20 @@ utf8Length c
133--
257--
134-- This is an example of an algorithm where code coverage could be high, even 100%, but the
258-- This is an example of an algorithm where code coverage could be high, even 100%, but the
135-- algorithm still under tested. I should collect more of these examples...
259-- algorithm still under tested. I should collect more of these examples...
136−initInputForFd :: Int -> ClassifyTable -> Fd -> IO (Chan Event, IO ())
260+initInputForFd :: IORef Config -> ClassifyTable -> Fd -> IO (Chan Event, IO ())
137−initInputForFd escDelay classify_table input_fd = do
261+initInputForFd config_ref classify_table input_fd = do
138− inputChannel <- newChan
139 eventChannel <- newChan
262 eventChannel <- newChan
140− hadInput <- newEmptyMVar
263+#if 0
141− let finishAtomicInput = writeChan inputChannel '\xFFFE'
264+ should_exit <- newIORef False
265+ let -- initial state: read bytes until a ESC. Emit bytes. Go to possible-control-seq state.
266+ -- possible-control-seq: read available bytes.
267+ -- If time is < controlSeqPeriod then emit as chunk with ESC prefix.
268+ -- If time is < metaComboPeriod then emit chunk with Meta shift.
269+ -- If time is > metaComboPeriod then emit ESC event then chunk of bytes.
142 inputThread :: IO ()
270 inputThread :: IO ()
143 inputThread = do
271 inputThread = do
272+ let k = 1024
144− _ <- alloca $ \(input_buffer :: Ptr Word8) -> do
273+ _ <- allocaArray k $ \(input_buffer :: Ptr Word8) -> do
145 let loop = do
274 let loop = do
146 setFdOption input_fd NonBlockingRead False
275 setFdOption input_fd NonBlockingRead False
147 threadWaitRead input_fd
276 threadWaitRead input_fd
@@ -172,15 +301,16 @@ initInputForFd escDelay classify_table input_fd = do
172 loop
301 loop
173 classifier = classify classify_table
302 classifier = classify classify_table
174 eventThreadId <- forkIO $ void $ inputToEventThread classifier inputChannel eventChannel
303 eventThreadId <- forkIO $ void $ inputToEventThread classifier inputChannel eventChannel
175− inputThreadId <- forkIO $ inputThread
304+ inputThreadId <- forkIO $ input_thread
176 noInputThreadId <- forkIO $ noInputThread
305 noInputThreadId <- forkIO $ noInputThread
177 -- TODO(corey): killThread is a bit risky for my tastes.
306 -- TODO(corey): killThread is a bit risky for my tastes.
178 -- H - somewhat mitigated by sending a magic terminate character?
307 -- H - somewhat mitigated by sending a magic terminate character?
179 let shutdown_event_processing = do
308 let shutdown_event_processing = do
180− writeChan inputChannel '\xFFFD'
181− killThread noInputThreadId
182 killThread eventThreadId
309 killThread eventThreadId
183 killThread inputThreadId
310 killThread inputThreadId
311+#endif
312+ let shutdown_event_processing = return ()
313+
184 return (eventChannel, shutdown_event_processing)
314 return (eventChannel, shutdown_event_processing)
185
315
186−foreign import ccall "vty_set_term_timing" set_term_timing :: Fd -> IO ()
316+foreign import ccall "vty_set_term_timing" set_term_timing :: Fd -> Int -> Int -> IO ()
test/VerifyParseTerminfoCaps.hs+11−15
@@ -40,23 +40,19 @@ from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr n
40
40
41tests :: IO [Test]
41tests :: IO [Test]
42tests = do
42tests = do
43− parse_tests <- concat <$> forM terminals_of_interest ( \term_name -> do
43+ parse_tests <- concat <$> forM terminals_of_interest (\term_name ->
44− mti <- liftIO $ try $ Terminfo.setupTerm term_name
44+ liftIO (try $ Terminfo.setupTerm term_name)
45− case mti of
46− Left (_e :: SomeException)
45+ >>= either (\(_e :: SomeException) -> return [])
47− -> return []
48− Right ti -> do
49− concat <$> forM caps_of_interest ( \cap_name -> do
46+ (\ti -> concat <$> forM caps_of_interest (\cap_name -> do
50− liftIO $ putStrLn $ "\tparsing cap: " ++ cap_name
47+ let case_name = "\tparsing cap: " ++ cap_name
48+ liftIO $ putStrLn case_name
51− case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
49+ return $ case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
52− Just cap_def -> do
50+ Just cap_def -> [verify (case_name ++ " -> " ++ show cap_def)
53− return [ verify ( "\tparse cap " ++ cap_name ++ " -> " ++ show cap_def )
54− ( verify_parse_cap cap_def $ const (return succeeded) ) ]
51+ (verify_parse_cap cap_def $ const (return succeeded))]
55− Nothing -> do
52+ Nothing -> []
56− return []
57 )
53 )
54+ )
58 )
55 )
59− -- The quickcheck tests
60 return $ [ verify "parse_non_paramaterized_caps" non_paramaterized_caps
56 return $ [ verify "parse_non_paramaterized_caps" non_paramaterized_caps
61 , verify "parse cap string with literal %" literal_percent_caps
57 , verify "parse cap string with literal %" literal_percent_caps
62 , verify "parse cap string with %i op" inc_first_two_caps
58 , verify "parse cap string with %i op" inc_first_two_caps
vty.cabal+2
@@ -41,6 +41,7 @@ library
41 build-depends: base >= 4 && < 5,
41 build-depends: base >= 4 && < 5,
42 bytestring,
42 bytestring,
43 containers,
43 containers,
44+ data-default >= 0.5.3,
44 deepseq >= 1.1 && < 1.4,
45 deepseq >= 1.1 && < 1.4,
45 ghc-prim,
46 ghc-prim,
46 lens >= 3.9.0.2,
47 lens >= 3.9.0.2,
@@ -50,6 +51,7 @@ library
50 parallel >= 2.2 && < 3.3,
51 parallel >= 2.2 && < 3.3,
51 parsec >= 2 && < 4,
52 parsec >= 2 && < 4,
52 terminfo >= 0.3 && < 0.4,
53 terminfo >= 0.3 && < 0.4,
54+ transformers >= 0.3.0.0,
53 text >= 0.11.3,
55 text >= 0.11.3,
54 unix,
56 unix,
55 utf8-string >= 0.3 && < 0.4,
57 utf8-string >= 0.3 && < 0.4,