Move liftData and use it as a default definition for Lift.

Summary:
This should make it a lot easier to define Lift instances.
See https://mail.haskell.org/pipermail/libraries/2015-May/025728.html
for motivating discussion.

I needed to muck out some code from Quote into Syntax to get
the definition in the right place; but I would argue that code
never really belonged in Quote to begin with.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: austin, ekmett, goldfire

Subscribers: bgamari, thomie

Differential Revision: https://phabricator.haskell.org/D923

3 files changed, 113 insertions, 76 deletions

diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml
index d0eefabbdb..f217b91cdd 100644
--- a/docs/users_guide/7.12.1-notes.xml
+++ b/docs/users_guide/7.12.1-notes.xml
@@ -403,6 +403,18 @@
                     Version number XXXXX (was 2.9.0.0)
                </para>
            </listitem>
+            <listitem>
+                <para>
+                    The <literal>Lift</literal> type class for lifting values
+                    into Template Haskell splices now has a default signature
+                    <literal>lift :: Data a => a -> Q Exp</literal>, which means
+                    that you do not have to provide an explicit implementation
+                    of <literal>lift</literal> for types which have a <literal>Data</literal>
+                    instance.  To manually use this default implementation, you
+                    can use the <literal>liftData</literal> function which is
+                    now exported from <literal>Language.Haskell.TH.Syntax</literal>.
+               </para>
+           </listitem>
        </itemizedlist>
     </sect3>
 
diff --git a/libraries/template-haskell/Language/Haskell/TH/Quote.hs b/libraries/template-haskell/Language/Haskell/TH/Quote.hs
index 66ee115b61..91e37399e6 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Quote.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Quote.hs
@@ -15,13 +15,11 @@ that is up to you.
 -}
 module Language.Haskell.TH.Quote(
         QuasiQuoter(..),
-        dataToQa, dataToExpQ, dataToPatQ,
-        liftData,
-        quoteFile
+        quoteFile,
+        -- * For backwards compatibility
+        dataToQa, dataToExpQ, dataToPatQ
     ) where
 
-import Data.Data
-import Language.Haskell.TH.Lib
 import Language.Haskell.TH.Syntax
 
 -- | The 'QuasiQuoter' type, a value @q@ of this type can be used
@@ -42,75 +40,6 @@ data QuasiQuoter = QuasiQuoter {
     quoteDec  :: String -> Q [Dec]
     }
 
