@@ -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.
@@ -163,7 +169,7 @@ deleteLeftWord (TextZipper lb b a la) =
163169-- | Insert up to n spaces to get to the next logical column that is a multiple of n
164170tab :: Int -> TextZipper -> TextZipper
165171tab n z@(TextZipper _ b _ _) =
166− insert (T.replicate (fromEnum $ n - (T.length b `mod` (max 1 n))) " ") z
172+ insert (T.replicate (fromEnum $ n - (T.length b `mod` max 1 n)) " ") z
167173
168174-- | The plain text contents of the zipper
169175value :: TextZipper -> Text
@@ -224,10 +230,13 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
224230 (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
225231 initLast $ map ((:[]) . Span tag) (wrapWithOffset width 0 b)
226232 -- Calculate the number of columns on the cursor's display line before the cursor
227− curLineOffset = spansLength spansCurLineBefore
233+ curLineOffset = spansWidth spansCurLineBefore
228234 -- Check whether the spans on the current display line are long enough that
229235 -- the cursor has to go to the next line
230236 cursorAfterEOL = curLineOffset == width
237+ cursorCharWidth = case T.uncons a of
238+ Nothing -> 1
239+ Just (c, _) -> charWidth c
231240 -- Separate the span after the cursor into
232241 -- * spans that are on the same display line, and
233242 -- * spans that are on later display lines (though on the same logical line)
@@ -235,7 +244,7 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
235244 headTail $ case T.uncons a of
236245 Nothing -> [[Span cursorTag " "]]
237246 Just (c, rest) ->
238− let o = if cursorAfterEOL then 1 else curLineOffset + 1
247+ let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
239248 cursor = Span cursorTag (T.singleton c)
240249 in case map ((:[]) . Span tag) (wrapWithOffset width o rest) of
241250 [] -> [[cursor]]
@@ -254,7 +263,7 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
254263 , _displayLines_cursorY = sum
255264 [ length spansBefore
256265 , length spansCurrentBefore
257− , if cursorAfterEOL then 1 else 0
266+ , if cursorAfterEOL then cursorCharWidth else 0
258267 ]
259268 }
260269 where
@@ -272,11 +281,62 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
272281-- | Wraps a logical line of text to fit within the given width. The first
273282-- wrapped line is offset by the number of columns provided. Subsequent wrapped
274283-- lines are not.
275−wrapWithOffset :: Int -> Int -> Text -> [Text]
284+wrapWithOffset
285+ :: Int -- ^ Maximum width
286+ -> Int -- ^ Offset for first line
287+ -> Text -- ^ Text to be wrapped
288+ -> [Text]
276289wrapWithOffset maxWidth _ _ | maxWidth <= 0 = []
277290wrapWithOffset maxWidth n xs =
278− let (firstLine, rest) = T.splitAt (maxWidth - n) xs
279− in firstLine : (fmap (T.take maxWidth) . takeWhile (not . T.null) . iterate (T.drop maxWidth) $ rest)
291+ let (firstLine, rest) = splitAtWidth (maxWidth - n) xs
292+ in firstLine : (fmap (takeWidth maxWidth) . takeWhile (not . T.null) . iterate (dropWidth maxWidth) $ rest)
293+
294+-- | Split a 'Text' at the given column index. For example
295+--
296+-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
297+--
298+-- because the first character has a width of two (see 'charWidth' for more on that).
299+splitAtWidth :: Int -> Text -> (Text, Text)
300+splitAtWidth n t@(Text arr off len)
301+ | n <= 0 = (T.empty, t)
302+ | n >= textWidth t = (t, T.empty)
303+ | otherwise = let k = iterNWidth n t
304+ in (text arr off k, text arr (off+k) (len-k))
305+ where
306+ iterNWidth :: Int -> Text -> Int
307+ iterNWidth n' t'@(Text _ _ len') = loop 0 0
308+ where loop !i !cnt
309+ | i >= len' || cnt + w > n' = i
310+ | otherwise = loop (i+d) (cnt + w)
311+ where Iter c d = iter t' i
312+ w = charWidth c
313+
314+-- | Takes the given number of columns of characters. For example
315+--
316+-- > takeWidth 3 "ᄀabc" == "ᄀa"
317+--
318+-- because the first character has a width of 2 (see 'charWidth' for more on that).
319+-- This function will not take a character if its width exceeds the width it seeks to take.
320+takeWidth :: Int -> Text -> Text
321+takeWidth n = fst . splitAtWidth n
322+
323+-- | Drops the given number of columns of characters. For example
324+--
325+-- > dropWidth 2 "ᄀabc" == "abc"
326+--
327+-- because the first character has a width of 2 (see 'charWidth' for more on that).
328+-- This function will not drop a character if its width exceeds the width it seeks to drop.
329+dropWidth :: Int -> Text -> Text
330+dropWidth n = snd . splitAtWidth n
331+
332+-- | Get the display width of a 'Char'. "Full width" and "wide" characters
333+-- take two columns and everything else takes a single column. See
334+-- <https://www.unicode.org/reports/tr11/> for more information.
335+charWidth :: Char -> Int
336+charWidth c = case property EastAsianWidth c of
337+ EAFull -> 2
338+ EAWide -> 2
339+ _ -> 1
280340
281341-- | For a given set of wrapped logical lines, computes a map
282342-- from display line index to text offset in the original text.
@@ -322,9 +382,29 @@ goToDisplayLinePosition x y dl tz =
322382 Just o ->
323383 let displayLineLength = case drop y $ _displayLines_spans dl of
324384 [] -> x
325− (s:_) -> spansLength s
326− in rightN (o + (min displayLineLength x)) $ top tz
385+ (s:_) -> spansWidth s
386+ in rightN (o + min displayLineLength x) $ top tz
327387
328−-- | Get the length of the text in a set of 'Span's
388+-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
389+spansWidth :: [Span tag] -> Int
390+spansWidth = sum . map (\(Span _ t) -> textWidth t)
391+
392+-- | Get the length (number of characters) of the text in a set of 'Span's
329393spansLength :: [Span tag] -> Int
330394spansLength = sum . map (\(Span _ t) -> T.length t)
395+
396+-- | Compute the width of some 'Text', taking into account fullwidth
397+-- unicode forms.
398+textWidth :: Text -> Int
399+textWidth t = widthI (stream t)
400+
401+-- | Compute the width of a stream of characters, taking into account
402+-- fullwidth unicode forms.
403+widthI :: Stream Char -> Int
404+widthI (Stream next s0 _len) = loop_length 0 s0
405+ where
406+ loop_length !z s = case next s of
407+ Done -> z
408+ Skip s' -> loop_length z s'
409+ Yield c s' -> loop_length (z + charWidth c) s'
410+{-# INLINE[0] widthI #-}