{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Data.Text.ParagraphLayout.PlainSpec (spec) where
import Control.Monad (forM_)
import Data.Int (Int32)
import Test.Hspec
import System.FilePath ((</>))
import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.FontLoader
import Data.Text.ParagraphLayout.Internal.Paginable (paginateAll)
import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout (shapedRuns)
import Data.Text.ParagraphLayout.Plain
import Data.Text.ParagraphLayout.Plain.ParagraphData
import Data.Text.ParagraphLayout.PrettyShow
import Data.Text.ParagraphLayout.PrettyShow.Golden
import Data.Text.ParagraphLayout.Rect
emptyLayout :: ParagraphLayout d
emptyLayout = ParagraphLayout (Rect 0 0 0 0) []
emptySpanLayout :: ParagraphLayout d
emptySpanLayout = ParagraphLayout (Rect 0 0 0 0) [SpanLayout []]
spec :: Spec
spec = do
describe "layoutPlain" $ do
let
goldenDir = ".golden" </> "paragraphLayout"
shouldBeGolden = goldenTest goldenDir id id
describe "with Arabic font" $ do
font <- runIO $ loadFont arabicFont 0 testingOptions
let opts_ = defaultParagraphOptions { paragraphFont = font }
it "handles input with no spans" $ do
let opts = opts_
let result = layoutPlain $ emptyParagraph opts
result `shouldBe` emptyLayout
it "wraps filler text at 20em" $ do
let opts = opts_ { paragraphMaxWidth = 20000 }
let result = layoutPlain $ arabicFillerParagraph opts
result `shouldBeGolden` "arabicFiller20em"
it "wraps filler text with spans at 20em" $ do
let opts = opts_ { paragraphMaxWidth = 20000 }
let result = layoutPlain $ spannedArabicFillerParagraph opts
result `shouldBeGolden` "spannedArabicFiller20em"
it "spans do not reposition filler text at 20em" $ do
let opts = opts_ { paragraphMaxWidth = 20000 }
let withoutSpans = layoutPlain $ arabicFillerParagraph opts
let withSpans = layoutPlain $ spannedArabicFillerParagraph opts
paragraphRect withoutSpans `shouldBe` paragraphRect withSpans
it "applies hard breaks correctly" $ do
let opts = opts_ { paragraphMaxWidth = 6000 }
let result = layoutPlain $ hardBreaksRTLParagraph opts
result `shouldBeGolden` "hardBreaksRTL"
describe "with Devanagari font" $ do
font <- runIO $ loadFont devanagariFont 0 testingOptions
let opts_ = defaultParagraphOptions { paragraphFont = font }
describe "lone accent character" $ do
let
opts = opts_
result = layoutPlain $
devanagariAccentParagraph opts
it "inserts a dotted circle" $ do
x_size (paragraphRect result) `shouldBe` 645
it "is golden" $ do
result `shouldBeGolden` "devanagariAccent"
describe "lone accent character after prefix" $ do
let
opts = opts_
result = layoutPlain $
devanagariPrefixedAccentParagraph opts
it "does not insert a dotted circle" $ do
x_size (paragraphRect result) `shouldBe` 0
it "is golden" $ do
result `shouldBeGolden` "devanagariPrefixedAccent"
it "handles input without wrapping" $ do
let opts = opts_
let result = layoutPlain $ devanagariParagraph opts
result `shouldBeGolden` "devanagari"
describe "with Latin font" $ do
-- Note: This font does not contain Japanese glyphs.
font <- runIO $ loadFont latinFont 0 testingOptions
let opts_ = defaultParagraphOptions { paragraphFont = font }
it "handles input with no spans" $ do
let opts = opts_
let result = layoutPlain $ emptyParagraph opts
result `shouldBe` emptyLayout
it "handles one span with no text" $ do
let opts = opts_
let result = layoutPlain $ emptySpanParagraph opts
result `shouldBe` emptySpanLayout
it "handles Czech hello" $ do
let opts = opts_
let result = layoutPlain $ czechHelloParagraph opts
result `shouldBeGolden` "czechHello"
it "renders an \"ffi\" ligature" $ do
let opts = opts_
let result = layoutPlain $ ligatureParagraph opts
result `shouldBeGolden` "ligature"
it "breaks an \"ffi\" ligature into \"ff\" + \"i\"" $ do
let opts = opts_ { paragraphMaxWidth = 2418 }
let result = layoutPlain $ ligatureParagraph opts
result `shouldBeGolden` "ligatureParagraphBreak1"
it "breaks an \"ffi\" ligature into \"f\" + \"fi\"" $ do
let opts = opts_ { paragraphMaxWidth = 1800 }
let result = layoutPlain $ ligatureParagraph opts
result `shouldBeGolden` "ligatureParagraphBreak2"
it "handles mixed languages in LTR layout" $ do
let opts = opts_
let result = layoutPlain $ mixedLanguageLTRParagraph opts
result `shouldBeGolden` "mixedLanguageLTR"
it "handles normal line height" $ do
let opts = opts_
let result = layoutPlain $ trivialParagraph opts
result `shouldBeGolden` "lineHeightNormal"
it "handles larger line height" $ do
let opts = opts_ { paragraphLineHeight = Absolute 1600 }
let result = layoutPlain $ trivialParagraph opts
result `shouldBeGolden` "lineHeightLarger"
it "handles smaller line height" $ do
let opts = opts_ { paragraphLineHeight = Absolute 599 }
let result = layoutPlain $ trivialParagraph opts
result `shouldBeGolden` "lineHeightSmaller"
it "wraps mid-word when line is narrow" $ do
let opts = opts_ { paragraphMaxWidth = 1300 }
let result = layoutPlain $ czechHelloParagraph opts
result `shouldBeGolden` "czechHelloParagraphNarrow"
it "wraps by characters when line is ultra narrow" $ do
let opts = opts_ { paragraphMaxWidth = 100 }
let result = layoutPlain $ czechHelloParagraph opts
result `shouldBeGolden` "czechHelloParagraphUltraNarrow"
focus $ describe "ultra narrow line stress test" $
([(-1),(-2)..(-999)] :: [Int32]) `forM_` \w ->
it ("h = " ++ show w) $ do
let opts = opts_ { paragraphMaxWidth = w }
let result = layoutPlain $ czechHelloParagraph opts
result `shouldBeGolden` "czechHelloParagraphUltraNarrow"
it "wraps lorem ipsum at 20em" $ do
let opts = opts_ { paragraphMaxWidth = 20000 }
let result = layoutPlain $ loremIpsumParagraph opts
result `shouldBeGolden` "loremIpsum20em"
it "wraps lorem ipsum at 100em" $ do
let opts = opts_ { paragraphMaxWidth = 100000 }
let result = layoutPlain $ loremIpsumParagraph opts
result `shouldBeGolden` "loremIpsum100em"
it "wraps lorem ipsum with spans at 20em" $ do
let opts = opts_ { paragraphMaxWidth = 20000 }
let result = layoutPlain $ spannedLoremIpsumParagraph opts
result `shouldBeGolden` "spannedLoremIpsum20em"
it "spans do not reposition lorem ipsum at 20em" $ do
let opts = opts_ { paragraphMaxWidth = 20000 }
let withoutSpans = layoutPlain $ loremIpsumParagraph opts
let withSpans = layoutPlain $ spannedLoremIpsumParagraph opts
paragraphRect withoutSpans `shouldBe` paragraphRect withSpans
it "wraps mixed-script words correctly" $ do
let opts = opts_ { paragraphMaxWidth = 6000 }
let result = layoutPlain $ mixedScriptWordsParagraph opts
result `shouldBeGolden` "mixedScriptWords"
it "trims spaces around lines" $ do
let opts = opts_ { paragraphMaxWidth = 6000 }
let result = layoutPlain $ manySpacesParagraph opts
result `shouldBeGolden` "manySpaces"
it "applies hard breaks correctly" $ do
let opts = opts_ { paragraphMaxWidth = 5000 }
let result = layoutPlain $ hardBreaksLTRParagraph opts
result `shouldBeGolden` "hardBreaksLTR"
describe "paginate" $ do
let
goldenDir = ".golden" </> "paginatedParagraphLayout"
shouldBeGolden = goldenTest goldenDir getPages Pages
describe "with Arabic font" $ do
font <- runIO $ loadFont arabicFont 0 testingOptions
it "wraps filler text with spans at 20em" $ do
let
opts = defaultParagraphOptions
{ paragraphFont = font
, paragraphMaxWidth = 20000
}
pl = layoutPlain $ spannedArabicFillerParagraph opts
popts = PageOptions
{ pageCurrentHeight = 1000
, pageNextHeight = 5000
, pageOrphans = 2
, pageWidows = 2
}
pages = paginateAll popts pl
pages `shouldBeGolden` "spannedArabicFiller20em"
describe "with Latin font" $ do
font <- runIO $ loadFont latinFont 0 testingOptions
it "wraps lorem ipsum at 20em" $ do
let
opts = defaultParagraphOptions
{ paragraphFont = font
, paragraphMaxWidth = 20000
}
pl = layoutPlain $ loremIpsumParagraph opts
popts = PageOptions
{ pageCurrentHeight = 2500
, pageNextHeight = 8500
, pageOrphans = 2
, pageWidows = 3
}
pages = paginateAll popts pl
pages `shouldBeGolden` "loremIpsum20em"
describe "shaped runs for demo" $ do
let
goldenDir = ".golden" </> "shapedRuns"
shouldBeGolden = goldenTest goldenDir getShapedRuns ShapedRuns
-- | Test shaped runs against an expected value,
-- and write metadata about the used font afterwards.
shapedRunsSpecWithFont fontPath font subject name result = do
let infoPath = fontInfoPath goldenDir name
let writeInfo = writeFontInfo infoPath fontPath font
after_ writeInfo $ it subject $
shapedRuns result `shouldBeGolden` name
describe "with Latin font" $ do
let fontPath = latinFont
font <- runIO $ loadFont fontPath 0 demoOptions
let
opts = defaultParagraphOptions
{ paragraphFont = font
, paragraphMaxWidth = 640
}
shapedRunsSpec = shapedRunsSpecWithFont fontPath font
fullLayout = layoutPlain $ spannedLoremIpsumParagraph opts
popts = PageOptions
{ pageCurrentHeight = 108
, pageNextHeight = 108
, pageOrphans = 1
, pageWidows = 1
}
pages = paginateAll popts fullLayout
page3 = snd $ pages !! 2
describe "wraps lorem ipsum with spans at 20em" $ do
shapedRunsSpec "full layout" "spannedLoremIpsum20em" fullLayout
shapedRunsSpec "only page 3" "spannedLoremIpsum20emPage3" page3