3 files changed, 26 insertions(+), 24 deletions(-)

M src/Data/Text/ParagraphLayout/Plain.hs
M src/Data/Text/ParagraphLayout/Run.hs
M test/Data/Text/ParagraphLayout/RunSpec.hs

@@ 87,6 87,12 @@ data ParagraphLayout = ParagraphLayout
 data SpanLayout = SpanLayout [Fragment]
     deriving (Eq, Read, Show)
 
+-- | Wrapper for temporarily mapping the relationship to a `Span`.
+data WithSpan a = WithSpan RS.ResolvedSpan a
+
+instance Functor WithSpan where
+    fmap f (WithSpan s a) = WithSpan s (f a)
+
 spanRects :: SpanLayout -> [Rect Int32]
 spanRects (SpanLayout frags) = map fragmentRect frags
 


@@ 131,12 137,15 @@ addSpansH currentX rss = mapAccumL addSpanH currentX rss
 -- and return the final x_offset for continuation.
 addSpanH :: Int32 -> RS.ResolvedSpan -> (Int32, SpanLayout)
 addSpanH currentX rs = (nextX, SpanLayout frags)
-    where (nextX, frags) = mapAccumL addRunH currentX $ spanToRuns rs
+    where (nextX, frags) = mapAccumL addRunH currentX $ spanToRunsWrapped rs
+
+spanToRunsWrapped :: RS.ResolvedSpan -> [WithSpan Run]
+spanToRunsWrapped s = map (WithSpan s) (spanToRuns s)
 
 -- | Calculate layout for the given run,
 -- place the generated fragment horizontally at the given x_offset,
 -- and return the final x_offset for continuation.
-addRunH :: Int32 -> Run -> (Int32, Fragment)
+addRunH :: Int32 -> WithSpan Run -> (Int32, Fragment)
 addRunH currentX run = (nextX, nextFrag)
     where
         frag = layoutRun run


@@ 145,14 154,13 @@ addRunH currentX run = (nextX, nextFrag)
         nextFrag = frag { fragmentRect = nextRect }
         nextRect = rect { x_origin = currentX }
 
--- | Calculate layout for the given run independently of its position.
-layoutRun :: Run -> Fragment
-layoutRun run = Fragment rect (penX, penY) glyphs
+layoutRun :: WithSpan Run -> Fragment
+layoutRun (WithSpan rs run) = Fragment rect (penX, penY) glyphs
     where
         rect = containGlyphsH lineHeight $ map snd $ glyphs
         penX = 0 -- for horizontal text
         penY = descent + leading `div` 2
-        glyphs = shapeRun run
+        glyphs = shapeRun (WithSpan rs run)
         lineHeight = case RS.spanLineHeight rs of
             Normal -> normalLineHeight
             Absolute h -> h


@@ 163,10 171,10 @@ layoutRun run = Fragment rect (penX, penY) glyphs
         extents = fontExtentsForDir font dir
         font = RS.spanFont rs
         dir = runDirection run
-        rs = runOriginalSpan run
 
-shapeRun :: Run -> [(GlyphInfo, GlyphPos)]
-shapeRun run = shape font buffer features
+-- | Calculate layout for the given run independently of its position.
+shapeRun :: WithSpan Run -> [(GlyphInfo, GlyphPos)]
+shapeRun (WithSpan rs run) = shape font buffer features
     where
         font = RS.spanFont rs
         -- TODO: Set beginsText / endsText.


@@ 178,18 186,17 @@ shapeRun run = shape font buffer features
             , language = Just $ RS.spanLanguage rs
             }
         features = []
-        rs = runOriginalSpan run
 
 resolveSpans :: Paragraph -> [RS.ResolvedSpan]
-resolveSpans (Paragraph arr off spans opts) = map resolve $ zip spans texts
-    where
-        resolve (s, t) = RS.ResolvedSpan
-            { RS.spanText = t
-            , RS.spanFont = paragraphFont opts
-            , RS.spanLineHeight = paragraphLineHeight opts
-            , RS.spanLanguage = spanLanguage s
-            }
-        texts = cuts arr off spans
+resolveSpans (Paragraph arr off spans opts) = do
+    let texts = cuts arr off spans
+    (s, t) <- zip spans texts
+    return RS.ResolvedSpan
+        { RS.spanText = t
+        , RS.spanFont = paragraphFont opts
+        , RS.spanLineHeight = paragraphLineHeight opts
+        , RS.spanLanguage = spanLanguage s
+        }
 
 -- | Produce a list of `Text`s, defined by an initial offset and a list of
 -- consecutive `Span`s, out of the underlying `Array`.

@@ 20,7 20,6 @@ data Run = Run
     { runText :: Text
     , runDirection :: Maybe Direction
     , runScript :: Maybe ScriptCode
-    , runOriginalSpan :: ResolvedSpan
     }
     deriving (Eq, Show)
 


@@ 56,7 55,6 @@ spanToRuns s = map run $ protoRuns zipper
             { runText = preceding z
             , runDirection = d
             , runScript = Just sc
-            , runOriginalSpan = s
             }
 
 protoRuns :: Zipper -> [ProtoRun]

@@ 22,7 22,6 @@ spec = do
                     { runText = spanText inputSpan
                     , runDirection = Just DirLTR
                     , runScript = Just "Latn"
-                    , runOriginalSpan = inputSpan
                     }
                 ]
         it "handles Serbian with mixed script" $ \font -> do


@@ 34,12 33,10 @@ spec = do
                     { runText = pack "Vikipedija ("
                     , runDirection = Just DirLTR
                     , runScript = Just "Latn"
-                    , runOriginalSpan = inputSpan
                     }
                 , Run
                     { runText = pack "Википедија)"
                     , runDirection = Just DirLTR
                     , runScript = Just "Cyrl"
-                    , runOriginalSpan = inputSpan
                     }
                 ]