1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
{-# LANGUAGE CPP #-}
module Render
( main
)
where
import Brick
import Control.Monad (when)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import qualified Graphics.Vty as V
import qualified Graphics.Vty.CrossPlatform.Testing as V
import Brick.Widgets.Border (hBorder)
import Control.Exception (SomeException, try)
region :: V.DisplayRegion
region = (30, 10)
renderDisplay :: Ord n => [Widget n] -> IO ()
renderDisplay ws = do
outp <- V.mkDefaultOutput
ctx <- V.displayContext outp region
V.outputPicture ctx (renderWidget Nothing ws region)
V.releaseDisplay outp
myWidget :: Widget ()
myWidget = str "Why" <=> hBorder <=> str "not?"
-- Since you can't Read a Picture, we have to compare the result with
-- the Shown one
expectedResult :: String
expectedResult = "Picture {picCursor = NoCursor, picLayers = [VertJoin {partTop = VertJoin {partTop = HorizText {attr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}, displayText = \"Why \", outputWidth = 30, charWidth = 30}, partBottom = VertJoin {partTop = HorizText {attr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}, displayText = \"\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\", outputWidth = 30, charWidth = 30}, partBottom = HorizText {attr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}, displayText = \"not? \", outputWidth = 30, charWidth = 30}, outputWidth = 30, outputHeight = 2}, outputWidth = 30, outputHeight = 3}, partBottom = BGFill {outputWidth = 30, outputHeight = 7}, outputWidth = 30, outputHeight = 10}], picBackground = Background {backgroundChar = ' ', backgroundAttr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}}}"
main :: IO Bool
main = do
result <- try (renderDisplay [myWidget]) :: IO (Either SomeException ())
case result of
Left _ -> do
putStrLn "Terminal is not available, skipping test"
-- Even though we could not actually run the test, we return
-- True here to prevent the absence of a terminal from
-- causing a test suite failure in an automated context.
-- This means that this test effectively doesn't get
-- considered at all in the automated context.
return True
Right () -> do
let matched = actualResult == expectedResult
actualResult = show (renderWidget Nothing [myWidget] region)
msg = if matched then "rendering match" else "rendering mismatch"
putStrLn ""
putStrLn $ "renderWidget test outcome: " <> msg
when (not matched) $ do
putStrLn "Expected result:"
putStrLn expectedResult
putStrLn "Actual result:"
putStrLn actualResult
return matched
|
