From 5d0bf7627c61fa5a70757ad5fe726b04eaa657c6 Mon Sep 17 00:00:00 2001 From: Jaro Date: Sun, 25 Jun 2023 03:37:18 +0200 Subject: [PATCH] Add helper function to strut empty boxes. --- lib/Data/Text/ParagraphLayout/Rich.hs | 2 + .../ParagraphLayout/Internal/BoxOptions.hs | 2 + .../Text/ParagraphLayout/Internal/Tree.hs | 34 ++++ .../Text/ParagraphLayout/Internal/TreeSpec.hs | 170 ++++++++++++------ 4 files changed, 154 insertions(+), 54 deletions(-) diff --git a/lib/Data/Text/ParagraphLayout/Rich.hs b/lib/Data/Text/ParagraphLayout/Rich.hs index d48530e..bb5f29b 100644 --- a/lib/Data/Text/ParagraphLayout/Rich.hs +++ b/lib/Data/Text/ParagraphLayout/Rich.hs @@ -28,6 +28,8 @@ module Data.Text.ParagraphLayout.Rich , RootNode (RootBox) , InnerNode (InlineBox, TextSequence) , Box (Box) + , EmptyText + , strut , BoxOptions , defaultBoxOptions , TextOptions diff --git a/src/Data/Text/ParagraphLayout/Internal/BoxOptions.hs b/src/Data/Text/ParagraphLayout/Internal/BoxOptions.hs index ea009de..0057086 100644 --- a/src/Data/Text/ParagraphLayout/Internal/BoxOptions.hs +++ b/src/Data/Text/ParagraphLayout/Internal/BoxOptions.hs @@ -66,6 +66,8 @@ data BoxSpacing -- For CSS-compliant behaviour: -- -- - Ensure that empty boxes contain empty text sequences as mentioned above. +-- This can be achieved using the `Data.Text.ParagraphLayout.Rich.strut` +-- function. -- -- - Set `AllowBoxCollapse` for boxes with zero margins, padding, -- and borders. diff --git a/src/Data/Text/ParagraphLayout/Internal/Tree.hs b/src/Data/Text/ParagraphLayout/Internal/Tree.hs index b3208de..5364ccc 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Tree.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Tree.hs @@ -19,12 +19,15 @@ module Data.Text.ParagraphLayout.Internal.Tree , InnerNode (..) , Box (..) , Leaf (..) + , EmptyText , flatten , glue + , strut ) where import Data.Text (Text) +import qualified Data.Text as Text import Data.Text.Foreign (lengthWord8) import qualified Data.Text.Lazy as Lazy (toStrict) import qualified Data.Text.Internal.Lazy as Lazy (Text, chunk, empty) @@ -68,6 +71,13 @@ data Box t d = Box [InnerNode t d] -- ^ Text nodes and other boxes contained by this box. + -- + -- Please note that boxes which are not the ancestors of any leaf nodes + -- will have no effect on the output. + -- + -- To ensure that all boxes are represented in the output, as would be + -- expected for DOM elements in HTML, an empty text sequence must be added + -- to otherwise empty boxes. This can be done by using the `strut` function. TextOptions -- ^ Style options to apply to text sequences directly contained @@ -92,6 +102,30 @@ data Leaf t d = TextLeaf -- ^ Inline boxes found on the path from this text sequence to the root -- of the original tree. +-- | Data types that can represent an empty text sequence in a `Tree`. +class EmptyText t where + empty :: t + +instance EmptyText Int where + empty = 0 + +instance EmptyText Text where + empty = Text.empty + +-- | Insert an empty text sequence with the given user data into each empty box. +strut :: EmptyText t => d -> RootNode t d -> RootNode t d +strut d (RootBox (Box ns textOpts)) = RootBox $ Box (strutNodes d ns) textOpts + +strutNodes :: EmptyText t => d -> [InnerNode t d] -> [InnerNode t d] +strutNodes d ns = map (strutNode d) ns + +strutNode :: EmptyText t => d -> InnerNode t d -> InnerNode t d +strutNode _ x@(TextSequence _ _) = x +strutNode d (InlineBox boxData (Box [] textOpts) boxOpts) = + InlineBox boxData (Box [TextSequence d empty] textOpts) boxOpts +strutNode d (InlineBox boxData (Box ns textOpts) boxOpts) = + InlineBox boxData (Box (strutNodes d ns) textOpts) boxOpts + -- | Convert the tree to a flat list of its leaf nodes (text sequences). flatten :: RootNode t d -> [Leaf t d] flatten (RootBox (Box ns textOpts)) = snd $ flattenNodes 0 [] textOpts ns diff --git a/test/Data/Text/ParagraphLayout/Internal/TreeSpec.hs b/test/Data/Text/ParagraphLayout/Internal/TreeSpec.hs index c7ba082..d488779 100644 --- a/test/Data/Text/ParagraphLayout/Internal/TreeSpec.hs +++ b/test/Data/Text/ParagraphLayout/Internal/TreeSpec.hs @@ -83,6 +83,48 @@ complexTree = RootBox $ Box ] t +sparseTree :: RootNode Int String +sparseTree = RootBox $ Box + [ TextSequence "a" 1 + , InlineBox + "empty box level 1 of 1" + (Box + [] + t + ) + defaultBoxOptions + , InlineBox + "empty box level 1 of 2" + (Box + [ InlineBox + "empty box level 2 of 2" + (Box + [] + t + ) + defaultBoxOptions + ] + t + ) + defaultBoxOptions + , InlineBox + "non-empty box" + (Box + [ TextSequence "b" 1 + , InlineBox + "empty box in non-empty box" + (Box + [] + t + ) + defaultBoxOptions + ] + t + ) + defaultBoxOptions + ] + t + leafData :: Leaf t d -> d leafData (TextLeaf d _ _ _) = d @@ -102,57 +144,77 @@ spec :: Spec spec = do describe "flatten" $ do - let leaves = flatten complexTree - - it "should have one leaf per text sequence" $ - length leaves `shouldBe` 13 - - it "leaves should have expected data" $ do - map leafData leaves `shouldBe` - map (: []) ['a' .. 'm'] - - it "leaves should have expected depths" $ do - map leafDepth leaves `shouldBe` - [0, 1, 1, 2, 2, 1, 2, 3, 2, 2, 2, 3, 1] - - it "leaves should have expected ancestor data" $ do - map leafPathData leaves `shouldBe` - [ [] - , ["box1"] - , ["box1"] - , ["box2", "box1"] - , ["box2", "box1"] - , ["box1"] - , ["box3", "box1"] - , ["box4", "box3", "box1"] - , ["box3", "box1"] - , ["box6", "box5"] - , ["box6", "box5"] - , ["box8", "box7", "box5"] - , ["box5"] - ] - - it "leaves should have expected ancestor indexes" $ do - map leafPathIndexes leaves `shouldBe` - [ [] - , [0] - , [0] - , [1, 0] - , [1, 0] - , [0] - , [2, 0] - , [3, 2, 0] - , [2, 0] - , [5, 4] - , [5, 4] - , [7, 6, 4] - , [4] - ] - - it "leaves 'c' and 'f' should have the same parent" $ - leafPath (leaves !! 2) !! 0 == - leafPath (leaves !! 5) !! 0 `shouldBe` True - - it "leaves 'e' and 'i' should have a different parent" $ - leafPath (leaves !! 4) !! 0 == - leafPath (leaves !! 8) !! 0 `shouldBe` False + + describe "complex tree" $ do + let leaves = flatten complexTree + + it "should have one leaf per text sequence" $ + length leaves `shouldBe` 13 + + it "leaves should have expected data" $ do + map leafData leaves `shouldBe` + map (: []) ['a' .. 'm'] + + it "leaves should have expected depths" $ do + map leafDepth leaves `shouldBe` + [0, 1, 1, 2, 2, 1, 2, 3, 2, 2, 2, 3, 1] + + it "leaves should have expected ancestor data" $ do + map leafPathData leaves `shouldBe` + [ [] + , ["box1"] + , ["box1"] + , ["box2", "box1"] + , ["box2", "box1"] + , ["box1"] + , ["box3", "box1"] + , ["box4", "box3", "box1"] + , ["box3", "box1"] + , ["box6", "box5"] + , ["box6", "box5"] + , ["box8", "box7", "box5"] + , ["box5"] + ] + + it "leaves should have expected ancestor indexes" $ do + map leafPathIndexes leaves `shouldBe` + [ [] + , [0] + , [0] + , [1, 0] + , [1, 0] + , [0] + , [2, 0] + , [3, 2, 0] + , [2, 0] + , [5, 4] + , [5, 4] + , [7, 6, 4] + , [4] + ] + + it "leaves 'c' and 'f' should have the same parent" $ + leafPath (leaves !! 2) !! 0 == + leafPath (leaves !! 5) !! 0 `shouldBe` True + + it "leaves 'e' and 'i' should have a different parent" $ + leafPath (leaves !! 4) !! 0 == + leafPath (leaves !! 8) !! 0 `shouldBe` False + + describe "unstrutted sparse tree with empty boxes" $ do + let leaves = flatten sparseTree + + it "should have one leaf per text sequence" $ + length leaves `shouldBe` 2 + + it "leaves should have expected data" $ do + map leafData leaves `shouldBe` ["a", "b"] + + describe "strutted sparse tree with empty boxes" $ do + let leaves = flatten $ strut "d" sparseTree + + it "should have one leaf per text sequence" $ + length leaves `shouldBe` 5 + + it "leaves should have expected data" $ do + map leafData leaves `shouldBe` ["a", "d", "d", "b", "d"] -- 2.30.2