git.iko.soy/vty
on master help sign in
Moving construction of terminfo CapExpression to MonadIO
04c79d2coreyoconnor
src/Data/Terminfo/Parse.hs+7−4
compare with master
unifiedsplit
@@ -10,6 +10,7 @@ module Data.Terminfo.Parse ( module Data.Terminfo.Parse
10 where
10 where
11
11
12import Control.Monad ( liftM )
12import Control.Monad ( liftM )
13+import Control.Monad.Trans
13import Control.Parallel.Strategies
14import Control.Parallel.Strategies
14
15
15import Data.Array.Unboxed
16import Data.Array.Unboxed
@@ -66,16 +67,18 @@ data ParamOp =
66 IncFirstTwo
67 IncFirstTwo
67 deriving ( Show )
68 deriving ( Show )
68
69
69−parse_cap_expression :: String -> Either ParseError CapExpression
70+parse_cap_expression :: MonadIO m => String -> m ( Either ParseError CapExpression )
70parse_cap_expression cap_string =
71parse_cap_expression cap_string =
71 let v = runParser cap_expression_parser
72 let v = runParser cap_expression_parser
72 initial_build_state
73 initial_build_state
73 "terminfo cap"
74 "terminfo cap"
74 cap_string
75 cap_string
75 in case v of
76 in case v of
76− Left e -> Left e
77+ Left e -> return $ Left e
77 Right build_results ->
78 Right build_results ->
79+ return
80+ $! Right
78− Right $! ( CapExpression
81+ $! ( CapExpression
79 { cap_ops = out_cap_ops build_results
82 { cap_ops = out_cap_ops build_results
80 -- The cap bytes are the lower 8 bits of the input string's characters.
83 -- The cap bytes are the lower 8 bits of the input string's characters.
81 -- \todo Verify the input string actually contains an 8bit byte per character.
84 -- \todo Verify the input string actually contains an 8bit byte per character.
@@ -86,7 +89,7 @@ parse_cap_expression cap_string =
86 , param_ops = out_param_ops build_results
89 , param_ops = out_param_ops build_results
87 }
90 }
88 `using` rdeepseq
91 `using` rdeepseq
89− )
92+ )
90
93
91type CapParser a = GenParser Char BuildState a
94type CapParser a = GenParser Char BuildState a
92
95
src/Graphics/Vty/Terminal/TerminfoBased.hs+15−9
@@ -75,15 +75,19 @@ terminal_instance in_ID = do
75 let require_cap str
75 let require_cap str
76 = case Terminfo.getCapability ti (Terminfo.tiGetStr str) of
76 = case Terminfo.getCapability ti (Terminfo.tiGetStr str) of
77 Nothing -> fail $ "Terminal does not define required capability \"" ++ str ++ "\""
77 Nothing -> fail $ "Terminal does not define required capability \"" ++ str ++ "\""
78− Just cap_str -> case parse_cap_expression cap_str of
78+ Just cap_str -> do
79+ parse_result <- parse_cap_expression cap_str
80+ case parse_result of
79− Left e -> fail $ show e
81+ Left e -> fail $ show e
80− Right cap -> return cap
82+ Right cap -> return cap
81 probe_cap cap_name
83 probe_cap cap_name
82 = case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
84 = case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
83 Nothing -> return Nothing
85 Nothing -> return Nothing
84− Just cap_str -> case parse_cap_expression cap_str of
86+ Just cap_str -> do
87+ parse_result <- parse_cap_expression cap_str
88+ case parse_result of
85− Left e -> fail $ show e
89+ Left e -> fail $ show e
86− Right cap -> return $ Just cap
90+ Right cap -> return $ Just cap
87 pure Term
91 pure Term
88 <*> pure in_ID
92 <*> pure in_ID
89 <*> pure ti
93 <*> pure ti
@@ -114,9 +118,11 @@ current_display_attr_caps ti
114 where probe_cap cap_name
118 where probe_cap cap_name
115 = case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
119 = case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
116 Nothing -> return Nothing
120 Nothing -> return Nothing
117− Just cap_str -> case parse_cap_expression cap_str of
121+ Just cap_str -> do
122+ parse_result <- parse_cap_expression cap_str
123+ case parse_result of
118− Left e -> fail $ show e
124+ Left e -> fail $ show e
119− Right cap -> return $ Just cap
125+ Right cap -> return $ Just cap
120
126
121instance Terminal Term where
127instance Terminal Term where
122 terminal_ID t = term_info_ID t ++ " :: TerminfoBased"
128 terminal_ID t = term_info_ID t ++ " :: TerminfoBased"
test/Verify/Data/Terminfo/Parse.hs+2−2
@@ -103,8 +103,8 @@ collect_bytes e = concat [ bytes
103
103
104verify_bytes_equal out_bytes expected_bytes
104verify_bytes_equal out_bytes expected_bytes
105 = if out_bytes == expected_bytes
105 = if out_bytes == expected_bytes
106− then liftResult succeeded
106+ then succeeded
107− else liftResult $ failed
107+ else failed
108 { reason = "out_bytes ["
108 { reason = "out_bytes ["
109 ++ hex_dump ( listArray (0, toEnum $ length out_bytes - 1) out_bytes )
109 ++ hex_dump ( listArray (0, toEnum $ length out_bytes - 1) out_bytes )
110 ++ "] /= expected_bytes ["
110 ++ "] /= expected_bytes ["
test/verify_eval_terminfo_caps.hs+1−1
@@ -101,7 +101,7 @@ main = do
101 liftIO $ putStrLn $ "\tevaluating cap: " ++ cap_name
101 liftIO $ putStrLn $ "\tevaluating cap: " ++ cap_name
102 case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
102 case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
103 Just cap_def -> do
103 Just cap_def -> do
104− let parse_result = parse_cap_expression cap_def
104+ parse_result <- parse_cap_expression cap_def
105 let test_name = "\teval cap " ++ cap_name ++ " -> " ++ show cap_def
105 let test_name = "\teval cap " ++ cap_name ++ " -> " ++ show cap_def
106 _ <- case parse_result of
106 _ <- case parse_result of
107 Left error -> verify test_name ( liftResult $ failed { reason = "prase error " ++ show error } )
107 Left error -> verify test_name ( liftResult $ failed { reason = "prase error " ++ show error } )
test/verify_parse_terminfo_caps.hs+16−12
@@ -98,7 +98,7 @@ main = do
98 case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
98 case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
99 Just cap_def -> do
99 Just cap_def -> do
100 verify ( "\tparse cap " ++ cap_name ++ " -> " ++ show cap_def )
100 verify ( "\tparse cap " ++ cap_name ++ " -> " ++ show cap_def )
101− ( verify_parse_cap cap_def $ const (liftResult succeeded) )
101+ ( verify_parse_cap cap_def $ const ( return succeeded ) )
102 return ()
102 return ()
103 Nothing -> do
103 Nothing -> do
104 return ()
104 return ()
@@ -110,9 +110,10 @@ main = do
110 return ()
110 return ()
111 return ()
111 return ()
112
112
113−verify_parse_cap cap_string on_parse = do
113+verify_parse_cap cap_string on_parse = liftIOResult $ do
114− case parse_cap_expression cap_string of
114+ parse_result <- parse_cap_expression cap_string
115+ case parse_result of
115− Left error -> liftResult $ failed { reason = "parse error " ++ show error }
116+ Left error -> return $ failed { reason = "parse error " ++ show error }
116 Right e -> on_parse e
117 Right e -> on_parse e
117
118
118non_paramaterized_caps (NonParamCapString cap) = do
119non_paramaterized_caps (NonParamCapString cap) = do
@@ -120,39 +121,42 @@ non_paramaterized_caps (NonParamCapString cap) = do
120 let expected_count :: Word8 = toEnum $ length cap
121 let expected_count :: Word8 = toEnum $ length cap
121 expected_bytes = map (toEnum . fromEnum) cap
122 expected_bytes = map (toEnum . fromEnum) cap
122 out_bytes = bytes_for_range e 0 expected_count
123 out_bytes = bytes_for_range e 0 expected_count
123− in verify_bytes_equal out_bytes expected_bytes
124+ in return $ verify_bytes_equal out_bytes expected_bytes
124
125
125literal_percent_caps (LiteralPercentCap cap_string expected_bytes) = do
126literal_percent_caps (LiteralPercentCap cap_string expected_bytes) = do
126 verify_parse_cap cap_string $ \e ->
127 verify_parse_cap cap_string $ \e ->
127 let expected_count :: Word8 = toEnum $ length expected_bytes
128 let expected_count :: Word8 = toEnum $ length expected_bytes
128 out_bytes = collect_bytes e
129 out_bytes = collect_bytes e
129− in verify_bytes_equal out_bytes expected_bytes
130+ in return $ verify_bytes_equal out_bytes expected_bytes
130
131
131inc_first_two_caps (IncFirstTwoCap cap_string expected_bytes) = do
132inc_first_two_caps (IncFirstTwoCap cap_string expected_bytes) = do
132 verify_parse_cap cap_string $ \e ->
133 verify_parse_cap cap_string $ \e ->
133 let expected_count :: Word8 = toEnum $ length expected_bytes
134 let expected_count :: Word8 = toEnum $ length expected_bytes
134 out_bytes = collect_bytes e
135 out_bytes = collect_bytes e
135− in verify_bytes_equal out_bytes expected_bytes
136+ in return $ verify_bytes_equal out_bytes expected_bytes
136
137
137push_param_caps (PushParamCap cap_string expected_param_count expected_bytes) = do
138push_param_caps (PushParamCap cap_string expected_param_count expected_bytes) = do
138 verify_parse_cap cap_string $ \e ->
139 verify_parse_cap cap_string $ \e ->
139 let expected_count :: Word8 = toEnum $ length expected_bytes
140 let expected_count :: Word8 = toEnum $ length expected_bytes
140 out_bytes = collect_bytes e
141 out_bytes = collect_bytes e
141 out_param_count = param_count e
142 out_param_count = param_count e
143+ in return $ if out_param_count == expected_param_count
142− in verify_bytes_equal out_bytes expected_bytes
144+ then verify_bytes_equal out_bytes expected_bytes
143− .&. out_param_count == expected_param_count
145+ else failed { reason = "out param count /= expected param count" }
144
146
145dec_print_param_caps (DecPrintCap cap_string expected_param_count expected_bytes) = do
147dec_print_param_caps (DecPrintCap cap_string expected_param_count expected_bytes) = do
146 verify_parse_cap cap_string $ \e ->
148 verify_parse_cap cap_string $ \e ->
147 let expected_count :: Word8 = toEnum $ length expected_bytes
149 let expected_count :: Word8 = toEnum $ length expected_bytes
148 out_bytes = collect_bytes e
150 out_bytes = collect_bytes e
149 out_param_count = param_count e
151 out_param_count = param_count e
152+ in return $ if out_param_count == expected_param_count
150− in verify_bytes_equal out_bytes expected_bytes
153+ then verify_bytes_equal out_bytes expected_bytes
151− .&. out_param_count == expected_param_count
154+ else failed { reason = "out param count /= expected param count" }
152
155
153print_cap ti cap_name = do
156print_cap ti cap_name = do
154 putStrLn $ cap_name ++ ": " ++ show (from_capname ti cap_name)
157 putStrLn $ cap_name ++ ": " ++ show (from_capname ti cap_name)
155
158
156print_expression ti cap_name = do
159print_expression ti cap_name = do
157− putStrLn $ cap_name ++ ": " ++ show (parse_cap_expression $ from_capname ti cap_name)
160+ parse_result <- parse_cap_expression $ from_capname ti cap_name
161+ putStrLn $ cap_name ++ ": " ++ show parse_result
158
162