Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
51 changes: 30 additions & 21 deletions Data/ByteString/Internal/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -199,11 +199,17 @@ import GHC.Int (Int (..))
import GHC.ForeignPtr (unsafeWithForeignPtr)
#endif

import qualified Language.Haskell.TH.Lib as TH
#if defined(MIN_VERSION_template_haskell_lift)
import qualified Language.Haskell.TH.Lift as TH
import Language.Haskell.TH.Lift (Code, Quote)
#else
import qualified Language.Haskell.TH.Syntax as TH
import Language.Haskell.TH.Syntax (Lift, TExp)
#if __GLASGOW_HASKELL__ >= 900
import qualified Language.Haskell.TH.Lib as TH
#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH.Syntax (Code, Quote)
#else
import Language.Haskell.TH.Syntax (TExp)
#endif
#endif

#if !MIN_VERSION_base(4,13,0)
Expand Down Expand Up @@ -371,9 +377,14 @@ byteStringDataType :: DataType
byteStringDataType = mkDataType "Data.ByteString.ByteString" [packConstr]

-- | @since 0.11.2.0
instance Lift ByteString where
#if MIN_VERSION_template_haskell(2,16,0)
-- template-haskell-2.16 first ships with ghc-8.10
instance TH.Lift ByteString where
#if defined(MIN_VERSION_template_haskell_lift)
lift (BS ptr len) =
[| unsafePackLenLiteral
$(TH.lift len)
$(TH.liftAddrCompat ptr 0 (fromIntegral len))
|]
#elif MIN_VERSION_template_haskell(2,16,0)
lift (BS ptr len) = [| unsafePackLenLiteral |]
`TH.appE` TH.litE (TH.integerL (fromIntegral len))
`TH.appE` TH.litE (TH.BytesPrimL $ TH.Bytes ptr 0 (fromIntegral len))
Expand All @@ -383,11 +394,11 @@ instance Lift ByteString where
`TH.appE` TH.litE (TH.StringPrimL $ unpackBytes bs)
#endif

#if MIN_VERSION_template_haskell(2,17,0)
-- template-haskell-2.17 first ships with ghc-9.0
#if defined(MIN_VERSION_template_haskell_lift)
liftTyped = TH.defaultLiftTyped
#elif MIN_VERSION_template_haskell(2,17,0)
liftTyped = TH.unsafeCodeCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
-- template-haskell-2.16 first ships with ghc-8.10
liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif

Expand Down Expand Up @@ -554,22 +565,20 @@ packUptoLenChars len cs0 =
go !p (c:cs) = pokeFp p (c2w c) >> go (p `plusForeignPtr` 1) cs
in go p0 cs0

#if __GLASGOW_HASKELL__ < 900
#if !defined(MIN_VERSION_template_haskell_lift)
#if !MIN_VERSION_template_haskell(2,17,0)
type Quote m = (TH.Q ~ m)
type Code m a = m (TExp a)
#endif
#endif

liftTyped :: forall a m. (MonadFail m, Quote m, Lift a) => a -> Code m a
#if MIN_VERSION_template_haskell(2,17,0)
liftTyped :: forall a m. (MonadFail m, Quote m, TH.Lift a) => a -> Code m a
#if defined(MIN_VERSION_template_haskell_lift)
liftTyped = TH.defaultLiftTyped
#elif MIN_VERSION_template_haskell(2,17,0)
liftTyped = TH.liftTyped

liftCode :: forall a m. (MonadFail m, Quote m) => m (TExp a) -> Code m a
liftCode = TH.liftCode
#else
liftTyped = TH.unsafeTExpCoerce . TH.lift

liftCode :: forall a m. (MonadFail m, Quote m) => m TH.Exp -> Code m a
liftCode = TH.unsafeTExpCoerce
#endif

