diff --git a/Data/ByteString/Short.hs b/Data/ByteString/Short.hs index fd3e55118..b1ab36142 100644 --- a/Data/ByteString/Short.hs +++ b/Data/ByteString/Short.hs @@ -1,5 +1,9 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE Trustworthy #-} +#define BYTEARRAY_IN_BASE MIN_VERSION_base(4,17,0) + -- | -- Module : Data.ByteString.Short -- Copyright : (c) Duncan Coutts 2012-2013 @@ -28,6 +32,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 index de0afcb08..89ce7b421 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -5,8 +5,16 @@ {-# 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 MIN_VERSION_base(4,17,0) + -- | -- Module : Data.ByteString.Short.Internal -- Copyright : (c) Duncan Coutts 2012-2013 @@ -22,6 +30,9 @@ module Data.ByteString.Short.Internal ( -- * The @ShortByteString@ type and representation ShortByteString(..), +#if BYTEARRAY_IN_BASE + pattern SBS, +#endif -- * Conversions toShort, @@ -45,15 +56,21 @@ module Data.ByteString.Short.Internal ( useAsCStringLen ) where +#if BYTEARRAY_IN_BASE +import Data.ByteArray +#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.Semigroup (Semigroup) 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 +124,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 +163,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 +183,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 +194,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� @@ -392,6 +427,7 @@ 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 @@ -399,6 +435,7 @@ equateBytes sbs1 sbs2 = in len1 == len2 && 0 == accursedUnutterablePerformIO (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len1) +#endif compareBytes :: ShortByteString -> ShortByteString -> Ordering compareBytes sbs1 sbs2 = @@ -413,10 +450,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 @@ -438,7 +475,7 @@ concat sbss = let !len = length src copyByteArray (asBA src) 0 dst off len copy dst (off + len) sbss - +#endif ------------------------------------------------------------------------ -- Exported low level operations