module Data.Text.ParagraphLayoutSpec (spec) where
import Test.Hspec
import Test.Hspec.Golden
import System.FilePath ((<.>), (</>))
import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.FontLoader
import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout
import Data.Text.ParagraphLayout.ParagraphData
import Data.Text.ParagraphLayout.PrettyShow
import Data.Text.ParagraphLayout.Rect
type Page = (PageContinuity, ParagraphLayout)
goldenPath :: FilePath -> String -> FilePath
goldenPath dir name = dir </> name <.> "golden"
actualPath :: FilePath -> String -> FilePath
actualPath dir name = dir </> name <.> "actual"
fontInfoPath :: FilePath -> String -> FilePath
fontInfoPath dir name = dir </> name <.> "fontInfo"
goldenTest :: (PrettyShow a, Show inner, Read inner) =>
FilePath -> (a -> inner) -> (inner -> a) -> inner -> FilePath -> Golden a
goldenTest goldenDir unwrap wrap innerOutput name = Golden
{ output = wrap innerOutput
, encodePretty = show . unwrap
, writeToFile = \ path -> writeFile path . prettyShow
, readFromFile = \ path -> readFile path >>= return . wrap . read
, goldenFile = goldenPath goldenDir name
, actualFile = Just (actualPath goldenDir name)
, failFirstTime = True
}
emptyLayout :: ParagraphLayout
emptyLayout = ParagraphLayout (Rect 0 0 0 0) []
emptySpanLayout :: ParagraphLayout
emptySpanLayout = ParagraphLayout (Rect 0 0 0 0) [SpanLayout []]
paginateAll :: PageOptions -> ParagraphLayout -> [Page]
paginateAll opts pl = case paginate opts pl of
(c, pl1, next) -> (c, pl1) : case next of
Just pl2 -> paginateAll opts' pl2
Nothing -> []
where
opts' = opts { pageCurrentHeight = pageNextHeight opts }
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
it "handles input with no spans" $ do
let opts = ParagraphOptions font Normal 8000
let result = layoutPlain $ emptyParagraph opts
result `shouldBe` emptyLayout
it "wraps filler text at 20em" $ do
let opts = ParagraphOptions font Normal 20000
let result = layoutPlain $ arabicFillerParagraph opts
result `shouldBeGolden` "arabicFiller20em"
it "wraps filler text with spans at 20em" $ do
let opts = ParagraphOptions font Normal 20000
let result = layoutPlain $ spannedArabicFillerParagraph opts
result `shouldBeGolden` "spannedArabicFiller20em"
it "spans do not reposition filler text at 20em" $ do
let opts = ParagraphOptions font Normal 20000
let withoutSpans = layoutPlain $ arabicFillerParagraph opts
let withSpans = layoutPlain $ spannedArabicFillerParagraph opts
paragraphRect withoutSpans `shouldBe` paragraphRect withSpans
it "applies hard breaks correctly" $ do
let opts = ParagraphOptions font Normal 6000
let result = layoutPlain $ hardBreaksRTLParagraph opts
result `shouldBeGolden` "hardBreaksRTL"
describe "with Devanagari font" $ do
font <- runIO $ loadFont devanagariFont 0 testingOptions
describe "lone accent character" $ do
let
opts = ParagraphOptions font Normal 8000
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 = ParagraphOptions font Normal 8000
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 = ParagraphOptions font Normal 9000
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
it "handles input with no spans" $ do
let opts = ParagraphOptions font Normal 8000
let result = layoutPlain $ emptyParagraph opts
result `shouldBe` emptyLayout
it "handles one span with no text" $ do
let opts = ParagraphOptions font Normal 8000
let result = layoutPlain $ emptySpanParagraph opts
result `shouldBe` emptySpanLayout
it "handles Czech hello" $ do
let opts = ParagraphOptions font Normal 8000
let result = layoutPlain $ czechHelloParagraph opts
result `shouldBeGolden` "czechHello"
it "renders an \"ffi\" ligature" $ do
let opts = ParagraphOptions font Normal 8000
let result = layoutPlain $ ligatureParagraph opts
result `shouldBeGolden` "ligature"
it "breaks an \"ffi\" ligature into \"ff\" + \"i\"" $ do
let opts = ParagraphOptions font Normal 2418
let result = layoutPlain $ ligatureParagraph opts
result `shouldBeGolden` "ligatureParagraphBreak1"
it "breaks an \"ffi\" ligature into \"f\" + \"fi\"" $ do
let opts = ParagraphOptions font Normal 1800
let result = layoutPlain $ ligatureParagraph opts
result `shouldBeGolden` "ligatureParagraphBreak2"
it "handles mixed languages in LTR layout" $ do
let opts = ParagraphOptions font Normal 8000
let result = layoutPlain $ mixedLanguageLTRParagraph opts
result `shouldBeGolden` "mixedLanguageLTR"
it "handles normal line height" $ do
let opts = ParagraphOptions font Normal 8000
let result = layoutPlain $ trivialParagraph opts
result `shouldBeGolden` "lineHeightNormal"
it "handles larger line height" $ do
let opts = ParagraphOptions font (Absolute 1600) 8000
let result = layoutPlain $ trivialParagraph opts
result `shouldBeGolden` "lineHeightLarger"
it "handles smaller line height" $ do
let opts = ParagraphOptions font (Absolute 599) 8000
let result = layoutPlain $ trivialParagraph opts
result `shouldBeGolden` "lineHeightSmaller"
it "wraps mid-word when line is narrow" $ do
let opts = ParagraphOptions font Normal 1300
let result = layoutPlain $ czechHelloParagraph opts
result `shouldBeGolden` "czechHelloParagraphNarrow"
it "wraps by characters when line is ultra narrow" $ do
let opts = ParagraphOptions font Normal 100
let result = layoutPlain $ czechHelloParagraph opts
result `shouldBeGolden` "czechHelloParagraphUltraNarrow"
it "wraps lorem ipsum at 20em" $ do
let opts = ParagraphOptions font Normal 20000
let result = layoutPlain $ loremIpsumParagraph opts
result `shouldBeGolden` "loremIpsum20em"
it "wraps lorem ipsum at 100em" $ do
let opts = ParagraphOptions font Normal 100000
let result = layoutPlain $ loremIpsumParagraph opts
result `shouldBeGolden` "loremIpsum100em"
it "wraps lorem ipsum with spans at 20em" $ do
let opts = ParagraphOptions font Normal 20000
let result = layoutPlain $ spannedLoremIpsumParagraph opts
result `shouldBeGolden` "spannedLoremIpsum20em"
it "spans do not reposition lorem ipsum at 20em" $ do
let opts = ParagraphOptions font Normal 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 = ParagraphOptions font Normal 6000
let result = layoutPlain $ mixedScriptWordsParagraph opts
result `shouldBeGolden` "mixedScriptWords"
it "trims spaces around lines" $ do
let opts = ParagraphOptions font Normal 6000
let result = layoutPlain $ manySpacesParagraph opts
result `shouldBeGolden` "manySpaces"
it "applies hard breaks correctly" $ do
let opts = ParagraphOptions font Normal 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 = ParagraphOptions font Normal 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 = ParagraphOptions font Normal 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 p = do
let infoPath = fontInfoPath goldenDir name
let writeInfo = writeFontInfo infoPath fontPath font
after_ writeInfo $ it subject $ do
let result = layoutPlain p
shapedRuns result `shouldBeGolden` name
describe "with Latin font" $ do
let fontPath = latinFont
font <- runIO $ loadFont fontPath 0 demoOptions
let shapedRunsSpec = shapedRunsSpecWithFont fontPath font
shapedRunsSpec "wraps lorem ipsum with spans at 20em"
"spannedLoremIpsum20em" $
spannedLoremIpsumParagraph $
ParagraphOptions font Normal 640