2 files changed, 60 insertions(+), 72 deletions(-)

M src/Data/Text/ParagraphLayout/Internal/Plain.hs
M src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs

@@ 1,75 1,73 @@
+-- | Legacy plain text layout interface.
 module Data.Text.ParagraphLayout.Internal.Plain (layoutPlain)
 where
 
-import Control.Applicative (ZipList (ZipList), getZipList)
-import Data.List.NonEmpty (nonEmpty)
-import qualified Data.List.NonEmpty as NonEmpty
-import Data.Text (Text)
-import Data.Text.ICU (Breaker, LocaleName, breakCharacter, breakLine)
-
-import Data.Text.ParagraphLayout.Internal.Break
-import Data.Text.ParagraphLayout.Internal.Layout
+import Data.Text.ParagraphLayout.Internal.BoxOptions
+import Data.Text.ParagraphLayout.Internal.Fragment
 import Data.Text.ParagraphLayout.Internal.ParagraphOptions
-import Data.Text.ParagraphLayout.Internal.Plain.Paragraph
-import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout
-import Data.Text.ParagraphLayout.Internal.ResolvedSpan (WithSpan (WithSpan))
-import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS
-import Data.Text.ParagraphLayout.Internal.Run
+import qualified Data.Text.ParagraphLayout.Internal.Plain.Paragraph as P
+import qualified Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout as P
+import Data.Text.ParagraphLayout.Internal.Rich (layoutRich)
+import qualified Data.Text.ParagraphLayout.Internal.Rich.Paragraph as R
+import qualified Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout as R
 import Data.Text.ParagraphLayout.Internal.Span
 import Data.Text.ParagraphLayout.Internal.TextOptions
+import Data.Text.ParagraphLayout.Internal.Tree
+
+-- | Lay out a paragraph of plain text using a single font.
+layoutPlain :: P.Paragraph d -> P.ParagraphLayout d
+layoutPlain p@(P.Paragraph _ _ spans _) =
+    richLayoutToPlain (length spans) $ layoutRich $ plainToRich p
 
--- | Lay out a paragraph of plain, unidirectional text using a single font.
-layoutPlain :: Paragraph d -> ParagraphLayout d
-layoutPlain p@(Paragraph _ _ _ opts) = paragraphLayout sls
+-- | Convert a legacy plain text paragraph to a rich text paragraph.
+--
+-- Each plain text span is converted to a box with one text node inside.
+--
+-- Span indexes are added to the user data internally, then used to split the
+-- resulting fragments according to their corresponding spans.
+plainToRich :: P.Paragraph d -> R.Paragraph (Int, d)
+plainToRich (P.Paragraph arr off spans opts) = R.Paragraph arr off rootNode opts
     where
-        sls = map SpanLayout fragsBySpan
-        fragsBySpan = take (length spans) $ RS.splitBySpanIndex frags
-        frags = case nonEmpty wrappedRuns of
-            Just xs -> layoutAndAlignLines maxWidth xs
-            Nothing -> []
-        wrappedRuns = spansToRunsWrapped spans
-        maxWidth = paragraphMaxWidth opts
-        spans = resolveSpans p
+        rootNode = RootBox rootBox
+        rootBox = Box spanNodes baseOpts
+        spanNodes = map spanNode indexedSpans
+        spanNode (i, s) = InlineBox
+            (i, spanUserData s)
+            (boxFromPlain baseOpts i s)
+            defaultBoxOptions
+        indexedSpans = zip [0 ..] spans
+        baseOpts = defaultTextOptions
+            { textFont = paragraphFont opts
+            , textLineHeight = paragraphLineHeight opts
+            }
 
--- | Split a number of spans into a flat array of runs and add a wrapper
--- so that each run can be traced back to its originating span.
-spansToRunsWrapped :: [RS.ResolvedSpan d] -> [WithSpan d Run]
-spansToRunsWrapped ss = concat $ map spanToRunsWrapped ss
+-- | Convert a legacy `Span` to a rich text box with one text node inside.
+--
+-- Add the given index to the user data, so that it can be extracted later.
+boxFromPlain :: TextOptions -> Int -> Span d -> Box (Int, d)
+boxFromPlain baseOpts i s = Box [TextSequence (i, spanUserData s) len] opts
+    where
+        len = spanLength s
+        opts = baseOpts { textLanguage = spanLanguage $ spanOptions s }
 
