git.iko.soy/vty
on d64ff96 help sign in
vty/test/VerifyOutput.hs
54 lines 1.8 kB history raw
1-- We setup the environment to envoke certain terminals of interest.
2-- This assumes appropriate definitions exist in the current environment
3-- for the terminals of interest.
4module VerifyOutput where
6import Verify
8import Graphics.Vty
10import Verify.Graphics.Vty.Image
11import Verify.Graphics.Vty.Output
13import Control.Monad
15import qualified System.Console.Terminfo as Terminfo
16import System.Posix.Env
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 { outputFd = Just nullOut, termName = Just termName }
39 -- putStrLn $ "context color count: " ++ show (contextColorCount t)
40 reserveDisplay t
41 dc <- displayContext t (100,100)
42 -- always show the cursor to produce tests for terminals with no
43 -- cursor support.
44 let pic = (picForImage i) { picCursor = Cursor 0 0 }
45 outputPicture dc pic
46 setCursorPos t 0 0
47 when (supportsCursorVisibility t) $ do
48 hideCursor t
49 showCursor t
50 releaseDisplay t
51 releaseTerminal t
52 closeFd nullOut
53 return succeeded