ParagraphLayoutSpec.hs

module Data.Text.ParagraphLayoutSpec (spec) where

import Data.List (intersperse)
import Data.Text.Glyphize (Font)

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


prettyShow :: ParagraphLayout -> String
prettyShow (ParagraphLayout pr sls) = showParagraphLayout where
    showParagraphLayout = concat
        [ "ParagraphLayout {paragraphRect = "
        , show pr
        , ", spanLayouts = ["
        , newline
        , showSpanLayouts
        , newline
        , "]}"
        , newline
        ]
    showSpanLayouts = concat $ intersperse commaNewline $ map showSpanLayout sls
    showSpanLayout (SpanLayout frags) = concat
        [ indent1
        , "SpanLayout ["
        , concat $ intersperse ", " $ map showFrag frags
        , "]"
        ]
    showFrag (Fragment r pen glyphs) = concat
        [ "Fragment {fragmentRect = "
        , show r
        , ", "
        , "fragmentPen = "
        , show pen
        , ", "
        , "fragmentGlyphs ="
        , newline
        , indent2
        , "["
        , showGlyphs glyphs
        , "]"
        , newline
        , indent1
        , "}"
        ]
    showGlyphs = concat . intersperse (commaNewline ++ indent2) . map show
    indent1 = "    "
    indent2 = indent1 ++ indent1
    newline = "\n"
    commaNewline = "," ++ newline

shouldBeGolden :: ParagraphLayout -> FilePath -> Golden ParagraphLayout
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
    }

emptyLayout :: ParagraphLayout
emptyLayout = ParagraphLayout (Rect 0 0 0 0) []

emptySpanLayout :: ParagraphLayout
emptySpanLayout = ParagraphLayout (Rect 0 0 0 0) [SpanLayout []]

opts :: Font -> ParagraphOptions
opts font = ParagraphOptions font Normal 8000

spec :: Spec
spec = do
    -- Note: This font does not contain Japanese glyphs.
    describe "layoutPlain" $ do
        describe "with Arabic font" $ before loadPlexSansArabicRegular $ do
            it "handles input with no spans" $ \font -> do
                let result = layoutPlain $ emptyParagraph $ opts font
                result `shouldBe` emptyLayout
            it "wraps filler text at 20em" $ \font -> do
                let
                    result = layoutPlain $ arabicFillerParagraph $
                        (opts font)
                        { paragraphMaxWidth = 20000 }
                result `shouldBeGolden` "arabicFiller20em"
            it "wraps filler text with spans at 20em" $ \font -> do
                let
                    result = layoutPlain $ spannedArabicFillerParagraph $
                        (opts font)
                        { paragraphMaxWidth = 20000 }
                result `shouldBeGolden` "spannedArabicFiller20em"
            it "spans do not reposition filler text at 20em" $ \font -> do
                let
                    withoutSpans = layoutPlain $ arabicFillerParagraph $
                        (opts font)
                        { paragraphMaxWidth = 20000 }
                    withSpans = layoutPlain $ spannedArabicFillerParagraph $
                        (opts font)
                        { paragraphMaxWidth = 20000 }
                paragraphRect withoutSpans `shouldBe` paragraphRect withSpans
        describe "with Latin font" $ before loadUbuntuRegular $ do
            it "handles input with no spans" $ \font -> do
                let result = layoutPlain $ emptyParagraph $ opts font
                result `shouldBe` emptyLayout
            it "handles one span with no text" $ \font -> do
                let result = layoutPlain $ emptySpanParagraph $ opts font
                result `shouldBe` emptySpanLayout
            it "handles Czech hello" $ \font -> do
                let result = layoutPlain $ czechHelloParagraph $ opts font
                result `shouldBeGolden` "czechHelloParagraph"
            it "renders an \"ffi\" ligature" $ \ font -> do
                let result = layoutPlain $ ligatureParagraph $ opts font
                result `shouldBeGolden` "ligatureParagraph"
            it "breaks an \"ffi\" ligature into \"ff\" + \"i\"" $ \ font -> do
                let result = layoutPlain $ ligatureParagraph $
                        (opts font)
                        { paragraphMaxWidth = 2418 }
                result `shouldBeGolden` "ligatureParagraphBreak1"
            it "breaks an \"ffi\" ligature into \"f\" + \"fi\"" $ \ font -> do
                let result = layoutPlain $ ligatureParagraph $
                        (opts font)
                        { paragraphMaxWidth = 1800 }
                result `shouldBeGolden` "ligatureParagraphBreak2"
            it "handles mixed languages in LTR layout" $ \font -> do
                let result = layoutPlain $ mixedLanguageLTRParagraph $ opts font
                result `shouldBeGolden` "mixedLanguageLTRParagraph"
            it "handles normal line height" $ \font -> do
                let
                    result = layoutPlain $ trivialParagraph $
                        (opts font)
                        { paragraphLineHeight = Normal }
                result `shouldBeGolden` "lineHeightNormal"
            it "handles larger line height" $ \font -> do
                let
                    result = layoutPlain $ trivialParagraph $
                        (opts font)
                        { paragraphLineHeight = Absolute 1600 }
                result `shouldBeGolden` "lineHeightLarger"
            it "handles smaller line height" $ \font -> do
                let
                    result = layoutPlain $ trivialParagraph $
                        (opts font)
                        { paragraphLineHeight = Absolute 599 }
                result `shouldBeGolden` "lineHeightSmaller"
            it "wraps mid-word when line is narrow" $ \font -> do
                let
                    result = layoutPlain $ czechHelloParagraph $
                        (opts font)
                        { paragraphMaxWidth = 1300 }
                result `shouldBeGolden` "czechHelloParagraphNarrow"
            it "wraps by characters when line is ultra narrow" $ \font -> do
                let
                    result = layoutPlain $ czechHelloParagraph $
                        (opts font)
                        { paragraphMaxWidth = 100 }
                result `shouldBeGolden` "czechHelloParagraphUltraNarrow"
            it "wraps lorem ipsum at 20em" $ \font -> do
                let
                    result = layoutPlain $ loremIpsumParagraph $
                        (opts font)
                        { paragraphMaxWidth = 20000 }
                result `shouldBeGolden` "loremIpsum20em"
            it "wraps lorem ipsum at 100em" $ \font -> do
                let
                    result = layoutPlain $ loremIpsumParagraph $
                        (opts font)
                        { paragraphMaxWidth = 100000 }
                result `shouldBeGolden` "loremIpsum100em"
            it "wraps lorem ipsum with spans at 20em" $ \font -> do
                let
                    result = layoutPlain $ spannedLoremIpsumParagraph $
                        (opts font)
                        { paragraphMaxWidth = 20000 }
                result `shouldBeGolden` "spannedLoremIpsum20em"
            it "spans do not reposition lorem ipsum at 20em" $ \font -> do
                let
                    withoutSpans = layoutPlain $ loremIpsumParagraph $
                        (opts font)
                        { paragraphMaxWidth = 20000 }
                    withSpans = layoutPlain $ spannedLoremIpsumParagraph $
                        (opts font)
                        { paragraphMaxWidth = 20000 }
                paragraphRect withoutSpans `shouldBe` paragraphRect withSpans
            it "wraps mixed-script words correctly" $ \font -> do
                let
                    result = layoutPlain $ mixedScriptWordsParagraph $
                        (opts font)
                        { paragraphMaxWidth = 6000 }
                result `shouldBeGolden` "mixedScriptWordsParagraph"