--- | Split a span into runs and add a wrapper
--- so that each run can be traced back to its originating span.
-spanToRunsWrapped :: RS.ResolvedSpan d -> [WithSpan d Run]
-spanToRunsWrapped s = map (WithSpan s) (spanToRuns s)
+-- | Convert a rich paragraph layout with span indexes into the legacy paragraph
+-- layout with an array of spans.
+richLayoutToPlain :: Int -> R.ParagraphLayout (Int, d) -> P.ParagraphLayout d
+richLayoutToPlain numSpans pl = P.paragraphLayout sls
+    where
+        sls = map SpanLayout fragsBySpan
+        fragsBySpan = take numSpans $ splitBySpanIndex frags
+        frags = R.paragraphFragments pl
 
-resolveSpans :: Paragraph d -> [RS.ResolvedSpan d]
-resolveSpans p@(Paragraph _ pStart spans pOpts) = do
-    let sBounds = paragraphSpanBounds p
-    let sTexts = paragraphSpanTexts p
-    let pText = paragraphText p
-    let sStarts = NonEmpty.init sBounds
+splitBySpanIndex :: [Fragment (Int, d)] -> [[Fragment d]]
+splitBySpanIndex frags = [getBySpanIndex i frags | i <- [0 ..]]
 
-    (i, s, sStart, sText) <- getZipList $ (,,,)
-        <$> ZipList [0 ..]
-        <*> ZipList spans
-        <*> ZipList sStarts
-        <*> ZipList sTexts
-    let lang = spanLanguage $ spanOptions s
-    let lBreaks = paragraphBreaks breakLine pText lang
-    let cBreaks = paragraphBreaks breakCharacter pText lang
-    return RS.ResolvedSpan
-        { RS.spanUserData = spanUserData s
-        , RS.spanIndex = i
-        , RS.spanOffsetInParagraph = sStart - pStart
-        , RS.spanText = sText
-        , RS.spanTextOptions = defaultTextOptions
-            { textFont = paragraphFont pOpts
-            , textLineHeight = paragraphLineHeight pOpts
-            , textLanguage = lang
-            }
-        , RS.spanLineBreaks = subOffsetsDesc (sStart - pStart) lBreaks
-        , RS.spanCharacterBreaks = subOffsetsDesc (sStart - pStart) cBreaks
-        }
+getBySpanIndex :: Int -> [Fragment (Int, d)] -> [Fragment d]
+getBySpanIndex idx = map stripSpanIndex . filter ((== idx) . getSpanIndex)
+
+getSpanIndex :: Fragment (Int, d) -> Int
+getSpanIndex Fragment { fragmentUserData = (i, _) } = i
 
-paragraphBreaks :: (LocaleName -> Breaker a) -> Text -> String -> [(Int, a)]
-paragraphBreaks breakFunc txt lang =
-    breaksDesc (breakFunc (locale lang LBAuto)) txt
+stripSpanIndex :: Fragment (Int, d) -> Fragment d
+stripSpanIndex f = case fragmentUserData f of
+    (_, d) -> f { fragmentUserData = d }

@@ 1,7 1,6 @@
 module Data.Text.ParagraphLayout.Internal.ResolvedSpan
     ( ResolvedSpan (..)
     , WithSpan (WithSpan)
-    , splitBySpanIndex
     )
 where
 


@@ 48,12 47,3 @@ instance SeparableTextContainer a => SeparableTextContainer (WithSpan d a) where
 
 instance WithLevel a => WithLevel (WithSpan d a) where
     level (WithSpan _ x) = level x
-
-splitBySpanIndex :: [WithSpan d a] -> [[a]]
-splitBySpanIndex xs = [getBySpanIndex i xs | i <- [0 ..]]
-
-getBySpanIndex :: Int -> [WithSpan d a] -> [a]
-getBySpanIndex idx xs = map contents $ filter matchingIndex $ xs
-    where
-        matchingIndex (WithSpan rs _) = (spanIndex rs) == idx
-        contents (WithSpan _ x) = x