on master help sign in
vty/test/VerifyParseTerminfoCaps.hs
101 lines 3.6 kB history raw
1{-# LANGUAGE NamedFieldPuns #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3module VerifyParseTerminfoCaps where
5import Prelude hiding ( catch )
7import qualified System.Console.Terminfo as Terminfo
9import Verify.Data.Terminfo.Parse
10import Verify.Graphics.Vty.Output
11import Verify
13import Data.Maybe ( catMaybes, fromJust )
14import Data.Word
16import Numeric
18-- If a terminal defines one of the caps then it's expected to be parsable.
19-- TODO: reduce duplication with terminfo terminal implementation.
20capsOfInterest =
21 [ "cup"
22 , "sc"
23 , "rc"
24 , "setf"
25 , "setb"
26 , "setaf"
27 , "setab"
28 , "op"
29 , "cnorm"
30 , "civis"
31 , "smcup"
32 , "rmcup"
33 , "clear"
34 , "hpa"
35 , "vpa"
36 , "sgr"
37 , "sgr0"
38 ]
40fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)
42tests :: IO [Test]
43tests = do
44 parseTests <- concat <$> forM terminalsOfInterest (\termName ->
45 liftIO (try $ Terminfo.setupTerm termName)
46 >>= either (\(_e :: SomeException) -> return [])
47 (\ti -> concat <$> forM capsOfInterest (\capName -> do
48 let caseName = "\tparsing cap: " ++ capName
49 liftIO $ putStrLn caseName
50 return $ case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
51 Just capDef -> [verify (caseName ++ " -> " ++ show capDef)
52 (verifyParseCap capDef $ const succeeded)]
53 Nothing -> []
54 )
55 )
56 )
57 return $ [ verify "parse_nonParamaterizedCaps" nonParamaterizedCaps
58 , verify "parse cap string with literal %" literalPercentCaps
59 , verify "parse cap string with %i op" incFirstTwoCaps
60 , verify "parse cap string with %pN op" pushParamCaps
61 ] ++ parseTests
63verifyParseCap capString onParse =
64 case parseCapExpression capString of
65 Left error -> failed { reason = "parse error " ++ show error }
66 Right e -> onParse e
68nonParamaterizedCaps (NonParamCapString cap) = do
69 verifyParseCap cap $ \e ->
70 let expectedBytes = map (toEnum . fromEnum) cap
71 outBytes = bytesForRange e 0 (length cap)
72 in verifyBytesEqual outBytes expectedBytes
74literalPercentCaps (LiteralPercentCap capString expectedBytes) = do
75 verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes
77incFirstTwoCaps (IncFirstTwoCap capString expectedBytes) = do
78 verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes
80pushParamCaps (PushParamCap capString expectedParamCount expectedBytes) = do
81 verifyParseCap capString $ \e ->
82 let outBytes = collectBytes e
83 outParamCount = paramCount e
84 in if outParamCount == expectedParamCount
85 then verifyBytesEqual outBytes expectedBytes
86 else failed { reason = "out param count /= expected param count" }
88decPrintParamCaps (DecPrintCap capString expectedParamCount expectedBytes) = do
89 verifyParseCap capString $ \e ->
90 let outBytes = collectBytes e
91 outParamCount = paramCount e
92 in if outParamCount == expectedParamCount
93 then verifyBytesEqual outBytes expectedBytes
94 else failed { reason = "out param count /= expected param count" }
96printCap ti capName = do
97 putStrLn $ capName ++ ": " ++ show (fromCapname ti capName)
99printExpression ti capName = do
100 let parseResult = parseCapExpression $ fromCapname ti capName
101 putStrLn $ capName ++ ": " ++ show parseResult