aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
authorRyanGlScott <ryan.gl.scott@gmail.com>2016-01-17 01:04:04 -0500
committerBen Gamari <ben@smart-cactus.org>2016-02-07 23:25:57 +0100
commitaf205d20bf3502b41e4fd34b1c991d5014388004 (patch)
treec2878ed4c857ba7b69f1a9d99abe4b017dcb3ccc /haddock-api/src
parent695cb7fecc511e51ceded125dbba276a89a4d86b (diff)
Render */# instead of TYPE 'Lifted/TYPE 'Unlifted (fixes #473)
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock/Convert.hs17
1 files changed, 14 insertions, 3 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index b6dd06e9..02e4356a 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -1,3 +1,4 @@
+
{-# LANGUAGE CPP, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
@@ -33,9 +34,10 @@ import TcType ( tcSplitSigmaTy )
import TyCon
import Type
import TyCoRep
-import TysPrim ( alphaTyVars )
-import TysWiredIn ( listTyConName )
-import PrelNames ( hasKey, eqTyConKey, ipClassKey )
+import TysPrim ( alphaTyVars, unliftedTypeKindTyConName )
+import TysWiredIn ( listTyConName, starKindTyConName )
+import PrelNames ( hasKey, eqTyConKey, ipClassKey
+ , tYPETyConKey, liftedDataConKey, unliftedDataConKey )
import Unique ( getUnique )
import Util ( filterByList, filterOut )
import Var
@@ -360,6 +362,15 @@ synifySigWcType s ty = mkEmptyImplicitBndrs (mkEmptyWildCardBndrs (synifyType s
synifyType :: SynifyTypeState -> Type -> LHsType Name
synifyType _ (TyVarTy tv) = noLoc $ HsTyVar $ noLoc (getName tv)
synifyType _ (TyConApp tc tys)
+ -- Use */# instead of TYPE 'Lifted/TYPE 'Unlifted (#473)
+ | tc `hasKey` tYPETyConKey
+ , [TyConApp lev []] <- tys
+ , lev `hasKey` liftedDataConKey
+ = noLoc (HsTyVar (noLoc starKindTyConName))
+ | tc `hasKey` tYPETyConKey
+ , [TyConApp lev []] <- tys
+ , lev `hasKey` unliftedDataConKey
+ = noLoc (HsTyVar (noLoc unliftedTypeKindTyConName))
-- Use non-prefix tuple syntax where possible, because it looks nicer.
| Just sort <- tyConTuple_maybe tc
, tyConArity tc == length tys