TreeSpec.hs

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

t :: TextOptions
t = defaultTextOptions undefined

complexTree :: RootNode Int 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
                    ]
                    t
                )
                defaultBoxOptions
            , TextSequence "f" 1
            , InlineBox
                "box3"
                (Box
                    [ TextSequence "g" 1
                    , InlineBox
                        "box4"
                        (Box
                            [ TextSequence "h" 1
                            ]
                            t
                        )
                        defaultBoxOptions
                    , TextSequence "i" 1
                    ]
                    t
                )
                defaultBoxOptions
            ]
            t
        )
        defaultBoxOptions
    , InlineBox
        "box5"
        (Box
            [ InlineBox
                "box6"
                (Box
                    [ TextSequence "j" 1
                    , TextSequence "k" 1
                    ]
                    t
                )
                defaultBoxOptions
            , InlineBox
                "box7"
                (Box
                    [ InlineBox
                        "box8"
                        (Box
                            [ TextSequence "l" 1
                            ]
                            t
                        )
                        defaultBoxOptions
                    ]
                    t
                )
                defaultBoxOptions
            , TextSequence "m" 1
            ]
            t
        )
        defaultBoxOptions
    ]
    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

leafPath :: Leaf t d -> [ResolvedBox d]
leafPath (TextLeaf _ _ _ path) = path

leafDepth :: Leaf t d -> Int
leafDepth = length . leafPath

leafPathData :: Leaf t d -> [d]
leafPathData = map boxUserData . leafPath

leafPathIndexes :: Leaf t d -> [Int]
leafPathIndexes = map boxIndex . leafPath

spec :: Spec
spec = do

    describe "flatten" $ do

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