module Data.Text.ParagraphLayoutSpec (spec) where
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
class PrettyShow a where
prettyShow :: a -> String
instance PrettyShow ParagraphLayout where
prettyShow (ParagraphLayout pr sls) = concat
[ "ParagraphLayout {paragraphRect = "
, show pr
, commaSpace
, "spanLayouts = ["
, newline
, indent1
, concat $ indentedList indent1 $ map prettyShow sls
, newline
, "]}"
, newline
]
instance PrettyShow SpanLayout where
prettyShow (SpanLayout frags) = concat
[ "SpanLayout ["
, concat $ inlineList $ map prettyShow frags
, "]"
]
instance PrettyShow Fragment where
prettyShow (Fragment r pen glyphs) = concat
[ "Fragment {fragmentRect = "
, show r
, commaSpace
, "fragmentPen = "
, show pen
, commaSpace
, "fragmentGlyphs ="
, newline
, indent2
, "["
, concat $ indentedList indent2 $ map show glyphs
, "]"
, newline
, indent1
, "}"
]
inlineList :: [String] -> [String]
inlineList items = suffixInit commaSpace items
indentedList :: String -> [String] -> [String]
indentedList indent items = prefixTail indent $ suffixInit commaNewline items
suffixInit :: String -> [String] -> [String]
suffixInit suffix = mapInit (++suffix)
mapInit :: (a -> a) -> [a] -> [a]
mapInit _ [] = []
mapInit _ [x] = [x]
mapInit f (x:y:ys) = f x : mapInit f (y:ys)
prefixTail :: String -> [String] -> [String]
prefixTail prefix = mapTail (prefix++)
mapTail :: (a -> a) -> [a] -> [a]
mapTail _ [] = []
mapTail f (x:xs) = x:(map f xs)
indent1 :: String
indent1 = " "
indent2 :: String
indent2 = indent1 ++ indent1
newline :: String
newline = "\n"
commaSpace :: String
commaSpace = ", "
commaNewline :: String
commaNewline = "," ++ newline
class ShouldBeGolden a where
shouldBeGolden :: a -> FilePath -> Golden a
instance ShouldBeGolden ParagraphLayout where
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
describe "lone accent character" $ do
let
result = \font -> layoutPlain $
devanagariAccentParagraph $
opts font
it "inserts a dotted circle" $ \font -> do
x_size (paragraphRect (result font)) `shouldBe` 645
it "is golden" $ \font -> do
result font `shouldBeGolden`
"devanagariAccentParagraph"
describe "lone accent character after prefix" $ do
let
result = \font -> layoutPlain $
devanagariPrefixedAccentParagraph $
opts font
it "does not insert a dotted circle" $ \font -> do
x_size (paragraphRect (result font)) `shouldBe` 0
it "is golden" $ \font -> do
result font `shouldBeGolden`
"devanagariPrefixedAccentParagraph"
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"