Merge pull request #194 from Bodigrim/master

Support text-2.0

Author: bgamari

Data/Attoparsec/Text/Buffer.hs

@@ -34,7 +34,8 @@ module Data.Attoparsec.Text.Buffer
     , iter
     , iter_
     , substring
-    , dropWord16
+    , lengthCodeUnits
+    , dropCodeUnits
     ) where
 
 import Control.Exception (assert)
@@ -44,8 +45,14 @@ import Data.Monoid as Mon (Monoid(..))
 import Data.Semigroup (Semigroup(..))
 import Data.Text ()
 import Data.Text.Internal (Text(..))
+#if MIN_VERSION_text(2,0,0)
+import Data.Text.Internal.Encoding.Utf8 (utf8LengthByLeader)
+import Data.Text.Unsafe (iterArray, lengthWord8)
+#else
 import Data.Text.Internal.Encoding.Utf16 (chr2)
 import Data.Text.Internal.Unsafe.Char (unsafeChr)
+import Data.Text.Unsafe (lengthWord16)
+#endif
 import Data.Text.Unsafe (Iter(..))
 import Foreign.Storable (sizeOf)
 import GHC.Exts (Int(..), indexIntArray#, unsafeCoerce#, writeIntArray#)
@@ -108,16 +115,25 @@ append (Buf arr0 off0 len0 cap0 gen0) !arr1 !off1 !len1 = runST $ do
       let newgen = gen + 1
       marr <- unsafeThaw arr0
       writeGen marr newgen
+#if MIN_VERSION_text(2,0,0)
+      A.copyI newlen marr (off0+len0) arr1 off1
+#else
       A.copyI marr (off0+len0) arr1 off1 (off0+newlen)
+#endif
       arr2 <- A.unsafeFreeze marr
       return (Buf arr2 off0 newlen cap0 newgen)
     else do
       let newcap = newlen * 2
           newgen = 1
       marr <- A.new (newcap + woff)
       writeGen marr newgen
+#if MIN_VERSION_text(2,0,0)
+      A.copyI len0 marr woff arr0 off0
+      A.copyI newlen marr (woff+len0) arr1 off1
+#else
       A.copyI marr woff arr0 off0 (woff+len0)
       A.copyI marr (woff+len0) arr1 off1 (woff+newlen)
+#endif
       arr2 <- A.unsafeFreeze marr
       return (Buf arr2 woff newlen newcap newgen)
 
@@ -132,11 +148,52 @@ substring s l (Buf arr off len _ _) =
   Text arr (off+s) l
 {-# INLINE substring #-}
 
-dropWord16 :: Int -> Buffer -> Text
-dropWord16 s (Buf arr off len _ _) =
+#if MIN_VERSION_text(2,0,0)
+
+lengthCodeUnits :: Text -> Int
+lengthCodeUnits = lengthWord8
+
+dropCodeUnits :: Int -> Buffer -> Text
+dropCodeUnits s (Buf arr off len _ _) =
+  assert (s >= 0 && s <= len) $
+  Text arr (off+s) (len-s)
+{-# INLINE dropCodeUnits #-}
+
+-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-8
+-- array, returning the current character and the delta to add to give
+-- the next offset to iterate at.
+iter :: Buffer -> Int -> Iter
+iter (Buf arr off _ _ _) i = iterArray arr (off + i)
+{-# INLINE iter #-}
+
+-- | /O(1)/ Iterate one step through a UTF-8 array, returning the
+-- delta to add to give the next offset to iterate at.
+iter_ :: Buffer -> Int -> Int
+iter_ (Buf arr off _ _ _) i = utf8LengthByLeader $ A.unsafeIndex arr (off+i)
+{-# INLINE iter_ #-}
+
+unsafeThaw :: A.Array -> ST s (A.MArray s)
+unsafeThaw (A.ByteArray a) = ST $ \s# ->
+                          (# s#, A.MutableByteArray (unsafeCoerce# a) #)
+
+readGen :: A.Array -> Int
+readGen (A.ByteArray a) = case indexIntArray# a 0# of r# -> I# r#
+
+writeGen :: A.MArray s -> Int -> ST s ()
+writeGen (A.MutableByteArray a) (I# gen#) = ST $ \s0# ->
+  case writeIntArray# a 0# gen# s0# of
+    s1# -> (# s1#, () #)
+
+#else
+
+lengthCodeUnits :: Text -> Int
+lengthCodeUnits = lengthWord16
+
+dropCodeUnits :: Int -> Buffer -> Text
+dropCodeUnits s (Buf arr off len _ _) =
   assert (s >= 0 && s <= len) $
   Text arr (off+s) (len-s)
-{-# INLINE dropWord16 #-}
+{-# INLINE dropCodeUnits #-}
 
 -- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16
 -- array, returning the current character and the delta to add to give
@@ -170,3 +227,5 @@ writeGen :: A.MArray s -> Int -> ST s ()
 writeGen a (I# gen#) = ST $ \s0# ->
   case writeIntArray# (A.maBA a) 0# gen# s0# of
     s1# -> (# s1#, () #)
+
+#endif

Data/Attoparsec/Text/Internal.hs

@@ -176,7 +176,7 @@ string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
          | T.null ft         -> suspended s s t pos more lose succ
          | otherwise         -> lose t pos more [] "string"
        Just (pfx,ssfx,tsfx)
-         | T.null ssfx       -> let l = Pos (T.lengthWord16 pfx)
+         | T.null ssfx       -> let l = Pos (Buf.lengthCodeUnits pfx)
                                 in succ t (pos + l) more (substring pos l t)
          | not (T.null tsfx) -> lose t pos more [] "string"
          | otherwise         -> suspended s ssfx t pos more lose succ
@@ -195,7 +195,7 @@ stringSuspended f s000 s0 t0 pos0 more0 lose0 succ0 =
       in case T.commonPrefixes s0 s of
         Nothing         -> lose t pos more [] "string"
         Just (_pfx,ssfx,tsfx)
-          | T.null ssfx -> let l = Pos (T.lengthWord16 s000)
+          | T.null ssfx -> let l = Pos (Buf.lengthCodeUnits s000)
                            in succ t (pos + l) more (substring pos l t)
           | T.null tsfx -> stringSuspended f s000 ssfx t pos more lose succ
           | otherwise   -> lose t pos more [] "string"
@@ -445,12 +445,12 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
 
 -- | Terminal failure continuation.
 failK :: Failure a
-failK t (Pos pos) _more stack msg = Fail (Buf.dropWord16 pos t) stack msg
+failK t (Pos pos) _more stack msg = Fail (Buf.dropCodeUnits pos t) stack msg
 {-# INLINE failK #-}
 
 -- | Terminal success continuation.
 successK :: Success a a
-successK t (Pos pos) _more a = Done (Buf.dropWord16 pos t) a
+successK t (Pos pos) _more a = Done (Buf.dropCodeUnits pos t) a
 {-# INLINE successK #-}
 
 -- | Run a parser.
@@ -477,7 +477,7 @@ parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
 
 get :: Parser Text
 get = T.Parser $ \t pos more _lose succ ->
-  succ t pos more (Buf.dropWord16 (fromPos pos) t)
+  succ t pos more (Buf.dropCodeUnits (fromPos pos) t)
 {-# INLINE get #-}
 
 endOfChunk :: Parser Bool

tests/QC/Buffer.hs

@@ -51,7 +51,7 @@ b_length :: BPB -> Property
 b_length (BP _ts t buf) = B.length t === BB.length buf
 
 t_length :: BPT -> Property
-t_length (BP _ts t buf) = T.lengthWord16 t === BT.length buf
+t_length (BP _ts t buf) = BT.lengthCodeUnits t === BT.length buf
 
 b_unsafeIndex :: BPB -> Gen Property
 b_unsafeIndex (BP _ts t buf) = do
@@ -61,14 +61,14 @@ b_unsafeIndex (BP _ts t buf) = do
 
 t_iter :: BPT -> Gen Property
 t_iter (BP _ts t buf) = do
-  let l = T.lengthWord16 t
+  let l = BT.lengthCodeUnits t
   i <- choose (0,l-1)
   let it (T.Iter c q) = (c,q)
   return $ l === 0 .||. it (T.iter t i) === it (BT.iter buf i)
 
 t_iter_ :: BPT -> Gen Property
 t_iter_ (BP _ts t buf) = do
-  let l = T.lengthWord16 t
+  let l = BT.lengthCodeUnits t
   i <- choose (0,l-1)
   return $ l === 0 .||. T.iter_ t i === BT.iter_ buf i
 
@@ -77,10 +77,16 @@ b_unsafeDrop (BP _ts t buf) = do
   i <- choose (0, B.length t)
   return $ B.unsafeDrop i t === BB.unsafeDrop i buf
 
-t_dropWord16 :: BPT -> Gen Property
-t_dropWord16 (BP _ts t buf) = do
-  i <- choose (0, T.lengthWord16 t)
-  return $ T.dropWord16 i t === BT.dropWord16 i buf
+t_dropCodeUnits :: BPT -> Gen Property
+t_dropCodeUnits (BP _ts t buf) = do
+  i <- choose (0, BT.lengthCodeUnits t)
+  return $ dropCodeUnits i t === BT.dropCodeUnits i buf
+  where
+#if MIN_VERSION_text(2,0,0)
+    dropCodeUnits = T.dropWord8
+#else
+    dropCodeUnits = T.dropWord16
+#endif
 
 tests :: [TestTree]
 tests = [
@@ -92,5 +98,5 @@ tests = [
   , testProperty "t_iter" t_iter
   , testProperty "t_iter_" t_iter_
   , testProperty "b_unsafeDrop" b_unsafeDrop
-  , testProperty "t_dropWord16" t_dropWord16
+  , testProperty "t_dropCodeUnits" t_dropCodeUnits
   ]