@@ -0,0 +1,545 @@
1+{-|
2+Module: Data.Text.Zipper
3+Description: A zipper for text documents that allows convenient editing and navigation
4+
5+'TextZipper' is designed to be help manipulate the contents of a text input field. It keeps track of the logical lines of text (i.e., lines separated by user-entered newlines) and the current cursor position. Several functions are defined in this module to navigate and edit the TextZipper from the cursor position.
6+
7+'TextZipper's can be converted into 'DisplayLines', which describe how the contents of the zipper will be displayed when wrapped to fit within a container of a certain width. It also provides some convenience facilities for converting interactions with the rendered DisplayLines back into manipulations of the underlying TextZipper.
8+
9+-}
10+module Data.Text.Zipper where
11+
12+import Prelude
13+
14+import Control.Exception (assert)
15+import Control.Monad.State (evalState, forM, get, put)
16+import Data.Char (isSpace)
17+import Data.Map (Map)
18+import Data.Maybe (fromMaybe)
19+import Data.String
20+import Data.Text (Text)
21+import Data.Text.Internal (Text(..), text)
22+import Data.Text.Internal.Fusion (stream)
23+import Data.Text.Internal.Fusion.Types (Stream(..), Step(..))
24+import Data.Text.Unsafe
25+import qualified Data.List as L
26+import qualified Data.Map as Map
27+import qualified Data.Text as T
28+
29+import Graphics.Text.Width (wcwidth)
30+
31+
32+-- | A zipper of the logical text input contents (the "document"). The lines
33+-- before the line containing the cursor are stored in reverse order.
34+-- The cursor is logically between the "before" and "after" text.
35+-- A "logical" line of input is a line of input up until a user-entered newline
36+-- character (as compared to a "display" line, which is wrapped to fit within
37+-- a given viewport width).
38+data TextZipper = TextZipper
39+ { _textZipper_linesBefore :: [Text] -- reversed
40+ , _textZipper_before :: Text
41+ , _textZipper_after :: Text -- The cursor is on top of the first character of this text
42+ , _textZipper_linesAfter :: [Text]
43+ }
44+ deriving (Show)
45+
46+instance IsString TextZipper where
47+ fromString = fromText . T.pack
48+
49+-- | Map a replacement function over the characters in a 'TextZipper'
50+mapZipper :: (Char -> Char) -> TextZipper -> TextZipper
51+mapZipper f (TextZipper lb b a la) = TextZipper
52+ { _textZipper_linesBefore = fmap (T.map f) lb
53+ , _textZipper_before = T.map f b
54+ , _textZipper_after = T.map f a
55+ , _textZipper_linesAfter = fmap (T.map f) la
56+ }
57+
58+-- | Move the cursor left one character, if possible
59+left :: TextZipper -> TextZipper
60+left = leftN 1
61+
62+-- | Move the cursor left by the given number of characters, or, if the document
63+-- isn't long enough, to the beginning of the document
64+leftN :: Int -> TextZipper -> TextZipper
65+leftN n z@(TextZipper lb b a la) =
66+ if T.length b >= n
67+ then
68+ let n' = T.length b - n
69+ in TextZipper lb (T.take n' b) (T.drop n' b <> a) la
70+ else case lb of
71+ [] -> home z
72+ (l:ls) -> leftN (n - T.length b - 1) $ TextZipper ls l "" ((b <> a) : la)
73+
74+-- | Move the cursor right one character, if possible
75+right :: TextZipper -> TextZipper
76+right = rightN 1
77+
78+-- | Move the character right by the given number of characters, or, if the document
79+-- isn't long enough, to the end of the document
80+rightN :: Int -> TextZipper -> TextZipper
81+rightN n z@(TextZipper lb b a la) =
82+ if T.length a >= n
83+ then TextZipper lb (b <> T.take n a) (T.drop n a) la
84+ else case la of
85+ [] -> end z
86+ (l:ls) -> rightN (n - T.length a - 1) $ TextZipper ((b <> a) : lb) "" l ls
87+
88+-- | Move the cursor up one logical line, if possible
89+up :: TextZipper -> TextZipper
90+up z@(TextZipper lb b a la) = case lb of
91+ [] -> z
92+ (l:ls) ->
93+ let (b', a') = T.splitAt (T.length b) l
94+ in TextZipper ls b' a' ((b <> a) : la)
95+
96+-- | Move the cursor down one logical line, if possible
97+down :: TextZipper -> TextZipper
98+down z@(TextZipper lb b a la) = case la of
99+ [] -> z
100+ (l:ls) ->
101+ let (b', a') = T.splitAt (T.length b) l
102+ in TextZipper ((b <> a) : lb) b' a' ls
103+
104+-- | Move the cursor up by the given number of lines
105+pageUp :: Int -> TextZipper -> TextZipper
106+pageUp pageSize z = if pageSize <= 0
107+ then z
108+ else pageUp (pageSize - 1) $ up z
109+
110+-- | Move the cursor down by the given number of lines
111+pageDown :: Int -> TextZipper -> TextZipper
112+pageDown pageSize z = if pageSize <= 0
113+ then z
114+ else pageDown (pageSize - 1) $ down z
115+
116+-- | Move the cursor to the beginning of the current logical line
117+home :: TextZipper -> TextZipper
118+home (TextZipper lb b a la) = TextZipper lb "" (b <> a) la
119+
120+-- | Move the cursor to the end of the current logical line
121+end :: TextZipper -> TextZipper
122+end (TextZipper lb b a la) = TextZipper lb (b <> a) "" la
123+
124+-- | Move the cursor to the top of the document
125+top :: TextZipper -> TextZipper
126+top (TextZipper lb b a la) = case reverse lb of
127+ [] -> TextZipper [] "" (b <> a) la
128+ (start:rest) -> TextZipper [] "" start (rest <> [b <> a] <> la)
129+
130+-- | Insert a character at the current cursor position
131+insertChar :: Char -> TextZipper -> TextZipper
132+insertChar i = insert (T.singleton i)
133+
134+-- | Insert text at the current cursor position
135+insert :: Text -> TextZipper -> TextZipper
136+insert i z@(TextZipper lb b a la) = case T.split (=='\n') i of
137+ [] -> z
138+ (start:rest) -> case reverse rest of
139+ [] -> TextZipper lb (b <> start) a la
140+ (l:ls) -> TextZipper (ls <> [b <> start] <> lb) l a la
141+
142+-- | Delete the character to the left of the cursor
143+deleteLeft :: TextZipper-> TextZipper
144+deleteLeft z@(TextZipper lb b a la) = case T.unsnoc b of
145+ Nothing -> case lb of
146+ [] -> z
147+ (l:ls) -> TextZipper ls l a la
148+ Just (b', _) -> TextZipper lb b' a la
149+
150+-- | Delete the character under/to the right of the cursor
151+deleteRight :: TextZipper -> TextZipper
152+deleteRight z@(TextZipper lb b a la) = case T.uncons a of
153+ Nothing -> case la of
154+ [] -> z
155+ (l:ls) -> TextZipper lb b l ls
156+ Just (_, a') -> TextZipper lb b a' la
157+
158+-- | Delete a word to the left of the cursor. Deletes all whitespace until it
159+-- finds a non-whitespace character, and then deletes contiguous non-whitespace
160+-- characters.
161+deleteLeftWord :: TextZipper -> TextZipper
162+deleteLeftWord (TextZipper lb b a la) =
163+ let b' = T.dropWhileEnd isSpace b
164+ in if T.null b'
165+ then case lb of
166+ [] -> TextZipper [] b' a la
167+ (l:ls) -> deleteLeftWord $ TextZipper ls l a la
168+ else TextZipper lb (T.dropWhileEnd (not . isSpace) b') a la
169+
170+-- | Insert up to n spaces to get to the next logical column that is a multiple of n
171+tab :: Int -> TextZipper -> TextZipper
172+tab n z@(TextZipper _ b _ _) =
173+ insert (T.replicate (fromEnum $ n - T.length b `mod` max 1 n) " ") z
174+
175+-- | The plain text contents of the zipper
176+value :: TextZipper -> Text
177+value (TextZipper lb b a la) = T.intercalate "\n" $ mconcat [ reverse lb
178+ , [b <> a]
179+ , la
180+ ]
181+
182+-- | The empty zipper
183+empty :: TextZipper
184+empty = TextZipper [] "" "" []
185+
186+-- | Constructs a zipper with the given contents. The cursor is placed after
187+-- the contents.
188+fromText :: Text -> TextZipper
189+fromText = flip insert empty
190+
191+-- | A span of text tagged with some metadata that makes up part of a display
192+-- line.
193+data Span tag = Span tag Text
194+ deriving (Show)
195+
196+-- | Text alignment type
197+data TextAlignment =
198+ TextAlignment_Left
199+ | TextAlignment_Right
200+ | TextAlignment_Center
201+ deriving (Eq, Show)
202+
203+-- A map from the index (row) of display line to (fst,snd)
204+-- fst: leading empty spaces from left (may be negative) to adjust for alignment
205+-- snd: the text offset from the beginning of the document
206+-- to the first character of the display line
207+type OffsetMapWithAlignment = Map Int (Int, Int)
208+
209+-- helper type representing a single visual line that may be part of a wrapped logical line
210+data WrappedLine = WrappedLine
211+ { _wrappedLines_text :: Text
212+ , _wrappedLines_hiddenWhitespace :: Bool -- ^ 'True' if this line ends with a deleted whitespace character
213+ , _wrappedLines_offset :: Int -- ^ offset from beginning of line
214+ }
215+ deriving (Eq, Show)
216+
217+-- | Information about the document as it is displayed (i.e., post-wrapping)
218+data DisplayLines tag = DisplayLines
219+ { _displayLines_spans :: [[Span tag]]
220+ , _displayLines_offsetMap :: OffsetMapWithAlignment
221+ , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
222+ }
223+ deriving (Show)
224+
225+-- | Split a 'Text' at the given column index. For example
226+--
227+-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
228+--
229+-- because the first character has a width of two (see 'charWidth' for more on that).
230+splitAtWidth :: Int -> Text -> (Text, Text)
231+splitAtWidth n t@(Text arr off len)
232+ | n <= 0 = (T.empty, t)
233+ | n >= textWidth t = (t, T.empty)
234+ | otherwise = let k = toLogicalIndex n t
235+ in (text arr off k, text arr (off+k) (len-k))
236+
237+toLogicalIndex :: Int -> Text -> Int
238+toLogicalIndex n' t'@(Text _ _ len') = loop 0 0
239+ where loop !i !cnt
240+ | i >= len' || cnt + w > n' = i
241+ | otherwise = loop (i+d) (cnt + w)
242+ where Iter c d = iter t' i
243+ w = charWidth c
244+
245+-- | Takes the given number of columns of characters. For example
246+--
247+-- > takeWidth 3 "ᄀabc" == "ᄀa"
248+--
249+-- because the first character has a width of 2 (see 'charWidth' for more on that).
250+-- This function will not take a character if its width exceeds the width it seeks to take.
251+takeWidth :: Int -> Text -> Text
252+takeWidth n = fst . splitAtWidth n
253+
254+-- | Drops the given number of columns of characters. For example
255+--
256+-- > dropWidth 2 "ᄀabc" == "abc"
257+--
258+-- because the first character has a width of 2 (see 'charWidth' for more on that).
259+-- This function will not drop a character if its width exceeds the width it seeks to drop.
260+dropWidth :: Int -> Text -> Text
261+dropWidth n = snd . splitAtWidth n
262+
263+-- | Get the display width of a 'Char'. "Full width" and "wide" characters
264+-- take two columns and everything else takes a single column. See
265+-- <https://www.unicode.org/reports/tr11/> for more information
266+-- This is implemented using wcwidth from Vty such that it matches what will
267+-- be displayed on the terminal. Note that this method can change depending
268+-- on how vty is configed. Please see vty documentation for details.
269+charWidth :: Char -> Int
270+charWidth = wcwidth
271+
272+-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
273+spansWidth :: [Span tag] -> Int
274+spansWidth = sum . map (\(Span _ t) -> textWidth t)
275+
276+-- | Get the length (number of characters) of the text in a set of 'Span's
277+spansLength :: [Span tag] -> Int
278+spansLength = sum . map (\(Span _ t) -> T.length t)
279+
280+-- | Compute the width of some 'Text', taking into account fullwidth
281+-- unicode forms.
282+textWidth :: Text -> Int
283+textWidth t = widthI (stream t)
284+
285+-- | Compute the width of a stream of characters, taking into account
286+-- fullwidth unicode forms.
287+widthI :: Stream Char -> Int
288+widthI (Stream next s0 _len) = loop_length 0 s0
289+ where
290+ loop_length !z s = case next s of
291+ Done -> z
292+ Skip s' -> loop_length z s'
293+ Yield c s' -> loop_length (z + charWidth c) s'
294+{-# INLINE[0] widthI #-}
295+
296+-- | Compute the logical index position of a stream of characters from a visual
297+-- position taking into account fullwidth unicode forms.
298+charIndexAt :: Int -> Stream Char -> Int
299+charIndexAt pos (Stream next s0 _len) = loop_length 0 0 s0
300+ where
301+ loop_length i !z s = case next s of
302+ Done -> i
303+ Skip s' -> loop_length i z s'
304+ Yield c s' -> if w > pos then i else loop_length (i+1) w s' where
305+ w = z + charWidth c
306+{-# INLINE[0] charIndexAt #-}
307+
308+
309+
310+
311+-- | Same as T.words except whitespace characters are included at end (i.e. ["line1 ", ...])
312+-- 'Char's representing white space.
313+wordsWithWhitespace :: Text -> [Text]
314+wordsWithWhitespace t@(Text arr off len) = loop 0 0 False
315+ where
316+ loop !start !n !wasSpace
317+ | n >= len = [Text arr (start+off) (n-start) | not (start == n)]
318+ | isSpace c = loop start (n+d) True
319+ | wasSpace = Text arr (start+off) (n-start) : loop n n False
320+ | otherwise = loop start (n+d) False
321+ where Iter c d = iter t n
322+{-# INLINE wordsWithWhitespace #-}
323+
324+-- | Split words into logical lines, 'True' in the tuple indicates line ends with a whitespace character that got deleted
325+splitWordsAtDisplayWidth :: Int -> [Text] -> [(Text, Bool)]
326+splitWordsAtDisplayWidth maxWidth wwws = reverse $ loop wwws 0 [] where
327+ appendOut :: [(Text,Bool)] -> Text -> Bool -> [(Text,Bool)]
328+ appendOut [] t b = [(t,b)]
329+ appendOut ((t',_):ts') t b = (t'<>t,b) : ts'
330+
331+ -- remove the last whitespace in output
332+ modifyOutForNewLine :: [(Text,Bool)] -> [(Text,Bool)]
333+ modifyOutForNewLine [] = error "should never happen"
334+ modifyOutForNewLine ((t',_):ts) = case T.unsnoc t' of
335+ Nothing -> error "should never happen"
336+ Just (t,lastChar) -> assert (isSpace lastChar) $ (t,True):ts -- assume last char is whitespace
337+
338+ loop :: [Text] -> Int -> [(Text,Bool)] -> [(Text,Bool)]
339+ loop [] _ out = out
340+ loop (x:xs) cumw out = r where
341+ newWidth = textWidth x + cumw
342+ r = if newWidth > maxWidth
343+ then if isSpace $ T.index x (toLogicalIndex (maxWidth - cumw) x)
344+ -- if line runs over but character of splitting is whitespace then split on the whitespace
345+ then let (t1,t2) = splitAtWidth (maxWidth - cumw) x
346+ in loop (T.drop 1 t2:xs) 0 [] <> appendOut out t1 True
347+ else if cumw == 0
348+ -- single word exceeds max width, so just split on the word
349+ then let (t1,t2) = splitAtWidth (maxWidth - cumw) x
350+ in loop (t2:xs) 0 [] <> appendOut out t1 False
351+ -- otherwise start a new line
352+ else loop (x:xs) 0 [] <> modifyOutForNewLine out
353+ else loop xs newWidth $ appendOut out x False
354+
355+
356+
357+-- | Wraps a logical line of text to fit within the given width. The first
358+-- wrapped line is offset by the number of columns provided. Subsequent wrapped
359+-- lines are not.
360+wrapWithOffsetAndAlignment
361+ :: TextAlignment
362+ -> Int -- ^ Maximum width
363+ -> Int -- ^ Offset for first line
364+ -> Text -- ^ Text to be wrapped
365+ -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)
366+wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []
367+wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r where
368+ -- we pad by offset amount with any non-space character which we will remove later so that no changes need to be made to splitWordsAtDisplayWidth
369+ r' = splitWordsAtDisplayWidth maxWidth $ wordsWithWhitespace ( T.replicate n "." <> txt)
370+ fmapfn (t,b) = case alignment of
371+ TextAlignment_Left -> WrappedLine t b 0
372+ TextAlignment_Right -> WrappedLine t b (maxWidth-l)
373+ TextAlignment_Center -> WrappedLine t b ((maxWidth-l) `div` 2)
374+ where l = textWidth t
375+ r'' = case r' of
376+ [] -> []
377+ (x,b):xs -> (T.drop n x,b):xs
378+ r = fmap fmapfn r''
379+
380+-- converts deleted eol spaces into logical lines
381+eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]
382+eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . concatMap (L.groupBy (\(WrappedLine _ b _) _ -> not b))
383+
384+offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
385+offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines
386+
387+offsetMapWithAlignment
388+ :: [[(Text, Int)]] -- ^ The outer list represents logical lines, inner list represents wrapped lines
389+ -> OffsetMapWithAlignment
390+offsetMapWithAlignment ts = evalState (offsetMap' ts) (0, 0)
391+ where
392+ offsetMap' xs = fmap Map.unions $ forM xs $ \x -> do
393+ maps <- forM x $ \(line,align) -> do
394+ let l = T.length line
395+ (dl, o) <- get
396+ put (dl + 1, o + l)
397+ return $ Map.singleton dl (align, o)
398+ (dl, o) <- get
399+ put (dl, o + 1)
400+ -- add additional offset to last line in wrapped lines (for newline char)
401+ return $ Map.adjust (\(align,_)->(align,o+1)) dl $ Map.unions maps
402+
403+
404+-- | Given a width and a 'TextZipper', produce a list of display lines
405+-- (i.e., lines of wrapped text) with special attributes applied to
406+-- certain segments (e.g., the cursor). Additionally, produce the current
407+-- y-coordinate of the cursor and a mapping from display line number to text
408+-- offset
409+displayLinesWithAlignment
410+ :: TextAlignment
411+ -> Int -- ^ Width, used for wrapping
412+ -> tag -- ^ Metadata for normal characters
413+ -> tag -- ^ Metadata for the cursor
414+ -> TextZipper -- ^ The text input contents and cursor state
415+ -> DisplayLines tag
416+displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
417+ let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line
418+ linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb
419+ linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line
420+ linesAfter = map (wrapWithOffsetAndAlignment alignment width 0) la
421+
422+ -- simulate trailing cursor character when computing OffsetMap
423+ afterWithCursor = if T.null a then " " else a
424+ offsets :: OffsetMapWithAlignment
425+ offsets = offsetMapWithAlignmentInternal $ mconcat
426+ [ linesBefore
427+ , [wrapWithOffsetAndAlignment alignment width 0 $ b <> afterWithCursor]
428+ , linesAfter
429+ ]
430+ flattenLines = concatMap (fmap _wrappedLines_text)
431+ spansBefore = map ((:[]) . Span tag) $ flattenLines linesBefore
432+ spansAfter = map ((:[]) . Span tag) $ flattenLines linesAfter
433+ -- Separate the spans before the cursor into
434+ -- * spans that are on earlier display lines (though on the same logical line), and
435+ -- * spans that are on the same display line
436+
437+ (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
438+ initLast $ map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width 0 b)
439+ -- Calculate the number of columns on the cursor's display line before the cursor
440+ curLineOffset = spansWidth spansCurLineBefore
441+ -- Check whether the spans on the current display line are long enough that
442+ -- the cursor has to go to the next line
443+ cursorAfterEOL = curLineOffset == width
444+ cursorCharWidth = case T.uncons a of
445+ Nothing -> 1
446+ Just (c, _) -> charWidth c
447+
448+ -- Separate the span after the cursor into
449+ -- * spans that are on the same display line, and
450+ -- * spans that are on later display lines (though on the same logical line)
451+
452+ (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
453+ headTail $ case T.uncons a of
454+ Nothing -> [[Span cursorTag " "]]
455+ Just (c, rest) ->
456+ let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
457+ cursor = Span cursorTag (T.singleton c)
458+ in case map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width o rest) of
459+ [] -> [[cursor]]
460+ (l:ls) -> (cursor : l) : ls
461+
462+ curLineSpanNormalCase = if cursorAfterEOL
463+ then [ spansCurLineBefore, spansCurLineAfter ]
464+ else [ spansCurLineBefore <> spansCurLineAfter ]
465+
466+ -- for right alignment, we want draw the cursor tag to be on the character just before the logical cursor position
467+ curLineSpan = if alignment == TextAlignment_Right && not cursorAfterEOL
468+ then case reverse spansCurLineBefore of
469+ [] -> curLineSpanNormalCase
470+ (Span _ x):xs -> case spansCurLineAfter of
471+ [] -> error "should not be possible" -- curLineSpanNormalCase
472+ (Span _ y):ys -> [reverse (Span cursorTag x:xs) <> ((Span tag y):ys)]
473+ else curLineSpanNormalCase
474+
475+ cursorY = sum
476+ [ length spansBefore
477+ , length spansCurrentBefore
478+ , if cursorAfterEOL then 1 else 0
479+ ]
480+ -- a little silly to convert back to text but whatever, it works
481+ cursorX = if cursorAfterEOL then 0 else textWidth (mconcat $ fmap (\(Span _ t) -> t) spansCurLineBefore)
482+
483+ in DisplayLines
484+ { _displayLines_spans = concat
485+ [ spansBefore
486+ , spansCurrentBefore
487+ , curLineSpan
488+ , spansCurrentAfter
489+ , spansAfter
490+ ]
491+ , _displayLines_offsetMap = offsets
492+ , _displayLines_cursorPos = (cursorX, cursorY)
493+ }
494+ where
495+ initLast :: [a] -> Maybe ([a], a)
496+ initLast = \case
497+ [] -> Nothing
498+ (x:xs) -> case initLast xs of
499+ Nothing -> Just ([], x)
500+ Just (ys, y) -> Just (x:ys, y)
501+ headTail :: [a] -> Maybe (a, [a])
502+ headTail = \case
503+ [] -> Nothing
504+ x:xs -> Just (x, xs)
505+
506+
507+-- | Move the cursor of the given 'TextZipper' to the logical position indicated
508+-- by the given display line coordinates, using the provided 'DisplayLinesWithAlignment'
509+-- information. If the x coordinate is beyond the end of a line, the cursor is
510+-- moved to the end of the line.
511+goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
512+goToDisplayLinePosition x y dl tz =
513+ let offset = Map.lookup y $ _displayLines_offsetMap dl
514+ in case offset of
515+ Nothing -> tz
516+ Just (alignOff,o) ->
517+ let
518+ trueX = max 0 (x - alignOff)
519+ moveRight = case drop y $ _displayLines_spans dl of
520+ [] -> 0
521+ (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s
522+ in rightN (o + moveRight) $ top tz
523+
524+-- | Given a width and a 'TextZipper', produce a list of display lines
525+-- (i.e., lines of wrapped text) with special attributes applied to
526+-- certain segments (e.g., the cursor). Additionally, produce the current
527+-- y-coordinate of the cursor and a mapping from display line number to text
528+-- offset
529+displayLines
530+ :: Int -- ^ Width, used for wrapping
531+ -> tag -- ^ Metadata for normal characters
532+ -> tag -- ^ Metadata for the cursor
533+ -> TextZipper -- ^ The text input contents and cursor state
534+ -> DisplayLines tag
535+displayLines = displayLinesWithAlignment TextAlignment_Left
536+
537+-- | Wraps a logical line of text to fit within the given width. The first
538+-- wrapped line is offset by the number of columns provided. Subsequent wrapped
539+-- lines are not.
540+wrapWithOffset
541+ :: Int -- ^ Maximum width
542+ -> Int -- ^ Offset for first line
543+ -> Text -- ^ Text to be wrapped
544+ -> [Text]
545+wrapWithOffset maxWidth n xs = _wrappedLines_text <$> wrapWithOffsetAndAlignment TextAlignment_Left maxWidth n xs