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

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