@@ -12,7 +12,7 @@ module Data.Text.Zipper where
1212import Prelude
1313
1414import Control.Exception (assert)
15−import Control.Monad.State (evalState, forM, get, put)
15+import Control.Monad.State (evalState, forM, get, put, join)
1616import Data.Char (isSpace)
1717import Data.Map (Map)
1818import Data.Maybe (fromMaybe)
@@ -170,7 +170,7 @@ deleteLeftWord (TextZipper lb b a la) =
170170-- | Insert up to n spaces to get to the next logical column that is a multiple of n
171171tab :: Int -> TextZipper -> TextZipper
172172tab 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
174174
175175-- | The plain text contents of the zipper
176176value :: TextZipper -> Text
@@ -193,35 +193,105 @@ fromText = flip insert empty
193193data Span tag = Span tag Text
194194 deriving (Show)
195195
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−
217196-- | Information about the document as it is displayed (i.e., post-wrapping)
218197data DisplayLines tag = DisplayLines
219198 { _displayLines_spans :: [[Span tag]]
220− , _displayLines_offsetMap :: OffsetMapWithAlignment
221− , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
199+ , _displayLines_offsetMap :: Map Int Int
200+ , _displayLines_cursorY :: Int
222201 }
223202 deriving (Show)
224203
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
208+-- offset
209+displayLines
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
214+ -> DisplayLines tag
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
222+ [ linesBefore
223+ , [wrapWithOffset width 0 $ b <> a]
224+ , linesAfter
225+ ]
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
239+ Nothing -> 1
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 " "]]
247+ Just (c, rest) ->
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
251+ [] -> [[cursor]]
252+ (l:ls) -> (cursor : l) : ls
253+ in DisplayLines
254+ { _displayLines_spans = concat
255+ [ spansBefore
256+ , spansCurrentBefore
257+ , if cursorAfterEOL
258+ then [ spansCurLineBefore, spansCurLineAfter ]
259+ else [ spansCurLineBefore <> spansCurLineAfter ]
260+ , spansCurrentAfter
261+ , spansAfter
262+ ]
263+ , _displayLines_offsetMap = offsets
264+ , _displayLines_cursorY = sum
265+ [ length spansBefore
266+ , length spansCurrentBefore
267+ , if cursorAfterEOL then 1 else 0
268+ ]
269+ }
270+ where
271+ initLast :: [a] -> Maybe ([a], a)
272+ initLast = \case
273+ [] -> Nothing
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])
278+ headTail = \case
279+ [] -> Nothing
280+ x:xs -> Just (x, xs)
281+
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
284+-- lines are not.
285+wrapWithOffset
286+ :: Int -- ^ Maximum width
287+ -> Int -- ^ Offset for first line
288+ -> Text -- ^ Text to be wrapped
289+ -> [Text]
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)
294+
225295-- | Split a 'Text' at the given column index. For example
226296--
227297-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
@@ -269,6 +339,56 @@ dropWidth n = snd . splitAtWidth n
269339charWidth :: Char -> Int
270340charWidth = wcwidth
271341
342+
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
349+-- in column 1:
350+--
351+-- > AA... (0, 0)
352+-- > BBB.. (1, 3)
353+-- > CCCCC (2, 7) -- (this line wraps to the next row)
354+-- > CCC.. (3, 12)
355+-- > ..... (4, 16)
356+offsetMap
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)
364+ where
365+ offsetMap' xs = fmap Map.unions $ forM xs $ \x -> do
366+ maps <- forM x $ \line -> do
367+ let l = T.length line
368+ (dl, o) <- get
369+ put (dl + 1, o + l)
370+ return $ Map.singleton dl o
371+ (dl, o) <- get
372+ put (dl, o + 1)
373+ return $ Map.insert dl (o + 1) $ Map.unions maps
374+
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
382+ in case offset of
383+ Nothing -> tz
384+ Just o ->
385+ let
386+ moveRight = case drop y $ _displayLines_spans dl of
387+ [] -> x
388+ (s:_) -> charIndexAt x . stream . mconcat . fmap (\(Span _ t) -> t) $ s
389+ in rightN (o + min moveRight x) $ top tz
390+
391+
272392-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
273393spansWidth :: [Span tag] -> Int
274394spansWidth = sum . map (\(Span _ t) -> textWidth t)
@@ -314,7 +434,9 @@ wordsWithWhitespace :: Text -> [Text]
314434wordsWithWhitespace t@(Text arr off len) = loop 0 0 False
315435 where
316436 loop !start !n !wasSpace
317− | n >= len = [Text arr (start+off) (n-start) | not (start == n)]
437+ | n >= len = if start == n
438+ then []
439+ else [Text arr (start+off) (n-start)]
318440 | isSpace c = loop start (n+d) True
319441 | wasSpace = Text arr (start+off) (n-start) : loop n n False
320442 | otherwise = loop start (n+d) False
@@ -352,6 +474,33 @@ splitWordsAtDisplayWidth maxWidth wwws = reverse $ loop wwws 0 [] where
352474 else loop (x:xs) 0 [] <> modifyOutForNewLine out
353475 else loop xs newWidth $ appendOut out x False
354476
477+data TextAlignment =
478+ TextAlignment_Left
479+ | TextAlignment_Right
480+ | TextAlignment_Center
481+ deriving (Eq, Show)
482+
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)
488+
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
495+ }
496+ deriving (Show)
497+
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
502+ }
503+ deriving (Eq, Show)
355504
356505
357506-- | Wraps a logical line of text to fit within the given width. The first
@@ -365,8 +514,7 @@ wrapWithOffsetAndAlignment
365514 -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)
366515wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []
367516wrapWithOffsetAndAlignment 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
370518 fmapfn (t,b) = case alignment of
371519 TextAlignment_Left -> WrappedLine t b 0
372520 TextAlignment_Right -> WrappedLine t b (maxWidth-l)
@@ -379,7 +527,7 @@ wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r w
379527
380528-- converts deleted eol spaces into logical lines
381529eolSpacesToLogicalLines :: [[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))
383531
384532offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
385533offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines
@@ -407,24 +555,21 @@ offsetMapWithAlignment ts = evalState (offsetMap' ts) (0, 0)
407555-- y-coordinate of the cursor and a mapping from display line number to text
408556-- offset
409557displayLinesWithAlignment
410− :: TextAlignment
558+ :: (Show tag) => TextAlignment
411559 -> Int -- ^ Width, used for wrapping
412560 -> tag -- ^ Metadata for normal characters
413561 -> tag -- ^ Metadata for the cursor
414562 -> TextZipper -- ^ The text input contents and cursor state
415− -> DisplayLines tag
563+ -> DisplayLinesWithAlignment tag
416564displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
417565 let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line
418566 linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb
419567 linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line
420568 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
424569 offsets :: OffsetMapWithAlignment
425570 offsets = offsetMapWithAlignmentInternal $ mconcat
426571 [ linesBefore
427− , [wrapWithOffsetAndAlignment alignment width 0 $ b <> afterWithCursor]
572+ , [wrapWithOffsetAndAlignment alignment width 0 $ b <> a]
428573 , linesAfter
429574 ]
430575 flattenLines = concatMap (fmap _wrappedLines_text)
@@ -434,8 +579,9 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
434579 -- * spans that are on earlier display lines (though on the same logical line), and
435580 -- * spans that are on the same display line
436581
582+ -- TODO cursor goes here if align right
437583 (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)
439585 -- Calculate the number of columns on the cursor's display line before the cursor
440586 curLineOffset = spansWidth spansCurLineBefore
441587 -- 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) =
449595 -- * spans that are on the same display line, and
450596 -- * spans that are on later display lines (though on the same logical line)
451597
598+ -- TODO do not show cursor if align right
452599 (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
453600 headTail $ case T.uncons a of
454601 Nothing -> [[Span cursorTag " "]]
455602 Just (c, rest) ->
456603 let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
457604 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
459606 [] -> [[cursor]]
460607 (l:ls) -> (cursor : l) : ls
461608
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−
475609 cursorY = sum
476610 [ length spansBefore
477611 , length spansCurrentBefore
@@ -480,16 +614,18 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
480614 -- a little silly to convert back to text but whatever, it works
481615 cursorX = if cursorAfterEOL then 0 else textWidth (mconcat $ fmap (\(Span _ t) -> t) spansCurLineBefore)
482616
483− in DisplayLines
484− { _displayLines_spans = concat
617+ in DisplayLinesWithAlignment
618+ { _displayLinesWithAlignment_spans = concat
485619 [ spansBefore
486620 , spansCurrentBefore
487− , curLineSpan
621+ , if cursorAfterEOL
622+ then [ spansCurLineBefore, spansCurLineAfter ]
623+ else [ spansCurLineBefore <> spansCurLineAfter ]
488624 , spansCurrentAfter
489625 , spansAfter
490626 ]
491− , _displayLines_offsetMap = offsets
492− , _displayLines_cursorPos = (cursorX, cursorY)
627+ , _displayLinesWithAlignment_offsetMap = offsets
628+ , _displayLinesWithAlignment_cursorPos = (cursorX, cursorY)
493629 }
494630 where
495631 initLast :: [a] -> Maybe ([a], a)
@@ -508,38 +644,15 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
508644-- by the given display line coordinates, using the provided 'DisplayLinesWithAlignment'
509645-- information. If the x coordinate is beyond the end of a line, the cursor is
510646-- 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
647+goToDisplayLineWithAlignmentPosition :: Int -> Int -> DisplayLinesWithAlignment tag -> TextZipper -> TextZipper
648+goToDisplayLineWithAlignmentPosition x y dl tz =
649+ let offset = Map.lookup y $ _displayLinesWithAlignment_offsetMap dl
514650 in case offset of
515651 Nothing -> tz
516652 Just (alignOff,o) ->
517653 let
518654 trueX = max 0 (x - alignOff)
519− moveRight = case drop y $ _displayLines_spans dl of
655+ moveRight = case drop y $ _displayLinesWithAlignment_spans dl of
520656 [] -> 0
521657 (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s
522658 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