@@ -1,6 +1,3 @@
1−-- | forked from reflex-vty-0.1.4.1
2−-- adds alignment support
3−
41{-|
52Module: Potato.Data.Text.Zipper
63Description: A zipper for text documents that allows convenient editing and navigation
@@ -19,8 +16,8 @@ module Data.Text.Zipper where
1916
2017import Prelude
2118
22−import Control.Exception (assert)
23−import Control.Monad (join)
19+import Control.Exception (assert)
20+import Control.Monad (join)
2421import Control.Monad.State (evalState, forM, get, put)
2522import Data.Char (isSpace)
2623import Data.Map (Map)
@@ -28,17 +25,17 @@ import qualified Data.Map as Map
2825import Data.Maybe (fromMaybe)
2926import Data.String
3027
31−import qualified Data.List as L
28+import qualified Data.List as L
3229import Data.Text (Text)
3330import qualified Data.Text as T
3431import Data.Text.Internal (Text (..), text)
3532import Data.Text.Internal.Fusion (stream)
3633import Data.Text.Internal.Fusion.Types (Step (..), Stream (..))
3734import Data.Text.Unsafe
38−import Data.Tuple.Extra
35+import Data.Tuple.Extra
3936
4037
41−import Graphics.Text.Width (wcwidth)
38+import Graphics.Text.Width (wcwidth)
4239
4340-- | A zipper of the logical text input contents (the "document"). The lines
4441-- before the line containing the cursor are stored in reverse order.
@@ -47,12 +44,13 @@ import Graphics.Text.Width (wcwidth)
4744-- character (as compared to a "display" line, which is wrapped to fit within
4845-- a given viewport width).
4946data TextZipper = TextZipper
50− { _textZipper_linesBefore :: [Text] -- reversed
51− , _textZipper_before :: Text
52− , _textZipper_after :: Text -- The cursor is on top of the first character of this text
53− , _textZipper_linesAfter :: [Text]
54− }
55− deriving (Show)
47+ { _textZipper_linesBefore :: [Text] -- reversed
48+ , _textZipper_before :: Text
49+ -- The cursor is on top of the first character of this text
50+ , _textZipper_after :: Text -- The cursor is on top of the first character of this text
51+ , _textZipper_linesAfter :: [Text]
52+ }
53+ deriving (Show)
5654
5755instance IsString TextZipper where
5856 fromString = fromText . T.pack
@@ -135,7 +133,7 @@ end (TextZipper lb b a la) = TextZipper lb (b <> a) "" la
135133-- | Move the cursor to the top of the document
136134top :: TextZipper -> TextZipper
137135top (TextZipper lb b a la) = case reverse lb of
138− [] -> TextZipper [] "" (b <> a) la
136+ [] -> TextZipper [] "" (b <> a) la
139137 (start:rest) -> TextZipper [] "" start (rest <> [b <> a] <> la)
140138
141139-- | Insert a character at the current cursor position
@@ -147,14 +145,14 @@ insert :: Text -> TextZipper -> TextZipper
147145insert i z@(TextZipper lb b a la) = case T.split (=='\n') i of
148146 [] -> z
149147 (start:rest) -> case reverse rest of
150− [] -> TextZipper lb (b <> start) a la
148+ [] -> TextZipper lb (b <> start) a la
151149 (l:ls) -> TextZipper (ls <> [b <> start] <> lb) l a la
152150
153151-- | Delete the character to the left of the cursor
154152deleteLeft :: TextZipper-> TextZipper
155153deleteLeft z@(TextZipper lb b a la) = case T.unsnoc b of
156154 Nothing -> case lb of
157− [] -> z
155+ [] -> z
158156 (l:ls) -> TextZipper ls l a la
159157 Just (b', _) -> TextZipper lb b' a la
160158
@@ -162,7 +160,7 @@ deleteLeft z@(TextZipper lb b a la) = case T.unsnoc b of
162160deleteRight :: TextZipper -> TextZipper
163161deleteRight z@(TextZipper lb b a la) = case T.uncons a of
164162 Nothing -> case la of
165− [] -> z
163+ [] -> z
166164 (l:ls) -> TextZipper lb b l ls
167165 Just (_, a') -> TextZipper lb b a' la
168166
@@ -174,7 +172,7 @@ deleteLeftWord (TextZipper lb b a la) =
174172 let b' = T.dropWhileEnd isSpace b
175173 in if T.null b'
176174 then case lb of
177− [] -> TextZipper [] b' a la
175+ [] -> TextZipper [] b' a la
178176 (l:ls) -> deleteLeftWord $ TextZipper ls l a la
179177 else TextZipper lb (T.dropWhileEnd (not . isSpace) b') a la
180178
@@ -202,15 +200,15 @@ fromText = flip insert empty
202200-- | A span of text tagged with some metadata that makes up part of a display
203201-- line.
204202data Span tag = Span tag Text
205− deriving (Show)
203+ deriving (Show)
206204
207205-- | Information about the document as it is displayed (i.e., post-wrapping)
208206data DisplayLines tag = DisplayLines
209− { _displayLines_spans :: [[Span tag]]
210− , _displayLines_offsetMap :: Map Int Int
211− , _displayLines_cursorY :: Int
212− }
213− deriving (Show)
207+ { _displayLines_spans :: [[Span tag]]
208+ , _displayLines_offsetMap :: Map Int Int
209+ , _displayLines_cursorY :: Int
210+ }
211+ deriving (Show)
214212
215213-- | Given a width and a 'TextZipper', produce a list of display lines
216214-- (i.e., lines of wrapped text) with special attributes applied to
@@ -247,7 +245,7 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
247245 -- the cursor has to go to the next line
248246 cursorAfterEOL = curLineOffset == width
249247 cursorCharWidth = case T.uncons a of
250− Nothing -> 1
248+ Nothing -> 1
251249 Just (c, _) -> charWidth c
252250 -- Separate the span after the cursor into
253251 -- * spans that are on the same display line, and
@@ -259,7 +257,7 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
259257 let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
260258 cursor = Span cursorTag (T.singleton c)
261259 in case map ((:[]) . Span tag) (wrapWithOffset width o rest) of
262− [] -> [[cursor]]
260+ [] -> [[cursor]]
263261 (l:ls) -> (cursor : l) : ls
264262 in DisplayLines
265263 { _displayLines_spans = concat
@@ -283,7 +281,7 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
283281 initLast = \case
284282 [] -> Nothing
285283 (x:xs) -> case initLast xs of
286− Nothing -> Just ([], x)
284+ Nothing -> Just ([], x)
287285 Just (ys, y) -> Just (x:ys, y)
288286 headTail :: [a] -> Maybe (a, [a])
289287 headTail = \case
@@ -439,27 +437,6 @@ charIndexAt pos (Stream next s0 _len) = loop_length 0 0 s0
439437
440438
441439
442−
443−
444−
445−
446−
447−
448−
449−
450−
451−
452−
453−
454−
455−
456−
457−
458−
459−
460−-- NEW TEXT ALIGNMENT STUFF BELOW
461−
462−
463440-- same as T.words except whitespace characters are included at end (i.e. ["line1 ", ...])
464441-- 'Char's representing white space.
465442wordsWithWhitespace :: Text -> [Text]
@@ -475,19 +452,18 @@ wordsWithWhitespace t@(Text arr off len) = loop 0 0 False
475452 where Iter c d = iter t n
476453{-# INLINE wordsWithWhitespace #-}
477454
478−-- TODO Check that this handles EOL space/newline stuff correctly
479455-- take sum of word length, returns True if ends with trailng space
480456splitWordsAtDisplayWidth :: Int -> [Text] -> [(Text, Bool)]
481457splitWordsAtDisplayWidth maxWidth wwws = reverse $ loop wwws 0 [] where
482458 appendOut :: [(Text,Bool)] -> Text -> Bool -> [(Text,Bool)]
483− appendOut [] t b = [(t,b)]
459+ appendOut [] t b = [(t,b)]
484460 appendOut ((t',_):ts') t b = (t'<>t,b) : ts'
485461
486462 -- remove the last whitespace in output
487463 modifyOutForNewLine :: [(Text,Bool)] -> [(Text,Bool)]
488464 modifyOutForNewLine [] = error "should never happen"
489465 modifyOutForNewLine ((t',_):ts) = case T.unsnoc t' of
490− Nothing -> error "should never happen"
466+ Nothing -> error "should never happen"
491467 Just (t,lastChar) -> assert (isSpace lastChar) $ (t,True):ts -- assume last char is whitespace
492468
493469 loop :: [Text] -> Int -> [(Text,Bool)] -> [(Text,Bool)]
@@ -508,7 +484,9 @@ splitWordsAtDisplayWidth maxWidth wwws = reverse $ loop wwws 0 [] where
508484 else loop (x:xs) 0 [] <> modifyOutForNewLine out
509485 else loop xs newWidth $ appendOut out x False
510486
511−data TextAlignment = TextAlignment_Left | TextAlignment_Right | TextAlignment_Center
487+data TextAlignment = TextAlignment_Left
488+ | TextAlignment_Right
489+ | TextAlignment_Center
512490
513491-- A map from the index (row) of display line to
514492-- fst: leading empty spaces from left (may be negative) to adjust for alignment
@@ -518,11 +496,12 @@ type OffsetMapWithAlignment = Map Int (Int, Int)
518496
519497-- | Information about the document as it is displayed (i.e., post-wrapping)
520498data DisplayLinesWithAlignment tag = DisplayLinesWithAlignment
521− { _displayLinesWithAlignment_spans :: [[Span tag]]
522− , _displayLinesWithAlignment_offsetMap :: OffsetMapWithAlignment
523− , _displayLinesWithAlignment_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
524− }
525− deriving (Show)
499+ { _displayLinesWithAlignment_spans :: [[Span tag]]
500+ , _displayLinesWithAlignment_offsetMap :: OffsetMapWithAlignment
501+ -- cursor position relative to upper left hand corner
502+ , _displayLinesWithAlignment_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
503+ }
504+ deriving (Show)
526505
527506-- | Wraps a logical line of text to fit within the given width. The first
528507-- wrapped line is offset by the number of columns provided. Subsequent wrapped
@@ -537,12 +516,12 @@ wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []
537516wrapWithOffsetAndAlignment alignment maxWidth n text = assert (n <= maxWidth) r where
538517 r' = splitWordsAtDisplayWidth maxWidth $ T.replicate n " " : wordsWithWhitespace text
539518 fmapfn (t,b) = case alignment of
540− TextAlignment_Left -> (t,b,0)
541− TextAlignment_Right -> (t,b,maxWidth-l)
519+ TextAlignment_Left -> (t,b,0)
520+ TextAlignment_Right -> (t,b,maxWidth-l)
542521 TextAlignment_Center -> (t,b,(maxWidth-l) `div` 2)
543522 where l = textWidth t
544523 r'' = case r' of
545− [] -> []
524+ [] -> []
546525 (x,b):xs -> (T.drop n x,b):xs
547526 r = fmap fmapfn r''
548527