@@ -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, join)
15+import Control.Monad.State (evalState, forM, get, put)
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,105 +193,35 @@ 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+
196217-- | Information about the document as it is displayed (i.e., post-wrapping)
197218data DisplayLines tag = DisplayLines
198219 { _displayLines_spans :: [[Span tag]]
199− , _displayLines_offsetMap :: Map Int Int
200− , _displayLines_cursorY :: Int
220+ , _displayLines_offsetMap :: OffsetMapWithAlignment
221+ , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
201222 }
202223 deriving (Show)
203224
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−
295225-- | Split a 'Text' at the given column index. For example
296226--
297227-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
@@ -339,56 +269,6 @@ dropWidth n = snd . splitAtWidth n
339269charWidth :: Char -> Int
340270charWidth = wcwidth
341271
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−
392272-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
393273spansWidth :: [Span tag] -> Int
394274spansWidth = sum . map (\(Span _ t) -> textWidth t)
@@ -434,9 +314,7 @@ wordsWithWhitespace :: Text -> [Text]
434314wordsWithWhitespace t@(Text arr off len) = loop 0 0 False
435315 where
436316 loop !start !n !wasSpace
437− | n >= len = if start == n
438− then []
439− else [Text arr (start+off) (n-start)]
317+ | n >= len = [Text arr (start+off) (n-start) | not (start == n)]
440318 | isSpace c = loop start (n+d) True
441319 | wasSpace = Text arr (start+off) (n-start) : loop n n False
442320 | otherwise = loop start (n+d) False
@@ -474,33 +352,6 @@ splitWordsAtDisplayWidth maxWidth wwws = reverse $ loop wwws 0 [] where
474352 else loop (x:xs) 0 [] <> modifyOutForNewLine out
475353 else loop xs newWidth $ appendOut out x False
476354
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)
504355
505356
506357-- | Wraps a logical line of text to fit within the given width. The first
@@ -514,7 +365,8 @@ wrapWithOffsetAndAlignment
514365 -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)
515366wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []
516367wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r where
517− r' = splitWordsAtDisplayWidth maxWidth $ T.replicate n " " : wordsWithWhitespace txt
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)
518370 fmapfn (t,b) = case alignment of
519371 TextAlignment_Left -> WrappedLine t b 0
520372 TextAlignment_Right -> WrappedLine t b (maxWidth-l)
@@ -527,7 +379,7 @@ wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r w
527379
528380-- converts deleted eol spaces into logical lines
529381eolSpacesToLogicalLines :: [[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))
531383
532384offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment
533385offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines
@@ -555,21 +407,24 @@ offsetMapWithAlignment ts = evalState (offsetMap' ts) (0, 0)
555407-- y-coordinate of the cursor and a mapping from display line number to text
556408-- offset
557409displayLinesWithAlignment
558− :: (Show tag) => TextAlignment
410+ :: TextAlignment
559411 -> Int -- ^ Width, used for wrapping
560412 -> tag -- ^ Metadata for normal characters
561413 -> tag -- ^ Metadata for the cursor
562414 -> TextZipper -- ^ The text input contents and cursor state
563− -> DisplayLinesWithAlignment tag
415+ -> DisplayLines tag
564416displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
565417 let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line
566418 linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb
567419 linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line
568420 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
569424 offsets :: OffsetMapWithAlignment
570425 offsets = offsetMapWithAlignmentInternal $ mconcat
571426 [ linesBefore
572− , [wrapWithOffsetAndAlignment alignment width 0 $ b <> a]
427+ , [wrapWithOffsetAndAlignment alignment width 0 $ b <> afterWithCursor]
573428 , linesAfter
574429 ]
575430 flattenLines = concatMap (fmap _wrappedLines_text)
@@ -579,9 +434,8 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
579434 -- * spans that are on earlier display lines (though on the same logical line), and
580435 -- * spans that are on the same display line
581436
582− -- TODO cursor goes here if align right
583437 (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)
585439 -- Calculate the number of columns on the cursor's display line before the cursor
586440 curLineOffset = spansWidth spansCurLineBefore
587441 -- 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) =
595449 -- * spans that are on the same display line, and
596450 -- * spans that are on later display lines (though on the same logical line)
597451
598− -- TODO do not show cursor if align right
599452 (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
600453 headTail $ case T.uncons a of
601454 Nothing -> [[Span cursorTag " "]]
602455 Just (c, rest) ->
603456 let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
604457 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
606459 [] -> [[cursor]]
607460 (l:ls) -> (cursor : l) : ls
608461
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+
609475 cursorY = sum
610476 [ length spansBefore
611477 , length spansCurrentBefore
@@ -614,18 +480,16 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
614480 -- a little silly to convert back to text but whatever, it works
615481 cursorX = if cursorAfterEOL then 0 else textWidth (mconcat $ fmap (\(Span _ t) -> t) spansCurLineBefore)
616482
617− in DisplayLinesWithAlignment
618− { _displayLinesWithAlignment_spans = concat
483+ in DisplayLines
484+ { _displayLines_spans = concat
619485 [ spansBefore
620486 , spansCurrentBefore
621− , if cursorAfterEOL
622− then [ spansCurLineBefore, spansCurLineAfter ]
623− else [ spansCurLineBefore <> spansCurLineAfter ]
487+ , curLineSpan
624488 , spansCurrentAfter
625489 , spansAfter
626490 ]
627− , _displayLinesWithAlignment_offsetMap = offsets
628− , _displayLinesWithAlignment_cursorPos = (cursorX, cursorY)
491+ , _displayLines_offsetMap = offsets
492+ , _displayLines_cursorPos = (cursorX, cursorY)
629493 }
630494 where
631495 initLast :: [a] -> Maybe ([a], a)
@@ -644,15 +508,38 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
644508-- by the given display line coordinates, using the provided 'DisplayLinesWithAlignment'
645509-- information. If the x coordinate is beyond the end of a line, the cursor is
646510-- moved to the end of the line.
647−goToDisplayLineWithAlignmentPosition :: Int -> Int -> DisplayLinesWithAlignment tag -> TextZipper -> TextZipper
648−goToDisplayLineWithAlignmentPosition x y dl tz =
649− let offset = Map.lookup y $ _displayLinesWithAlignment_offsetMap dl
511+goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
512+goToDisplayLinePosition x y dl tz =
513+ let offset = Map.lookup y $ _displayLines_offsetMap dl
650514 in case offset of
651515 Nothing -> tz
652516 Just (alignOff,o) ->
653517 let
654518 trueX = max 0 (x - alignOff)
655− moveRight = case drop y $ _displayLinesWithAlignment_spans dl of
519+ moveRight = case drop y $ _displayLines_spans dl of
656520 [] -> 0
657521 (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s
658522 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