From d967aa9649fb81cb13f7fb00e5fec774b4dfb7f0 Mon Sep 17 00:00:00 2001
From: Jaro <jaro@argonaut-constellation.org>
Date: Sun, 30 Apr 2023 04:57:14 +0200
Subject: [PATCH] Implement piecewise paragraph construction.

---
 balkon.cabal                                  |  1 +
 .../Internal/Rich/Paragraph.hs                | 10 +++
 .../ParagraphLayout/Internal/TreeOfTexts.hs   | 88 +++++++++++++++++++
 3 files changed, 99 insertions(+)
 create mode 100644 src/Data/Text/ParagraphLayout/Internal/TreeOfTexts.hs

diff --git a/balkon.cabal b/balkon.cabal
index 8a42d90..4c576bb 100644
--- a/balkon.cabal
+++ b/balkon.cabal
@@ -126,6 +126,7 @@ library balkon-internal
         Data.Text.ParagraphLayout.Internal.TextContainer,
         Data.Text.ParagraphLayout.Internal.TextOptions,
         Data.Text.ParagraphLayout.Internal.Tree,
+        Data.Text.ParagraphLayout.Internal.TreeOfTexts,
         Data.Text.ParagraphLayout.Internal.Zipper
 
     -- Modules used purely internally and not in any tests.
diff --git a/src/Data/Text/ParagraphLayout/Internal/Rich/Paragraph.hs b/src/Data/Text/ParagraphLayout/Internal/Rich/Paragraph.hs
index d5bf356..647cf72 100644
--- a/src/Data/Text/ParagraphLayout/Internal/Rich/Paragraph.hs
+++ b/src/Data/Text/ParagraphLayout/Internal/Rich/Paragraph.hs
@@ -1,5 +1,6 @@
 module Data.Text.ParagraphLayout.Internal.Rich.Paragraph
     ( Paragraph (..)
+    , constructParagraph
     , paragraphSpanBounds
     , paragraphSpanTexts
     , paragraphText
@@ -11,6 +12,7 @@ import qualified Data.List.NonEmpty as NonEmpty
 import Data.Text.Array (Array)
 import Data.Text.Internal (Text (Text))
 
+import qualified Data.Text.ParagraphLayout.Internal.TreeOfTexts as Texts
 import Data.Text.ParagraphLayout.Internal.ParagraphOptions
 import Data.Text.ParagraphLayout.Internal.Tree
 
@@ -48,6 +50,14 @@ data Paragraph d = Paragraph
     ParagraphOptions
     -- ^ Options applying to the paragraph as a whole.
 
+constructParagraph :: Text -> Texts.RootNode d -> Text -> ParagraphOptions ->
+    Paragraph d
+constructParagraph prefix root suffix = Paragraph arr afterPrefix root'
+    where
+        (Text arr beforePrefix _) = txt
+        afterPrefix = beforePrefix + prefixLen
+        (txt, prefixLen, root') = Texts.toStrict prefix root suffix
+
 -- | Calculate the offsets into the `Paragraph`'s underlying `Data.Text.Array`
 -- where each text node starts and ends, in ascending order. The resulting list
 -- will be one larger than the number of text nodes in the input.
diff --git a/src/Data/Text/ParagraphLayout/Internal/TreeOfTexts.hs b/src/Data/Text/ParagraphLayout/Internal/TreeOfTexts.hs
new file mode 100644
index 0000000..61253cf
--- /dev/null
+++ b/src/Data/Text/ParagraphLayout/Internal/TreeOfTexts.hs
@@ -0,0 +1,88 @@
+-- | Represents the contents of a paragraph as a tree of boxes and texts.
+--
+-- This is intended for easier construction of paragraphs, at the cost of lower
+-- performance. All texts will be concatenated together by layout functions.
+module Data.Text.ParagraphLayout.Internal.TreeOfTexts
+    ( RootNode (..)
+    , InnerNode (..)
+    , Box (..)
+    , toStrict
+    )
+where
+
+import Data.Text (Text)
+import Data.Text.Foreign (lengthWord8)
+import qualified Data.Text.Lazy as Lazy (toStrict)
+import qualified Data.Text.Internal.Lazy as Lazy (Text, chunk, empty)
+
+import Data.Text.ParagraphLayout.Internal.BoxOptions
+import Data.Text.ParagraphLayout.Internal.TextOptions
+import qualified Data.Text.ParagraphLayout.Internal.Tree as Strict
+
+-- | Root of the paragraph tree.
+data RootNode d
+
+    = RootBox (Box d)
+    -- ^ The root box.
+
+-- | Non-root node of the paragraph tree.
+data InnerNode d
+
+    = InlineBox
+    -- ^ An inline box, nested in another box.
+        d
+        -- ^ User-defined data associated with the box.
+        (Box d)
+        -- ^ Contents of the box.
+        BoxOptions
+        -- ^ Style options to apply to the inline box.
+
+    | TextSequence
+    -- ^ A leaf node containing text.
+        d
+        -- ^ User-defined data associated with the text node.
+        Text
+        -- ^ Text contents of the node.
+
+-- | A box with content and a defined format. Corresponds to a DOM element.
+data Box d = Box
+
+    [InnerNode d]
+    -- ^ Text nodes and other boxes contained by this box.
+
+    TextOptions
+    -- ^ Style options to apply to text sequences directly contained
+    -- by this box.
+
+toStrict :: Text -> RootNode d -> Text -> (Text, Int, Strict.RootNode d)
+toStrict prefix root suffix = (txt, initialOffset, root')
+    where
+        txt = Lazy.toStrict $ Lazy.chunk prefix txtTail
+        initialOffset = lengthWord8 prefix
+        (txtTail, root') = strictRoot (Lazy.chunk suffix Lazy.empty) root
+
+strictRoot :: Lazy.Text -> RootNode d -> (Lazy.Text, Strict.RootNode d)
+strictRoot t (RootBox b) = (t', Strict.RootBox b')
+    where
+        (t', b') = strictBox t b
+
+strictBox :: Lazy.Text -> Box d -> (Lazy.Text, Strict.Box d)
+strictBox t (Box nodes opts) = (t', Strict.Box nodes' opts)
+    where
+        (t', nodes') = strictNodes t nodes
+
+strictNodes :: Lazy.Text -> [InnerNode d] -> (Lazy.Text, [Strict.InnerNode d])
+strictNodes t [] = (t, [])
+strictNodes t (node : nodes) = (t'', node' : nodes')
+    where
+        (t'', node') = strictNode t' node
+        (t', nodes') = strictNodes t nodes
+
+strictNode :: Lazy.Text -> InnerNode d -> (Lazy.Text, Strict.InnerNode d)
+strictNode suffix (TextSequence d txt) = (combinedText, node)
+    where
+        combinedText = Lazy.chunk txt suffix
+        node = Strict.TextSequence d (lengthWord8 txt)
+strictNode suffix (InlineBox d b o) = (combinedText, Strict.InlineBox d node o)
+    where
+        (combinedText, node) = strictBox suffix b
-- 
2.30.2