diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/Backends/Hoogle.hs | 2 | ||||
| -rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 1 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 1 | ||||
| -rw-r--r-- | src/Haddock/Convert.hs | 9 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 11 | 
5 files changed, 13 insertions, 11 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index 64905a37..58c02534 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/src/Haddock/Backends/Hoogle.hs @@ -195,7 +195,7 @@ ppCtor dflags dat subdocs con = lookupCon dflags subdocs (con_name con)          resType = case con_res con of              ResTyH98 -> apps $ map (reL . HsTyVar) $  -                        (tcdName dat) : [hsTyVarName v | L _ (v@UserTyVar {}) <- hsQTvBndrs $ tyClDeclTyVars dat] +                        (tcdName dat) : [hsTyVarName v | L _ v@(HsTyVarBndr _ Nothing Nothing) <- hsQTvBndrs $ tyClDeclTyVars dat]              ResTyGADT x -> x diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index 5d0fabe9..b8635d03 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/src/Haddock/Backends/LaTeX.hs @@ -847,6 +847,7 @@ ppr_mono_ty _         (HsTyVar name)      _ = ppDocName name  ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u  ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)  ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind) +ppr_mono_ty _         (HsRoleAnnot {})    _ = error "ppr_mono_ty HsRoleAnnot"  ppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)  ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)  ppr_mono_ty _         (HsIParamTy n ty)   u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u) diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 2ecc6464..54c202b8 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -676,6 +676,7 @@ ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q = ppr_fun_ty ctxt_prec ty1 ty2 u q  ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)  ppr_mono_ty _         (HsKindSig ty kind) u q =      parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind) +ppr_mono_ty _         (HsRoleAnnot {})    _ _ = error "ppr_mono_ty HsRoleAnnot"  ppr_mono_ty _         (HsListTy ty)       u q = brackets (ppr_mono_lty pREC_TOP ty u q)  ppr_mono_ty _         (HsPArrTy ty)       u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)  ppr_mono_ty _         (HsIParamTy n ty)   u q = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q) diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index 0f7e5b9c..04acbc9b 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -120,8 +120,9 @@ synifyTyCon tc    = DataDecl { tcdLName = synifyName tc               , tcdTyVars =       -- tyConTyVars doesn't work on fun/prim, but we can make them up:                           let mk_hs_tv realKind fakeTyVar  -                                = noLoc $ KindedTyVar (getName fakeTyVar)  -                                                      (synifyKindSig realKind) +                                = noLoc $ HsTyVarBndr (getName fakeTyVar)  +                                                      (Just $ synifyKindSig realKind) +                                                      Nothing                           in HsQTvs { hsq_kvs = []   -- No kind polymorphism                                     , hsq_tvs = zipWith mk_hs_tv (fst (splitKindFunTys (tyConKind tc)))                                                                  alphaTyVars --a, b, c... which are unfortunately all kind * @@ -275,8 +276,8 @@ synifyTyVars ktvs = HsQTvs { hsq_kvs = map tyVarName kvs    where      (kvs, tvs) = partition isKindVar ktvs      synifyTyVar tv  -      | isLiftedTypeKind kind = noLoc (UserTyVar name) -      | otherwise             = noLoc (KindedTyVar name (synifyKindSig kind)) +      | isLiftedTypeKind kind = noLoc (HsTyVarBndr name Nothing Nothing) +      | otherwise             = noLoc (HsTyVarBndr name (Just $ synifyKindSig kind) Nothing)        where          kind = tyVarKind tv          name = getName tv diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index f21088d8..a6f48520 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -263,6 +263,8 @@ renameType t = case t of      k' <- renameLKind k      return (HsKindSig ty' k') +  HsRoleAnnot _ _ -> error "renameType: HsRoleAnnot" +    HsDocTy ty doc -> do      ty' <- renameLType ty      doc' <- renameLDocHsSyn doc @@ -288,13 +290,10 @@ renameLTyVarBndrs (HsQTvs { hsq_kvs = _, hsq_tvs = tvs })                  -- This is rather bogus, but I'm not sure what else to do  renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName) -renameLTyVarBndr (L loc (UserTyVar n)) -  = do { n' <- rename n -       ; return (L loc (UserTyVar n')) } -renameLTyVarBndr (L loc (KindedTyVar n k)) +renameLTyVarBndr (L loc (HsTyVarBndr n mkind mrole))    = do { n' <- rename n -       ; k' <- renameLKind k -       ; return (L loc (KindedTyVar n' k')) } +       ; mkind' <- mapM renameLKind mkind +       ; return (L loc (HsTyVarBndr n' mkind' mrole)) }  renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])  renameLContext (L loc context) = do  | 
