From 04c79d2e8c1eedfed1eb492727805954eee95df7 Mon Sep 17 00:00:00 2001 From: coreyoconnor Date: Wed, 13 Jan 2010 17:38:36 -0800 Subject: [PATCH] Moving construction of terminfo CapExpression to MonadIO Ignore-this: 5c78cc78ce2ad3f394484f76cb840272 darcs-hash:20100114013836-f0a0d-52bfc693e29d2e2bc36931b0e944d1cc3da7a94f.gz --- src/Data/Terminfo/Parse.hs | 11 +++++---- src/Graphics/Vty/Terminal/TerminfoBased.hs | 24 ++++++++++++------- test/Verify/Data/Terminfo/Parse.hs | 4 ++-- test/verify_eval_terminfo_caps.hs | 2 +- test/verify_parse_terminfo_caps.hs | 28 ++++++++++++---------- 5 files changed, 41 insertions(+), 28 deletions(-) diff --git a/src/Data/Terminfo/Parse.hs b/src/Data/Terminfo/Parse.hs index 799e9ae..b5a5b85 100644 --- a/src/Data/Terminfo/Parse.hs +++ b/src/Data/Terminfo/Parse.hs @@ -10,6 +10,7 @@ module Data.Terminfo.Parse ( module Data.Terminfo.Parse where import Control.Monad ( liftM ) +import Control.Monad.Trans import Control.Parallel.Strategies import Data.Array.Unboxed @@ -66,16 +67,18 @@ data ParamOp = IncFirstTwo deriving ( Show ) -parse_cap_expression :: String -> Either ParseError CapExpression +parse_cap_expression :: MonadIO m => String -> m ( Either ParseError CapExpression ) parse_cap_expression cap_string = let v = runParser cap_expression_parser initial_build_state "terminfo cap" cap_string in case v of - Left e -> Left e + Left e -> return $ Left e Right build_results -> - Right $! ( CapExpression + return + $! Right + $! ( CapExpression { cap_ops = out_cap_ops build_results -- The cap bytes are the lower 8 bits of the input string's characters. -- \todo Verify the input string actually contains an 8bit byte per character. @@ -86,7 +89,7 @@ parse_cap_expression cap_string = , param_ops = out_param_ops build_results } `using` rdeepseq - ) + ) type CapParser a = GenParser Char BuildState a diff --git a/src/Graphics/Vty/Terminal/TerminfoBased.hs b/src/Graphics/Vty/Terminal/TerminfoBased.hs index 000be8a..5bd1692 100644 --- a/src/Graphics/Vty/Terminal/TerminfoBased.hs +++ b/src/Graphics/Vty/Terminal/TerminfoBased.hs @@ -75,15 +75,19 @@ terminal_instance in_ID = do let require_cap str = case Terminfo.getCapability ti (Terminfo.tiGetStr str) of Nothing -> fail $ "Terminal does not define required capability \"" ++ str ++ "\"" - Just cap_str -> case parse_cap_expression cap_str of - Left e -> fail $ show e - Right cap -> return cap + Just cap_str -> do + parse_result <- parse_cap_expression cap_str + case parse_result of + Left e -> fail $ show e + Right cap -> return cap probe_cap cap_name = case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of Nothing -> return Nothing - Just cap_str -> case parse_cap_expression cap_str of - Left e -> fail $ show e - Right cap -> return $ Just cap + Just cap_str -> do + parse_result <- parse_cap_expression cap_str + case parse_result of + Left e -> fail $ show e + Right cap -> return $ Just cap pure Term <*> pure in_ID <*> pure ti @@ -114,9 +118,11 @@ current_display_attr_caps ti where probe_cap cap_name = case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of Nothing -> return Nothing - Just cap_str -> case parse_cap_expression cap_str of - Left e -> fail $ show e - Right cap -> return $ Just cap + Just cap_str -> do + parse_result <- parse_cap_expression cap_str + case parse_result of + Left e -> fail $ show e + Right cap -> return $ Just cap instance Terminal Term where terminal_ID t = term_info_ID t ++ " :: TerminfoBased" diff --git a/test/Verify/Data/Terminfo/Parse.hs b/test/Verify/Data/Terminfo/Parse.hs index 1611b56..8f2daf0 100644 --- a/test/Verify/Data/Terminfo/Parse.hs +++ b/test/Verify/Data/Terminfo/Parse.hs @@ -103,8 +103,8 @@ collect_bytes e = concat [ bytes verify_bytes_equal out_bytes expected_bytes = if out_bytes == expected_bytes - then liftResult succeeded - else liftResult $ failed + then succeeded + else failed { reason = "out_bytes [" ++ hex_dump ( listArray (0, toEnum $ length out_bytes - 1) out_bytes ) ++ "] /= expected_bytes [" diff --git a/test/verify_eval_terminfo_caps.hs b/test/verify_eval_terminfo_caps.hs index a05b5b0..418169f 100644 --- a/test/verify_eval_terminfo_caps.hs +++ b/test/verify_eval_terminfo_caps.hs @@ -101,7 +101,7 @@ main = do liftIO $ putStrLn $ "\tevaluating cap: " ++ cap_name case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of Just cap_def -> do - let parse_result = parse_cap_expression cap_def + parse_result <- parse_cap_expression cap_def let test_name = "\teval cap " ++ cap_name ++ " -> " ++ show cap_def _ <- case parse_result of Left error -> verify test_name ( liftResult $ failed { reason = "prase error " ++ show error } ) diff --git a/test/verify_parse_terminfo_caps.hs b/test/verify_parse_terminfo_caps.hs index a3cabcc..03ce65e 100644 --- a/test/verify_parse_terminfo_caps.hs +++ b/test/verify_parse_terminfo_caps.hs @@ -98,7 +98,7 @@ main = do case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of Just cap_def -> do verify ( "\tparse cap " ++ cap_name ++ " -> " ++ show cap_def ) - ( verify_parse_cap cap_def $ const (liftResult succeeded) ) + ( verify_parse_cap cap_def $ const ( return succeeded ) ) return () Nothing -> do return () @@ -110,9 +110,10 @@ main = do return () return () -verify_parse_cap cap_string on_parse = do - case parse_cap_expression cap_string of - Left error -> liftResult $ failed { reason = "parse error " ++ show error } +verify_parse_cap cap_string on_parse = liftIOResult $ do + parse_result <- parse_cap_expression cap_string + case parse_result of + Left error -> return $ failed { reason = "parse error " ++ show error } Right e -> on_parse e non_paramaterized_caps (NonParamCapString cap) = do @@ -120,39 +121,42 @@ non_paramaterized_caps (NonParamCapString cap) = do let expected_count :: Word8 = toEnum $ length cap expected_bytes = map (toEnum . fromEnum) cap out_bytes = bytes_for_range e 0 expected_count - in verify_bytes_equal out_bytes expected_bytes + in return $ verify_bytes_equal out_bytes expected_bytes literal_percent_caps (LiteralPercentCap cap_string expected_bytes) = do verify_parse_cap cap_string $ \e -> let expected_count :: Word8 = toEnum $ length expected_bytes out_bytes = collect_bytes e - in verify_bytes_equal out_bytes expected_bytes + in return $ verify_bytes_equal out_bytes expected_bytes inc_first_two_caps (IncFirstTwoCap cap_string expected_bytes) = do verify_parse_cap cap_string $ \e -> let expected_count :: Word8 = toEnum $ length expected_bytes out_bytes = collect_bytes e - in verify_bytes_equal out_bytes expected_bytes + in return $ verify_bytes_equal out_bytes expected_bytes push_param_caps (PushParamCap cap_string expected_param_count expected_bytes) = do verify_parse_cap cap_string $ \e -> let expected_count :: Word8 = toEnum $ length expected_bytes out_bytes = collect_bytes e out_param_count = param_count e - in verify_bytes_equal out_bytes expected_bytes - .&. out_param_count == expected_param_count + in return $ if out_param_count == expected_param_count + then verify_bytes_equal out_bytes expected_bytes + else failed { reason = "out param count /= expected param count" } dec_print_param_caps (DecPrintCap cap_string expected_param_count expected_bytes) = do verify_parse_cap cap_string $ \e -> let expected_count :: Word8 = toEnum $ length expected_bytes out_bytes = collect_bytes e out_param_count = param_count e - in verify_bytes_equal out_bytes expected_bytes - .&. out_param_count == expected_param_count + in return $ if out_param_count == expected_param_count + then verify_bytes_equal out_bytes expected_bytes + else failed { reason = "out param count /= expected param count" } print_cap ti cap_name = do putStrLn $ cap_name ++ ": " ++ show (from_capname ti cap_name) print_expression ti cap_name = do - putStrLn $ cap_name ++ ": " ++ show (parse_cap_expression $ from_capname ti cap_name) + parse_result <- parse_cap_expression $ from_capname ti cap_name + putStrLn $ cap_name ++ ": " ++ show parse_result