Switch Data.ByteString.Short to ByteArray

haskell · Nov 24, 2021 · 7aba6b4 · 7aba6b4
1 parent e682cf7
commit 7aba6b4
Show file tree

Hide file tree

Showing 2 changed files with 54 additions and 6 deletions.
diff --git a/Data/ByteString/Short.hs b/Data/ByteString/Short.hs
@@ -1,5 +1,11 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE Trustworthy #-}
 
+#define BYTEARRAY_IN_BASE (__GLASGOW_HASKELL__ >= 903)
+-- At the moment of writing GHC source tree has not yet bumped `base` version,
+-- so using __GLASGOW_HASKELL__ as a proxy instead of MIN_VERSION_base(4,17,0).
+
 -- |
 -- Module      : Data.ByteString.Short
 -- Copyright   : (c) Duncan Coutts 2012-2013
@@ -28,6 +34,9 @@ module Data.ByteString.Short (
     -- * The @ShortByteString@ type
 
     ShortByteString(..),
+#if BYTEARRAY_IN_BASE
+    pattern SBS,
+#endif
 
     -- ** Memory overhead
     -- | With GHC, the memory overheads are as follows, expressed in words and

diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs
@@ -5,8 +5,18 @@
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# LANGUAGE Unsafe #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+#if MIN_VERSION_base(4,10,0)
+{-# LANGUAGE DerivingStrategies #-}
+#endif
+
 {-# OPTIONS_HADDOCK not-home #-}
 
+#define BYTEARRAY_IN_BASE (__GLASGOW_HASKELL__ >= 903)
+-- At the moment of writing GHC source tree has not yet bumped `base` version,
+-- so using __GLASGOW_HASKELL__ as a proxy instead of MIN_VERSION_base(4,17,0).
+
 -- |
 -- Module      : Data.ByteString.Short.Internal
 -- Copyright   : (c) Duncan Coutts 2012-2013
@@ -22,6 +32,9 @@ module Data.ByteString.Short.Internal (
 
     -- * The @ShortByteString@ type and representation
     ShortByteString(..),
+#if BYTEARRAY_IN_BASE
+    pattern SBS,
+#endif
 
     -- * Conversions
     toShort,
@@ -45,15 +58,21 @@ module Data.ByteString.Short.Internal (
     useAsCStringLen
   ) where
 
+#if BYTEARRAY_IN_BASE
+import Data.Array.Byte
+import Data.Semigroup   (Semigroup)
+#else
+import Data.Typeable    (Typeable)
+import Data.Semigroup   (Semigroup((<>)))
+import Control.DeepSeq  (NFData(..))
+#endif
+
 import Data.ByteString.Internal (ByteString(..), accursedUnutterablePerformIO)
 import qualified Data.ByteString.Internal as BS
 
-import Data.Typeable    (Typeable)
 import Data.Data        (Data(..), mkNoRepType)
-import Data.Semigroup   (Semigroup((<>)))
 import Data.Monoid      (Monoid(..))
 import Data.String      (IsString(..))
-import Control.DeepSeq  (NFData(..))
 import qualified Data.List as List (length)
 import Foreign.C.String (CString, CStringLen)
 import Foreign.C.Types  (CSize(..), CInt(..))
@@ -107,8 +126,17 @@ import qualified Language.Haskell.TH.Syntax as TH
 -- The 'ByteString' type is usually more suitable for use in interfaces; it is
 -- more flexible and it supports a wide range of operations.
 --
+#if BYTEARRAY_IN_BASE
+newtype ShortByteString = ShortByteString { unShortByteString :: ByteArray }
+  deriving newtype (Eq, Semigroup, Monoid)
+
+pattern SBS :: ByteArray# -> ShortByteString
+pattern SBS x = ShortByteString (ByteArray x)
+{-# COMPLETE SBS #-}
+#else
 data ShortByteString = SBS ByteArray#
     deriving Typeable
+#endif
 
 -- | @since 0.11.2.0
 instance TH.Lift ShortByteString where
@@ -137,13 +165,16 @@ instance TH.Lift ShortByteString where
 -- the 0--3 trailing bytes undefined. This means we can use word-sized writes,
 -- but we have to be careful with reads, see equateBytes and compareBytes below.
 
-
+#if !BYTEARRAY_IN_BASE
 instance Eq ShortByteString where
     (==)    = equateBytes
+#endif
 
+-- | Lexicographic order.
 instance Ord ShortByteString where
     compare = compareBytes
 
+#if !BYTEARRAY_IN_BASE
 instance Semigroup ShortByteString where
     (<>)    = append
 
@@ -154,6 +185,7 @@ instance Monoid ShortByteString where
 
 instance NFData ShortByteString where
     rnf SBS{} = ()
+#endif
 
 instance Show ShortByteString where
     showsPrec p ps r = showsPrec p (unpackChars ps) r
@@ -164,8 +196,13 @@ instance Read ShortByteString where
 -- | @since 0.10.12.0
 instance GHC.Exts.IsList ShortByteString where
   type Item ShortByteString = Word8
+#if BYTEARRAY_IN_BASE
+  fromList = ShortByteString . GHC.Exts.fromList
+  toList   = GHC.Exts.toList . unShortByteString
+#else
   fromList = packBytes
   toList   = unpackBytes
+#endif
 
 -- | Beware: 'fromString' truncates multi-byte characters to octets.
 -- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n�
@@ -393,13 +430,15 @@ unpackAppendBytesStrict !sbs off len = go (off-1) (off-1 + len)
 ------------------------------------------------------------------------
 -- Eq and Ord implementations
 
+#if !BYTEARRAY_IN_BASE
 equateBytes :: ShortByteString -> ShortByteString -> Bool
 equateBytes sbs1 sbs2 =
     let !len1 = length sbs1
         !len2 = length sbs2
      in len1 == len2
      && 0 == accursedUnutterablePerformIO
                (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len1)
+#endif
 
 compareBytes :: ShortByteString -> ShortByteString -> Ordering
 compareBytes sbs1 sbs2 =
@@ -414,10 +453,10 @@ compareBytes sbs1 sbs2 =
             | len2 < len1 -> GT
             | otherwise   -> EQ
 
-
 ------------------------------------------------------------------------
 -- Appending and concatenation
 
+#if !BYTEARRAY_IN_BASE
 append :: ShortByteString -> ShortByteString -> ShortByteString
 append src1 src2 =
   let !len1 = length src1
@@ -439,7 +478,7 @@ concat sbss =
       let !len = length src
       copyByteArray (asBA src) 0 dst off len
       copy dst (off + len) sbss
-
+#endif
 
 ------------------------------------------------------------------------
 -- Exported low level operations