--- | 'dataToQa' is a generic utility function for constructing generic
--- conversion functions from types with 'Data' instances to various
--- quasi-quoting representations.  It's used by 'dataToExpQ' and
--- 'dataToPatQ'
-dataToQa  ::  forall a k q. Data a
-          =>  (Name -> k)
-          ->  (Lit -> Q q)
-          ->  (k -> [Q q] -> Q q)
-          ->  (forall b . Data b => b -> Maybe (Q q))
-          ->  a
-          ->  Q q
-dataToQa mkCon mkLit appCon antiQ t =
-    case antiQ t of
-      Nothing ->
-          case constrRep constr of
-            AlgConstr _ ->
-                appCon (mkCon conName) conArgs
-              where
-                conName :: Name
-                conName =
-                    case showConstr constr of
-                      "(:)"       -> Name (mkOccName ":") (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
-                      con@"[]"    -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
-                      con@('(':_) -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Tuple"))
-                      con         -> mkNameG_d (tyConPackage tycon)
-                                               (tyConModule tycon)
-                                               con
-                  where
-                    tycon :: TyCon
-                    tycon = (typeRepTyCon . typeOf) t
-
-                conArgs :: [Q q]
-                conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
-            IntConstr n ->
-                mkLit $ integerL n
-            FloatConstr n ->
-                mkLit $ rationalL n
-            CharConstr c ->
-                mkLit $ charL c
-        where
-          constr :: Constr
-          constr = toConstr t
-
-      Just y -> y
-
--- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the
--- same value, in the SYB style. It is generalized to take a function
--- override type-specific cases; see 'liftData' for a more commonly
--- used variant.
-dataToExpQ  ::  Data a
-            =>  (forall b . Data b => b -> Maybe (Q Exp))
-            ->  a
-            ->  Q Exp
-dataToExpQ = dataToQa conE litE (foldl appE)
-
--- | 'liftData' is a variant of 'lift' in the 'Lift' type class which
--- works for any type with a 'Data' instance.
-liftData :: Data a => a -> Q Exp
-liftData = dataToExpQ (const Nothing)
-
--- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
--- value, in the SYB style. It takes a function to handle type-specific cases,
--- alternatively, pass @const Nothing@ to get default behavior.
-dataToPatQ  ::  Data a
-            =>  (forall b . Data b => b -> Maybe (Q Pat))
-            ->  a
-            ->  Q Pat
-dataToPatQ = dataToQa id litP conP
-
 -- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read
 -- the data out of a file.  For example, suppose 'asmq' is an 
 -- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index a6f970d125..8ab183c745 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP, DeriveDataTypeable, PolymorphicComponents,
-             DeriveGeneric, FlexibleInstances #-}
+             DeriveGeneric, FlexibleInstances, DefaultSignatures,
+             ScopedTypeVariables, Rank2Types #-}
 
 #if __GLASGOW_HASKELL__ >= 707
 {-# LANGUAGE RoleAnnotations #-}
@@ -28,7 +29,7 @@
 
 module Language.Haskell.TH.Syntax where
 
-import Data.Data (Data(..), Typeable )
+import Data.Data hiding (Fixity(..))
 #if __GLASGOW_HASKELL__ < 709
 import Control.Applicative( Applicative(..) )
 #endif
@@ -468,6 +469,8 @@ sequenceQ = sequence
 
 class Lift t where
   lift :: t -> Q Exp
+  default lift :: Data t => t -> Q Exp
+  lift = liftData
 
 -- If you add any instances here, consider updating test th/TH_Lift
 instance Lift Integer where
@@ -590,6 +593,99 @@ leftName, rightName :: Name
 leftName  = mkNameG DataName "base" "Data.Either" "Left"
 rightName = mkNameG DataName "base" "Data.Either" "Right"
 
+-----------------------------------------------------
+--
+--              Generic Lift implementations
+--
+-----------------------------------------------------
+
+-- | 'dataToQa' is an internal utility function for constructing generic
+-- conversion functions from types with 'Data' instances to various
+-- quasi-quoting representations.  See the source of 'dataToExpQ' and
+-- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@
+-- and @appQ@ are overloadable to account for different syntax for
+-- expressions and patterns; @antiQ@ allows you to override type-specific
+-- cases, a common usage is just @const Nothing@, which results in
+-- no overloading.
+dataToQa  ::  forall a k q. Data a
+          =>  (Name -> k)
+          ->  (Lit -> Q q)
+          ->  (k -> [Q q] -> Q q)
+          ->  (forall b . Data b => b -> Maybe (Q q))
+          ->  a
+          ->  Q q
+dataToQa mkCon mkLit appCon antiQ t =
+    case antiQ t of
+      Nothing ->
+          case constrRep constr of
+            AlgConstr _ ->
+                appCon (mkCon conName) conArgs
+              where
+                conName :: Name
+                conName =
+                    case showConstr constr of
+                      "(:)"       -> Name (mkOccName ":")
+                                          (NameG DataName
+                                                (mkPkgName "ghc-prim")
+                                                (mkModName "GHC.Types"))
+                      con@"[]"    -> Name (mkOccName con)
+                                          (NameG DataName
+                                                (mkPkgName "ghc-prim")
+                                                (mkModName "GHC.Types"))
+                      con@('(':_) -> Name (mkOccName con)
+                                          (NameG DataName
+                                                (mkPkgName "ghc-prim")
+                                                (mkModName "GHC.Tuple"))
+                      con         -> mkNameG_d (tyConPackage tycon)
+                                               (tyConModule tycon)
+                                               con
+                  where
+                    tycon :: TyCon
+                    tycon = (typeRepTyCon . typeOf) t
+
+                conArgs :: [Q q]
+                conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
+            IntConstr n ->
+                mkLit $ IntegerL n
+            FloatConstr n ->
+                mkLit $ RationalL n
+            CharConstr c ->
+                mkLit $ CharL c
+        where
+          constr :: Constr
+          constr = toConstr t
+
+      Just y -> y
+
+-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the
+-- same value, in the SYB style. It is generalized to take a function
+-- override type-specific cases; see 'liftData' for a more commonly
+-- used variant.
+dataToExpQ  ::  Data a
+            =>  (forall b . Data b => b -> Maybe (Q Exp))
+            ->  a
+            ->  Q Exp
+dataToExpQ = dataToQa conE litE (foldl appE)
+    where conE s =  return (ConE s)
+          appE x y = do { a <- x; b <- y; return (AppE a b)}
+          litE c = return (LitE c)
+
+-- | 'liftData' is a variant of 'lift' in the 'Lift' type class which
+-- works for any type with a 'Data' instance.
+liftData :: Data a => a -> Q Exp
+liftData = dataToExpQ (const Nothing)
+
+-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
+-- value, in the SYB style. It takes a function to handle type-specific cases,
+-- alternatively, pass @const Nothing@ to get default behavior.
+dataToPatQ  ::  Data a
+            =>  (forall b . Data b => b -> Maybe (Q Pat))
+            ->  a
+            ->  Q Pat
+dataToPatQ = dataToQa id litP conP
+    where litP l = return (LitP l)
+          conP n ps = do ps' <- sequence ps
+                         return (ConP n ps')
 
 -----------------------------------------------------
 --              Names and uniques