rope-utf16-splay 0.3.2.0 → 0.4.0.0

raw patch · 7 files changed

+121/−67 lines, 7 filesdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• LICENSE +2/−2
• rope-utf16-splay.cabal +3/−3
• src/Data/Rope/UTF16/Internal.hs +32/−30
• src/Data/Rope/UTF16/Internal/Position.hs +4/−4
• src/Data/Rope/UTF16/Internal/Text.hs +54/−18
• tests/Main.hs +22/−10

@@ -1,3 +1,7 @@+# 0.4.0.0++- Support `text-2.0` and up without backward compatibility+ # 0.3.2.0  - Add `codeUnitsRowColumn` function

@@ -1,4 +1,4 @@-Copyright Olle Fredriksson (c) 2018+Copyright Olle Fredriksson (c) 2018-2022  All rights reserved. @@ -13,7 +13,7 @@       disclaimer in the documentation and/or other materials provided       with the distribution. -    * Neither the name of Author name here nor the names of other+    * Neither the name of Olle Fredriksson nor the names of other       contributors may be used to endorse or promote products derived       from this software without specific prior written permission. 

@@ -1,5 +1,5 @@ name:                rope-utf16-splay-version:             0.3.2.0+version:             0.4.0.0 synopsis:            Ropes optimised for updating using UTF-16 code units and                      row/column pairs. description:         Ropes optimised for updating using UTF-16 code units and@@ -11,7 +11,7 @@ license-file:        LICENSE author:              Olle Fredriksson maintainer:          fredriksson.olle@gmail.com-copyright:           (c) 2018 Olle Fredriksson+copyright:           (c) 2018-2022 Olle Fredriksson category:            Data, Text, Language build-type:          Simple extra-source-files:@@ -34,7 +34,7 @@                        Data.SplayTree   build-depends:                        base >= 4.9 && < 5,-                       text >= 1.0+                       text >= 2.0   default-language:    Haskell2010   ghc-options:         -Wall                        -funbox-strict-fields

