git.iko.soy/vty
on master help sign in
vty/test/VerifyOutput.hs
58 lines 1.9 kB history raw
1-- We setup the environment to invoke certain terminals of interest.
2-- This assumes appropriate definitions exist in the current environment
3-- for the terminals of interest.
4{-# LANGUAGE ScopedTypeVariables #-}
5module VerifyOutput where
7import Verify
9import Graphics.Vty
11import Verify.Graphics.Vty.Image
12import Verify.Graphics.Vty.Output
14import Control.Monad
16import qualified System.Console.Terminfo as Terminfo
17import System.Posix.IO
19tests :: IO [Test]
20tests = concat <$> forM terminalsOfInterest (\termName -> do
21 -- check if that terminfo exists
22 -- putStrLn $ "testing end to end for terminal: " ++ termName
23 mti <- try $ Terminfo.setupTerm termName
24 case mti of
25 Left (_ :: SomeException) -> return []
26 Right _ -> return [ verify ("verify " ++ termName ++ " could output a picture")
27 (smokeTestTermNonMac termName)
28 ]
29 )
31smokeTestTermNonMac :: String -> Image -> Property
32smokeTestTermNonMac termName i = liftIOResult $ do
33 smokeTestTerm termName i
35smokeTestTerm :: String -> Image -> IO Result
36smokeTestTerm termName i = do
37 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags
38 t <- outputForConfig $ defaultConfig
39 { outputFd = Just nullOut
40 , termName = Just termName
41 , colorMode = Just NoColor
42 }
43 -- putStrLn $ "context color count: " ++ show (contextColorCount t)
44 reserveDisplay t
45 dc <- displayContext t (100,100)
46 -- always show the cursor to produce tests for terminals with no
47 -- cursor support.
48 let pic = (picForImage i) { picCursor = Cursor 0 0 }
49 outputPicture dc pic
50 setCursorPos t 0 0
51 when (supportsCursorVisibility t) $ do
52 hideCursor t
53 showCursor t
54 releaseDisplay t
55 releaseTerminal t
56 closeFd nullOut
57 return succeeded