From c03c9c477e07614aaf52a79c794a7543e8fb7ad4 Mon Sep 17 00:00:00 2001 From: Teo Camarasu Date: Sun, 12 Oct 2025 12:05:47 +0100 Subject: [PATCH] Use template-haskell-lift for GHC>=9.14 This new boot library should be more stable than template-haskell and should eventually allow us to remove much of the CPP around TH. It will also make it easier for end-users to reinstall template-haskell as it will no longer be used by any boot libraries --- Data/ByteString/Internal/Type.hs | 51 ++++++++++++++++++------------- Data/ByteString/Lazy/Internal.hs | 4 +++ Data/ByteString/Short/Internal.hs | 5 +++ bytestring.cabal | 16 ++++++++-- tests/Lift.hs | 10 ++++-- 5 files changed, 60 insertions(+), 26 deletions(-) diff --git a/Data/ByteString/Internal/Type.hs b/Data/ByteString/Internal/Type.hs index 10a7a59e..0a47714e 100644 --- a/Data/ByteString/Internal/Type.hs +++ b/Data/ByteString/Internal/Type.hs @@ -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) @@ -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)) @@ -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 @@ -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] @@ -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 @@ -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]. diff --git a/Data/ByteString/Lazy/Internal.hs b/Data/ByteString/Lazy/Internal.hs index b8f42551..a2859dc5 100644 --- a/Data/ByteString/Lazy/Internal.hs +++ b/Data/ByteString/Lazy/Internal.hs @@ -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) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 7fe8b267..07c940b4 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -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. -- diff --git a/bytestring.cabal b/bytestring.cabal index 09879788..c5aa90af 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -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 + -- 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 @@ -224,7 +232,6 @@ test-suite bytestring-tests QuickCheck, tasty, tasty-quickcheck >= 0.8.1, - template-haskell, transformers >= 0.3, syb @@ -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 diff --git a/tests/Lift.hs b/tests/Lift.hs index bd262d57..fe989db4 100644 --- a/tests/Lift.hs +++ b/tests/Lift.hs @@ -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 @@ -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]) @@ -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]) @@ -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])