Make Lift Text work under RebindableSyntax

src/Data/Text.hs

@@ -418,8 +418,10 @@ instance TH.Lift Text where
 #if MIN_VERSION_template_haskell(2,16,0)
   lift txt = do
     let (ptr, len) = unsafePerformIO $ asForeignPtr txt
-    let lenInt = P.fromIntegral len
-    TH.appE (TH.appE (TH.varE 'unpackCStringLen#) (TH.litE . TH.bytesPrimL $ TH.mkBytes ptr 0 lenInt)) (TH.lift lenInt)
+        bytesQ = TH.litE . TH.bytesPrimL $ TH.mkBytes ptr 0 (P.fromIntegral len)
+        lenQ = liftInt (P.fromIntegral len)
+        liftInt n = (TH.appE (TH.conE 'Exts.I#) (TH.litE (TH.IntPrimL n)))
+    TH.varE 'unpackCStringLen# `TH.appE` bytesQ `TH.appE` lenQ
 #else
   lift = TH.appE (TH.varE 'pack) . TH.stringE . unpack
 #endif

tests/Tests.hs

@@ -9,10 +9,12 @@ import Test.Tasty (defaultMain, testGroup)
 import qualified Tests.Lift as Lift
 import qualified Tests.Properties as Properties
 import qualified Tests.Regressions as Regressions
+import qualified Tests.RebindableSyntaxTest as RST
 
 main :: IO ()
 main = defaultMain $ testGroup "All"
   [ Lift.tests
   , Properties.tests
   , Regressions.tests
+  , RST.tests
   ]

tests/Tests/RebindableSyntaxTest.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE RebindableSyntax, TemplateHaskell #-}
+
+module Tests.RebindableSyntaxTest where
+
+import qualified Data.Text as Text
+import Language.Haskell.TH.Syntax (lift)
+import Test.Tasty.HUnit (testCase, assertEqual)
+import Test.Tasty (TestTree, testGroup)
+import Prelude (($))
+
+tests :: TestTree
+tests = testGroup "RebindableSyntax"
+  [ testCase "test" $ assertEqual "a" $(lift (Text.pack "a")) (Text.pack "a")
+  ]

text.cabal

@@ -251,6 +251,7 @@ test-suite tests
     Tests.Properties.Text
     Tests.Properties.Transcoding
     Tests.QuickCheckUtils
+    Tests.RebindableSyntaxTest
     Tests.Regressions
     Tests.SlowFunctions
     Tests.Utils