LinePagination.hs

-- | 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
    ( LineHeight
    , lineHeight
    , PageContinuity (Break, Continue)
    , bestSplit
    , 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 LineHeight a where
    lineHeight :: a -> Int32

-- | A trivial instance of `LineHeight` that is just a height.
--
-- For testing purposes.
instance LineHeight Int32 where
    lineHeight = id

-- | Represents the best place to place a chunk of paginated content.
data PageContinuity

    = Continue
    -- ^ The content is split so that a given chunk 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 content is split so that a given chunk 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 content at all.

    deriving (Eq, Show, Read, Enum, Bounded)

-- | Split a list of lines in order to meet the given pagination constraints.
--
-- This is a high-level function that produces the best usable result,
-- even if some constraints have to be violated.
--
-- 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 :: LineHeight 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 satisfying the given constraints.
--
-- This is a low-level function that makes no compromises.
bestSplit :: LineHeight a
    => Word
    -- ^ Number of lines at the beginning ("orphans") to keep together.
    -> Word
    -- ^ Number of lines at the end ("widows") to keep together.
    -> Int32
    -- ^ Maximum total height of lines in the prefix.
    -> [a]
    -- ^ Lines to split.
    -> ([a], [a])
    -- ^ Two lists of lines that yield the original list when concatenated,
    -- where the prefix, if non-empty, matches the given orphan, widow, and
    -- maximum height constraints.
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
    :: LineHeight 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 :: LineHeight 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 :: LineHeight a => [a] -> NonEmpty (Int32, ([a], [a]))
splitsWithTotal ls = zeroSplit :| splits
    where
        zeroSplit = (zeroTotal, (zeroClosed, ls))
        splits = splitsWithTotal' zeroTotal zeroClosed ls
        zeroClosed = []
        zeroTotal = 0

splitsWithTotal' :: LineHeight 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