@@ -27,14 +27,13 @@   Chunk t1 m1 <> Chunk t2 m2 = Chunk (t1 <> t2) (m1 <> m2)  chunk :: Text -> Chunk-chunk t = Chunk t $ Position len $ go 0 $ RowColumn 0 0+chunk t =+  Chunk t+  $ Position (lengthWord16 t)+  $ Text.foldl' go (RowColumn 0 0) t   where-    len = Unsafe.lengthWord16 t-    go i !v-      | i >= len = v-      | otherwise = case Unsafe.iter t i of-        Unsafe.Iter '\n' delta -> go (i + delta) (v <> RowColumn 1 0)-        Unsafe.Iter _ delta -> go (i + delta) (v <> RowColumn 0 delta)+    go rc '\n' = rc <> RowColumn 1 0+    go rc c = rc <> RowColumn 0 (utf16Length c)  instance SplayTree.Measured Position Chunk where   measure (Chunk _ m) = m@@ -45,7 +44,7 @@ newtype Rope = Rope { unrope :: SplayTree Position Chunk }   deriving (SplayTree.Measured Position, Show) --- | The maximum length, in code units, of a chunk+-- | The maximum length, in UTF-8 code units, of a chunk chunkLength :: Int chunkLength = 1000 @@ -56,7 +55,7 @@     (Nothing, _) -> Rope r2     (_, Nothing) -> Rope r1     (Just (r1', a), Just (b, r2'))-      | codeUnits (SplayTree.measure a) + codeUnits (SplayTree.measure b) <= chunkLength+      | Unsafe.lengthWord8 (chunkText a) + Unsafe.lengthWord8 (chunkText b) <= chunkLength         -> Rope $ r1' <> ((a <> b) SplayTree.<| r2')       | otherwise         -> Rope $ r1' <> (a SplayTree.<| b SplayTree.<| r2')@@ -66,10 +65,10 @@   mappend = (<>)  instance Eq Rope where-  (==) = (==) `on` toText+  (==) = (==) `on` toLazyText  instance Ord Rope where-  compare = compare `on` toText+  compare = compare `on` toLazyText  instance IsString Rope where   fromString = fromText . Text.pack@@ -84,7 +83,7 @@ null :: Rope -> Bool null (Rope r) = SplayTree.null r --- | Length in code units (not characters)+-- | Length in UTF-16 code units (not characters) length :: Rope -> Int length = codeUnits . SplayTree.measure @@ -94,7 +93,7 @@ rows :: Rope -> Int rows (Rope r) = row $ rowColumn $ SplayTree.measure r --- | The number of code units (not characters) since the last newline or the+-- | The number of UTF-16 code units (not characters) since the last newline or the -- start of the rope -- -- @since 0.3.0.0@@ -115,7 +114,7 @@   | Text.null t = mempty   | otherwise = Rope $ go numChunks chunks   where-    chunks = chunks16Of chunkLength t+    chunks = chunks8Of chunkLength t     numChunks = Prelude.length chunks     go !_ [] = mempty     go len cs = SplayTree.fork (go mid pre) (chunk c) (go (len - mid - 1) post)@@ -168,26 +167,28 @@ ------------------------------------------------------------------------------- -- * UTF-16 code unit indexing --- | Split the rope at the nth code unit (not character)+-- | Split the rope at the nth UTF-16 code unit (not character) splitAt :: Int -> Rope -> (Rope, Rope) splitAt n (Rope r) = case SplayTree.split ((> n) . codeUnits) r of   SplayTree.Outside     | n < 0 -> (mempty, Rope r)     | otherwise -> (Rope r, mempty)-  SplayTree.Inside pre (Chunk t _) post -> (Rope pre <> fromShortText pret, fromShortText postt <> Rope post)+  SplayTree.Inside pre (Chunk t m) post -> (Rope pre <> fromShortText pret, fromShortText postt <> Rope post)     where       n' = n - codeUnits (SplayTree.measure pre)-      (pret, postt) = split16At n' t+      (pret, postt) | codeUnits m == Unsafe.lengthWord8 t = split8At n' t+                    | otherwise = split16At n' t --- | Take the first n code units (not characters)+-- | Take the first n UTF-16 code units (not characters) take :: Int -> Rope -> Rope take n = fst . Data.Rope.UTF16.Internal.splitAt n --- | Drop the first n code units (not characters)+-- | Drop the first n UTF-16 code units (not characters) drop :: Int -> Rope -> Rope drop n = snd . Data.Rope.UTF16.Internal.splitAt n --- | Get the code unit index in the rope that corresponds to a 'RowColumn' position+-- | Get the UTF-16 code unit index in the rope that corresponds to a+-- 'RowColumn' position -- -- @since 0.2.0.0 rowColumnCodeUnits :: RowColumn -> Rope -> Int@@ -195,19 +196,20 @@   SplayTree.Outside     | v <= RowColumn 0 0 -> 0     | otherwise -> codeUnits $ SplayTree.measure r-  SplayTree.Inside pre (Chunk t _) _ -> go 0 $ rowColumn prePos+  SplayTree.Inside pre (Chunk t _) _ -> go 0 0 $ rowColumn prePos     where       prePos = SplayTree.measure pre-      len = Unsafe.lengthWord16 t-      go i !v'-        | v <= v' || i >= len = codeUnits prePos + i-        | otherwise = case Unsafe.iter t i of-          Unsafe.Iter '\n' delta -> go (i + delta) (v' <> RowColumn 1 0)-          Unsafe.Iter _ 2 | v == v' <> RowColumn 0 1 -> codeUnits prePos + i-          Unsafe.Iter _ delta -> go (i + delta) (v' <> RowColumn 0 delta)+      length8 = Unsafe.lengthWord8 t+      go !i8 !i16 !v'+        | v <= v' || i8 >= length8 = codeUnits prePos + i16+        | otherwise = case Unsafe.iter t i8 of+          Unsafe.Iter '\n' delta8 -> go (i8 + delta8) (i16 + utf16Length '\n') (v' <> RowColumn 1 0)+          Unsafe.Iter c delta8 -> go (i8 + delta8) (i16 + delta16) (v' <> RowColumn 0 delta16)+            where+              delta16 = utf16Length c --- | Get the 'RowColumn' position that corresponds to a code unit--- index in the rope+-- | Get the 'RowColumn' position that corresponds to a UTF-16 code unit index+-- in the rope -- -- @since 0.3.2.0 codeUnitsRowColumn :: Int -> Rope -> RowColumn

@@ -4,7 +4,7 @@  data RowColumn = RowColumn   { row :: !Int -- ^ Number of newlines before this position-  , column :: !Int -- ^ Number of code units since last newline or start of string+  , column :: !Int -- ^ Number of UTF-16 code units since last newline or start of string   } deriving (Eq, Ord, Show)  instance Semigroup RowColumn where@@ -18,13 +18,13 @@   mappend = (<>)  data Position = Position-  { codeUnits :: !Int+  { codeUnits :: !Int -- ^ UTF-16 code units   , rowColumn :: !RowColumn   } deriving (Eq, Ord, Show)  instance Semigroup Position where-  Position cp1 v1 <> Position cp2 v2-    = Position (cp1 + cp2) (v1 <> v2)+  Position cu rc <> Position cu' rc'+    = Position (cu + cu') (rc <> rc')  instance Monoid Position where   mempty = Position 0 mempty

@@ -1,38 +1,74 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE NumericUnderscores #-} -- | Helpers for working with 'Text' in UTF-16 code units module Data.Rope.UTF16.Internal.Text where  import Data.Text(Text) import qualified Data.Text.Array as Array+import Data.Bits import qualified Data.Text.Internal as Text import qualified Data.Text.Unsafe as Unsafe+import qualified Data.Text as Text+import Data.Char -clamp16 :: Int -> Text -> Int-clamp16 i t@(Text.Text arr off _len)-  | i <= 0 = 0-  | i >= len = len-  | isLowSurrogate = i - 1-  | otherwise = i+lengthWord16 :: Text -> Int+lengthWord16 = Text.foldl' (\n c -> n + utf16Length c) 0++utf16Length :: Char -> Int+utf16Length c+  | ord c < 0x10000 = 1+  | otherwise = 2++index8To16 :: Int -> Text -> Int+index8To16 index8 t = go 0 0   where-    cp = Array.unsafeIndex arr (off + i)-    isLowSurrogate = 0xDC00 <= cp && cp <= 0xDFFF-    len = Unsafe.lengthWord16 t+    index8' = min (Unsafe.lengthWord8 t) index8+    go !i8 !i16+      | i8 >= index8' = i16+      | otherwise = do+        let Unsafe.Iter c delta = Unsafe.iter t i8+        go (i8 + delta) (i16 + utf16Length c) +index16To8 :: Int -> Text -> Int+index16To8 index16 t = go 0 0+  where+    length8 = Unsafe.lengthWord8 t+    go !i8 !i16+      | i8 >= length8 = i8+      | i16 >= index16 = i8+      | otherwise = do+        let Unsafe.Iter c delta = Unsafe.iter t i8+        go (i8 + delta) (i16 + utf16Length c)+ take16 :: Int -> Text -> Text-take16 n t = Unsafe.takeWord16 (clamp16 n t) t+take16 i16 t = Unsafe.takeWord8 (index16To8 i16 t) t  drop16 :: Int -> Text -> Text-drop16 n t = Unsafe.dropWord16 (clamp16 n t) t+drop16 i16 t = Unsafe.dropWord8 (index16To8 i16 t) t  split16At :: Int -> Text -> (Text, Text)-split16At n t = (Unsafe.takeWord16 n' t, Unsafe.dropWord16 n' t)+split16At i16 t = split8At (index16To8 i16 t) t++split8At :: Int -> Text -> (Text, Text)+split8At i8 t = (Unsafe.takeWord8 i8 t, Unsafe.dropWord8 i8 t)++clamp8 :: Int -> Text -> Int+clamp8 i t@(Text.Text arr off _len)+  | i <= 0 = 0+  | i >= len = len+  | isFirstCodeUnit = i+  | otherwise = clamp8 (i - 1) t   where-    n' = clamp16 n t+    cu = Array.unsafeIndex arr (off + i)+    len = Unsafe.lengthWord8 t+    isFirstCodeUnit = cu .&. 0b1100_0000 /= 0b1000_0000 -chunks16Of :: Int -> Text -> [Text]-chunks16Of n t+chunks8Of :: Int -> Text -> [Text]+chunks8Of n t   | len == 0 = []   | len <= n = [t]-  | otherwise = pre : chunks16Of n post+  | otherwise = pre : chunks8Of n post   where-    (pre, post) = split16At n t-    len = Unsafe.lengthWord16 t+    (pre, post) = split8At (clamp8 n t) t+    len = Unsafe.lengthWord8 t

@@ -4,7 +4,6 @@ import Data.Semigroup import Data.Text (Text) import qualified Data.Text as Text-import qualified Data.Text.Unsafe as Unsafe import Test.QuickCheck.Function as QC import Test.Tasty import Test.Tasty.QuickCheck@@ -14,7 +13,17 @@  main :: IO () main = defaultMain $ testGroup "Tests"-  [ testProperty "toText . fromText = id" $ \s -> do+  [ testProperty "Eq matches Text" $ \s1 s2 -> do+    let t1  = Text.pack s1+        t2  = Text.pack s2+    (Rope.fromText t1 == Rope.fromText t2) == (t1 == t2)++  , testProperty "Ord matches Text" $ \s1 s2 -> do+    let t1  = Text.pack s1+        t2  = Text.pack s2+    (Rope.fromText t1 `compare` Rope.fromText t2) == (t1 `compare` t2)++  , testProperty "toText . fromText = id" $ \s -> do     let t = Text.pack s     Rope.toText (Rope.fromText t) == t @@ -25,7 +34,7 @@    , testProperty "length is UTF-16 code units" $ \s -> do     let t = Text.pack s-    Rope.length (Rope.fromText t) == Unsafe.lengthWord16 t+    Rope.length (Rope.fromText t) == Rope.lengthWord16 t    , testProperty "splitAt matches Text" $ \s i -> do     let t = Text.pack s@@ -40,13 +49,16 @@     let t = Text.pack s     Rope.toText (Rope.drop i $ Rope.fromText t) == Rope.drop16 i t -  , testProperty "rowColumnCodeUnits first line" $ \s i -> do+  , testProperty "rowColumnCodeUnits first line" $ \s i8 -> do     let t = Text.pack $ takeWhile (/= '\n') s-    Rope.clamp16 i t == Rope.rowColumnCodeUnits (Rope.RowColumn 0 i) (Rope.fromText t)+        i16 = Rope.index8To16 i8 t+    i16 == Rope.rowColumnCodeUnits (Rope.RowColumn 0 i16) (Rope.fromText t) -  , testProperty "rowColumnCodeUnits subsequent lines" $ \s (NonNegative newlines) (NonNegative i) -> do-    let t = Text.pack $ replicate newlines '\n' ++ takeWhile (/= '\n') s-    Rope.clamp16 (newlines + i) t == Rope.rowColumnCodeUnits (Rope.RowColumn newlines i) (Rope.fromText t)+  , testProperty "rowColumnCodeUnits subsequent lines" $ \s (NonNegative newlines) (NonNegative i8) -> do+    let t = Text.pack $ takeWhile (/= '\n') s+        newlinest = Text.replicate newlines "\n" <> t+        i16 = Rope.index8To16 i8 t+    newlines + i16 == Rope.rowColumnCodeUnits (Rope.RowColumn newlines i16) (Rope.fromText newlinest)    , testProperty "codeUnitsRowColumn" $ \s i -> do     let t = Text.pack s@@ -92,7 +104,7 @@   , testProperty "columns is number of code units of last line" $ \s -> do     let t = Text.pack s         lastLine = Text.takeWhileEnd (/= '\n') t-        cols = Unsafe.lengthWord16 lastLine+        cols = Rope.lengthWord16 lastLine     Rope.columns (Rope.fromText t) == cols    , testProperty "foldl matches Text" $ \s p a -> do@@ -146,4 +158,4 @@       []   -> Rope.RowColumn 0 0       [""] -> Rope.RowColumn 0 0       _ -> do-        Rope.RowColumn (length (init ts)) (Unsafe.lengthWord16 (last ts))+        Rope.RowColumn (length (init ts)) (Rope.lengthWord16 (last ts))