diff options
| author | RyanGlScott <ryan.gl.scott@gmail.com> | 2016-01-17 01:04:04 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2016-02-07 23:25:57 +0100 |
| commit | af205d20bf3502b41e4fd34b1c991d5014388004 (patch) | |
| tree | c2878ed4c857ba7b69f1a9d99abe4b017dcb3ccc /haddock-api | |
| parent | 695cb7fecc511e51ceded125dbba276a89a4d86b (diff) | |
Render */# instead of TYPE 'Lifted/TYPE 'Unlifted (fixes #473)
Diffstat (limited to 'haddock-api')
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 17 |
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 |