~jaro/balkon

633d18066bdebdd14f5ae6116741dcf7963327ce — Jaro 1 year, 2 months ago ff10798
Separate tests by module.
M balkon.cabal => balkon.cabal +7 -1
@@ 92,7 92,13 @@ test-suite balkon-test
    hs-source-dirs:   test

    -- The entrypoint to the test suite.
    main-is:          ParagraphLayoutTest.hs
    main-is:          Spec.hs

    other-modules:
        Data.Text.ParagraphLayoutSpec,
        Data.Text.ParagraphLayout.FontLoader,
        Data.Text.ParagraphLayout.RunSpec,
        Data.Text.ParagraphLayout.SpanData

    -- Test dependencies.
    build-depends:

A test/Data/Text/ParagraphLayout/FontLoader.hs => test/Data/Text/ParagraphLayout/FontLoader.hs +17 -0
@@ 0,0 1,17 @@
module Data.Text.ParagraphLayout.FontLoader (loadUbuntuRegular) where

import Data.ByteString (readFile)
import Data.Text.Glyphize
    (Font
    ,createFace
    ,createFont
    )
import Prelude (IO, return)
import System.FilePath ((</>))

loadUbuntuRegular :: IO Font
loadUbuntuRegular = do
    ttf <- readFile ("assets" </> "fonts" </> "ubuntu" </> "Ubuntu-R.ttf")
    let face = createFace ttf 0
    let font = createFont face
    return font

A test/Data/Text/ParagraphLayout/RunSpec.hs => test/Data/Text/ParagraphLayout/RunSpec.hs +45 -0
@@ 0,0 1,45 @@
module Data.Text.ParagraphLayout.RunSpec (spec) where

import Data.Text.Glyphize (Direction(..))
import Data.Text.Lazy (pack)

import Test.Hspec
import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.FontLoader
import Data.Text.ParagraphLayout.Run
import Data.Text.ParagraphLayout.SpanData

spec :: Spec
spec = do
    describe "spanToRuns" $ before loadUbuntuRegular $ do
        it "handles span with no text" $ \font -> do
            spanToRuns (emptySpan font) `shouldBe` []
        it "handles Czech hello" $ \font -> do
            let inputSpan = czechHello font
            let runs = spanToRuns inputSpan
            runs `shouldBe`
                [ Run
                    { runText = spanText inputSpan
                    , runDirection = Just DirLTR
                    , runScript = Just "Latn"
                    , runOriginalSpan = inputSpan
                    }
                ]
        it "handles Serbian with mixed script" $ \font -> do
            let inputSpan = serbianMixedScript font
            let runs = spanToRuns inputSpan
            runs `shouldBe`
                [ Run
                    -- TODO: We might want both parentheses in the same run.
                    { runText = pack "Vikipedija ("
                    , runDirection = Just DirLTR
                    , runScript = Just "Latn"
                    , runOriginalSpan = inputSpan
                    }
                , Run
                    { runText = pack "Википедија)"
                    , runDirection = Just DirLTR
                    , runScript = Just "Cyrl"
                    , runOriginalSpan = inputSpan
                    }
                ]

A test/Data/Text/ParagraphLayout/SpanData.hs => test/Data/Text/ParagraphLayout/SpanData.hs +31 -0
@@ 0,0 1,31 @@
module Data.Text.ParagraphLayout.SpanData
    (emptySpan
    ,czechHello
    ,serbianMixedScript
    )
where

import Data.Text.Glyphize (Font)
import Data.Text.Lazy (pack)
import Data.Text.ParagraphLayout (Span(..))

emptySpan :: Font -> Span
emptySpan font = Span
    { spanText = pack ""
    , spanFont = font
    , spanLanguage = Nothing
    }

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

serbianMixedScript :: Font -> Span
serbianMixedScript font = Span
    { spanText = pack "Vikipedija (Википедија)"
    , spanFont = font
    , spanLanguage = Just "sr"
    }

A test/Data/Text/ParagraphLayoutSpec.hs => test/Data/Text/ParagraphLayoutSpec.hs +45 -0
@@ 0,0 1,45 @@
module Data.Text.ParagraphLayoutSpec (spec) where

import Data.List (intersperse)
import Data.Text.Glyphize (GlyphInfo, GlyphPos)

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

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

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
    }

spec :: Spec
spec = do
    describe "layout" $ before loadUbuntuRegular $ do
        it "handles input with no spans" $ \_ -> do
            layout [] `shouldBe` []
        it "handles one span with no text" $ \font -> do
            layout [emptySpan font] `shouldBe` []
        it "handles Czech hello" $ \font -> do
            layout [czechHello font] `shouldBeGolden` "czechHello"

D test/ParagraphLayoutTest.hs => test/ParagraphLayoutTest.hs +0 -111
@@ 1,111 0,0 @@
module Main (main) where

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

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

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

emptySpan :: Font -> Span
emptySpan font = Span
    { spanText = pack ""
    , spanFont = font
    , spanLanguage = Nothing
    }

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

serbianMixedScript :: Font -> Span
serbianMixedScript font = Span
    { spanText = pack "Vikipedija (Википедија)"
    , spanFont = font
    , spanLanguage = Just "sr"
    }

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 "spanToRuns" $ do
            it "handles span with no text" $ do
                spanToRuns (emptySpan font) `shouldBe` []
            it "handles Czech hello" $ do
                let inputSpan = czechHello font
                let runs = spanToRuns inputSpan
                runs `shouldBe`
                    [ Run
                        { runText = spanText inputSpan
                        , runDirection = Just DirLTR
                        , runScript = Just "Latn"
                        , runOriginalSpan = inputSpan
                        }
                    ]
            it "handles Serbian with mixed script" $ do
                let inputSpan = serbianMixedScript font
                let runs = spanToRuns inputSpan
                runs `shouldBe`
                    [ Run
                        -- TODO: We might want both parentheses in the same run.
                        { runText = pack "Vikipedija ("
                        , runDirection = Just DirLTR
                        , runScript = Just "Latn"
                        , runOriginalSpan = inputSpan
                        }
                    , Run
                        { runText = pack "Википедија)"
                        , runDirection = Just DirLTR
                        , runScript = Just "Cyrl"
                        , runOriginalSpan = inputSpan
                        }
                    ]

        describe "layout" $ do
            it "handles input with no spans" $ do
                layout [] `shouldBe` []
            it "handles one span with no text" $ do
                layout [emptySpan font] `shouldBe` []
            it "handles Czech hello" $ do
                layout [czechHello font] `shouldBeGolden` "czechHello"

A test/Spec.hs => test/Spec.hs +14 -0
@@ 0,0 1,14 @@
import Test.Hspec

import qualified Data.Text.ParagraphLayoutSpec
import qualified Data.Text.ParagraphLayout.RunSpec

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
    describe "Data.Text.ParagraphLayout"
        Data.Text.ParagraphLayoutSpec.spec
    describe "Data.Text.ParagraphLayout.Run"
        Data.Text.ParagraphLayout.RunSpec.spec