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