@@ -9,22 +9,26 @@ 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)
12import Data.Char (isSpace)
16import Data.Char (isSpace)
13import Data.Map (Map)
17import Data.Map (Map)
14−import qualified Data.Map as Map
15import Data.Maybe (fromMaybe)
18import Data.Maybe (fromMaybe)
16import Data.String
19import Data.String
17−import Control.Monad.State (evalState, forM, get, put)
19import Data.Text (Text)
20import 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
26import Graphics.Text.Width (wcwidth)
29import Graphics.Text.Width (wcwidth)
28-- | A zipper of the logical text input contents (the "document"). The lines
32-- | A zipper of the logical text input contents (the "document"). The lines
29-- before the line containing the cursor are stored in reverse order.
33-- before the line containing the cursor are stored in reverse order.
30-- The cursor is logically between the "before" and "after" text.
34-- The cursor is logically between the "before" and "after" text.
@@ -166,7 +170,7 @@ deleteLeftWord (TextZipper lb b a la) =
166-- | Insert up to n spaces to get to the next logical column that is a multiple of n
170-- | Insert up to n spaces to get to the next logical column that is a multiple of n
167tab :: Int -> TextZipper -> TextZipper
171tab :: Int -> TextZipper -> TextZipper
168tab n z@(TextZipper _ b _ _) =
172tab n z@(TextZipper _ b _ _) =
169− insert (T.replicate (fromEnum $ n - (T.length b `mod` max 1 n)) " ") z
173+ insert (T.replicate (fromEnum $ n - T.length b `mod` max 1 n) " ") z
171-- | The plain text contents of the zipper
175-- | The plain text contents of the zipper
172value :: TextZipper -> Text
176value :: TextZipper -> Text
@@ -189,105 +193,35 @@ fromText = flip insert empty
189data Span tag = Span tag Text
193data Span tag = Span tag Text
190 deriving (Show)
194 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
192-- | Information about the document as it is displayed (i.e., post-wrapping)
217-- | Information about the document as it is displayed (i.e., post-wrapping)
193data DisplayLines tag = DisplayLines
218data DisplayLines tag = DisplayLines
194 { _displayLines_spans :: [[Span tag]]
219 { _displayLines_spans :: [[Span tag]]
195− , _displayLines_offsetMap :: Map Int Int
220+ , _displayLines_offsetMap :: OffsetMapWithAlignment
196− , _displayLines_cursorY :: Int
221+ , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
198 deriving (Show)
223 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)
291-- | Split a 'Text' at the given column index. For example
225-- | Split a 'Text' at the given column index. For example
293-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
227-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
@@ -297,16 +231,16 @@ splitAtWidth :: Int -> Text -> (Text, Text)
297splitAtWidth n t@(Text arr off len)
231splitAtWidth n t@(Text arr off len)
298 | n <= 0 = (T.empty, t)
232 | n <= 0 = (T.empty, t)
299 | n >= textWidth t = (t, T.empty)
233 | n >= textWidth t = (t, T.empty)
300− | otherwise = let k = iterNWidth n t
234+ | otherwise = let k = toLogicalIndex n t
301 in (text arr off k, text arr (off+k) (len-k))
235 in (text arr off k, text arr (off+k) (len-k))
303− iterNWidth :: Int -> Text -> Int
237+toLogicalIndex :: Int -> Text -> Int
304− iterNWidth n' t'@(Text _ _ len') = loop 0 0
238+toLogicalIndex n' t'@(Text _ _ len') = loop 0 0
305− where loop !i !cnt
239+ where loop !i !cnt
306− | i >= len' || cnt + w > n' = i
240+ | i >= len' || cnt + w > n' = i
307− | otherwise = loop (i+d) (cnt + w)
241+ | otherwise = loop (i+d) (cnt + w)
308− where Iter c d = iter t' i
242+ where Iter c d = iter t' i
309− w = charWidth c
243+ w = charWidth c
311-- | Takes the given number of columns of characters. For example
245-- | Takes the given number of columns of characters. For example
@@ -335,56 +269,6 @@ dropWidth n = snd . splitAtWidth n
335charWidth :: Char -> Int
269charWidth :: Char -> Int
336charWidth = wcwidth
270charWidth = 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
388-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
272-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
389spansWidth :: [Span tag] -> Int
273spansWidth :: [Span tag] -> Int
390spansWidth = sum . map (\(Span _ t) -> textWidth t)
274spansWidth = sum . map (\(Span _ t) -> textWidth t)
@@ -420,3 +304,242 @@ charIndexAt pos (Stream next s0 _len) = loop_length 0 0 s0
420 Yield c s' -> if w > pos then i else loop_length (i+1) w s' where
304 Yield c s' -> if w > pos then i else loop_length (i+1) w s' where
421 w = z + charWidth c
305 w = z + charWidth c
422{-# INLINE[0] charIndexAt #-}
306{-# 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