diff --git a/Data/Text.hs b/Data/Text.hs
index b9182a77cc5de4ee5e1cac3e7f89b786cd448af8..ce953f0e3f73dcff1e784c84555011ad5a01fbd5 100644
--- a/Data/Text.hs
+++ b/Data/Text.hs
@@ -6,6 +6,17 @@
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE TypeFamilies #-}
 #endif
+-- Using TemplateHaskell in text unconditionally is unacceptable, as
+-- it's a GHC boot library. TemplateHaskellQuotes was added in 8.0, so
+-- this would seem to be a problem. However, GHC's policy of only
+-- needing to be able to compile itself from the last few releases
+-- allows us to use full-fat TH on older versions, while using THQ for
+-- GHC versions that may be used for bootstrapping.
+#if __GLASGOW_HASKELL__ >= 800
+{-# LANGUAGE TemplateHaskellQuotes #-}
+#else
+{-# LANGUAGE TemplateHaskell #-}
+#endif
 
 -- |
 -- Module      : Data.Text
@@ -244,6 +255,8 @@ import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as Exts
 #endif
+import qualified Language.Haskell.TH.Lib as TH
+import Language.Haskell.TH.Syntax (Lift, lift)
 #if MIN_VERSION_base(4,7,0)
 import Text.Printf (PrintfArg, formatArg, formatString)
 #endif
@@ -413,6 +426,13 @@ instance Data Text where
     _ -> P.error "gunfold"
   dataTypeOf _ = textDataType
 
+-- | This instance has similar considerations to the 'Data' instance:
+-- it preserves abstraction at the cost of inefficiency.
+--
+-- @since 1.2.4.0
+instance Lift Text where
+  lift = TH.appE (TH.varE 'pack) . TH.stringE . unpack
+
 #if MIN_VERSION_base(4,7,0)
 -- | Only defined for @base-4.7.0.0@ and later
 --
diff --git a/Data/Text/Lazy.hs b/Data/Text/Lazy.hs
index 8f36f1581b83ed3a6e7296b93b29b84ed3e3e912..90eb571f837880a273e759a48bd90152f90a59bd 100644
--- a/Data/Text/Lazy.hs
+++ b/Data/Text/Lazy.hs
@@ -6,6 +6,17 @@
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE TypeFamilies #-}
 #endif
+-- Using TemplateHaskell in text unconditionally is unacceptable, as
+-- it's a GHC boot library. TemplateHaskellQuotes was added in 8.0, so
+-- this would seem to be a problem. However, GHC's policy of only
+-- needing to be able to compile itself from the last few releases
+-- allows us to use full-fat TH on older versions, while using THQ for
+-- GHC versions that may be used for bootstrapping.
+#if __GLASGOW_HASKELL__ >= 800
+{-# LANGUAGE TemplateHaskellQuotes #-}
+#else
+{-# LANGUAGE TemplateHaskell #-}
+#endif
 
 -- |
 -- Module      : Data.Text.Lazy
@@ -239,6 +250,8 @@ import qualified GHC.Base as GHC
 import qualified GHC.Exts as Exts
 #endif
 import GHC.Prim (Addr#)
+import qualified Language.Haskell.TH.Lib as TH
+import Language.Haskell.TH.Syntax (Lift, lift)
 #if MIN_VERSION_base(4,7,0)
 import Text.Printf (PrintfArg, formatArg, formatString)
 #endif
@@ -399,6 +412,13 @@ instance Data Text where
     _ -> error "Data.Text.Lazy.Text.gunfold"
   dataTypeOf _   = textDataType
 
+-- | This instance has similar considerations to the 'Data' instance:
+-- it preserves abstraction at the cost of inefficiency.
+--
+-- @since 1.2.4.0
+instance Lift Text where
+  lift = TH.appE (TH.varE 'pack) . TH.stringE . unpack
+
 #if MIN_VERSION_base(4,7,0)
 -- | Only defined for @base-4.7.0.0@ and later
 --
diff --git a/benchmarks/text-benchmarks.cabal b/benchmarks/text-benchmarks.cabal
index 073dfeee6e001febcfcaa3b2edd7c6421df9db8f..5e0624d76a4a2f2eff30873a6d0e3a52d0d88594 100644
--- a/benchmarks/text-benchmarks.cabal
+++ b/benchmarks/text-benchmarks.cabal
@@ -42,6 +42,7 @@ executable text-benchmarks
                   ghc-prim,
                   integer-gmp,
                   stringsearch,
+                  template-haskell,
                   transformers,
                   utf8-string,
                   vector
diff --git a/cabal.project b/cabal.project
index 9afa76598638d666038fd05f1ec1e147b9cc029a..50143f87b27af57b874d67f642f0a4be32b93679 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,3 +1,3 @@
 -- See http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html
-packages: ., benchmarks
+packages: ., benchmarks, th-tests
 tests: True
diff --git a/changelog.md b/changelog.md
index 4bbeaf4d7768a5a0810a5d1bc4bf48d69c00d139..1776530d8f40a58bf89122638c7770ead0e1edaf 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,7 @@
+### next
+
+* `Lift` instances `Data.Text.Text` and `Data.Text.Lazy.Text`.
+
 ### 1.2.3.1
 
 * Make `decodeUtf8With` fail explicitly for unsupported non-BMP
diff --git a/tests/text-tests.cabal b/tests/text-tests.cabal
index 4baf4223d451b91373c825480e89dbd6c9b8d55f..1292ee4f8809fa6714f3d3d97a1f95a77c57467e 100644
--- a/tests/text-tests.cabal
+++ b/tests/text-tests.cabal
@@ -146,7 +146,8 @@ library
     binary,
     deepseq,
     ghc-prim,
-    integer-gmp
+    integer-gmp,
+    template-haskell
 
   if flag(bytestring-builder)
     build-depends: bytestring         >= 0.9    && < 0.10.4,
diff --git a/text.cabal b/text.cabal
index d3048da526be2585d95bebca83ded82715cdad4f..659cf5ca5a9d05eed6d8e7ce3d1a343ad2168212 100644
--- a/text.cabal
+++ b/text.cabal
@@ -1,6 +1,6 @@
 cabal-version:  >= 1.8
 name:           text
-version:        1.2.3.1
+version:        1.2.4.0
 
 homepage:       https://github.com/haskell/text
 bug-reports:    https://github.com/haskell/text/issues
@@ -147,7 +147,8 @@ library
     base       >= 4.2 && < 5,
     binary,
     deepseq    >= 1.1.0.0,
-    ghc-prim   >= 0.2
+    ghc-prim   >= 0.2,
+    template-haskell
 
   if flag(bytestring-builder)
     build-depends: bytestring         >= 0.9    && < 0.10.4,
@@ -255,6 +256,7 @@ test-suite tests
     ghc-prim,
     quickcheck-unicode >= 1.0.1.0,
     random,
+    template-haskell,
     test-framework >= 0.4,
     test-framework-hunit >= 0.2,
     test-framework-quickcheck2 >= 0.2
diff --git a/th-tests/LICENSE b/th-tests/LICENSE
new file mode 100644
index 0000000000000000000000000000000000000000..3c92c1b9125e73e714e6bc8d7f4959dcfeb215d5
--- /dev/null
+++ b/th-tests/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2008-2009, Tom Harper
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/th-tests/tests/Lift.hs b/th-tests/tests/Lift.hs
new file mode 100644
index 0000000000000000000000000000000000000000..8c7c5879f53438d663423cdbe51f6f7930142828
--- /dev/null
+++ b/th-tests/tests/Lift.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Lift
+  ( tests
+  )
+  where
+
+import qualified Data.Text as S
+import qualified Data.Text.Lazy as L
+import Language.Haskell.TH.Syntax (lift)
+import Test.HUnit (assertBool, assertEqual, assertFailure)
+import qualified Test.Framework as F
+import qualified Test.Framework.Providers.HUnit as F
+
+tests :: F.Test
+tests = F.testGroup "TH lifting Text"
+  [ F.testCase "strict" $ assertEqual "strict"
+      $(lift ("foo" :: S.Text))
+      ("foo" :: S.Text)
+  , F.testCase "lazy" $ assertEqual "lazy"
+      $(lift ("foo" :: L.Text))
+      ("foo" :: L.Text)
+  ]
diff --git a/th-tests/tests/th-tests.hs b/th-tests/tests/th-tests.hs
new file mode 100644
index 0000000000000000000000000000000000000000..2482bcd31dd0dd4fb5d0296dbf84ad7d8d6f8ce4
--- /dev/null
+++ b/th-tests/tests/th-tests.hs
@@ -0,0 +1,12 @@
+-- | Provides a simple main function which runs all the tests
+--
+module Main
+    ( main
+    ) where
+
+import Test.Framework (defaultMain)
+
+import qualified Lift
+
+main :: IO ()
+main = defaultMain [Lift.tests]
diff --git a/th-tests/th-tests.cabal b/th-tests/th-tests.cabal
new file mode 100644
index 0000000000000000000000000000000000000000..108194510383340074c33d2a66fd858fe7c434ce
--- /dev/null
+++ b/th-tests/th-tests.cabal
@@ -0,0 +1,25 @@
+cabal-version: 2.2
+name: th-tests
+version: 0
+description:
+  Tests that use 'Text' functions during compile time.
+  .
+  These are in a separate package because of https://github.com/haskell/cabal/issues/5623
+license: BSD-2-Clause
+license-file: LICENSE
+
+test-suite th-tests
+  default-language: Haskell2010
+  type: exitcode-stdio-1.0
+  hs-source-dirs:
+    tests/
+  main-is: th-tests.hs
+  other-modules:
+    Lift
+  build-depends:
+    HUnit >= 1.2,
+    base,
+    template-haskell,
+    text,
+    test-framework >= 0.4,
+    test-framework-hunit >= 0.2