3 files changed, 175 insertions(+), 13 deletions(-)

M balkon.cabal
M src/Data/Text/ParagraphLayout/Internal/Tree.hs
A test/Data/Text/ParagraphLayout/Internal/TreeSpec.hs

@@ 184,6 184,7 @@ test-suite balkon-test
         Data.Text.ParagraphLayout.Internal.LinePaginationSpec,
         Data.Text.ParagraphLayout.Internal.RunSpec,
         Data.Text.ParagraphLayout.Internal.TextContainerSpec,
+        Data.Text.ParagraphLayout.Internal.TreeSpec,
         Data.Text.ParagraphLayout.Internal.ZipperSpec,
         Data.Text.ParagraphLayout.Plain.ParagraphData,
         Data.Text.ParagraphLayout.PlainSpec,

@@ 12,6 12,7 @@ module Data.Text.ParagraphLayout.Internal.Tree
 where
 
 import Data.Text.ParagraphLayout.Internal.BoxOptions
+import Data.Text.ParagraphLayout.Internal.ResolvedBox
 import Data.Text.ParagraphLayout.Internal.TextOptions
 
 -- | Root of the paragraph tree.


@@ 54,8 55,8 @@ data Box d = Box
     -- ^ Style options to apply to text sequences directly contained
     -- by this box.
 
--- TODO: we need a way to test box equality, maybe add indexes?
-type BoxPath d = [(d, BoxOptions)]
+
+type BoxPath d = [ResolvedBox d]
 
 -- | Representation of a leaf node of the tree after flattening.
 data Leaf d = TextLeaf


@@ 75,14 76,19 @@ data Leaf d = TextLeaf
 
 -- | Convert the tree to a flat list of its leaf nodes (text sequences).
 flatten :: RootNode d -> [Leaf d]
-flatten (RootBox (Box ns textOpts)) = flattenNodes [] textOpts ns
-
-flattenNodes :: BoxPath d -> TextOptions -> [InnerNode d] -> [Leaf d]
-flattenNodes _ _ [] = []
-flattenNodes path textOpts (n : ns) =
-    flattenNode path textOpts n ++ flattenNodes path textOpts ns
-
-flattenNode :: BoxPath d -> TextOptions -> InnerNode d -> [Leaf d]
-flattenNode path textOpts (TextSequence d len) = [TextLeaf d len textOpts path]
-flattenNode path _ (InlineBox d (Box ns textOpts) boxOpts) =
-    flattenNodes ((d, boxOpts) : path) textOpts ns
+flatten (RootBox (Box ns textOpts)) = snd $ flattenNodes 0 [] textOpts ns
+
+flattenNodes :: Int -> BoxPath d -> TextOptions -> [InnerNode d] ->
+    (Int, [Leaf d])
+flattenNodes idx _ _ [] = (idx, [])
+flattenNodes idx path textOpts (n : ns) = (idx'', flat1 ++ flat2)
+    where
+        (idx', flat1) = flattenNode idx path textOpts n
+        (idx'', flat2) = flattenNodes idx' path textOpts ns
+
+flattenNode :: Int -> BoxPath d -> TextOptions -> InnerNode d ->
+    (Int, [Leaf d])
+flattenNode idx path textOpts (TextSequence d len) =
+    (idx, [TextLeaf d len textOpts path])
+flattenNode idx path _ (InlineBox d (Box ns textOpts) boxOpts) =
+    flattenNodes (idx + 1) (ResolvedBox d idx boxOpts : path) textOpts ns

@@ 0,0 1,155 @@
+module Data.Text.ParagraphLayout.Internal.TreeSpec (spec) where
+
+import Test.Hspec
+import Data.Text.ParagraphLayout.Internal.BoxOptions
+import Data.Text.ParagraphLayout.Internal.ResolvedBox
+import Data.Text.ParagraphLayout.Internal.TextOptions
+import Data.Text.ParagraphLayout.Internal.Tree
+
+complexTree :: RootNode String
+complexTree = RootBox $ Box
+    [ TextSequence "a" 1
+    , InlineBox
+        "box1"
+        (Box
+            [ TextSequence "b" 1
+            , TextSequence "c" 1
+            , InlineBox
+                "box2"
+                (Box
+                    [ TextSequence "d" 1
+                    , TextSequence "e" 1
+                    ]
+                    defaultTextOptions
+                )
+                defaultBoxOptions
+            , TextSequence "f" 1
+            , InlineBox
+                "box3"
+                (Box
+                    [ TextSequence "g" 1
+                    , InlineBox
+                        "box4"
+                        (Box
+                            [ TextSequence "h" 1
+                            ]
+                            defaultTextOptions
+                        )
+                        defaultBoxOptions
+                    , TextSequence "i" 1
+                    ]
+                    defaultTextOptions
+                )
+                defaultBoxOptions
+            ]
+            defaultTextOptions
+        )
+        defaultBoxOptions
+    , InlineBox
+        "box5"
+        (Box
+            [ InlineBox
+                "box6"
+                (Box
+                    [ TextSequence "j" 1
+                    , TextSequence "k" 1
+                    ]
+                    defaultTextOptions
+                )
+                defaultBoxOptions
+            , InlineBox
+                "box7"
+                (Box
+                    [ InlineBox
+                        "box8"
+                        (Box
+                            [ TextSequence "l" 1
+                            ]
+                            defaultTextOptions
+                        )
+                        defaultBoxOptions
+                    ]
+                    defaultTextOptions
+                )
+                defaultBoxOptions
+            , TextSequence "m" 1
+            ]
+            defaultTextOptions
+        )
+        defaultBoxOptions
+    ]
+    defaultTextOptions
+
+leafData :: Leaf d -> d
+leafData (TextLeaf d _ _ _) = d
+
+leafPath :: Leaf d -> [ResolvedBox d]
+leafPath (TextLeaf _ _ _ path) = path
+
+leafDepth :: Leaf d -> Int
+leafDepth = length . leafPath
+
+leafPathData :: Leaf d -> [d]
+leafPathData = map boxUserData . leafPath
+
+leafPathIndexes :: Leaf d -> [Int]
+leafPathIndexes = map boxIndex . leafPath
+
+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