From e92c514980b34e43c2d3958129b94fc8ac0b64dc Mon Sep 17 00:00:00 2001 From: Jaro Date: Mon, 24 Apr 2023 07:20:32 +0200 Subject: [PATCH] Future-proof records with options. --- CHANGELOG.md | 3 + lib/Data/Text/ParagraphLayout.hs | 7 +- .../ParagraphLayout/ParagraphConstruction.hs | 4 +- .../Internal/ParagraphOptions.hs | 17 +++- .../Text/ParagraphLayout/Internal/Span.hs | 15 +++- .../ParagraphLayout/Plain/ParagraphData.hs | 17 ++-- test/Data/Text/ParagraphLayoutSpec.hs | 81 +++++++++++-------- 7 files changed, 96 insertions(+), 48 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7440b3f..8310213 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,9 @@ ## 1.0.0.0 -- TBD +* Future-proofed `ParagraphOptions` and `SpanOptions` by hiding their + constructors. Use `defaultParagraphOptions` and `defaultSpanOptions` instead. + ## 0.3.0.1 -- TBD * Increased font size for the "shaped runs" output so that it better fits diff --git a/lib/Data/Text/ParagraphLayout.hs b/lib/Data/Text/ParagraphLayout.hs index fe2369d..22a69af 100644 --- a/lib/Data/Text/ParagraphLayout.hs +++ b/lib/Data/Text/ParagraphLayout.hs @@ -27,14 +27,15 @@ module Data.Text.ParagraphLayout , Paragraph (Paragraph) , ParagraphLayout (ParagraphLayout, paragraphRect, spanLayouts) , ParagraphOptions - ( ParagraphOptions - , paragraphFont + ( paragraphFont , paragraphLineHeight , paragraphMaxWidth ) , Span (Span, spanLength, spanOptions) , SpanLayout (SpanLayout) - , SpanOptions (SpanOptions, spanLanguage) + , SpanOptions (spanLanguage) + , defaultParagraphOptions + , defaultSpanOptions , layoutPlain , paginate , paragraphSpanBounds diff --git a/lib/Data/Text/ParagraphLayout/ParagraphConstruction.hs b/lib/Data/Text/ParagraphLayout/ParagraphConstruction.hs index 8fe9e65..469d9a4 100644 --- a/lib/Data/Text/ParagraphLayout/ParagraphConstruction.hs +++ b/lib/Data/Text/ParagraphLayout/ParagraphConstruction.hs @@ -2,8 +2,8 @@ -- -- Example construction: -- --- > let en = (,) SpanOptions { spanLanguage = "en" } --- > ja = (,) SpanOptions { spanLanguage = "ja" } +-- > let en = (,) defaultSpanOptions { spanLanguage = "en" } +-- > ja = (,) defaultSpanOptions { spanLanguage = "ja" } -- > in "ignored prefix" |< en "one two " >|< ja "三四" >| "ignored suffix" -- -- Special syntax for paragraphs with no contents: diff --git a/src/Data/Text/ParagraphLayout/Internal/ParagraphOptions.hs b/src/Data/Text/ParagraphLayout/Internal/ParagraphOptions.hs index 64a313d..3adf859 100644 --- a/src/Data/Text/ParagraphLayout/Internal/ParagraphOptions.hs +++ b/src/Data/Text/ParagraphLayout/Internal/ParagraphOptions.hs @@ -1,14 +1,19 @@ module Data.Text.ParagraphLayout.Internal.ParagraphOptions ( ParagraphOptions (..) + , defaultParagraphOptions ) where import Data.Int (Int32) -import Data.Text.Glyphize (Font) +import Data.Text.Glyphize (Font, emptyFont) import Data.Text.ParagraphLayout.Internal.LineHeight -- | Defines options relevant to the entire paragraph. +-- +-- This record type is likely to be extended in the future. +-- Use `defaultParagraphOptions` and update it with specific record selectors +-- instead of constructing `ParagraphOptions` directly. data ParagraphOptions = ParagraphOptions { paragraphFont :: Font @@ -27,4 +32,12 @@ data ParagraphOptions = ParagraphOptions -- be further broken down, it will overflow. } - deriving (Eq, Show) + deriving (Eq) + +-- | `ParagraphOptions` with default values. +defaultParagraphOptions :: ParagraphOptions +defaultParagraphOptions = ParagraphOptions + { paragraphFont = emptyFont + , paragraphLineHeight = Normal + , paragraphMaxWidth = maxBound + } diff --git a/src/Data/Text/ParagraphLayout/Internal/Span.hs b/src/Data/Text/ParagraphLayout/Internal/Span.hs index 6bc4c40..1789f28 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Span.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Span.hs @@ -2,6 +2,7 @@ module Data.Text.ParagraphLayout.Internal.Span ( Span (..) , SpanLayout (..) , SpanOptions (..) + , defaultSpanOptions , spanFragments , spanRects ) @@ -25,9 +26,13 @@ data Span = Span -- ^ Options applying to this specific span. } - deriving (Eq, Read, Show) + deriving (Eq) -- | Defines options relevant to the layout of a single span of text. +-- +-- This record type is likely to be extended in the future. +-- Use `defaultSpanOptions` and update it with specific record selectors +-- instead of constructing `SpanOptions` directly. data SpanOptions = SpanOptions { spanLanguage :: String @@ -40,7 +45,13 @@ data SpanOptions = SpanOptions -- TODO: Add all relevant attributes. } - deriving (Eq, Read, Show) + deriving (Eq) + +-- | `SpanOptions` with default values. +defaultSpanOptions :: SpanOptions +defaultSpanOptions = SpanOptions + { spanLanguage = "" + } -- | The resulting layout of each span, which may include multiple fragments -- as required by line breaking, text writing direction, and changes of script. diff --git a/test/Data/Text/ParagraphLayout/Plain/ParagraphData.hs b/test/Data/Text/ParagraphLayout/Plain/ParagraphData.hs index 98f0f4a..838a8d8 100644 --- a/test/Data/Text/ParagraphLayout/Plain/ParagraphData.hs +++ b/test/Data/Text/ParagraphLayout/Plain/ParagraphData.hs @@ -20,28 +20,33 @@ module Data.Text.ParagraphLayout.Plain.ParagraphData ) where -import Data.Text.ParagraphLayout (Paragraph, ParagraphOptions, SpanOptions (..)) +import Data.Text.ParagraphLayout + ( Paragraph + , ParagraphOptions + , SpanOptions (spanLanguage) + , defaultSpanOptions + ) import Data.Text.ParagraphLayout.ParagraphConstruction -- | Span with text in the Czech language. cs :: String -> (SpanOptions, String) -cs = (,) SpanOptions { spanLanguage = "cs" } +cs = (,) defaultSpanOptions { spanLanguage = "cs" } -- | Span with text in the English language. en :: String -> (SpanOptions, String) -en = (,) SpanOptions { spanLanguage = "en" } +en = (,) defaultSpanOptions { spanLanguage = "en" } -- | Span with text in the Japanese language. ja :: String -> (SpanOptions, String) -ja = (,) SpanOptions { spanLanguage = "ja" } +ja = (,) defaultSpanOptions { spanLanguage = "ja" } -- | Span with text in the Serbian language. sr :: String -> (SpanOptions, String) -sr = (,) SpanOptions { spanLanguage = "sr" } +sr = (,) defaultSpanOptions { spanLanguage = "sr" } -- | Span with text in no language. zxx :: String -> (SpanOptions, String) -zxx = (,) SpanOptions { spanLanguage = "zxx" } +zxx = (,) defaultSpanOptions { spanLanguage = "zxx" } emptyParagraph :: ParagraphOptions -> Paragraph emptyParagraph = "x" |<>| "zzzzzzz" diff --git a/test/Data/Text/ParagraphLayoutSpec.hs b/test/Data/Text/ParagraphLayoutSpec.hs index cec3997..808d244 100644 --- a/test/Data/Text/ParagraphLayoutSpec.hs +++ b/test/Data/Text/ParagraphLayoutSpec.hs @@ -36,39 +36,41 @@ spec = do 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 = ParagraphOptions font Normal 8000 + let opts = opts_ let result = layoutPlain $ emptyParagraph opts result `shouldBe` emptyLayout it "wraps filler text at 20em" $ do - let opts = ParagraphOptions font Normal 20000 + let opts = opts_ { paragraphMaxWidth = 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 opts = opts_ { paragraphMaxWidth = 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 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 = ParagraphOptions font Normal 6000 + 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 = ParagraphOptions font Normal 8000 + opts = opts_ result = layoutPlain $ devanagariAccentParagraph opts @@ -80,7 +82,7 @@ spec = do describe "lone accent character after prefix" $ do let - opts = ParagraphOptions font Normal 8000 + opts = opts_ result = layoutPlain $ devanagariPrefixedAccentParagraph opts @@ -91,107 +93,108 @@ spec = do result `shouldBeGolden` "devanagariPrefixedAccent" it "handles input without wrapping" $ do - let opts = ParagraphOptions font Normal 9000 + 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 = ParagraphOptions font Normal 8000 + let opts = opts_ let result = layoutPlain $ emptyParagraph opts result `shouldBe` emptyLayout it "handles one span with no text" $ do - let opts = ParagraphOptions font Normal 8000 + let opts = opts_ let result = layoutPlain $ emptySpanParagraph opts result `shouldBe` emptySpanLayout it "handles Czech hello" $ do - let opts = ParagraphOptions font Normal 8000 + let opts = opts_ let result = layoutPlain $ czechHelloParagraph opts result `shouldBeGolden` "czechHello" it "renders an \"ffi\" ligature" $ do - let opts = ParagraphOptions font Normal 8000 + let opts = opts_ let result = layoutPlain $ ligatureParagraph opts result `shouldBeGolden` "ligature" it "breaks an \"ffi\" ligature into \"ff\" + \"i\"" $ do - let opts = ParagraphOptions font Normal 2418 + let opts = opts_ { paragraphMaxWidth = 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 opts = opts_ { paragraphMaxWidth = 1800 } let result = layoutPlain $ ligatureParagraph opts result `shouldBeGolden` "ligatureParagraphBreak2" it "handles mixed languages in LTR layout" $ do - let opts = ParagraphOptions font Normal 8000 + let opts = opts_ let result = layoutPlain $ mixedLanguageLTRParagraph opts result `shouldBeGolden` "mixedLanguageLTR" it "handles normal line height" $ do - let opts = ParagraphOptions font Normal 8000 + let opts = opts_ let result = layoutPlain $ trivialParagraph opts result `shouldBeGolden` "lineHeightNormal" it "handles larger line height" $ do - let opts = ParagraphOptions font (Absolute 1600) 8000 + let opts = opts_ { paragraphLineHeight = Absolute 1600 } let result = layoutPlain $ trivialParagraph opts result `shouldBeGolden` "lineHeightLarger" it "handles smaller line height" $ do - let opts = ParagraphOptions font (Absolute 599) 8000 + 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 = ParagraphOptions font Normal 1300 + 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 = ParagraphOptions font Normal 100 + let opts = opts_ { paragraphMaxWidth = 100 } let result = layoutPlain $ czechHelloParagraph opts result `shouldBeGolden` "czechHelloParagraphUltraNarrow" it "wraps lorem ipsum at 20em" $ do - let opts = ParagraphOptions font Normal 20000 + let opts = opts_ { paragraphMaxWidth = 20000 } let result = layoutPlain $ loremIpsumParagraph opts result `shouldBeGolden` "loremIpsum20em" it "wraps lorem ipsum at 100em" $ do - let opts = ParagraphOptions font Normal 100000 + let opts = opts_ { paragraphMaxWidth = 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 opts = opts_ { paragraphMaxWidth = 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 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 = ParagraphOptions font Normal 6000 + let opts = opts_ { paragraphMaxWidth = 6000 } let result = layoutPlain $ mixedScriptWordsParagraph opts result `shouldBeGolden` "mixedScriptWords" it "trims spaces around lines" $ do - let opts = ParagraphOptions font Normal 6000 + let opts = opts_ { paragraphMaxWidth = 6000 } let result = layoutPlain $ manySpacesParagraph opts result `shouldBeGolden` "manySpaces" it "applies hard breaks correctly" $ do - let opts = ParagraphOptions font Normal 5000 + let opts = opts_ { paragraphMaxWidth = 5000 } let result = layoutPlain $ hardBreaksLTRParagraph opts result `shouldBeGolden` "hardBreaksLTR" @@ -205,7 +208,10 @@ spec = do it "wraps filler text with spans at 20em" $ do let - opts = ParagraphOptions font Normal 20000 + opts = defaultParagraphOptions + { paragraphFont = font + , paragraphMaxWidth = 20000 + } pl = layoutPlain $ spannedArabicFillerParagraph opts popts = PageOptions { pageCurrentHeight = 1000 @@ -221,7 +227,10 @@ spec = do it "wraps lorem ipsum at 20em" $ do let - opts = ParagraphOptions font Normal 20000 + opts = defaultParagraphOptions + { paragraphFont = font + , paragraphMaxWidth = 20000 + } pl = layoutPlain $ loremIpsumParagraph opts popts = PageOptions { pageCurrentHeight = 2500 @@ -248,9 +257,15 @@ spec = do 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" + let + opts = defaultParagraphOptions + { paragraphFont = font + , paragraphMaxWidth = 640 + } + shapedRunsSpec = shapedRunsSpecWithFont fontPath font + + shapedRunsSpec + "wraps lorem ipsum with spans at 20em" "spannedLoremIpsum20em" $ - spannedLoremIpsumParagraph $ - ParagraphOptions font Normal 640 + spannedLoremIpsumParagraph opts -- 2.30.2