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 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 Devanagari font" $ before loadSaralaRegular $ do it "handles input without wrapping" $ \font -> do let result = layoutPlain $ devanagariParagraph $ (opts font) { paragraphMaxWidth = 9000 } result `shouldBeGolden` "devanagariParagraph" -- Note: This font does not contain Japanese glyphs. 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"