@@ -9,26 +9,22 @@ Description: A zipper for text documents that allows convenient editing and navi
10module Data.Text.Zipper where
10module Data.Text.Zipper where
14−import Control.Exception (assert)
15−import Control.Monad.State (evalState, forM, get, put)
16import Data.Char (isSpace)
12import Data.Char (isSpace)
17import Data.Map (Map)
13import Data.Map (Map)
14+import qualified Data.Map as Map
18import Data.Maybe (fromMaybe)
15import Data.Maybe (fromMaybe)
19import Data.String
16import Data.String
17+import Control.Monad.State (evalState, forM, get, put)
20import Data.Text (Text)
19import Data.Text (Text)
20+import qualified Data.Text as T
21import Data.Text.Internal (Text(..), text)
21import Data.Text.Internal (Text(..), text)
22import Data.Text.Internal.Fusion (stream)
22import Data.Text.Internal.Fusion (stream)
23import Data.Text.Internal.Fusion.Types (Stream(..), Step(..))
23import Data.Text.Internal.Fusion.Types (Stream(..), Step(..))
24import Data.Text.Unsafe
24import Data.Text.Unsafe
25−import qualified Data.List as L
26−import qualified Data.Map as Map
27−import qualified Data.Text as T
29import Graphics.Text.Width (wcwidth)
26import Graphics.Text.Width (wcwidth)
32-- | A zipper of the logical text input contents (the "document"). The lines
28-- | A zipper of the logical text input contents (the "document"). The lines
33-- before the line containing the cursor are stored in reverse order.
29-- before the line containing the cursor are stored in reverse order.
34-- The cursor is logically between the "before" and "after" text.
30-- The cursor is logically between the "before" and "after" text.
@@ -170,7 +166,7 @@ deleteLeftWord (TextZipper lb b a la) =
170-- | Insert up to n spaces to get to the next logical column that is a multiple of n
166-- | Insert up to n spaces to get to the next logical column that is a multiple of n
171tab :: Int -> TextZipper -> TextZipper
167tab :: Int -> TextZipper -> TextZipper
172tab n z@(TextZipper _ b _ _) =
168tab n z@(TextZipper _ b _ _) =
173− insert (T.replicate (fromEnum $ n - T.length b `mod` max 1 n) " ") z
169+ insert (T.replicate (fromEnum $ n - (T.length b `mod` max 1 n)) " ") z
175-- | The plain text contents of the zipper
171-- | The plain text contents of the zipper
176value :: TextZipper -> Text
172value :: TextZipper -> Text
@@ -193,35 +189,105 @@ fromText = flip insert empty
193data Span tag = Span tag Text
189data Span tag = Span tag Text
194 deriving (Show)
190 deriving (Show)
196−-- | Text alignment type
199− | TextAlignment_Right
200− | TextAlignment_Center
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)
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
217-- | Information about the document as it is displayed (i.e., post-wrapping)
192-- | Information about the document as it is displayed (i.e., post-wrapping)
218data DisplayLines tag = DisplayLines
193data DisplayLines tag = DisplayLines
219 { _displayLines_spans :: [[Span tag]]
194 { _displayLines_spans :: [[Span tag]]
220− , _displayLines_offsetMap :: OffsetMapWithAlignment
195+ , _displayLines_offsetMap :: Map Int Int
221− , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
196+ , _displayLines_cursorY :: Int
223 deriving (Show)
198 deriving (Show)
200+-- | Given a width and a 'TextZipper', produce a list of display lines
201+-- (i.e., lines of wrapped text) with special attributes applied to
202+-- certain segments (e.g., the cursor). Additionally, produce the current
203+-- y-coordinate of the cursor and a mapping from display line number to text
206+ :: Int -- ^ Width, used for wrapping
207+ -> tag -- ^ Metadata for normal characters
208+ -> tag -- ^ Metadata for the cursor
209+ -> TextZipper -- ^ The text input contents and cursor state
211+displayLines width tag cursorTag (TextZipper lb b a la) =
212+ let linesBefore :: [[Text]] -- The wrapped lines before the cursor line
213+ linesBefore = map (wrapWithOffset width 0) $ reverse lb
214+ linesAfter :: [[Text]] -- The wrapped lines after the cursor line
215+ linesAfter = map (wrapWithOffset width 0) la
216+ offsets :: Map Int Int
217+ offsets = offsetMap $ mconcat
219+ , [wrapWithOffset width 0 $ b <> a]
222+ spansBefore = map ((:[]) . Span tag) $ concat linesBefore
223+ spansAfter = map ((:[]) . Span tag) $ concat linesAfter
224+ -- Separate the spans before the cursor into
225+ -- * spans that are on earlier display lines (though on the same logical line), and
226+ -- * spans that are on the same display line
227+ (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
228+ initLast $ map ((:[]) . Span tag) (wrapWithOffset width 0 b)
229+ -- Calculate the number of columns on the cursor's display line before the cursor
230+ curLineOffset = spansWidth spansCurLineBefore
231+ -- Check whether the spans on the current display line are long enough that
232+ -- the cursor has to go to the next line
233+ cursorAfterEOL = curLineOffset == width
234+ cursorCharWidth = case T.uncons a of
236+ Just (c, _) -> charWidth c
237+ -- Separate the span after the cursor into
238+ -- * spans that are on the same display line, and
239+ -- * spans that are on later display lines (though on the same logical line)
240+ (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
241+ headTail $ case T.uncons a of
242+ Nothing -> [[Span cursorTag " "]]
244+ let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
245+ cursor = Span cursorTag (T.singleton c)
246+ in case map ((:[]) . Span tag) (wrapWithOffset width o rest) of
248+ (l:ls) -> (cursor : l) : ls
250+ { _displayLines_spans = concat
252+ , spansCurrentBefore
254+ then [ spansCurLineBefore, spansCurLineAfter ]
255+ else [ spansCurLineBefore <> spansCurLineAfter ]
259+ , _displayLines_offsetMap = offsets
260+ , _displayLines_cursorY = sum
261+ [ length spansBefore
262+ , length spansCurrentBefore
263+ , if cursorAfterEOL then 1 else 0
267+ initLast :: [a] -> Maybe ([a], a)
270+ (x:xs) -> case initLast xs of
271+ Nothing -> Just ([], x)
272+ Just (ys, y) -> Just (x:ys, y)
273+ headTail :: [a] -> Maybe (a, [a])
276+ x:xs -> Just (x, xs)
278+-- | Wraps a logical line of text to fit within the given width. The first
279+-- wrapped line is offset by the number of columns provided. Subsequent wrapped
282+ :: Int -- ^ Maximum width
283+ -> Int -- ^ Offset for first line
284+ -> Text -- ^ Text to be wrapped
286+wrapWithOffset maxWidth _ _ | maxWidth <= 0 = []
287+wrapWithOffset maxWidth n xs =
288+ let (firstLine, rest) = splitAtWidth (maxWidth - n) xs
289+ in firstLine : (fmap (takeWidth maxWidth) . takeWhile (not . T.null) . iterate (dropWidth maxWidth) $ rest)
225-- | Split a 'Text' at the given column index. For example
291-- | Split a 'Text' at the given column index. For example
227-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
293-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
@@ -231,16 +297,16 @@ splitAtWidth :: Int -> Text -> (Text, Text)
231splitAtWidth n t@(Text arr off len)
297splitAtWidth n t@(Text arr off len)
232 | n <= 0 = (T.empty, t)
298 | n <= 0 = (T.empty, t)
233 | n >= textWidth t = (t, T.empty)
299 | n >= textWidth t = (t, T.empty)
234− | otherwise = let k = toLogicalIndex n t
300+ | otherwise = let k = iterNWidth n t
235 in (text arr off k, text arr (off+k) (len-k))
301 in (text arr off k, text arr (off+k) (len-k))
237−toLogicalIndex :: Int -> Text -> Int
303+ iterNWidth :: Int -> Text -> Int
238−toLogicalIndex n' t'@(Text _ _ len') = loop 0 0
304+ iterNWidth n' t'@(Text _ _ len') = loop 0 0
239− where loop !i !cnt
305+ where loop !i !cnt
240− | i >= len' || cnt + w > n' = i
306+ | i >= len' || cnt + w > n' = i
241− | otherwise = loop (i+d) (cnt + w)
307+ | otherwise = loop (i+d) (cnt + w)
242− where Iter c d = iter t' i
308+ where Iter c d = iter t' i
243− w = charWidth c
309+ w = charWidth c
245-- | Takes the given number of columns of characters. For example
311-- | Takes the given number of columns of characters. For example
@@ -269,6 +335,56 @@ dropWidth n = snd . splitAtWidth n
269charWidth :: Char -> Int
335charWidth :: Char -> Int
270charWidth = wcwidth
336charWidth = wcwidth
339+-- | For a given set of wrapped logical lines, computes a map
340+-- from display line index to text offset in the original text.
341+-- This is used to help determine how interactions with the displayed
342+-- text map back to the original text.
343+-- For example, given the document @\"AA\\nBBB\\nCCCCCCCC\\n\"@ wrapped to 5 columns,
344+-- this function will compute the offset in the original document of each character
349+-- > CCCCC (2, 7) -- (this line wraps to the next row)
353+ :: [[Text]] -- ^ The outer list represents logical lines, and the
354+ -- inner list represents the display lines into which
355+ -- the logical line has been wrapped
356+ -> Map Int Int -- ^ A map from the index (row) of display line to
357+ -- the text offset from the beginning of the document
358+ -- to the first character of the display line
359+offsetMap ts = evalState (offsetMap' ts) (0, 0)
361+ offsetMap' xs = fmap Map.unions $ forM xs $ \x -> do
362+ maps <- forM x $ \line -> do
363+ let l = T.length line
366+ return $ Map.singleton dl o
369+ return $ Map.insert dl (o + 1) $ Map.unions maps
371+-- | Move the cursor of the given 'TextZipper' to the logical position indicated
372+-- by the given display line coordinates, using the provided 'DisplayLines'
373+-- information. If the x coordinate is beyond the end of a line, the cursor is
374+-- moved to the end of the line.
375+goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
376+goToDisplayLinePosition x y dl tz =
377+ let offset = Map.lookup y $ _displayLines_offsetMap dl
382+ moveRight = case drop y $ _displayLines_spans dl of
384+ (s:_) -> charIndexAt x . stream . mconcat . fmap (\(Span _ t) -> t) $ s
385+ in rightN (o + min moveRight x) $ top tz
272-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
388-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
273spansWidth :: [Span tag] -> Int
389spansWidth :: [Span tag] -> Int
274spansWidth = sum . map (\(Span _ t) -> textWidth t)
390spansWidth = sum . map (\(Span _ t) -> textWidth t)
@@ -304,242 +420,3 @@ charIndexAt pos (Stream next s0 _len) = loop_length 0 0 s0
304 Yield c s' -> if w > pos then i else loop_length (i+1) w s' where
420 Yield c s' -> if w > pos then i else loop_length (i+1) w s' where
305 w = z + charWidth c
421 w = z + charWidth c
306{-# INLINE[0] charIndexAt #-}
422{-# INLINE[0] charIndexAt #-}
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
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 #-}
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'
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
338− loop :: [Text] -> Int -> [(Text,Bool)] -> [(Text,Bool)]
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
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
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
360−wrapWithOffsetAndAlignment
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
377− (x,b):xs -> (T.drop n x,b):xs
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))
384−offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
385−offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines
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)
392− offsetMap' xs = fmap Map.unions $ forM xs $ \x -> do
393− maps <- forM x $ \(line,align) -> do
394− let l = T.length line
397− return $ Map.singleton dl (align, o)
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
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
409−displayLinesWithAlignment
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
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
422− -- simulate trailing cursor character when computing OffsetMap
423− afterWithCursor = if T.null a then " " else a
424− offsets :: OffsetMapWithAlignment
425− offsets = offsetMapWithAlignmentInternal $ mconcat
427− , [wrapWithOffsetAndAlignment alignment width 0 $ b <> afterWithCursor]
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
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
446− Just (c, _) -> charWidth c
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)
452− (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
453− headTail $ case T.uncons a of
454− Nothing -> [[Span cursorTag " "]]
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
460− (l:ls) -> (cursor : l) : ls
462− curLineSpanNormalCase = if cursorAfterEOL
463− then [ spansCurLineBefore, spansCurLineAfter ]
464− else [ spansCurLineBefore <> spansCurLineAfter ]
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
476− [ length spansBefore
477− , length spansCurrentBefore
478− , if cursorAfterEOL then 1 else 0
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)
484− { _displayLines_spans = concat
486− , spansCurrentBefore
491− , _displayLines_offsetMap = offsets
492− , _displayLines_cursorPos = (cursorX, cursorY)
495− initLast :: [a] -> Maybe ([a], a)
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])
504− x:xs -> Just (x, xs)
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
516− Just (alignOff,o) ->
518− trueX = max 0 (x - alignOff)
519− moveRight = case drop y $ _displayLines_spans dl of
521− (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s
522− in rightN (o + moveRight) $ top tz
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
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
535−displayLines = displayLinesWithAlignment TextAlignment_Left
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
541− :: Int -- ^ Maximum width
542− -> Int -- ^ Offset for first line
543− -> Text -- ^ Text to be wrapped
545−wrapWithOffset maxWidth n xs = _wrappedLines_text <$> wrapWithOffsetAndAlignment TextAlignment_Left maxWidth n xs