@@ 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
@@ 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"]