diff options
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 2 | ||||
| -rw-r--r-- | src/Haddock/Convert.hs | 17 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 15 |
3 files changed, 18 insertions, 16 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 71bcd581..28955c22 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -164,7 +164,7 @@ ppTyFamHeader summary associated decl unicode qual = ppTyClBinderWithVars summary decl <+> case tcdKindSig decl of - Just kind -> dcolon unicode <+> ppLKind unicode qual kind + Just (HsBSig kind _) -> dcolon unicode <+> ppLKind unicode qual kind Nothing -> noHtml diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index 480e5728..3dad9a2c 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -104,15 +104,14 @@ synifyTyCon tc (zipWith (\fakeTyVar realKind -> noLoc $ KindedTyVar (getName fakeTyVar) - (HsBSig (synifyKind realKind) placeHolderBndrs) - placeHolderKind) + (synifyKindSig realKind)) alphaTyVars --a, b, c... which are unfortunately all kind * (fst . splitKindFunTys $ tyConKind tc) ) -- assume primitive types aren't members of data/newtype families: Nothing -- we have their kind accurately: - (Just (synifyKind (tyConKind tc))) + (Just (synifyKindSig (tyConKind tc))) -- no algebraic constructors: [] -- "deriving" needn't be specified: @@ -121,7 +120,7 @@ synifyTyCon tc case synTyConRhs tc of SynFamilyTyCon -> TyFamily TypeFamily (synifyName tc) (synifyTyVars (tyConTyVars tc)) - (Just (synifyKind (synTyConResKind tc))) -- placeHolderKind + (Just (synifyKindSig (synTyConResKind tc))) _ -> error "synifyTyCon: impossible open type synonym?" | isDataFamilyTyCon tc = --(why no "isOpenAlgTyCon"?) case algTyConRhs tc of @@ -167,7 +166,7 @@ synifyTyCon tc syn_type = synifyType WithinType (synTyConType tc) in if isSynTyCon tc then TySynonym name tyvars typats syn_type placeHolderNames - else TyData alg_nd alg_ctx name Nothing tyvars typats (fmap synifyKind alg_kindSig) alg_cons alg_deriv + else TyData alg_nd alg_ctx name Nothing tyvars typats (fmap synifyKindSig alg_kindSig) alg_cons alg_deriv -- User beware: it is your responsibility to pass True (use_gadt_syntax) @@ -240,8 +239,8 @@ synifyTyVars = map synifyTyVar kind = tyVarKind tv name = getName tv in if isLiftedTypeKind kind - then UserTyVar name placeHolderKind - else KindedTyVar name (HsBSig (synifyKind kind) placeHolderBndrs) placeHolderKind + then UserTyVar name + else KindedTyVar name (synifyKindSig kind) --states of what to do with foralls: @@ -309,8 +308,8 @@ synifyType s forallty@(ForAllTy _tv _ty) = in noLoc $ HsForAllTy forallPlicitness sTvs sCtx sTau -synifyKind :: Kind -> LHsKind Name -synifyKind = synifyType (error "synifyKind") +synifyKindSig :: Kind -> HsBndrSig (LHsKind Name) +synifyKindSig k = HsBSig (synifyType (error "synifyKind") k) placeHolderBndrs synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> ([HsType Name], Name, [HsType Name]) diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index a295fe29..6034688e 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -206,9 +206,12 @@ renameLType = mapM renameType renameLKind :: LHsKind Name -> RnM (LHsKind DocName) renameLKind = renameLType -renameMaybeLKind :: Maybe (LHsKind Name) -> RnM (Maybe (LHsKind DocName)) +renameMaybeLKind :: Maybe (HsBndrSig (LHsKind Name)) + -> RnM (Maybe (HsBndrSig (LHsKind DocName))) renameMaybeLKind Nothing = return Nothing -renameMaybeLKind (Just ki) = renameLKind ki >>= return . Just +renameMaybeLKind (Just (HsBSig ki fvs)) + = do { ki' <- renameLKind ki + ; return (Just (HsBSig ki' fvs)) } renameType :: HsType Name -> RnM (HsType DocName) renameType t = case t of @@ -260,13 +263,13 @@ renameType t = case t of renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName) -renameLTyVarBndr (L loc (UserTyVar n tck)) +renameLTyVarBndr (L loc (UserTyVar n)) = do { n' <- rename n - ; return (L loc (UserTyVar n' tck)) } -renameLTyVarBndr (L loc (KindedTyVar n (HsBSig k fvs) tck)) + ; return (L loc (UserTyVar n')) } +renameLTyVarBndr (L loc (KindedTyVar n (HsBSig k fvs))) = do { n' <- rename n ; k' <- renameLKind k - ; return (L loc (KindedTyVar n' (HsBSig k' fvs) tck)) } + ; return (L loc (KindedTyVar n' (HsBSig k' fvs))) } renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName]) renameLContext (L loc context) = do |