@@ -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)
15+import Control.Monad.State (evalState, forM, get, put, join)
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,35 +193,105 @@ 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
217-- | Information about the document as it is displayed (i.e., post-wrapping)
196-- | Information about the document as it is displayed (i.e., post-wrapping)
218data DisplayLines tag = DisplayLines
197data DisplayLines tag = DisplayLines
219 { _displayLines_spans :: [[Span tag]]
198 { _displayLines_spans :: [[Span tag]]
220− , _displayLines_offsetMap :: OffsetMapWithAlignment
199+ , _displayLines_offsetMap :: Map Int Int
221− , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
200+ , _displayLines_cursorY :: Int
223 deriving (Show)
202 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)
225-- | Split a 'Text' at the given column index. For example
295-- | Split a 'Text' at the given column index. For example
227-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
297-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
@@ -269,6 +339,56 @@ dropWidth n = snd . splitAtWidth n
269charWidth :: Char -> Int
339charWidth :: Char -> Int
270charWidth = wcwidth
340charWidth = 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
272-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
392-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
273spansWidth :: [Span tag] -> Int
393spansWidth :: [Span tag] -> Int
274spansWidth = sum . map (\(Span _ t) -> textWidth t)
394spansWidth = sum . map (\(Span _ t) -> textWidth t)
@@ -314,7 +434,9 @@ wordsWithWhitespace :: Text -> [Text]
314wordsWithWhitespace t@(Text arr off len) = loop 0 0 False
434wordsWithWhitespace t@(Text arr off len) = loop 0 0 False
316 loop !start !n !wasSpace
436 loop !start !n !wasSpace
437+ | n >= len = if start == n
317− | n >= len = [Text arr (start+off) (n-start) | not (start == n)]
439+ else [Text arr (start+off) (n-start)]
318 | isSpace c = loop start (n+d) True
440 | isSpace c = loop start (n+d) True
319 | wasSpace = Text arr (start+off) (n-start) : loop n n False
441 | wasSpace = Text arr (start+off) (n-start) : loop n n False
320 | otherwise = loop start (n+d) False
442 | otherwise = loop start (n+d) False
@@ -352,6 +474,33 @@ splitWordsAtDisplayWidth maxWidth wwws = reverse $ loop wwws 0 [] where
352 else loop (x:xs) 0 [] <> modifyOutForNewLine out
474 else loop (x:xs) 0 [] <> modifyOutForNewLine out
353 else loop xs newWidth $ appendOut out x False
475 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
357-- | Wraps a logical line of text to fit within the given width. The first
506-- | Wraps a logical line of text to fit within the given width. The first
@@ -365,8 +514,7 @@ wrapWithOffsetAndAlignment
365 -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)
514 -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)
366wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []
515wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []
367wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r where
516wrapWithOffsetAndAlignment 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)
517+ r' = splitWordsAtDisplayWidth maxWidth $ T.replicate n " " : wordsWithWhitespace txt
370 fmapfn (t,b) = case alignment of
518 fmapfn (t,b) = case alignment of
371 TextAlignment_Left -> WrappedLine t b 0
519 TextAlignment_Left -> WrappedLine t b 0
372 TextAlignment_Right -> WrappedLine t b (maxWidth-l)
520 TextAlignment_Right -> WrappedLine t b (maxWidth-l)
@@ -379,7 +527,7 @@ wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r w
380-- converts deleted eol spaces into logical lines
528-- converts deleted eol spaces into logical lines
381eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]
529eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]
382−eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . concatMap (L.groupBy (\(WrappedLine _ b _) _ -> not b))
530+eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . join . fmap (L.groupBy (\(WrappedLine _ b _) _ -> not b))
384offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
532offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
385offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines
533offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines
@@ -407,24 +555,21 @@ offsetMapWithAlignment ts = evalState (offsetMap' ts) (0, 0)
407-- y-coordinate of the cursor and a mapping from display line number to text
555-- y-coordinate of the cursor and a mapping from display line number to text
409displayLinesWithAlignment
557displayLinesWithAlignment
410− :: TextAlignment
558+ :: (Show tag) => TextAlignment
411 -> Int -- ^ Width, used for wrapping
559 -> Int -- ^ Width, used for wrapping
412 -> tag -- ^ Metadata for normal characters
560 -> tag -- ^ Metadata for normal characters
413 -> tag -- ^ Metadata for the cursor
561 -> tag -- ^ Metadata for the cursor
414 -> TextZipper -- ^ The text input contents and cursor state
562 -> TextZipper -- ^ The text input contents and cursor state
415− -> DisplayLines tag
563+ -> DisplayLinesWithAlignment tag
416displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
564displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
417 let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line
565 let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line
418 linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb
566 linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb
419 linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line
567 linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line
420 linesAfter = map (wrapWithOffsetAndAlignment alignment width 0) la
568 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
569 offsets :: OffsetMapWithAlignment
425 offsets = offsetMapWithAlignmentInternal $ mconcat
570 offsets = offsetMapWithAlignmentInternal $ mconcat
426 [ linesBefore
571 [ linesBefore
427− , [wrapWithOffsetAndAlignment alignment width 0 $ b <> afterWithCursor]
572+ , [wrapWithOffsetAndAlignment alignment width 0 $ b <> a]
428 , linesAfter
573 , linesAfter
430 flattenLines = concatMap (fmap _wrappedLines_text)
575 flattenLines = concatMap (fmap _wrappedLines_text)
@@ -434,8 +579,9 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
434 -- * spans that are on earlier display lines (though on the same logical line), and
579 -- * spans that are on earlier display lines (though on the same logical line), and
435 -- * spans that are on the same display line
580 -- * spans that are on the same display line
582+ -- TODO cursor goes here if align right
437 (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
583 (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
438− initLast $ map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width 0 b)
584+ initLast $ map ((:[]) . Span tag) $ fmap _wrappedLines_text $ (wrapWithOffsetAndAlignment alignment width 0 b)
439 -- Calculate the number of columns on the cursor's display line before the cursor
585 -- Calculate the number of columns on the cursor's display line before the cursor
440 curLineOffset = spansWidth spansCurLineBefore
586 curLineOffset = spansWidth spansCurLineBefore
441 -- Check whether the spans on the current display line are long enough that
587 -- Check whether the spans on the current display line are long enough that
@@ -449,29 +595,17 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
449 -- * spans that are on the same display line, and
595 -- * spans that are on the same display line, and
450 -- * spans that are on later display lines (though on the same logical line)
596 -- * spans that are on later display lines (though on the same logical line)
598+ -- TODO do not show cursor if align right
452 (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
599 (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
453 headTail $ case T.uncons a of
600 headTail $ case T.uncons a of
454 Nothing -> [[Span cursorTag " "]]
601 Nothing -> [[Span cursorTag " "]]
455 Just (c, rest) ->
602 Just (c, rest) ->
456 let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
603 let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
457 cursor = Span cursorTag (T.singleton c)
604 cursor = Span cursorTag (T.singleton c)
458− in case map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width o rest) of
605+ in case map ((:[]) . Span tag) $ fmap _wrappedLines_text $ (wrapWithOffsetAndAlignment alignment width o rest) of
459 [] -> [[cursor]]
606 [] -> [[cursor]]
460 (l:ls) -> (cursor : l) : ls
607 (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
475 cursorY = sum
609 cursorY = sum
476 [ length spansBefore
610 [ length spansBefore
477 , length spansCurrentBefore
611 , length spansCurrentBefore
@@ -480,16 +614,18 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
480 -- a little silly to convert back to text but whatever, it works
614 -- 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)
615 cursorX = if cursorAfterEOL then 0 else textWidth (mconcat $ fmap (\(Span _ t) -> t) spansCurLineBefore)
483− in DisplayLines
617+ in DisplayLinesWithAlignment
484− { _displayLines_spans = concat
618+ { _displayLinesWithAlignment_spans = concat
485 [ spansBefore
619 [ spansBefore
486 , spansCurrentBefore
620 , spansCurrentBefore
487− , curLineSpan
621+ , if cursorAfterEOL
622+ then [ spansCurLineBefore, spansCurLineAfter ]
623+ else [ spansCurLineBefore <> spansCurLineAfter ]
488 , spansCurrentAfter
624 , spansCurrentAfter
489 , spansAfter
625 , spansAfter
491− , _displayLines_offsetMap = offsets
627+ , _displayLinesWithAlignment_offsetMap = offsets
492− , _displayLines_cursorPos = (cursorX, cursorY)
628+ , _displayLinesWithAlignment_cursorPos = (cursorX, cursorY)
495 initLast :: [a] -> Maybe ([a], a)
631 initLast :: [a] -> Maybe ([a], a)
@@ -508,38 +644,15 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
508-- by the given display line coordinates, using the provided 'DisplayLinesWithAlignment'
644-- 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
645-- information. If the x coordinate is beyond the end of a line, the cursor is
510-- moved to the end of the line.
646-- moved to the end of the line.
511−goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
647+goToDisplayLineWithAlignmentPosition :: Int -> Int -> DisplayLinesWithAlignment tag -> TextZipper -> TextZipper
512−goToDisplayLinePosition x y dl tz =
648+goToDisplayLineWithAlignmentPosition x y dl tz =
513− let offset = Map.lookup y $ _displayLines_offsetMap dl
649+ let offset = Map.lookup y $ _displayLinesWithAlignment_offsetMap dl
514 in case offset of
650 in case offset of
515 Nothing -> tz
651 Nothing -> tz
516 Just (alignOff,o) ->
652 Just (alignOff,o) ->
518 trueX = max 0 (x - alignOff)
654 trueX = max 0 (x - alignOff)
519− moveRight = case drop y $ _displayLines_spans dl of
655+ moveRight = case drop y $ _displayLinesWithAlignment_spans dl of
521 (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s
657 (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s
522 in rightN (o + moveRight) $ top tz
658 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