diff options
| author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2018-06-07 15:45:22 +0300 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-06-14 17:06:21 -0400 |
| commit | 97c6cb949ffe707865b9c46016f97b441d114e45 (patch) | |
| tree | a81623757978b726043bb42cc55e4000d41bcd13 /haddock-api/src/Haddock/Convert.hs | |
| parent | 5b25163bad9c28040fdc61555659b4b4b6168032 (diff) | |
Handle -XStarIsType
Diffstat (limited to 'haddock-api/src/Haddock/Convert.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 31 |
1 files changed, 5 insertions, 26 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 4635c076..9979ebb7 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -36,7 +36,7 @@ import TyCon import Type import TyCoRep import TysPrim ( alphaTyVars ) -import TysWiredIn ( listTyConName, starKindTyConName, unitTy ) +import TysWiredIn ( listTyConName, liftedTypeKindTyConName, unitTy ) import PrelNames ( hasKey, eqTyConKey, ipClassKey , tYPETyConKey, liftedRepDataConKey ) import Unique ( getUnique ) @@ -167,7 +167,7 @@ synifyTyCon _coax tc -- algebraic data nor newtype: , dd_ctxt = noLoc [] , dd_cType = Nothing - , dd_kindSig = synifyDataTyConReturnKind tc + , dd_kindSig = Just (synifyKindSig (tyConKind tc)) -- we have their kind accurately: , dd_cons = [] -- No constructors , dd_derivs = noLoc [] } @@ -222,7 +222,7 @@ synifyTyCon coax tc -- CoAxioms, not their TyCons _ -> synifyName tc tyvars = synifyTyVars (tyConVisibleTyVars tc) - kindSig = synifyDataTyConReturnKind tc + kindSig = Just (tyConKind tc) -- The data constructors. -- -- Any data-constructors not exported from the module that *defines* the @@ -248,7 +248,7 @@ synifyTyCon coax tc , dd_ND = alg_nd , dd_ctxt = alg_ctx , dd_cType = Nothing - , dd_kindSig = kindSig + , dd_kindSig = fmap synifyKindSig kindSig , dd_cons = cons , dd_derivs = alg_deriv } in case lefts consRaw of @@ -258,27 +258,6 @@ synifyTyCon coax tc , tcdDExt = DataDeclRn False placeHolderNamesTc } dataConErrs -> Left $ unlines dataConErrs --- In this module, every TyCon being considered has come from an interface --- file. This means that when considering a data type constructor such as: --- --- data Foo (w :: *) (m :: * -> *) (a :: *) --- --- Then its tyConKind will be (* -> (* -> *) -> * -> *). But beware! We are --- also rendering the type variables of Foo, so if we synify the tyConKind of --- Foo in full, we will end up displaying this in Haddock: --- --- data Foo (w :: *) (m :: * -> *) (a :: *) --- :: * -> (* -> *) -> * -> * --- --- Which is entirely wrong (#548). We only want to display the *return* kind, --- which this function obtains. -synifyDataTyConReturnKind :: TyCon -> Maybe (LHsKind GhcRn) -synifyDataTyConReturnKind tc - = case splitFunTys (tyConKind tc) of - (_, ret_kind) - | isLiftedTypeKind ret_kind -> Nothing -- Don't bother displaying :: * - | otherwise -> Just (synifyKindSig ret_kind) - synifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity -> Maybe (LInjectivityAnn GhcRn) synifyInjectivityAnn Nothing _ _ = Nothing @@ -447,7 +426,7 @@ synifyType _ (TyConApp tc tys) | tc `hasKey` tYPETyConKey , [TyConApp lev []] <- tys , lev `hasKey` liftedRepDataConKey - = noLoc (HsTyVar noExt NotPromoted (noLoc starKindTyConName)) + = noLoc (HsTyVar noExt NotPromoted (noLoc liftedTypeKindTyConName)) -- Use non-prefix tuple syntax where possible, because it looks nicer. | Just sort <- tyConTuple_maybe tc , tyConArity tc == length tys |