vty/test/VerifyParseTerminfoCaps.hs

{-# LANGUAGE NamedFieldPuns #-}
module VerifyParseTerminfoCaps where

import Prelude hiding ( catch )

import qualified System.Console.Terminfo as Terminfo

import Verify.Data.Terminfo.Parse
import Verify.Graphics.Vty.Output
import Verify

import Data.Maybe ( catMaybes, fromJust )
import Data.Word

import Numeric

-- If a terminal defines one of the caps then it's expected to be parsable.
-- TODO: reduce duplication with terminfo terminal implementation.
capsOfInterest =
    [ "cup"
    , "sc"
    , "rc"
    , "setf"
    , "setb"
    , "setaf"
    , "setab"
    , "op"
    , "cnorm"
    , "civis"
    , "smcup"
    , "rmcup"
    , "clear"
    , "hpa"
    , "vpa"
    , "sgr"
    , "sgr0"
    ]

fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)

tests :: IO [Test]
tests = do
    parseTests <- concat <$> forM terminalsOfInterest (\termName ->
        liftIO (try $ Terminfo.setupTerm termName)
        >>= either (\(_e :: SomeException) -> return [])
                   (\ti -> concat <$> forM capsOfInterest (\capName -> do
                        let caseName = "\tparsing cap: " ++ capName
                        liftIO $ putStrLn caseName
                        return $ case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
                            Just capDef -> [verify (caseName ++ " -> " ++ show capDef)
                                                   (verifyParseCap capDef $ const succeeded)]
                            Nothing      -> []
                    )
                   )
        )
    return $ [ verify "parse_nonParamaterizedCaps" nonParamaterizedCaps
             , verify "parse cap string with literal %" literalPercentCaps
             , verify "parse cap string with %i op" incFirstTwoCaps
             , verify "parse cap string with %pN op" pushParamCaps
             ] ++ parseTests

verifyParseCap capString onParse =
    case parseCapExpression capString of
        Left error -> failed { reason = "parse error " ++ show error }
        Right e    -> onParse e

nonParamaterizedCaps (NonParamCapString cap) = do
    verifyParseCap cap $ \e ->
        let expectedBytes = map (toEnum . fromEnum) cap
            outBytes = bytesForRange e 0 (length cap)
        in verifyBytesEqual outBytes expectedBytes

literalPercentCaps (LiteralPercentCap capString expectedBytes) = do
    verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes

incFirstTwoCaps (IncFirstTwoCap capString expectedBytes) = do
    verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes

pushParamCaps (PushParamCap capString expectedParamCount expectedBytes) = do
    verifyParseCap capString $ \e ->
        let outBytes = collectBytes e
            outParamCount = paramCount e
        in if outParamCount == expectedParamCount
            then verifyBytesEqual outBytes expectedBytes
            else failed { reason = "out param count /= expected param count" }

decPrintParamCaps (DecPrintCap capString expectedParamCount expectedBytes) = do
    verifyParseCap capString $ \e ->
        let outBytes = collectBytes e
            outParamCount = paramCount e
        in if outParamCount == expectedParamCount
            then verifyBytesEqual outBytes expectedBytes
            else failed { reason = "out param count /= expected param count" }

printCap ti capName = do
    putStrLn $ capName ++ ": " ++ show (fromCapname ti capName)

printExpression ti capName = do
    let parseResult = parseCapExpression $ fromCapname ti capName
    putStrLn $ capName ++ ": " ++ show parseResult