@@ -12,7 +12,7 @@ module Data.Text.Zipper where
12import Prelude
12import Prelude
14import Control.Exception (assert)
14import Control.Exception (assert)
15−import Control.Monad.State (evalState, forM, get, put, join)
15+import Control.Monad.State (evalState, forM, get, put)
16import Data.Char (isSpace)
16import Data.Char (isSpace)
17import Data.Map (Map)
17import Data.Map (Map)
18import Data.Maybe (fromMaybe)
18import Data.Maybe (fromMaybe)
@@ -170,7 +170,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
170-- | Insert up to n spaces to get to the next logical column that is a multiple of n
171tab :: Int -> TextZipper -> TextZipper
171tab :: Int -> TextZipper -> TextZipper
172tab n z@(TextZipper _ b _ _) =
172tab n z@(TextZipper _ b _ _) =
173− 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
175-- | The plain text contents of the zipper
175-- | The plain text contents of the zipper
176value :: TextZipper -> Text
176value :: TextZipper -> Text
@@ -193,105 +193,35 @@ fromText = flip insert empty
193data Span tag = Span tag Text
193data Span tag = Span tag Text
194 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
196-- | 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)
197data DisplayLines tag = DisplayLines
218data DisplayLines tag = DisplayLines
198 { _displayLines_spans :: [[Span tag]]
219 { _displayLines_spans :: [[Span tag]]
199− , _displayLines_offsetMap :: Map Int Int
220+ , _displayLines_offsetMap :: OffsetMapWithAlignment
200− , _displayLines_cursorY :: Int
221+ , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
202 deriving (Show)
223 deriving (Show)
204−-- | Given a width and a 'TextZipper', produce a list of display lines
205−-- (i.e., lines of wrapped text) with special attributes applied to
206−-- certain segments (e.g., the cursor). Additionally, produce the current
207−-- y-coordinate of the cursor and a mapping from display line number to text
210− :: Int -- ^ Width, used for wrapping
211− -> tag -- ^ Metadata for normal characters
212− -> tag -- ^ Metadata for the cursor
213− -> TextZipper -- ^ The text input contents and cursor state
215−displayLines width tag cursorTag (TextZipper lb b a la) =
216− let linesBefore :: [[Text]] -- The wrapped lines before the cursor line
217− linesBefore = map (wrapWithOffset width 0) $ reverse lb
218− linesAfter :: [[Text]] -- The wrapped lines after the cursor line
219− linesAfter = map (wrapWithOffset width 0) la
220− offsets :: Map Int Int
221− offsets = offsetMap $ mconcat
223− , [wrapWithOffset width 0 $ b <> a]
226− spansBefore = map ((:[]) . Span tag) $ concat linesBefore
227− spansAfter = map ((:[]) . Span tag) $ concat linesAfter
228− -- Separate the spans before the cursor into
229− -- * spans that are on earlier display lines (though on the same logical line), and
230− -- * spans that are on the same display line
231− (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
232− initLast $ map ((:[]) . Span tag) (wrapWithOffset width 0 b)
233− -- Calculate the number of columns on the cursor's display line before the cursor
234− curLineOffset = spansWidth spansCurLineBefore
235− -- Check whether the spans on the current display line are long enough that
236− -- the cursor has to go to the next line
237− cursorAfterEOL = curLineOffset == width
238− cursorCharWidth = case T.uncons a of
240− Just (c, _) -> charWidth c
241− -- Separate the span after the cursor into
242− -- * spans that are on the same display line, and
243− -- * spans that are on later display lines (though on the same logical line)
244− (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
245− headTail $ case T.uncons a of
246− Nothing -> [[Span cursorTag " "]]
248− let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
249− cursor = Span cursorTag (T.singleton c)
250− in case map ((:[]) . Span tag) (wrapWithOffset width o rest) of
252− (l:ls) -> (cursor : l) : ls
254− { _displayLines_spans = concat
256− , spansCurrentBefore
258− then [ spansCurLineBefore, spansCurLineAfter ]
259− else [ spansCurLineBefore <> spansCurLineAfter ]
263− , _displayLines_offsetMap = offsets
264− , _displayLines_cursorY = sum
265− [ length spansBefore
266− , length spansCurrentBefore
267− , if cursorAfterEOL then 1 else 0
271− initLast :: [a] -> Maybe ([a], a)
274− (x:xs) -> case initLast xs of
275− Nothing -> Just ([], x)
276− Just (ys, y) -> Just (x:ys, y)
277− headTail :: [a] -> Maybe (a, [a])
280− x:xs -> Just (x, xs)
282−-- | Wraps a logical line of text to fit within the given width. The first
283−-- wrapped line is offset by the number of columns provided. Subsequent wrapped
286− :: Int -- ^ Maximum width
287− -> Int -- ^ Offset for first line
288− -> Text -- ^ Text to be wrapped
290−wrapWithOffset maxWidth _ _ | maxWidth <= 0 = []
291−wrapWithOffset maxWidth n xs =
292− let (firstLine, rest) = splitAtWidth (maxWidth - n) xs
293− in firstLine : (fmap (takeWidth maxWidth) . takeWhile (not . T.null) . iterate (dropWidth maxWidth) $ rest)
295-- | Split a 'Text' at the given column index. For example
225-- | Split a 'Text' at the given column index. For example
297-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
227-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
@@ -339,56 +269,6 @@ dropWidth n = snd . splitAtWidth n
339charWidth :: Char -> Int
269charWidth :: Char -> Int
340charWidth = wcwidth
270charWidth = wcwidth
343−-- | For a given set of wrapped logical lines, computes a map
344−-- from display line index to text offset in the original text.
345−-- This is used to help determine how interactions with the displayed
346−-- text map back to the original text.
347−-- For example, given the document @\"AA\\nBBB\\nCCCCCCCC\\n\"@ wrapped to 5 columns,
348−-- this function will compute the offset in the original document of each character
353−-- > CCCCC (2, 7) -- (this line wraps to the next row)
357− :: [[Text]] -- ^ The outer list represents logical lines, and the
358− -- inner list represents the display lines into which
359− -- the logical line has been wrapped
360− -> Map Int Int -- ^ A map from the index (row) of display line to
361− -- the text offset from the beginning of the document
362− -- to the first character of the display line
363−offsetMap ts = evalState (offsetMap' ts) (0, 0)
365− offsetMap' xs = fmap Map.unions $ forM xs $ \x -> do
366− maps <- forM x $ \line -> do
367− let l = T.length line
370− return $ Map.singleton dl o
373− return $ Map.insert dl (o + 1) $ Map.unions maps
375−-- | Move the cursor of the given 'TextZipper' to the logical position indicated
376−-- by the given display line coordinates, using the provided 'DisplayLines'
377−-- information. If the x coordinate is beyond the end of a line, the cursor is
378−-- moved to the end of the line.
379−goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
380−goToDisplayLinePosition x y dl tz =
381− let offset = Map.lookup y $ _displayLines_offsetMap dl
386− moveRight = case drop y $ _displayLines_spans dl of
388− (s:_) -> charIndexAt x . stream . mconcat . fmap (\(Span _ t) -> t) $ s
389− in rightN (o + min moveRight x) $ top tz
392-- | 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
393spansWidth :: [Span tag] -> Int
273spansWidth :: [Span tag] -> Int
394spansWidth = sum . map (\(Span _ t) -> textWidth t)
274spansWidth = sum . map (\(Span _ t) -> textWidth t)
@@ -434,9 +314,7 @@ wordsWithWhitespace :: Text -> [Text]
434wordsWithWhitespace t@(Text arr off len) = loop 0 0 False
314wordsWithWhitespace t@(Text arr off len) = loop 0 0 False
436 loop !start !n !wasSpace
316 loop !start !n !wasSpace
437− | n >= len = if start == n
439− else [Text arr (start+off) (n-start)]
317+ | n >= len = [Text arr (start+off) (n-start) | not (start == n)]
440 | isSpace c = loop start (n+d) True
318 | isSpace c = loop start (n+d) True
441 | wasSpace = Text arr (start+off) (n-start) : loop n n False
319 | wasSpace = Text arr (start+off) (n-start) : loop n n False
442 | otherwise = loop start (n+d) False
320 | otherwise = loop start (n+d) False
@@ -474,33 +352,6 @@ splitWordsAtDisplayWidth maxWidth wwws = reverse $ loop wwws 0 [] where
474 else loop (x:xs) 0 [] <> modifyOutForNewLine out
352 else loop (x:xs) 0 [] <> modifyOutForNewLine out
475 else loop xs newWidth $ appendOut out x False
353 else loop xs newWidth $ appendOut out x False
479− | TextAlignment_Right
480− | TextAlignment_Center
483−-- A map from the index (row) of display line to
484−-- fst: leading empty spaces from left (may be negative) to adjust for alignment
485−-- snd: the text offset from the beginning of the document
486−-- to the first character of the display line
487−type OffsetMapWithAlignment = Map Int (Int, Int)
489−-- | Information about the document as it is displayed (i.e., post-wrapping)
490−data DisplayLinesWithAlignment tag = DisplayLinesWithAlignment
491− { _displayLinesWithAlignment_spans :: [[Span tag]]
492− , _displayLinesWithAlignment_offsetMap :: OffsetMapWithAlignment
493− -- cursor position relative to upper left hand corner
494− , _displayLinesWithAlignment_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
498−data WrappedLine = WrappedLine
499− { _wrappedLines_text :: Text
500− , _wrappedLines_hiddenWhitespace :: Bool -- ^ 'True' if this line ends with a deleted whitespace character
501− , _wrappedLines_offset :: Int -- ^ offset from beginning of line
506-- | Wraps a logical line of text to fit within the given width. The first
357-- | Wraps a logical line of text to fit within the given width. The first
@@ -514,7 +365,8 @@ wrapWithOffsetAndAlignment
514 -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)
365 -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)
515wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []
366wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []
516wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r where
367wrapWithOffsetAndAlignment 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
517− r' = splitWordsAtDisplayWidth maxWidth $ T.replicate n " " : wordsWithWhitespace txt
369+ r' = splitWordsAtDisplayWidth maxWidth $ wordsWithWhitespace ( T.replicate n "." <> txt)
518 fmapfn (t,b) = case alignment of
370 fmapfn (t,b) = case alignment of
519 TextAlignment_Left -> WrappedLine t b 0
371 TextAlignment_Left -> WrappedLine t b 0
520 TextAlignment_Right -> WrappedLine t b (maxWidth-l)
372 TextAlignment_Right -> WrappedLine t b (maxWidth-l)
@@ -527,7 +379,7 @@ wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r w
528-- converts deleted eol spaces into logical lines
380-- converts deleted eol spaces into logical lines
529eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]
381eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]
530−eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . join . fmap (L.groupBy (\(WrappedLine _ b _) _ -> not b))
382+eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . concatMap (L.groupBy (\(WrappedLine _ b _) _ -> not b))
532offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
384offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
533offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines
385offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines
@@ -555,21 +407,24 @@ offsetMapWithAlignment ts = evalState (offsetMap' ts) (0, 0)
555-- y-coordinate of the cursor and a mapping from display line number to text
407-- y-coordinate of the cursor and a mapping from display line number to text
557displayLinesWithAlignment
409displayLinesWithAlignment
558− :: (Show tag) => TextAlignment
410+ :: TextAlignment
559 -> Int -- ^ Width, used for wrapping
411 -> Int -- ^ Width, used for wrapping
560 -> tag -- ^ Metadata for normal characters
412 -> tag -- ^ Metadata for normal characters
561 -> tag -- ^ Metadata for the cursor
413 -> tag -- ^ Metadata for the cursor
562 -> TextZipper -- ^ The text input contents and cursor state
414 -> TextZipper -- ^ The text input contents and cursor state
563− -> DisplayLinesWithAlignment tag
415+ -> DisplayLines tag
564displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
416displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
565 let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line
417 let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line
566 linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb
418 linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb
567 linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line
419 linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line
568 linesAfter = map (wrapWithOffsetAndAlignment alignment width 0) la
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
569 offsets :: OffsetMapWithAlignment
424 offsets :: OffsetMapWithAlignment
570 offsets = offsetMapWithAlignmentInternal $ mconcat
425 offsets = offsetMapWithAlignmentInternal $ mconcat
571 [ linesBefore
426 [ linesBefore
572− , [wrapWithOffsetAndAlignment alignment width 0 $ b <> a]
427+ , [wrapWithOffsetAndAlignment alignment width 0 $ b <> afterWithCursor]
573 , linesAfter
428 , linesAfter
575 flattenLines = concatMap (fmap _wrappedLines_text)
430 flattenLines = concatMap (fmap _wrappedLines_text)
@@ -579,9 +434,8 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
579 -- * spans that are on earlier display lines (though on the same logical line), and
434 -- * spans that are on earlier display lines (though on the same logical line), and
580 -- * spans that are on the same display line
435 -- * spans that are on the same display line
582− -- TODO cursor goes here if align right
583 (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
437 (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
584− initLast $ map ((:[]) . Span tag) $ fmap _wrappedLines_text $ (wrapWithOffsetAndAlignment alignment width 0 b)
438+ initLast $ map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width 0 b)
585 -- Calculate the number of columns on the cursor's display line before the cursor
439 -- Calculate the number of columns on the cursor's display line before the cursor
586 curLineOffset = spansWidth spansCurLineBefore
440 curLineOffset = spansWidth spansCurLineBefore
587 -- Check whether the spans on the current display line are long enough that
441 -- Check whether the spans on the current display line are long enough that
@@ -595,17 +449,29 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
595 -- * spans that are on the same display line, and
449 -- * spans that are on the same display line, and
596 -- * spans that are on later display lines (though on the same logical line)
450 -- * spans that are on later display lines (though on the same logical line)
598− -- TODO do not show cursor if align right
599 (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
452 (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
600 headTail $ case T.uncons a of
453 headTail $ case T.uncons a of
601 Nothing -> [[Span cursorTag " "]]
454 Nothing -> [[Span cursorTag " "]]
602 Just (c, rest) ->
455 Just (c, rest) ->
603 let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
456 let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
604 cursor = Span cursorTag (T.singleton c)
457 cursor = Span cursorTag (T.singleton c)
605− in case map ((:[]) . Span tag) $ fmap _wrappedLines_text $ (wrapWithOffsetAndAlignment alignment width o rest) of
458+ in case map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width o rest) of
606 [] -> [[cursor]]
459 [] -> [[cursor]]
607 (l:ls) -> (cursor : l) : ls
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
609 cursorY = sum
475 cursorY = sum
610 [ length spansBefore
476 [ length spansBefore
611 , length spansCurrentBefore
477 , length spansCurrentBefore
@@ -614,18 +480,16 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
614 -- a little silly to convert back to text but whatever, it works
480 -- a little silly to convert back to text but whatever, it works
615 cursorX = if cursorAfterEOL then 0 else textWidth (mconcat $ fmap (\(Span _ t) -> t) spansCurLineBefore)
481 cursorX = if cursorAfterEOL then 0 else textWidth (mconcat $ fmap (\(Span _ t) -> t) spansCurLineBefore)
617− in DisplayLinesWithAlignment
483+ in DisplayLines
618− { _displayLinesWithAlignment_spans = concat
484+ { _displayLines_spans = concat
619 [ spansBefore
485 [ spansBefore
620 , spansCurrentBefore
486 , spansCurrentBefore
621− , if cursorAfterEOL
487+ , curLineSpan
622− then [ spansCurLineBefore, spansCurLineAfter ]
623− else [ spansCurLineBefore <> spansCurLineAfter ]
624 , spansCurrentAfter
488 , spansCurrentAfter
625 , spansAfter
489 , spansAfter
627− , _displayLinesWithAlignment_offsetMap = offsets
491+ , _displayLines_offsetMap = offsets
628− , _displayLinesWithAlignment_cursorPos = (cursorX, cursorY)
492+ , _displayLines_cursorPos = (cursorX, cursorY)
631 initLast :: [a] -> Maybe ([a], a)
495 initLast :: [a] -> Maybe ([a], a)
@@ -644,15 +508,38 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
644-- by the given display line coordinates, using the provided 'DisplayLinesWithAlignment'
508-- by the given display line coordinates, using the provided 'DisplayLinesWithAlignment'
645-- information. If the x coordinate is beyond the end of a line, the cursor is
509-- information. If the x coordinate is beyond the end of a line, the cursor is
646-- moved to the end of the line.
510-- moved to the end of the line.
647−goToDisplayLineWithAlignmentPosition :: Int -> Int -> DisplayLinesWithAlignment tag -> TextZipper -> TextZipper
511+goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
648−goToDisplayLineWithAlignmentPosition x y dl tz =
512+goToDisplayLinePosition x y dl tz =
649− let offset = Map.lookup y $ _displayLinesWithAlignment_offsetMap dl
513+ let offset = Map.lookup y $ _displayLines_offsetMap dl
650 in case offset of
514 in case offset of
651 Nothing -> tz
515 Nothing -> tz
652 Just (alignOff,o) ->
516 Just (alignOff,o) ->
654 trueX = max 0 (x - alignOff)
518 trueX = max 0 (x - alignOff)
655− moveRight = case drop y $ _displayLinesWithAlignment_spans dl of
519+ moveRight = case drop y $ _displayLines_spans dl of
657 (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s
521 (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s
658 in rightN (o + moveRight) $ top tz
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