git.iko.soy/vty
on 5.3 help sign in
vty/test/VerifyOutput.hs
55 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 for the terminals of
3 - interest.
4 -}
5module VerifyOutput where
6import Verify
8import Graphics.Vty
10import Verify.Graphics.Vty.Image
11import Verify.Graphics.Vty.Output
13import Control.Monad
15import Data.Default
17import qualified System.Console.Terminfo as Terminfo
18import System.Posix.Env
19import System.Posix.IO
21tests :: IO [Test]
22tests = concat <$> forM terminalsOfInterest (\termName -> do
23 -- check if that terminfo exists
24 -- putStrLn $ "testing end to end for terminal: " ++ termName
25 mti <- try $ Terminfo.setupTerm termName
26 case mti of
27 Left (_ :: SomeException) -> return []
28 Right _ -> return [ verify ("verify " ++ termName ++ " could output a picture")
29 (smokeTestTermNonMac termName)
30 ]
31 )
33smokeTestTermNonMac :: String -> Image -> Property
34smokeTestTermNonMac termName i = liftIOResult $ do
35 smokeTestTerm termName i
37smokeTestTerm :: String -> Image -> IO Result
38smokeTestTerm termName i = do
39 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags
40 t <- outputForConfig $ def { outputFd = Just nullOut, termName = Just termName }
41 -- putStrLn $ "context color count: " ++ show (contextColorCount t)
42 reserveDisplay t
43 dc <- displayContext t (100,100)
44 -- always show the cursor to produce tests for terminals with no cursor support.
45 let pic = (picForImage i) { picCursor = Cursor 0 0 }
46 outputPicture dc pic
47 setCursorPos t 0 0
48 when (supportsCursorVisibility t) $ do
49 hideCursor t
50 showCursor t
51 releaseDisplay t
52 releaseTerminal t
53 closeFd nullOut
54 return succeeded