From d08655932562889f01aae90ed6e201fcddbaf169 Mon Sep 17 00:00:00 2001 From: Jaro Date: Tue, 28 Mar 2023 14:05:44 +0200 Subject: [PATCH] Implement generic pagination internally. --- balkon.cabal | 2 + .../Internal/LinePagination.hs | 178 +++++++++++++ .../Internal/LinePaginationSpec.hs | 246 ++++++++++++++++++ 3 files changed, 426 insertions(+) create mode 100644 src/Data/Text/ParagraphLayout/Internal/LinePagination.hs create mode 100644 test/Data/Text/ParagraphLayout/Internal/LinePaginationSpec.hs diff --git a/balkon.cabal b/balkon.cabal index dde3cff..f09170f 100644 --- a/balkon.cabal +++ b/balkon.cabal @@ -125,6 +125,7 @@ library balkon-internal Data.Text.ParagraphLayout.Internal.Break, Data.Text.ParagraphLayout.Internal.Fragment, Data.Text.ParagraphLayout.Internal.LineHeight, + Data.Text.ParagraphLayout.Internal.LinePagination, Data.Text.ParagraphLayout.Internal.Paragraph, Data.Text.ParagraphLayout.Internal.ParagraphConstruction, Data.Text.ParagraphLayout.Internal.ParagraphLayout, @@ -181,6 +182,7 @@ test-suite balkon-test Data.Text.ParagraphLayoutSpec, Data.Text.ParagraphLayout.FontLoader, Data.Text.ParagraphLayout.Internal.BreakSpec, + Data.Text.ParagraphLayout.Internal.LinePaginationSpec, Data.Text.ParagraphLayout.Internal.RunSpec, Data.Text.ParagraphLayout.Internal.TextContainerSpec, Data.Text.ParagraphLayout.Internal.ZipperSpec, diff --git a/src/Data/Text/ParagraphLayout/Internal/LinePagination.hs b/src/Data/Text/ParagraphLayout/Internal/LinePagination.hs new file mode 100644 index 0000000..fa59a10 --- /dev/null +++ b/src/Data/Text/ParagraphLayout/Internal/LinePagination.hs @@ -0,0 +1,178 @@ +-- | Breaking generic lines into discrete pages. +-- +-- This can be used for implementing fragmentation breaks as defined by the +-- [CSS Fragmentation Module Level 3](https://www.w3.org/TR/css-break-3/). +-- All types of fragmentation containers (pages, columns, regions) are referred +-- to as pages within this module. +-- +-- Assumptions: +-- * Lines are laid out from top to bottom. +-- * Each page has the same size. +-- (Preceding context may limit the space available on the given page, but it +-- is assumed that the space on every following page can be used in full.) +module Data.Text.ParagraphLayout.Internal.LinePagination + (Line + ,PageContinuity(Break, Continue) + ,bestSplit + ,lineHeight + ,paginateLines + ) +where + +import Data.Int (Int32) +import Data.List (dropWhileEnd, genericLength) +import Data.List.NonEmpty (NonEmpty((:|))) +import qualified Data.List.NonEmpty as NonEmpty + +-- | Representation of a line of text with a known height. +-- +-- Lines are assumed to be tightly packed without overlaps, +-- so that the vertical space taken up by multiple lines +-- is equal to the sum of the height of each line. +class Line a where + lineHeight :: a -> Int32 + +-- | A trivial instance of `Line` that is just a height. +-- +-- For testing purposes. +instance Line Int32 where + lineHeight = id + +-- | Represents the best place, as determined by the `paginateLines` function, +-- to place the first line of paginated text. +data PageContinuity + + = Continue + -- ^ The lines are split so that the prefix can continue on the same page + -- as its preceding context. + -- + -- This may be because all constraints were met, or because adding a page + -- break would have no benefit. + + | Break + -- ^ The lines are split so that the prefix should begin on a new page. + -- + -- This may be because the current page does not have enough space + -- to preserve orphan/widow constrains, or because it does not have space + -- for any lines at all. + + deriving (Eq, Show, Read, Enum, Bounded) + +-- | Split a list of lines in order to fit the given pagination constraints. +-- +-- The first component of the output determines whether a page break should +-- be inserted before any of the given lines. +-- +-- The second component of the output contains the lines that fit on one page +-- and satisfy the given constraints as much as possible. +-- +-- The third component of the output contains all remaining lines. If non-empty, +-- these can be passed to this function again to produce more pages. +paginateLines :: Line a + => Word + -- ^ Minimum number of lines to keep before a page break ("orphans"), + -- if possible. + -> Word + -- ^ Minimum number of lines to keep after a page break ("widows"), + -- if possible. + -> Int32 + -- ^ Height available when continuing the current page. + -- Used for calculating results with `PageContinuity` set to `Continue`. + -> Int32 + -- ^ Height available when breaking onto a new page. + -- Used for calculating results with `PageContinuity` set to `Break`. + -> [a] + -- ^ Lines to paginate. + -> (PageContinuity, [a], [a]) + -- ^ The best page break found. +paginateLines o w h1 h2 ls + -- First, attempt to satisfy the orphans and widows constraints, following + -- "Rule 3" of . + | canBeFinal constrained + = accept constrained Continue + | canBeFinal constrainedNextPage + = accept constrainedNextPage Break + -- Next, drop "rule 3" to provide more break points. + | canBeFinal relaxed + = accept relaxed Continue + | canBeFinal relaxedNextPage + = accept relaxedNextPage Break + -- If overflow is unavoidable, break after the first line. + -- Try adding a page break if it would make the line fit better. + | h1 >= h2 + = accept overflowing Continue + | otherwise + = accept overflowing Break + where + accept (prefix, suffix) continuity = (continuity, prefix, suffix) + constrained = bestSplit o w h1 ls + constrainedNextPage = bestSplit o w h2 ls + relaxed = bestSplit 1 1 h1 ls + relaxedNextPage = bestSplit 1 1 h2 ls + overflowing = split1 ls + +-- | Determine whether pagination will converge if pages are split +-- in the given way. +canBeFinal :: ([a], [a]) -> Bool +-- An empty suffix is OK, because this means the end of pagination. +canBeFinal (_, []) = True +-- An empty prefix with a non-empty suffix is unacceptable, because +-- repeating pagination on the suffix would diverge. +canBeFinal ([], _) = False +-- A non-empty prefix with a non-empty suffix is OK, because +-- repeating pagination on the suffix will eventually converge. +canBeFinal (_, _) = True + +-- | Split a non-empty list after its first element, +-- or split an empty list into two empty lists. +split1 :: [a] -> ([a], [a]) +split1 xs = (take 1 xs, drop 1 xs) + +-- | Split a list of lines so that the prefix contains as many lines +-- as possible while the total of line heights in the prefix does +-- not exceed @h@, the first @o@ lines ("orphans") are kept together, +-- and the last @w@ lines ("widows") are kept together. +bestSplit :: Line a => Word -> Word -> Int32 -> [a] -> ([a], [a]) +bestSplit o w h ls = NonEmpty.last $ constrainedSplits o w h ls + +-- | Split a list of lines in every possible way, from shortest prefix +-- to longest, as long as the total of line heights in the prefix does +-- not exceed @h@, the first @o@ lines ("orphans") are kept together, +-- and the last @w@ lines ("widows") are kept together. +constrainedSplits + :: Line a => Word -> Word -> Int32 -> [a] -> NonEmpty ([a], [a]) +constrainedSplits o w h ls = zeroSplit :| dropWhileEnd violating splits + where + zeroSplit :| splits = fittingSplits h ls + violating = not . meetingConstraints + meetingConstraints (prefix, suffix) + = (null prefix || genericLength prefix >= o) + && (null suffix || genericLength suffix >= w) + +-- | Split a list of lines in every possible way, from shortest prefix +-- to longest, as long as the total of line heights in the prefix does +-- not exceed @h@. +fittingSplits :: Line a => Int32 -> [a] -> NonEmpty ([a], [a]) +fittingSplits h ls = fmap snd $ zeroSplit :| takeWhile fitting splits + where + zeroSplit :| splits = splitsWithTotal ls + fitting (height, _) = height <= h + +-- | Split a list of lines in every possible way, from shortest prefix +-- to longest, and keep a running total of line heights in the prefix. +splitsWithTotal :: Line a => [a] -> NonEmpty (Int32, ([a], [a])) +splitsWithTotal ls = zeroSplit :| splits + where + zeroSplit = (zeroTotal, (zeroClosed, ls)) + splits = splitsWithTotal' zeroTotal zeroClosed ls + zeroClosed = [] + zeroTotal = 0 + +splitsWithTotal' :: Line a => Int32 -> [a] -> [a] -> [(Int32, ([a], [a]))] +splitsWithTotal' _ _ [] = [] +splitsWithTotal' total closed (x:xs) = split : splits + where + split = (newTotal, (reverse newClosed, xs)) + splits = splitsWithTotal' newTotal newClosed xs + newClosed = x:closed + newTotal = total + lineHeight x diff --git a/test/Data/Text/ParagraphLayout/Internal/LinePaginationSpec.hs b/test/Data/Text/ParagraphLayout/Internal/LinePaginationSpec.hs new file mode 100644 index 0000000..692927d --- /dev/null +++ b/test/Data/Text/ParagraphLayout/Internal/LinePaginationSpec.hs @@ -0,0 +1,246 @@ +module Data.Text.ParagraphLayout.Internal.LinePaginationSpec (spec) where + +import Control.Monad (forM_) +import Data.Int (Int32) + +import Test.Hspec +import Data.Text.ParagraphLayout.Internal.LinePagination + +emptyLines :: [Int32] +emptyLines = [] + +-- TODO: For rich text, add tests with unequal line heights. +tenLines :: [Int32] +tenLines = [10, 10, 10, 10, 10, 10, 10, 10, 10, 10] + +spec :: Spec +spec = do + + -- Lower level function. + -- Must prevent overflow and meet orphan/widow constraints at all times. + describe "bestSplit" $ do + + describe "emptyLines, orphans = 1, widows = 1" $ do + let ls = emptyLines + let page = bestSplit 1 1 + + ([-30, -5, 0, 5, 30, 90, 100, 110] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " returns empty lists") $ + page h ls `shouldBe` + ([], []) + + describe "tenLines, orphans = 1, widows = 1" $ do + let ls = tenLines + let page = bestSplit 1 1 + + ([-30, -5, 0, 5] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts all in second list") $ + page h ls `shouldBe` + ([], [10, 10, 10, 10, 10, 10, 10, 10, 10, 10]) + + ([30, 35] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts 3 in first list") $ + page h ls `shouldBe` + ([10, 10, 10], [10, 10, 10, 10, 10, 10, 10]) + + ([100, 110] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts all in first list") $ + page h ls `shouldBe` + ([10, 10, 10, 10, 10, 10, 10, 10, 10, 10], []) + + describe "tenLines, orphans = 3, widows = 4" $ do + let ls = tenLines + let page = bestSplit 3 4 + -- Acceptable page breaks: + -- * 0 + 10 + -- * 3 + 7 + -- * 4 + 6 + -- * 5 + 5 + -- * 6 + 4 + -- * 10 + 0 + + ([0, 10, 15, 25] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " ensures 3 orphans") $ + page h ls `shouldBe` + ([], [10, 10, 10, 10, 10, 10, 10, 10, 10, 10]) + + ([30, 35] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts 3 in first list") $ + page h ls `shouldBe` + ([10, 10, 10], [10, 10, 10, 10, 10, 10, 10]) + + ([40, 45] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts 4 in first list") $ + page h ls `shouldBe` + ([10, 10, 10, 10], [10, 10, 10, 10, 10, 10]) + + ([60, 75, 90] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " ensures 4 widows") $ + page h ls `shouldBe` + ([10, 10, 10, 10, 10, 10], [10, 10, 10, 10]) + + ([100, 110] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts all in first list") $ + page h ls `shouldBe` + ([10, 10, 10, 10, 10, 10, 10, 10, 10, 10], []) + + describe "tenLines, orphans = 6, widows = 4" $ do + let ls = tenLines + let page = bestSplit 6 4 + -- Acceptable page breaks: + -- * 0 + 10 + -- * 6 + 4 + -- * 10 + 0 + + ([0, 10, 15, 35, 50, 55] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " ensures 6 orphans") $ + page h ls `shouldBe` + ([], [10, 10, 10, 10, 10, 10, 10, 10, 10, 10]) + + ([60, 65, 85, 95] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts 6 in first list") $ + page h ls `shouldBe` + ([10, 10, 10, 10, 10, 10], [10, 10, 10, 10]) + + ([100, 110] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts all in first list") $ + page h ls `shouldBe` + ([10, 10, 10, 10, 10, 10, 10, 10, 10, 10], []) + + describe "tenLines, orphans = 6, widows = 5" $ do + let ls = tenLines + let page = bestSplit 6 5 + -- Acceptable page breaks: + -- * 0 + 10 + -- * 10 + 0 + + ([0, 10, 60, 65, 85, 95] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts all in second list") $ + page h ls `shouldBe` + ([], [10, 10, 10, 10, 10, 10, 10, 10, 10, 10]) + + ([100, 110] :: [Int32]) `forM_` \h -> + it ("maxHeight = " ++ show h ++ " puts all in first list") $ + page h ls `shouldBe` + ([10, 10, 10, 10, 10, 10, 10, 10, 10, 10], []) + + -- Higher level function. + -- Must return a non-empty prefix if input was non-empty. + -- May only break orphan/widow constraints or overflow if unavoidable. + describe "paginateLines" $ do + + describe "emptyLines, orphans = 1, widows = 1" $ do + let ls = emptyLines + let page = paginateLines 1 1 + + it "continues page with no lines when space is zero" $ + page 0 0 ls `shouldBe` + (Continue, [], []) + + it "tolerates negative current page height" $ + page (-30) 0 ls `shouldBe` + (Continue, [], []) + + it "tolerates negative next page height" $ + page 0 (-30) ls `shouldBe` + (Continue, [], []) + + it "continues page with no lines when space is equal" $ + page 50 50 ls `shouldBe` + (Continue, [], []) + + it "continues page with no lines when next page has more space" $ + page 50 100 ls `shouldBe` + (Continue, [], []) + + describe "tenLines, orphans = 1, widows = 1" $ do + let ls = tenLines + let page = paginateLines 1 1 + + it "puts all lines on current page if possible" $ + page 200 200 ls `shouldBe` + (Continue, [10, 10, 10, 10, 10, 10, 10, 10, 10, 10], []) + + it "puts as many lines on current page as possible" $ + page 60 200 ls `shouldBe` + (Continue, [10, 10, 10, 10, 10, 10], [10, 10, 10, 10]) + + it "starts at next page if not enough room" $ + page 5 200 ls `shouldBe` + (Break, [10, 10, 10, 10, 10, 10, 10, 10, 10, 10], []) + + it "starts at next page and handles breaking there" $ + page 5 70 ls `shouldBe` + (Break, [10, 10, 10, 10, 10, 10, 10], [10, 10, 10]) + + it "overflows on current page" $ + page 5 5 ls `shouldBe` + (Continue, [10], [10, 10, 10, 10, 10, 10, 10, 10, 10]) + + it "overflows on next page if it has more room" $ + page 5 6 ls `shouldBe` + (Break, [10], [10, 10, 10, 10, 10, 10, 10, 10, 10]) + + it "tolerates negative current page height" $ + page (-30) 0 ls `shouldBe` + (Break, [10], [10, 10, 10, 10, 10, 10, 10, 10, 10]) + + it "tolerates negative next page height" $ + page 0 (-30) ls `shouldBe` + (Continue, [10], [10, 10, 10, 10, 10, 10, 10, 10, 10]) + + describe "tenLines, orphans = 5, widows = 3" $ do + let ls = tenLines + let page = paginateLines 5 3 + -- Acceptable page breaks: + -- * 0 + 10 + -- * 5 + 5 + -- * 6 + 4 + -- * 7 + 3 + -- * 10 + 0 + + it "puts all lines on current page if possible" $ + page 200 200 ls `shouldBe` + (Continue, [10, 10, 10, 10, 10, 10, 10, 10, 10, 10], []) + + it "puts as many lines on current page as possible" $ + page 60 200 ls `shouldBe` + (Continue, [10, 10, 10, 10, 10, 10], [10, 10, 10, 10]) + + it "starts at next page if not enough room" $ + page 5 200 ls `shouldBe` + (Break, [10, 10, 10, 10, 10, 10, 10, 10, 10, 10], []) + + it "starts at next page and handles breaking there" $ + page 5 70 ls `shouldBe` + (Break, [10, 10, 10, 10, 10, 10, 10], [10, 10, 10]) + + it "overflows on current page" $ + page 5 5 ls `shouldBe` + (Continue, [10], [10, 10, 10, 10, 10, 10, 10, 10, 10]) + + it "overflows on next page if it has more room" $ + page 5 6 ls `shouldBe` + (Break, [10], [10, 10, 10, 10, 10, 10, 10, 10, 10]) + + -- Behaviour affected by orphans/widows: + + it "breaks early to meet widows constraint" $ + page 80 200 ls `shouldBe` + (Continue, [10, 10, 10, 10, 10, 10, 10], [10, 10, 10]) + + it "breaks at start to meet orphans constraint" $ + page 45 200 ls `shouldBe` + (Break, [10, 10, 10, 10, 10, 10, 10, 10, 10, 10], []) + + it "starts at next page and meets widows constraint there" $ + page 5 80 ls `shouldBe` + (Break, [10, 10, 10, 10, 10, 10, 10], [10, 10, 10]) + + it "continues page and violates impossible constraints" $ + page 45 46 ls `shouldBe` + (Continue, [10, 10, 10, 10], [10, 10, 10, 10, 10, 10]) + + it "breaks page and violates impossible constraints" $ + page 5 36 ls `shouldBe` + (Break, [10, 10, 10], [10, 10, 10, 10, 10, 10, 10]) -- 2.30.2