packages feed

granite-0.5.0.0: test/RenderSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module RenderSpec (spec) where

import Data.Text qualified as Text
import Granite.Color (Color (..))
import Granite.Render.Scene
import Granite.Render.Svg qualified as Svg
import Granite.Render.Terminal qualified as Terminal
import Test.Hspec

-- A small fixture exercising the four marks both backends understand today.
sampleScene :: Scene
sampleScene =
    Scene
        { sceneWidth = 200
        , sceneHeight = 100
        , sceneMarks =
            [ MRect (Rect 10 10 40 30) defaultStyle{styleFill = Just BrightBlue}
            , MCircle (Point 120 50) 12 defaultStyle{styleFill = Just BrightRed}
            , MPolyline
                [Point 20 80, Point 60 70, Point 100 75, Point 160 60]
                defaultStyle{styleStroke = Just BrightGreen, styleStrokeWidth = 2}
            , MText (Point 100 20) "Hello" defaultTextStyle{textFill = BrightYellow}
            ]
        }

spec :: Spec
spec = do
    describe "Granite.Render.Scene + backends" $ do
        it "both backends accept the same Scene" $ do
            let terminal = Terminal.renderScene sampleScene
                svg = Svg.renderScene sampleScene
            Text.length terminal `shouldSatisfy` (> 0)
            Text.length svg `shouldSatisfy` (> 0)

        it "SVG output is a well-formed document with all four marks" $ do
            let svg = Svg.renderScene sampleScene
            svg `shouldSatisfy` Text.isInfixOf "<svg"
            svg `shouldSatisfy` Text.isInfixOf "</svg>"
            svg `shouldSatisfy` Text.isInfixOf "<rect"
            svg `shouldSatisfy` Text.isInfixOf "<circle"
            svg `shouldSatisfy` Text.isInfixOf "<polyline"
            svg `shouldSatisfy` Text.isInfixOf "<text"
            svg `shouldSatisfy` Text.isInfixOf "Hello"

        it "SVG honours the requested viewport" $ do
            let svg = Svg.renderScene sampleScene
            svg `shouldSatisfy` Text.isInfixOf "viewBox=\"0 0 200 100\""

        it "Terminal output contains text marks and is multi-line" $ do
            let terminal = Terminal.renderScene sampleScene
            terminal `shouldSatisfy` Text.isInfixOf "Hello"
            length (Text.lines terminal) `shouldSatisfy` (> 1)

        it "Terminal output dimensions track the scene size" $ do
            let small =
                    Terminal.renderScene
                        sampleScene{sceneWidth = 80, sceneHeight = 32}
                big =
                    Terminal.renderScene
                        sampleScene{sceneWidth = 320, sceneHeight = 128}
            length (Text.lines big) `shouldSatisfy` (> length (Text.lines small))

        it "An empty scene still renders without crashing" $ do
            let empty = Scene 100 50 []
                term = Terminal.renderScene empty
                svg = Svg.renderScene empty
            Text.length term `shouldSatisfy` (>= 0)
            svg `shouldSatisfy` Text.isInfixOf "<svg"

        it "Grouping marks renders the same as flattening them" $ do
            let grouped =
                    sampleScene
                        { sceneMarks =
                            [MGroup (sceneMarks sampleScene)]
                        }
                flat = sampleScene
            Svg.renderScene grouped `shouldSatisfy` Text.isInfixOf "<g>"
            Text.length (Terminal.renderScene grouped)
                `shouldBe` Text.length (Terminal.renderScene flat)