Add instance Lift (Expr s a) (#1119)

This allows Exprs to be lifted in template-haskell. This is useful to
build a [dhall||] quasiquoter

dhall/dhall.cabal

@@ -562,6 +562,7 @@ Library
         scientific                  >= 0.3.0.0  && < 0.4 ,
         template-haskell                           < 2.15,
         text                        >= 0.11.1.0 && < 1.3 ,
+        th-lift-instances           >= 0.1.13   && < 0.2 ,
         transformers                >= 0.2.0.0  && < 0.6 ,
         transformers-compat         >= 0.6.2    && < 0.7 ,
         unordered-containers        >= 0.1.3.0  && < 0.3 ,

dhall/src/Dhall/Core.hs

@@ -91,6 +91,8 @@ import Dhall.Set (Set)
 import Dhall.Src (Src)
 import {-# SOURCE #-} Dhall.Pretty.Internal
 import GHC.Generics (Generic)
+import Instances.TH.Lift ()
+import Language.Haskell.TH.Syntax (Lift)
 import Numeric.Natural (Natural)
 import Prelude hiding (succ)
 
@@ -131,6 +133,8 @@ import qualified Text.Printf
 data Const = Type | Kind | Sort
     deriving (Show, Eq, Ord, Data, Bounded, Enum, Generic, NFData)
 
+instance Lift Const
+
 instance Pretty Const where
     pretty = Pretty.unAnnotate . prettyConst
 
@@ -342,6 +346,8 @@ instance Pretty Import where
 data Var = V Text !Int
     deriving (Data, Generic, Eq, Ord, Show, NFData)
 
+instance Lift Var
+
 instance IsString Var where
     fromString str = V (fromString str) 0
 
@@ -491,6 +497,8 @@ data Expr s a
 -- NB: If you add a constructor to Expr, please also update the Arbitrary
 -- instance in Dhall.Test.QuickCheck.
 
+instance (Lift s, Lift a, Data s, Data a) => Lift (Expr s a)
+
 -- This instance is hand-written due to the fact that deriving
 -- it does not give us an INLINABLE pragma. We annotate this fmap
 -- implementation with this pragma below to allow GHC to, possibly,
@@ -717,6 +725,8 @@ data Binding s a = Binding
     , value      :: Expr s a
     } deriving (Functor, Foldable, Generic, Traversable, Show, Eq, Ord, Data, NFData)
 
+instance (Lift s, Lift a, Data s, Data a) => Lift (Binding s a)
+
 instance Bifunctor Binding where
     first k (Binding a b c) = Binding a (fmap (first k) b) (first k c)
 
@@ -726,6 +736,8 @@ instance Bifunctor Binding where
 data Chunks s a = Chunks [(Text, Expr s a)] Text
     deriving (Functor, Foldable, Generic, Traversable, Show, Eq, Ord, Data, NFData)
 
+instance (Lift s, Lift a, Data s, Data a) => Lift (Chunks s a)
+
 instance Data.Semigroup.Semigroup (Chunks s a) where
     Chunks xysL zL <> Chunks         []    zR =
         Chunks xysL (zL <> zR)

dhall/src/Dhall/Map.hs

@@ -69,6 +69,8 @@ import Control.DeepSeq (NFData)
 import Data.Data (Data)
 import Data.Semigroup
 import GHC.Generics (Generic)
+import Instances.TH.Lift ()
+import Language.Haskell.TH.Syntax (Lift)
 import Prelude hiding (filter, lookup)
 
 import qualified Data.List
@@ -87,11 +89,15 @@ import qualified Prelude
 data Map k v = Map (Data.Map.Map k v) (Keys k)
     deriving (Data, Generic, NFData)
 
+instance (Data k, Data v, Lift k, Lift v, Ord k) => Lift (Map k v)
+
 data Keys a
     = Sorted
     | Original [a]
     deriving (Data, Generic, NFData)
 
+instance (Data a, Lift a) => Lift (Keys a)
+
 instance (Ord k, Eq v) => Eq (Map k v) where
   m1 == m2 =
       Data.Map.size (toMap m1) == Data.Map.size (toMap m2)

dhall/src/Dhall/Set.hs

@@ -28,6 +28,8 @@ import Data.List (foldl')
 import Data.Sequence (Seq, (|>))
 import Data.Data (Data)
 import GHC.Generics (Generic)
+import Instances.TH.Lift ()
+import Language.Haskell.TH.Syntax (Lift)
 
 import qualified Data.Set
 import qualified Data.Sequence
@@ -36,6 +38,8 @@ import qualified Data.Foldable
 data Set a = Set (Data.Set.Set a) (Seq a)
     deriving (Eq, Generic, Ord, Show, Data, NFData)
 
+instance (Data a, Lift a, Ord a) => Lift (Set a)
+
 instance Foldable Set where
     foldMap f = foldMap f . toSeq
 

dhall/src/Dhall/Src.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE TemplateHaskell    #-}
 
 -- | This module provides the `Src` type used for source spans in error messages
 
@@ -16,7 +17,9 @@ import Data.Monoid ((<>))
 import Data.Text (Text)
 import Data.Text.Prettyprint.Doc  (Pretty (..))
 import GHC.Generics (Generic)
-import Text.Megaparsec (SourcePos)
+import Instances.TH.Lift ()
+import Language.Haskell.TH.Syntax (Lift, lift)
+import Text.Megaparsec (SourcePos (SourcePos), mkPos, unPos)
 
 import {-# SOURCE #-} qualified Dhall.Util
 
@@ -29,6 +32,17 @@ data Src = Src !SourcePos !SourcePos Text
   -- Text field is intentionally lazy
   deriving (Data, Eq, Generic, Ord, Show, NFData)
 
+
+instance Lift Src where
+    lift (Src (SourcePos a b c) (SourcePos d e f) g) =
+        [| Src (SourcePos a (mkPos b') (mkPos c')) (SourcePos d (mkPos e') (mkPos f')) g |]
+      where
+        b' = unPos b
+        c' = unPos c
+        e' = unPos e
+        f' = unPos f
+
+
 instance Pretty Src where
     pretty (Src begin _ text) =
             pretty (Dhall.Util.snip numberedLines)

dhall/src/Dhall/X.hs

@@ -4,6 +4,8 @@ module Dhall.X where
 
 import Data.Data (Data(..))
 import Data.Text.Prettyprint.Doc (Pretty(..))
+import Instances.TH.Lift ()
+import Language.Haskell.TH.Syntax (Lift, lift)
 
 -- | Like `Data.Void.Void`, except with a shorter inferred type
 newtype X = X { absurd :: forall a . a }
@@ -21,3 +23,6 @@ instance Data X where
 
 instance Pretty X where
     pretty = absurd
+
+instance Lift X where
+  lift (X impossible) = impossible

nix/th-lift-instances.nix

@@ -0,0 +1,18 @@
+{ mkDerivation, base, bytestring, containers, QuickCheck, stdenv
+, template-haskell, text, th-lift, transformers, vector
+}:
+mkDerivation {
+  pname = "th-lift-instances";
+  version = "0.1.13";
+  sha256 = "4ecf55e742f0e40ad915ee26dbea19cc7320452a9b217d490af1393a52f9b07e";
+  libraryHaskellDepends = [
+    base bytestring containers template-haskell text th-lift
+    transformers vector
+  ];
+  testHaskellDepends = [
+    base bytestring containers QuickCheck template-haskell text vector
+  ];
+  homepage = "http://github.com/bennofs/th-lift-instances/";
+  description = "Lift instances for template-haskell for common data types";
+  license = stdenv.lib.licenses.bsd3;
+}

nix/th-lift.nix

@@ -0,0 +1,15 @@
+{ mkDerivation, base, ghc-prim, stdenv, template-haskell
+, th-abstraction
+}:
+mkDerivation {
+  pname = "th-lift";
+  version = "0.8.0.1";
+  sha256 = "a05133d8eac584fe47d8ff02163bb86193ce1f5de325ba73c98e95f0daa2d8a8";
+  libraryHaskellDepends = [
+    base ghc-prim template-haskell th-abstraction
+  ];
+  testHaskellDepends = [ base ghc-prim template-haskell ];
+  homepage = "http://github.com/mboes/th-lift";
+  description = "Derive Template Haskell's Lift class for datatypes";
+  license = stdenv.lib.licenses.bsd3;
+}

stack-lts-12.yaml

@@ -17,6 +17,8 @@ extra-deps:
   - turtle-1.5.14
   - transformers-compat-0.6.4
   - yaml-0.10.4.0
+  - th-lift-instances-0.1.13@sha256:2852e468511805cb25d9e3923c9e91647d008ab4a764ec0921e5e40ff8a8e874,2625
+  - th-lift-0.8.0.1@sha256:cceb81b12c0580e02a7a3898b6d60cca5e1be080741f69ddde4f12210d8ba7ca,1960
 flags:
   transformers-compat:
     five-three: true

stack.yaml

@@ -6,6 +6,8 @@ packages:
   - dhall-lsp-server
 extra-deps:
   - repline-0.2.1.0
+  - th-lift-instances-0.1.13@sha256:2852e468511805cb25d9e3923c9e91647d008ab4a764ec0921e5e40ff8a8e874,2625
+  - th-lift-0.8.0.1@sha256:cceb81b12c0580e02a7a3898b6d60cca5e1be080741f69ddde4f12210d8ba7ca,1960
 nix:
   packages:
     - ncurses