on 2dc9f45 help sign in
vty/test/VerifyTerminfoBased.hs
43 lines 1.6 kB history raw
1{-# LANGUAGE ScopedTypeVariables #-}
2{- We setup the environment to envoke certain terminals of interest.
3 - This assumes appropriate definitions exist in the current environment for the terminals of
4 - interest.
5 -}
6module VerifyTerminfoBased where
7import Verify
9import Graphics.Vty
10import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
12import Verify.Graphics.Vty.Image
13import Verify.Graphics.Vty.Terminal
15import qualified System.Console.Terminfo as Terminfo
16import System.IO
18tests :: IO [Test]
19tests = concat <$> forM terminals_of_interest (\term_name -> do
20 -- check if that terminfo exists
21 putStrLn $ "testing end to end for terminal: " ++ term_name
22 mti <- try $ Terminfo.setupTerm term_name
23 case mti of
24 Left (_ :: SomeException) -> return []
25 Right _ -> return [ verify ("verify " ++ term_name ++ " could output a picture")
26 (smoke_test_term term_name)
27 ]
28 )
30smoke_test_term :: String -> Image -> Property
31smoke_test_term term_name i = liftIOResult $ do
32 null_out <- openFile "/dev/null" WriteMode
33 t <- TerminfoBased.reserve_terminal term_name null_out
34 putStrLn $ "context color count: " ++ show (context_color_count t)
35 reserve_display t
36 dc <- display_context t (DisplayRegion 100 100)
37 -- always show the cursor to produce tests for terminals with no cursor support.
38 let pic = (pic_for_image i) { pic_cursor = Cursor 0 0 }
39 output_picture dc pic
40 release_display t
41 release_terminal t
42 return succeeded