Skip to content
Open
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
45 changes: 28 additions & 17 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 __GLASGOW_HASKELL__ >= 914
Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this is a roundabout way to express the idea. Could we use #ifdef MIN_VERSION_template_haskell_lift instead? And then it's up to bytestring.cabal whether template-haskell-lift is available in a given build configuration.

Similar below, and I'd prefer #if MIN_VERSION_template_haskell(2,16,0) || defined(MIN_VERSION_template_haskell_lift) to __GLASGOW_HASKELL__ >= 810.

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)
import qualified Language.Haskell.TH.Lib as TH
#if __GLASGOW_HASKELL__ >= 900
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,8 +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)
instance TH.Lift ByteString where
#if __GLASGOW_HASKELL__ >= 914
lift (BS ptr len) =
[| unsafePackLenLiteral
$(TH.lift len)
$(TH.liftAddrCompat ptr 0 (fromIntegral len))
|]
#elif __GLASGOW_HASKELL__ >= 810
-- template-haskell-2.16 first ships with ghc-8.10
lift (BS ptr len) = [| unsafePackLenLiteral |]
`TH.appE` TH.litE (TH.integerL (fromIntegral len))
Expand All @@ -383,10 +395,13 @@ instance Lift ByteString where
`TH.appE` TH.litE (TH.StringPrimL $ unpackBytes bs)
#endif

#if MIN_VERSION_template_haskell(2,17,0)
#if __GLASGOW_HASKELL__ >= 914
-- template-haskell-lift-0.1 first ships with ghc-9.14
liftTyped = TH.defaultLiftTyped
#elif __GLASGOW_HASKELL__ >= 900
-- template-haskell-2.17 first ships with ghc-9.0
liftTyped = TH.unsafeCodeCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
#elif __GLASGOW_HASKELL__ >= 810
-- template-haskell-2.16 first ships with ghc-8.10
liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif
Expand Down Expand Up @@ -559,17 +574,13 @@ type Quote m = (TH.Q ~ m)
type Code m a = m (TExp a)
#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 __GLASGOW_HASKELL__ >= 914
liftTyped = TH.defaultLiftTyped
#elif __GLASGOW_HASKELL__ >= 900
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 +610,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 +635,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 __GLASGOW_HASKELL__ >= 914
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 __GLASGOW_HASKELL__ >= 914
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