ilyakooo0/vty
1
0
Fork 0
mirror of https://github.com/ilyakooo0/vty.git synced 2024-12-02 08:53:43 +03:00
Code Issues Projects Releases Wiki Activity

Moving construction of terminfo CapExpression to MonadIO

Browse Source 
Ignore-this: 5c78cc78ce2ad3f394484f76cb840272

darcs-hash:20100114013836-f0a0d-52bfc693e29d2e2bc36931b0e944d1cc3da7a94f.gz
This commit is contained in:
coreyoconnor 2010-01-13 17:38:36 -08:00
parent 3e8999d6b1
commit 04c79d2e8c
5 changed files with 41 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Data/Terminfo/Parse.hs
View File

@ -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

24
src/Graphics/Vty/Terminal/TerminfoBased.hs
View File

@ -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"

4
test/Verify/Data/Terminfo/Parse.hs
View File

@ -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 ["

2
test/verify_eval_terminfo_caps.hs
View File

@ -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 } )

28
test/verify_parse_terminfo_caps.hs
View File

@ -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