From d947bae19e1cc3a1a2701a2b37e32f4291de0e2f Mon Sep 17 00:00:00 2001
From: quasicomputational <quasicomputational@gmail.com>
Date: Thu, 30 Aug 2018 07:17:22 +0100
Subject: [PATCH] Add Lift instances for Text.
These have similar trade-offs to the existing `Data` instances:
preserving abstraction at the cost of efficiency.
Due to haskell/cabal#5623, the tests exercising this feature have to
live in their own package.
---
Data/Text.hs | 20 ++++++++++++++++++++
Data/Text/Lazy.hs | 20 ++++++++++++++++++++
benchmarks/text-benchmarks.cabal | 1 +
cabal.project | 2 +-
changelog.md | 4 ++++
tests/text-tests.cabal | 3 ++-
text.cabal | 6 ++++--
th-tests/LICENSE | 26 ++++++++++++++++++++++++++
th-tests/tests/Lift.hs | 23 +++++++++++++++++++++++
th-tests/tests/th-tests.hs | 12 ++++++++++++
th-tests/th-tests.cabal | 25 +++++++++++++++++++++++++
11 files changed, 138 insertions(+), 4 deletions(-)
create mode 100644 th-tests/LICENSE
create mode 100644 th-tests/tests/Lift.hs
create mode 100644 th-tests/tests/th-tests.hs
create mode 100644 th-tests/th-tests.cabal
diff --git a/Data/Text.hs b/Data/Text.hs
index b9182a77..ce953f0e 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 8f36f158..90eb571f 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 073dfeee..5e0624d7 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 9afa7659..50143f87 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 4bbeaf4d..1776530d 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 4baf4223..1292ee4f 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 d3048da5..659cf5ca 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 00000000..3c92c1b9
--- /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 00000000..8c7c5879
--- /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 00000000..2482bcd3
--- /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 00000000..10819451
--- /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
--
GitLab