data S2W = Octets {-# UNPACK #-} !Int [Word8]
Expand Down Expand Up @@ -599,7 +608,7 @@ literalFromOctetString :: (MonadFail m, Quote m) => String -> Code m ByteString
literalFromOctetString "" = [||empty||]
literalFromOctetString s = case foldr' op (Octets 0 []) s of
Octets n ws -> liftTyped (unsafePackLenBytes n ws)
Hichar i w -> liftCode $ fail $ "non-octet character '\\" ++
Hichar i w -> error $ "non-octet character '\\" ++
show w ++ "' at offset: " ++ show i
where
op :: Char -> S2W -> S2W
Expand All @@ -624,8 +633,8 @@ literalFromHex "" = [||empty||]
literalFromHex s =
case foldr' op (Hex 0 []) s of
Hex n ws -> liftTyped (unsafePackLenBytes n ws)
Odd i _ _ -> liftCode $ fail $ "Odd input length: " ++ show (1 + 2 * i)
Bad i w -> liftCode $ fail $ "Non-hexadecimal character '\\" ++
Odd i _ _ -> error $ "Odd input length: " ++ show (1 + 2 * i)
Bad i w -> error $ "Non-hexadecimal character '\\" ++
show w ++ "' at offset: " ++ show i
where
-- Convert char to decimal digit value if result in [0, 9].
Expand Down
4 changes: 4 additions & 0 deletions Data/ByteString/Lazy/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,11 @@ import Data.Data (Data(..), mkConstr ,mkDataType, Constr, DataTyp

import GHC.Exts (IsList(..))

#if defined(MIN_VERSION_template_haskell_lift)
import qualified Language.Haskell.TH.Lift as TH
#else
import qualified Language.Haskell.TH.Syntax as TH
#endif

#ifdef HS_BYTESTRING_ASSERTIONS
import Control.Exception (assert)
Expand Down
5 changes: 5 additions & 0 deletions Data/ByteString/Short/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -250,7 +250,12 @@ import qualified Data.ByteString.Lazy.Internal as LBS

import qualified Data.List as List
import qualified GHC.Exts
#if defined(MIN_VERSION_template_haskell_lift)
import qualified Language.Haskell.TH.Lift as TH
#else
import qualified Language.Haskell.TH.Syntax as TH
#endif


-- | A compact representation of a 'Word8' vector.
--
Expand Down
16 changes: 14 additions & 2 deletions bytestring.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -109,11 +109,19 @@ common language

library
import: language
build-depends: base >= 4.12 && < 5, ghc-prim, deepseq, template-haskell
build-depends: base >= 4.12 && < 5, ghc-prim, deepseq

if impl(ghc < 9.4)
build-depends: data-array-byte >= 0.1 && < 0.2

-- template-haskell-lift was added as a boot library in GHC-9.14
Comment thread
TeofilC marked this conversation as resolved.
-- once we no longer wish to backport releases to older major releases of GHC,
-- this conditional can be dropped
if impl(ghc < 9.14)
build-depends: template-haskell
else
build-depends: template-haskell-lift >= 0.1 && <0.2

exposed-modules: Data.ByteString
Data.ByteString.Char8
Data.ByteString.Unsafe
Expand Down Expand Up @@ -224,7 +232,6 @@ test-suite bytestring-tests
QuickCheck,
tasty,
tasty-quickcheck >= 0.8.1,
template-haskell,
transformers >= 0.3,
syb

Expand All @@ -248,6 +255,11 @@ test-suite bytestring-tests
if os(openbsd)
build-depends: splitmix < 0.1.3 || > 0.1.3.1

if impl(ghc < 9.14)
build-depends: template-haskell
else
build-depends: template-haskell-lift

benchmark bytestring-bench
import: language
main-is: BenchAll.hs
Expand Down
10 changes: 7 additions & 3 deletions tests/Lift.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,11 @@ import Test.Tasty.QuickCheck (testProperty, (===))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Short as SBS
#if __GLASGOW_HASKELL__ >= 914
import qualified Language.Haskell.TH.Lift as TH
#else
import qualified Language.Haskell.TH.Syntax as TH
#endif

testSuite :: TestTree
#ifdef wasm32_HOST_ARCH
Expand All @@ -26,7 +30,7 @@ testSuite = testGroup "Lift"
let bs = "\0\1\2\3\0\1\2\3" :: BS.ByteString in
bs === $(TH.lift $ BS.pack [0,1,2,3,0,1,2,3])

#if MIN_VERSION_template_haskell(2,16,0)
#if __GLASGOW_HASKELL__ >= 810
, testProperty "typed" $
let bs = "\0\1\2\3\0\1\2\3" :: BS.ByteString in
bs === $$(TH.liftTyped $ BS.pack [0,1,2,3,0,1,2,3])
Expand All @@ -50,7 +54,7 @@ testSuite = testGroup "Lift"
let bs = "\0\1\2\3\0\1\2\3" :: LBS.ByteString in
bs === $(TH.lift $ LBS.pack [0,1,2,3,0,1,2,3])

#if MIN_VERSION_template_haskell(2,16,0)
#if __GLASGOW_HASKELL__ >= 810
, testProperty "typed" $
let bs = "\0\1\2\3\0\1\2\3" :: LBS.ByteString in
bs === $$(TH.liftTyped $ LBS.pack [0,1,2,3,0,1,2,3])
Expand All @@ -66,7 +70,7 @@ testSuite = testGroup "Lift"
let bs = "\0\1\2\3\0\1\2\3" :: SBS.ShortByteString in
bs === $(TH.lift $ SBS.pack [0,1,2,3,0,1,2,3])

#if MIN_VERSION_template_haskell(2,16,0)
#if __GLASGOW_HASKELL__ >= 810
, testProperty "typed" $
let bs = "\0\1\2\3\0\1\2\3" :: SBS.ShortByteString in
bs === $$(TH.liftTyped $ SBS.pack [0,1,2,3,0,1,2,3])
Expand Down
Loading