@@ -7,6 +7,7 @@ Description: A zipper for text documents that allows convenient editing and navi
77'TextZipper's can be converted into 'DisplayLines', which describe how the contents of the zipper will be displayed when wrapped to fit within a container of a certain width. It also provides some convenience facilities for converting interactions with the rendered DisplayLines back into manipulations of the underlying TextZipper.
88
99-}
10+{-# LANGUAGE BangPatterns #-}
1011{-# LANGUAGE FlexibleContexts #-}
1112{-# LANGUAGE LambdaCase #-}
1213{-# LANGUAGE OverloadedStrings #-}
@@ -21,6 +22,11 @@ import Control.Monad.State (evalState, forM, get, put)
2122
2223import Data.Text (Text)
2324import qualified Data.Text as T
25+import Data.Text.ICU.Char
26+import Data.Text.Internal (Text(..), text)
27+import Data.Text.Internal.Fusion (stream)
28+import Data.Text.Internal.Fusion.Types (Stream(..), Step(..))
29+import Data.Text.Unsafe
2430
2531-- | A zipper of the logical text input contents (the "document"). The lines
2632-- before the line containing the cursor are stored in reverse order.
@@ -154,7 +160,7 @@ deleteLeftWord (TextZipper lb b a la) =
154160-- | Insert up to n spaces to get to the next logical column that is a multiple of n
155161tab :: Int -> TextZipper -> TextZipper
156162tab n z@(TextZipper _ b _ _) =
157− insert (T.replicate (fromEnum $ n - (T.length b `mod` (max 1 n))) " ") z
163+ insert (T.replicate (fromEnum $ n - (T.length b `mod` max 1 n)) " ") z
158164
159165-- | The plain text contents of the zipper
160166value :: TextZipper -> Text
@@ -215,10 +221,13 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
215221 (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
216222 initLast $ map ((:[]) . Span tag) (wrapWithOffset width 0 b)
217223 -- Calculate the number of columns on the cursor's display line before the cursor
218− curLineOffset = spansLength spansCurLineBefore
224+ curLineOffset = spansWidth spansCurLineBefore
219225 -- Check whether the spans on the current display line are long enough that
220226 -- the cursor has to go to the next line
221227 cursorAfterEOL = curLineOffset == width
228+ cursorCharWidth = case T.uncons a of
229+ Nothing -> 1
230+ Just (c, _) -> charWidth c
222231 -- Separate the span after the cursor into
223232 -- * spans that are on the same display line, and
224233 -- * spans that are on later display lines (though on the same logical line)
@@ -226,7 +235,7 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
226235 headTail $ case T.uncons a of
227236 Nothing -> [[Span cursorTag " "]]
228237 Just (c, rest) ->
229− let o = if cursorAfterEOL then 1 else curLineOffset + 1
238+ let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
230239 cursor = Span cursorTag (T.singleton c)
231240 in case map ((:[]) . Span tag) (wrapWithOffset width o rest) of
232241 [] -> [[cursor]]
@@ -245,7 +254,7 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
245254 , _displayLines_cursorY = sum
246255 [ length spansBefore
247256 , length spansCurrentBefore
248− , if cursorAfterEOL then 1 else 0
257+ , if cursorAfterEOL then cursorCharWidth else 0
249258 ]
250259 }
251260 where
@@ -263,11 +272,56 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
263272-- | Wraps a logical line of text to fit within the given width. The first
264273-- wrapped line is offset by the number of columns provided. Subsequent wrapped
265274-- lines are not.
266−wrapWithOffset :: Int -> Int -> Text -> [Text]
275+wrapWithOffset
276+ :: Int -- ^ Maximum width
277+ -> Int -- ^ Offset for first line
278+ -> Text -- ^ Text to be wrapped
279+ -> [Text]
267280wrapWithOffset maxWidth _ _ | maxWidth <= 0 = []
268281wrapWithOffset maxWidth n xs =
269− let (firstLine, rest) = T.splitAt (maxWidth - n) xs
270− in firstLine : (fmap (T.take maxWidth) . takeWhile (not . T.null) . iterate (T.drop maxWidth) $ rest)
282+ let (firstLine, rest) = splitAtWidth (maxWidth - n) xs
283+ in firstLine : (fmap (takeWidth maxWidth) . takeWhile (not . T.null) . iterate (dropWidth maxWidth) $ rest)
284+
285+-- | Split a 'Text' at the given column index. For example
286+-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
287+-- becaues the first character has a width of two (see 'charWidth' for more on that).
288+splitAtWidth :: Int -> Text -> (Text, Text)
289+splitAtWidth n t@(Text arr off len)
290+ | n <= 0 = (T.empty, t)
291+ | n >= textWidth t = (t, T.empty)
292+ | otherwise = let k = iterNWidth n t
293+ in (text arr off k, text arr (off+k) (len-k))
294+ where
295+ iterNWidth :: Int -> Text -> Int
296+ iterNWidth n' t'@(Text _ _ len') = loop 0 0
297+ where loop !i !cnt
298+ | i >= len' || cnt + w > n' = i
299+ | otherwise = loop (i+d) (cnt + w)
300+ where Iter c d = iter t' i
301+ w = charWidth c
302+
303+-- | Takes the given number of columns of characters. For example
304+-- > takeWidth 3 "ᄀabc" == "ᄀa"
305+-- because the first character has a width of 2 (see 'charWidth' for more on that).
306+-- This function will not take a character if its width exceeds the width it seeks to take.
307+takeWidth :: Int -> Text -> Text
308+takeWidth n = fst . splitAtWidth n
309+
310+-- | Drops the given number of columns of characters. For example
311+-- > dropWidth 2 "ᄀabc" == "abc"
312+-- because the first character has a width of 2 (see 'charWidth' for more on that).
313+-- This function will not drop a character if its width exceeds the width it seeks to drop.
314+dropWidth :: Int -> Text -> Text
315+dropWidth n = snd . splitAtWidth n
316+
317+-- | Get the display width of a 'Char'. "Full width" and "wide" characters
318+-- take two columns and everything else takes a single column. See
319+-- <https://www.unicode.org/reports/tr11/> for more information.
320+charWidth :: Char -> Int
321+charWidth c = case property EastAsianWidth c of
322+ EAFull -> 2
323+ EAWide -> 2
324+ _ -> 1
271325
272326-- | For a given set of wrapped logical lines, computes a map
273327-- from display line index to text offset in the original text.
@@ -313,9 +367,29 @@ goToDisplayLinePosition x y dl tz =
313367 Just o ->
314368 let displayLineLength = case drop y $ _displayLines_spans dl of
315369 [] -> x
316− (s:_) -> spansLength s
317− in rightN (o + (min displayLineLength x)) $ top tz
370+ (s:_) -> spansWidth s
371+ in rightN (o + min displayLineLength x) $ top tz
372+
373+-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
374+spansWidth :: [Span tag] -> Int
375+spansWidth = sum . map (\(Span _ t) -> textWidth t)
318376
319−-- | Get the length of the text in a set of 'Span's
377+-- | Get the length (number of characters) of the text in a set of 'Span's
320378spansLength :: [Span tag] -> Int
321379spansLength = sum . map (\(Span _ t) -> T.length t)
380+
381+-- | Compute the width of some 'Text', taking into account fullwidth
382+-- unicode forms.
383+textWidth :: Text -> Int
384+textWidth t = widthI (stream t)
385+
386+-- | Compute the width of a stream of characters, taking into account
387+-- fullwidth unicode forms.
388+widthI :: Stream Char -> Int
389+widthI (Stream next s0 _len) = loop_length 0 s0
390+ where
391+ loop_length !z s = case next s of
392+ Done -> z
393+ Skip s' -> loop_length z s'
394+ Yield c s' -> loop_length (z + charWidth c) s'
395+{-# INLINE[0] widthI #-}