summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc/Deriv/Generate.hs
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-09-16 13:30:42 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-09-18 12:03:31 -0400
commit1350c220855ed31acc0f23bc7a547eff389711c8 (patch)
treec9bdc1ffaf843e20b075378debf473053bb8bb38 /compiler/GHC/Tc/Deriv/Generate.hs
parent78d27dd8fc376321097d242eee7f9c3346e52832 (diff)
downloadhaskell-1350c220855ed31acc0f23bc7a547eff389711c8.tar.gz
deriving: Always use module prefix in dataTypeName
This fixes a long standard bug where the module prefix was omitted from the data type name supplied by Data.Typeable instances. Instead of reusing the Outputable instance for TyCon, we now take matters into our own hands and explicitly print the module followed by the type constructor name. Fixes #20371
Diffstat (limited to 'compiler/GHC/Tc/Deriv/Generate.hs')
-rw-r--r--compiler/GHC/Tc/Deriv/Generate.hs7
1 files changed, 6 insertions, 1 deletions
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index 7ceefbd57a..b63b7696b1 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -82,6 +82,8 @@ import GHC.Data.Pair
import GHC.Data.Bag
import Data.List ( find, partition, intersperse )
+import GHC.Data.Maybe ( expectJust )
+import GHC.Unit.Module
type BagDerivStuff = Bag DerivStuff
@@ -2139,9 +2141,12 @@ genAuxBindSpecOriginal dflags loc spec
gen_bind (DerivDataDataType tycon dataT_RDR dataC_RDRs)
= mkHsVarBind loc dataT_RDR rhs
where
+ tc_name = tyConName tycon
+ tc_name_string = occNameString (getOccName tc_name)
+ definition_mod_name = moduleNameString (moduleName (expectJust "gen_bind DerivDataDataType" $ nameModule_maybe tc_name))
ctx = initDefaultSDocContext dflags
rhs = nlHsVar mkDataType_RDR
- `nlHsApp` nlHsLit (mkHsString (showSDocOneLine ctx (ppr tycon)))
+ `nlHsApp` nlHsLit (mkHsString (showSDocOneLine ctx (text definition_mod_name <> dot <> text tc_name_string)))
`nlHsApp` nlList (map nlHsVar dataC_RDRs)
gen_bind (DerivDataConstr dc dataC_RDR dataT_RDR)