[commit: template-haskell] patch-4491-take-2: Make dataToQa work regardless of the set of in-scope names (fixes #4491). (c4c250a)

[Geoffrey Mainland]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/template-haskell

On branch  : patch-4491-take-2

http://hackage.haskell.org/trac/ghc/changeset/c4c250a9a54e49505114b1ad81b6851ae501e8bd

>---------------------------------------------------------------

commit c4c250a9a54e49505114b1ad81b6851ae501e8bd
Author: Geoffrey Mainland <gmainlan at microsoft.com>
Date:   Tue Oct 4 17:57:29 2011 +0100

    Make dataToQa work regardless of the set of in-scope names (fixes #4491).
    
    Use tyConPackage and tyConModule to determine the package and module to which a
    data type belongs. With this information we can use mkNameG_d to build
    constructor names which ensures that dataToQa creates TH terms that are
    independent of the set of in-scope names.

>---------------------------------------------------------------

 Language/Haskell/TH/Quote.hs |   29 ++++++++++++++++++-----------
 1 files changed, 18 insertions(+), 11 deletions(-)

diff --git a/Language/Haskell/TH/Quote.hs b/Language/Haskell/TH/Quote.hs
index 2d98a92..357bf8f 100644
--- a/Language/Haskell/TH/Quote.hs
+++ b/Language/Haskell/TH/Quote.hs
@@ -25,8 +25,24 @@ dataToQa mkCon mkLit appCon antiQ t =
     case antiQ t of
       Nothing ->
           case constrRep constr of
-            AlgConstr _  ->
-                appCon con conArgs
+            AlgConstr _ ->
+                appCon (mkCon conName) conArgs
+              where
+                conName :: Name
+                conName =
+                    case showConstr constr of
+                      "(:)"       -> Name (mkOccName ":") NameS
+                      con@"[]"    -> Name (mkOccName con) NameS
+                      con@('(':_) -> Name (mkOccName con) NameS
+                      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 ->
@@ -36,15 +52,6 @@ dataToQa mkCon mkLit appCon antiQ t =
         where
           constr :: Constr
           constr = toConstr t
-          constrName :: Constr -> String
-          constrName k =
-              case showConstr k of
-                "(:)"  -> ":"
-                name   -> name
-          con :: k
-          con = mkCon (mkName (constrName constr))
-          conArgs :: [Q q]
-          conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
 
       Just y -> y