Implement generic pagination internally.
3 files changed, 426 insertions(+), 0 deletions(-) M balkon.cabal A src/Data/Text/ParagraphLayout/Internal/LinePagination.hs A test/Data/Text/ParagraphLayout/Internal/LinePaginationSpec.hs
M balkon.cabal => balkon.cabal +2 -0
@@ 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,
A src/Data/Text/ParagraphLayout/Internal/LinePagination.hs => src/Data/Text/ParagraphLayout/Internal/LinePagination.hs +178 -0
@@ 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 <https://www.w3.org/TR/css-break-3/#unforced-breaks>. | 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
A test/Data/Text/ParagraphLayout/Internal/LinePaginationSpec.hs => test/Data/Text/ParagraphLayout/Internal/LinePaginationSpec.hs +246 -0
@@ 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])