~jaro/balkon

ref: 7119d635d91170071a52846f983c43fc9ff435d2 balkon/test/ParagraphLayoutTest.hs -rw-r--r-- 1.7 KiB
7119d635Jaro WIP version with WIP interface. 1 year, 8 months ago
                                                                                
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
module Main (main) where

import qualified Data.ByteString as BS
import Data.List (intersperse)
import Data.Text.Glyphize (Font, GlyphInfo, GlyphPos, createFace, createFont)
import Data.Text.Lazy (pack)

import Test.Hspec
import Test.Hspec.Golden
import System.FilePath ((</>))
import Data.Text.ParagraphLayout

type LayoutOutput = [[(GlyphInfo,GlyphPos)]]

czechHello :: Font -> Span
czechHello font = Span
    { spanText = pack "Ahoj, světe!"
    , spanFont = font
    , spanLanguage = Just "cs"
    }

prettyShow :: LayoutOutput -> String
prettyShow = showOutput
    where
        showOutput rs = concat ["[\n", showRuns rs, "\n]\n"]
        showRuns = concat . intersperse ",\n" . map showRun
        showRun gs = concat [indent1, "[\n", showGlyphs gs, "\n", indent1, "]"]
        showGlyphs = concat . intersperse ",\n" . map showGlyph
        showGlyph g = concat [indent2, show g]
        indent1 = "    "
        indent2 = indent1 ++ indent1

shouldBeGolden :: LayoutOutput -> FilePath -> Golden LayoutOutput
shouldBeGolden output_ name = Golden
    { output = output_
    , encodePretty = show
    , writeToFile = \path -> writeFile path . prettyShow
    , readFromFile = \path -> readFile path >>= return . read
    , goldenFile = ".golden" </> name </> "golden"
    , actualFile = Just (".golden" </> name </> "actual")
    , failFirstTime = False
    }

main :: IO ()
main = do
    ttf <- BS.readFile ("assets" </> "fonts" </> "ubuntu" </> "Ubuntu-R.ttf")
    let face = createFace ttf 0
    let font = createFont face
    hspec $ do
        describe "layout" $ do
            it "handles empty input" $ do
                layout [] `shouldBe` []
            it "handles Czech hello" $ do
                layout [czechHello font] `shouldBeGolden` "czechHello"