module Data.Text.ParagraphLayout.Internal.ApplyBoxesSpec (spec) where import Data.List.NonEmpty (NonEmpty, fromList, toList) import Data.Text (empty) import Data.Text.Glyphize (Direction (DirLTR, DirRTL)) import Test.Hspec import Data.Text.ParagraphLayout.Internal.ApplyBoxes import Data.Text.ParagraphLayout.Internal.BiDiLevels import Data.Text.ParagraphLayout.Internal.BoxOptions import Data.Text.ParagraphLayout.Internal.ResolvedBox import Data.Text.ParagraphLayout.Internal.ResolvedSpan import Data.Text.ParagraphLayout.Internal.TextOptions import Data.Text.ParagraphLayout.Internal.WithSpan trivialBox :: d -> Int -> Direction -> ResolvedBox d trivialBox d i dir = ResolvedBox d i (defaultTextOptions dir) defaultBoxOptions dir trivialSpan :: d -> Int -> Direction -> [ResolvedBox d] -> ResolvedSpan d trivialSpan d i dir bs = ResolvedSpan { spanUserData = d , spanIndex = i , spanOffsetInParagraph = 0 , spanText = empty , spanTextOptions = defaultTextOptions dir , spanBoxes = bs , spanBiDiLevels = TextLevels [] (directionLevel 0 dir) , spanLineBreaks = [] , spanCharacterBreaks = [] } -- | Wrap nothing with the given span, since the algorithm expects `WithSpan`. wrapNothing :: ResolvedSpan d -> WithSpan d () wrapNothing rs = WithSpan rs () buildFrags :: [ResolvedSpan d] -> NonEmpty (WithSpan d ()) buildFrags spans = fmap wrapNothing $ fromList spans -- | Record for easy comparison of test output. data OutputFragment = OutputFragment { spanData :: String , leftBoxesData :: [String] , rightBoxesData :: [String] } deriving (Show, Eq) toOutput :: WithBoxes String (WithSpan String ()) -> OutputFragment toOutput a = OutputFragment { spanData = case unwrap a of WithSpan rs _ -> spanUserData rs , leftBoxesData = map boxUserData $ leftInBoxes a , rightBoxesData = map boxUserData $ rightInBoxes a } runTest :: [ResolvedBox String] -> [ResolvedSpan String] -> [ResolvedBox String] -> [OutputFragment] runTest prevOpen spans nextOpen = map toOutput $ toList $ applyBoxes prevOpen nextOpen (buildFrags spans) spec :: Spec spec = do describe "applyBoxes" $ do it "handles case without boxes" $ do let spans = [ trivialSpan "A" 0 DirLTR [] , trivialSpan "B" 1 DirLTR [] ] runTest [] spans [] `shouldBe` [ OutputFragment "A" [] [] , OutputFragment "B" [] [] ] it "handles discrete boxes" $ do let box1 = trivialBox "box1" 0 DirRTL box2 = trivialBox "box2" 1 DirRTL spans = [ trivialSpan "Z" 0 DirRTL [box2] , trivialSpan "Y" 1 DirRTL [box1] , trivialSpan "X" 2 DirRTL [box1] , trivialSpan "W" 3 DirRTL [] ] runTest [] spans [] `shouldBe` [ OutputFragment "Z" ["box2"] ["box2"] , OutputFragment "Y" ["box1"] [] , OutputFragment "X" [] ["box1"] , OutputFragment "W" [] [] ] it "handles deeply nested boxes" $ do let box1 = trivialBox "box1" 0 DirLTR box2 = trivialBox "box2" 1 DirRTL box3 = trivialBox "box3" 2 DirRTL box4 = trivialBox "box4" 3 DirLTR box5 = trivialBox "box5" 4 DirRTL spans = [ trivialSpan "A" 0 DirRTL [box3, box2, box1] , trivialSpan "B" 1 DirRTL [box5, box4, box3, box2, box1] ] runTest [] spans [] `shouldBe` [ OutputFragment "A" ["box3", "box2", "box1"] [] , OutputFragment "B" ["box5", "box4"] ["box5", "box4", "box3", "box2", "box1"] ] it "omits left edge of LTR box crossing previous line" $ do let box = trivialBox "box" 0 DirLTR spans = [trivialSpan "." 0 DirLTR [box]] runTest [box] spans [] `shouldBe` [OutputFragment "." [] ["box"]] it "omits right edge of RTL box crossing previous line" $ do let box = trivialBox "box" 0 DirRTL spans = [trivialSpan "." 0 DirRTL [box]] runTest [box] spans [] `shouldBe` [OutputFragment "." ["box"] []] it "omits right edge of LTR box crossing next line" $ do let box = trivialBox "box" 0 DirLTR spans = [trivialSpan "." 0 DirLTR [box]] runTest [] spans [box] `shouldBe` [OutputFragment "." ["box"] []] it "omits left edge of RTL box crossing next line" $ do let box = trivialBox "box" 0 DirRTL spans = [trivialSpan "." 0 DirRTL [box]] runTest [] spans [box] `shouldBe` [OutputFragment "." [] ["box"]] it "omits both edges of LTR box crossing previous and next line" $ do let box = trivialBox "box" 0 DirLTR spans = [trivialSpan "." 0 DirLTR [box]] runTest [box] spans [box] `shouldBe` [OutputFragment "." [] []] it "omits both edges of RTL box crossing previous and next line" $ do let box = trivialBox "box" 0 DirRTL spans = [trivialSpan "." 0 DirRTL [box]] runTest [box] spans [box] `shouldBe` [OutputFragment "." [] []] it "handles complex example" $ do let box1 = trivialBox "box1" 0 DirRTL box2 = trivialBox "box2" 1 DirLTR box3 = trivialBox "box3" 2 DirLTR box4 = trivialBox "box4" 3 DirRTL spans = [ trivialSpan "A" 0 DirRTL [box1] , trivialSpan "B" 1 DirLTR [box2, box1] , trivialSpan "C" 2 DirLTR [box2, box1] , trivialSpan "D" 3 DirRTL [box3, box2, box1] , trivialSpan "E" 4 DirLTR [box2, box1] , trivialSpan "F" 5 DirRTL [box4, box1] ] runTest [box1] spans [box4, box1] `shouldBe` [ OutputFragment "A" [] [] , OutputFragment "B" ["box2"] [] , OutputFragment "C" [] [] , OutputFragment "D" ["box3"] ["box3"] , OutputFragment "E" [] ["box2"] , OutputFragment "F" [] ["box4"] ]