From fef8a026aab8152a29cb875a599f4f9e5a3ca83b Mon Sep 17 00:00:00 2001
From: Jaro <jaro@argonaut-constellation.org>
Date: Sat, 29 Apr 2023 23:16:19 +0200
Subject: [PATCH] Refactor pagination to allow rich layout.

---
 .../ParagraphLayout/Internal/ParagraphLine.hs | 86 ++++++++++++-------
 .../Internal/Plain/ParagraphLayout.hs         |  4 +
 2 files changed, 58 insertions(+), 32 deletions(-)

diff --git a/src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs b/src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs
index 460a978..d662fae 100644
--- a/src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs
@@ -1,6 +1,6 @@
+-- | Splitting paragraph layouts between lines.
 module Data.Text.ParagraphLayout.Internal.ParagraphLine
-    ( ParagraphLine
-    , cutLines
+    ( cutLines
     , mergeLines
     )
 where
@@ -9,52 +9,75 @@ import Data.Int (Int32)
 import qualified Data.List.NonEmpty as NonEmpty
 
 import Data.Text.ParagraphLayout.Internal.Fragment
-import Data.Text.ParagraphLayout.Internal.LinePagination
-import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout
+import qualified Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout as P
 import Data.Text.ParagraphLayout.Internal.Rect
 
--- | Represents one line of a `ParagraphLayout`.
-newtype ParagraphLine d = ParagraphLine (ParagraphLayout d)
+class GenericLayout pl where
 
-instance Line (ParagraphLine d) where
-    lineHeight (ParagraphLine pl) = height $ paragraphRect pl
+    -- | A layout with no content, to be used as an identity for appending.
+    empty :: pl
 
--- | Split the given `ParagraphLayout` into individual lines.
-cutLines :: ParagraphLayout d -> [ParagraphLine d]
+    -- | Rectangle surrounding the layout, to be used for appending.
+    rect :: pl -> Rect Int32
+
+    -- | Actual distance between the paragraph origin and the nearest fragment.
+    topDistance :: pl -> Int32
+
+    -- | A list of all unique line numbers that have laid out content.
+    lineNumbers :: pl -> [Int]
+
+    -- | Keep only fragments with the given line number.
+    limitFragments :: Int -> pl -> pl
+
+    -- | Add @dy@ to each fragment's `y_origin`.
+    shiftFragments :: Int32 -> pl -> pl
+
+    -- | Combine fragments from two layouts into one,
+    -- without any adjustment of coordinates.
+    appendFragments :: pl -> pl -> pl
+
+instance GenericLayout (P.ParagraphLayout d) where
+    empty = P.emptyParagraphLayout
+    rect = P.paragraphRect
+    topDistance pl = topFragmentOrigin $ P.paragraphFragments pl
+    lineNumbers pl = uniqueFragmentLines $ P.paragraphFragments pl
+    limitFragments n = P.filterFragments (fragmentIsOnLine n)
+    shiftFragments dy = P.mapFragments (shiftFragment dy)
+    appendFragments = P.appendFragments
+
+-- | Split the given `ParagraphLayout` into single-line layouts.
+cutLines :: GenericLayout pl => pl -> [pl]
 cutLines pl = map (\ n -> cutLine n pl) (lineNumbers pl)
 
 -- | Reduce the given `ParagraphLayout` to fragments with the given line number.
-cutLine :: Int -> ParagraphLayout d -> ParagraphLine d
-cutLine n pl = ParagraphLine $ trimTop $ limitFragments n pl
+cutLine :: GenericLayout pl => Int -> pl -> pl
+cutLine n pl = trimTop $ limitFragments n pl
 
 -- | Add a constant to each fragment's `y_origin` so that their maximum is zero.
-trimTop :: ParagraphLayout d -> ParagraphLayout d
-trimTop pl = shiftFragments (-top) pl
-    where
-        top = maximum $ map (y_origin . fragmentRect) $ paragraphFragments pl
+trimTop :: GenericLayout pl => pl -> pl
+trimTop pl = shiftFragments (-topDistance pl) pl
 
-lineNumbers :: ParagraphLayout d -> [Int]
-lineNumbers pl = dedupe $ map fragmentLine $ paragraphFragments pl
+topFragmentOrigin :: [Fragment d] -> Int32
+topFragmentOrigin frags = maximum $ map (y_origin . fragmentRect) frags
+
+uniqueFragmentLines :: [Fragment d] -> [Int]
+uniqueFragmentLines frags = dedupe $ map fragmentLine frags
 
 -- | Remove duplicates from a sorted list.
 dedupe :: Eq a => [a] -> [a]
 dedupe xs = map NonEmpty.head $ NonEmpty.group xs
 
--- | Combine the given `ParagraphLine`s into a `ParagraphLayout` by merging
--- their fragments.
-mergeLines :: [ParagraphLine d] -> ParagraphLayout d
-mergeLines lls = foldl mergeLine emptyParagraphLayout lls
+-- | Put the given `ParagraphLayout`s together as a vertically contiguous
+-- sequence.
+mergeLines :: GenericLayout pl => [pl] -> pl
+mergeLines lls = foldl mergeLine empty lls
 
-mergeLine :: ParagraphLayout d -> ParagraphLine d -> ParagraphLayout d
-mergeLine pl (ParagraphLine nextLine) = pl'
+mergeLine :: GenericLayout pl => pl -> pl -> pl
+mergeLine pl nextLine = pl'
     where
         -- Quadratic time complexity. TODO: Consider optimising.
         pl' = appendFragments pl $ shiftFragments y nextLine
-        y = y_terminus $ paragraphRect pl
-
--- | Add @dy@ to each fragment's `y_origin`.
-shiftFragments :: Int32 -> ParagraphLayout d -> ParagraphLayout d
-shiftFragments dy = mapFragments (shiftFragment dy)
+        y = y_terminus $ rect pl
 
 shiftFragment :: Int32 -> Fragment d -> Fragment d
 shiftFragment dy f = f'
@@ -63,6 +86,5 @@ shiftFragment dy f = f'
         r' = r { y_origin = y_origin r + dy }
         r = fragmentRect f
 
--- | Keep only fragments with the given line number.
-limitFragments :: Int -> ParagraphLayout d -> ParagraphLayout d
-limitFragments n = filterFragments ((== n) . fragmentLine)
+fragmentIsOnLine :: Int -> Fragment d -> Bool
+fragmentIsOnLine n frag = n == fragmentLine frag
diff --git a/src/Data/Text/ParagraphLayout/Internal/Plain/ParagraphLayout.hs b/src/Data/Text/ParagraphLayout/Internal/Plain/ParagraphLayout.hs
index 70ee28b..5f18917 100644
--- a/src/Data/Text/ParagraphLayout/Internal/Plain/ParagraphLayout.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/Plain/ParagraphLayout.hs
@@ -13,6 +13,7 @@ where
 import Data.Int (Int32)
 
 import Data.Text.ParagraphLayout.Internal.Fragment
+import Data.Text.ParagraphLayout.Internal.LinePagination
 import Data.Text.ParagraphLayout.Internal.ParagraphExtents
 import Data.Text.ParagraphLayout.Internal.Rect
 import Data.Text.ParagraphLayout.Internal.Span
@@ -25,6 +26,9 @@ data ParagraphLayout d = ParagraphLayout
     }
     deriving (Eq, Read, Show)
 
+instance Line (ParagraphLayout d) where
+    lineHeight pl = height $ paragraphRect pl
+
 -- | Wrap the given `SpanLayout`s and compute their containing rectangle.
 paragraphLayout :: [SpanLayout d] -> ParagraphLayout d
 paragraphLayout sls = ParagraphLayout pRect sls
-- 
2.30.2