fixup! fixup! fixup! Implemented TH splices for validated ByteString literals

tweak TH type signatures

Author: hs-viktor

Data/ByteString/Internal/Type.hs

@@ -3,6 +3,7 @@
 
 {-# OPTIONS_HADDOCK not-home #-}
 
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UnliftedFFITypes #-}
@@ -199,6 +200,14 @@ import GHC.ForeignPtr           (unsafeWithForeignPtr)
 
 import qualified Language.Haskell.TH.Lib as TH
 import qualified Language.Haskell.TH.Syntax as TH
+import Language.Haskell.TH.Syntax (Lift, TExp)
+#if __GLASGOW_HASKELL__ >= 900
+import Language.Haskell.TH.Syntax (Code, Quote)
+#endif
+
+#if !MIN_VERSION_base(4,13,0)
+import Control.Monad.Fail (MonadFail)
+#endif
 
 #if !HS_unsafeWithForeignPtr_AVAILABLE
 unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
@@ -361,7 +370,7 @@ byteStringDataType :: DataType
 byteStringDataType = mkDataType "Data.ByteString.ByteString" [packConstr]
 
 -- | @since 0.11.2.0
-instance TH.Lift ByteString where
+instance Lift ByteString where
 #if MIN_VERSION_template_haskell(2,16,0)
 -- template-haskell-2.16 first ships with ghc-8.10
   lift (BS ptr len) = [| unsafePackLenLiteral |]
@@ -532,21 +541,21 @@ packUptoLenChars len cs0 =
           go !p (c:cs)          = pokeFp p (c2w c) >> go (p `plusForeignPtr` 1) cs
       in go p0 cs0
 
-#if MIN_VERSION_template_haskell(2,17,0)
-type THLift a = forall m. (MonadFail m, TH.Quote m) => TH.Code m a
+#if __GLASGOW_HASKELL__ < 900
+type Quote m = (TH.Q ~ m)
+type Code m a = m (TExp a)
+#endif
 
-liftTyped :: forall a m. (MonadFail m, TH.Quote m, TH.Lift a) => a -> TH.Code m a
+liftTyped :: forall a m. (MonadFail m, Quote m, Lift a) => a -> Code m a
+#if MIN_VERSION_template_haskell(2,17,0)
 liftTyped = TH.liftTyped
 
-liftCode :: forall a m. (MonadFail m, TH.Quote m) => m (TH.TExp a) -> TH.Code m a
+liftCode :: forall a m. (MonadFail m, Quote m) => m (TExp a) -> Code m a
 liftCode = TH.liftCode
 #else
-type THLift a = TH.Q (TH.TExp a)
-
-liftTyped :: forall a. TH.Lift a => a -> TH.Q (TH.TExp a)
 liftTyped = TH.unsafeTExpCoerce . TH.lift
 
-liftCode :: forall a. TH.Q TH.Exp -> TH.Q (TH.TExp a)
+liftCode :: forall a m. (MonadFail m, Quote m) => m TH.Exp -> Code m a
 liftCode = TH.unsafeTExpCoerce
 #endif
 
@@ -573,7 +582,7 @@ data H2W = Hex {-# UNPACK #-} !Int [Word8]
 -- > ehloCmd :: ByteString
 -- > ehloCmd = $$(literalFromChar8 "EHLO")
 --
-literalFromChar8 :: String -> THLift ByteString
+literalFromChar8 :: (MonadFail m, Quote m) => String -> Code m ByteString
 literalFromChar8 "" = [||empty||]
 literalFromChar8 s = case foldr' op (Octets 0 []) s of
     Octets n ws -> liftTyped (unsafePackLenBytes n ws)
@@ -597,7 +606,7 @@ literalFromChar8 s = case foldr' op (Octets 0 []) s of
 -- > ehloCmd :: ByteString
 -- > ehloCmd = $$(literalFromHex "45484c4F")
 --
-literalFromHex :: String -> THLift ByteString
+literalFromHex :: (MonadFail m, Quote m) => String -> Code m ByteString
 literalFromHex "" = [||empty||]
 literalFromHex s =
     case foldr' op (Hex 0 []) s of