Switch Data.ByteString.Short to ByteArray

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, Julian Ospald 2022
@@ -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

Data/ByteString/Short/Internal.hs

@@ -2,9 +2,11 @@
 {-# LANGUAGE CPP                      #-}
 {-# LANGUAGE DeriveDataTypeable       #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase               #-}
 {-# LANGUAGE MagicHash                #-}
 {-# LANGUAGE MultiWayIf               #-}
+{-# LANGUAGE PatternSynonyms          #-}
 {-# LANGUAGE RankNTypes               #-}
 {-# LANGUAGE ScopedTypeVariables      #-}
 {-# LANGUAGE TemplateHaskellQuotes    #-}
@@ -14,6 +16,10 @@
 {-# LANGUAGE UnliftedFFITypes         #-}
 {-# LANGUAGE Unsafe                   #-}
 
+#if MIN_VERSION_base(4,10,0)
+{-# LANGUAGE DerivingStrategies #-}
+#endif
+
 {-# OPTIONS_GHC -fno-warn-name-shadowing -fexpose-all-unfoldings #-}
 {-# OPTIONS_HADDOCK not-home #-}
 
@@ -27,6 +33,11 @@
 #define SAFE_UNALIGNED 1
 #endif
 
+
+#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, Julian Ospald 2022
@@ -42,6 +53,9 @@ module Data.ByteString.Short.Internal (
 
     -- * The @ShortByteString@ type and representation
     ShortByteString(..),
+#if BYTEARRAY_IN_BASE
+    pattern SBS,
+#endif
 
     -- * Introducing and eliminating 'ShortByteString's
     empty,
@@ -177,16 +191,10 @@ import Data.Data
   )
 import Data.Monoid
   ( Monoid(..) )
-import Data.Semigroup
-  ( Semigroup((<>)) )
 import Data.String
   ( IsString(..) )
-import Data.Typeable
-  ( Typeable )
 import Control.Applicative
   ( pure )
-import Control.DeepSeq
-  ( NFData(..) )
 import Control.Exception
   ( assert )
 import Control.Monad
@@ -265,6 +273,15 @@ import Prelude
   , snd
   )
 
+#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 qualified Data.ByteString.Internal as BS
 
 import qualified Data.Foldable as Foldable
@@ -286,8 +303,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
@@ -316,13 +342,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
 
@@ -333,6 +362,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
@@ -343,8 +373,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�
@@ -631,12 +666,14 @@ 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 == compareByteArrays (asBA sbs1) (asBA sbs2) len1
+#endif
 
 compareBytes :: ShortByteString -> ShortByteString -> Ordering
 compareBytes sbs1 sbs2 =
@@ -650,7 +687,6 @@ compareBytes sbs1 sbs2 =
             | len2 < len1 -> GT
             | otherwise   -> EQ
 
-
 ------------------------------------------------------------------------
 -- Appending and concatenation
 
@@ -1568,8 +1604,6 @@ findIndices k = \sbs ->
             | otherwise = go (n + 1)
   in go 0
 
-
-
 ------------------------------------------------------------------------
 -- Exported low level operations