1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
module Data.Text.ParagraphLayout.Internal.Rich (layoutRich)
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.Fragment
import Data.Text.ParagraphLayout.Internal.Layout
import Data.Text.ParagraphLayout.Internal.ParagraphOptions
import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS
import Data.Text.ParagraphLayout.Internal.Rich.Paragraph
import Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout
import Data.Text.ParagraphLayout.Internal.Run
import Data.Text.ParagraphLayout.Internal.TextOptions
import Data.Text.ParagraphLayout.Internal.Tree
import Data.Text.ParagraphLayout.Internal.WithSpan
-- | Lay out a rich text paragraph.
layoutRich :: Paragraph d -> ParagraphLayout d
layoutRich p@(Paragraph _ _ _ opts) = paragraphLayout $ map unwrap frags
where
unwrap (WithSpan rs frag) =
frag { fragmentUserData = RS.spanUserData rs }
frags = case nonEmpty wrappedRuns of
Just xs -> layoutAndAlignLines maxWidth xs
Nothing -> []
wrappedRuns = spansToRunsWrapped spans
maxWidth = paragraphMaxWidth opts
spans = resolveSpans p
-- | 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
-- | 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)
resolveSpans :: Paragraph d -> [RS.ResolvedSpan d]
resolveSpans p@(Paragraph _ pStart root _) = do
let leaves = flatten root
let sTexts = paragraphSpanTexts p
let sBounds = paragraphSpanBounds p
let sStarts = NonEmpty.init sBounds
let pText = paragraphText p
(i, leaf, sStart, sText) <- getZipList $ (,,,)
<$> ZipList [0 ..]
<*> ZipList leaves
<*> ZipList sStarts
<*> ZipList sTexts
let (TextLeaf userData _ textOpts boxes) = leaf
let lang = textLanguage textOpts
let lBreaks = paragraphBreaks breakLine pText lang
let cBreaks = paragraphBreaks breakCharacter pText lang
return RS.ResolvedSpan
{ RS.spanUserData = userData
, RS.spanIndex = i
, RS.spanOffsetInParagraph = sStart - pStart
-- TODO: Consider adding checks for array bounds.
, RS.spanText = sText
, RS.spanTextOptions = textOpts
, RS.spanBoxes = boxes
, RS.spanLineBreaks = subOffsetsDesc (sStart - pStart) lBreaks
, RS.spanCharacterBreaks = subOffsetsDesc (sStart - pStart) cBreaks
}
paragraphBreaks :: (LocaleName -> Breaker a) -> Text -> String -> [(Int, a)]
paragraphBreaks breakFunc txt lang =
breaksDesc (breakFunc (locale lang LBAuto)) txt