diff options
| author | Thomas Winant <thomas.winant@cs.kuleuven.be> | 2014-08-06 10:26:54 +0200 | 
|---|---|---|
| committer | Austin Seipp <aseipp@pobox.com> | 2014-11-28 16:11:22 -0600 | 
| commit | 1a9dcfef033dd66514015d4a942ba67d21f95482 (patch) | |
| tree | f0b19c268f65dd8e84112c4f22a81c9680628789 /src | |
| parent | 5d8117d8f1f910c85d36865d646b65510b23583d (diff) | |
Support for PartialTypeSignatures
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/Backends/Hoogle.hs | 20 | ||||
| -rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 27 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 2 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 33 | ||||
| -rw-r--r-- | src/Haddock/Convert.hs | 9 | ||||
| -rw-r--r-- | src/Haddock/GhcUtils.hs | 8 | ||||
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 16 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 14 | 
8 files changed, 73 insertions, 56 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index cdd4d56e..1df6d9b1 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/src/Haddock/Backends/Hoogle.hs @@ -64,7 +64,7 @@ dropHsDocTy :: HsType a -> HsType a  dropHsDocTy = f      where          g (L src x) = L src (f x) -        f (HsForAllTy a b c d) = HsForAllTy a b c (g d) +        f (HsForAllTy a b c d e) = HsForAllTy a b c d (g e)          f (HsBangTy a b) = HsBangTy a (g b)          f (HsAppTy a b) = HsAppTy (g a) (g b)          f (HsFunTy a b) = HsFunTy (g a) (g b) @@ -82,7 +82,7 @@ outHsType dflags = out dflags . dropHsDocTy  makeExplicit :: HsType a -> HsType a -makeExplicit (HsForAllTy _ a b c) = HsForAllTy Explicit a b c +makeExplicit (HsForAllTy _ a b c d) = HsForAllTy Explicit a b c d  makeExplicit x = x  makeExplicitL :: LHsType a -> LHsType a @@ -120,21 +120,21 @@ ppExport dflags ExportDecl { expItemDecl    = L _ decl          f (TyClD d@DataDecl{})  = ppData dflags d subdocs          f (TyClD d@SynDecl{})   = ppSynonym dflags d          f (TyClD d@ClassDecl{}) = ppClass dflags d -        f (ForD (ForeignImport name typ _ _)) = ppSig dflags $ TypeSig [name] typ -        f (ForD (ForeignExport name typ _ _)) = ppSig dflags $ TypeSig [name] typ +        f (ForD (ForeignImport name typ _ _)) = ppSig dflags $ TypeSig [name] typ [] +        f (ForD (ForeignExport name typ _ _)) = ppSig dflags $ TypeSig [name] typ []          f (SigD sig) = ppSig dflags sig          f _ = []  ppExport _ _ = []  ppSig :: DynFlags -> Sig Name -> [String] -ppSig dflags (TypeSig names sig) +ppSig dflags (TypeSig names sig _)      = [operator prettyNames ++ " :: " ++ outHsType dflags typ]      where          prettyNames = intercalate ", " $ map (out dflags) names          typ = case unL sig of -                   HsForAllTy Explicit a b c -> HsForAllTy Implicit a b c -                   HsForAllTy Qualified a b c -> HsForAllTy Implicit a b c +                   HsForAllTy Explicit a b c d  -> HsForAllTy Implicit a b c d +                   HsForAllTy Qualified a b c d -> HsForAllTy Implicit a b c d                     x -> x  ppSig _ _ = [] @@ -144,12 +144,12 @@ ppClass :: DynFlags -> TyClDecl Name -> [String]  ppClass dflags x = out dflags x{tcdSigs=[]} :              concatMap (ppSig dflags . addContext . unL) (tcdSigs x)      where -        addContext (TypeSig name (L l sig)) = TypeSig name (L l $ f sig) +        addContext (TypeSig name (L l sig) nwcs) = TypeSig name (L l $ f sig) nwcs          addContext (MinimalSig sig) = MinimalSig sig          addContext _ = error "expected TypeSig" -        f (HsForAllTy a b con d) = HsForAllTy a b (reL (context : unLoc con)) d -        f t = HsForAllTy Implicit emptyHsQTvs (reL [context]) (reL t) +        f (HsForAllTy a b c con d) = HsForAllTy a b c (reL (context : unLoc con)) d +        f t = HsForAllTy Implicit Nothing emptyHsQTvs (reL [context]) (reL t)          context = nlHsTyConApp (tcdName x)              (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tyClDeclTyVars x))) diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index ec3ea8d1..801f3138 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/src/Haddock/Backends/LaTeX.hs @@ -212,7 +212,7 @@ processExports (e : es) =  isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName) -isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames (L _ t))) +isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames (L _ t) _))                         , expItemMbDoc = (Documentation Nothing Nothing, argDocs) }    | Map.null argDocs = Just (map unLoc lnames, t)  isSimpleSig _ = Nothing @@ -249,7 +249,7 @@ ppDocGroup lev doc = sec lev <> braces doc  declNames :: LHsDecl DocName -> [DocName]  declNames (L _ decl) = case decl of    TyClD d  -> [tcdName d] -  SigD (TypeSig lnames _) -> map unLoc lnames +  SigD (TypeSig lnames _ _) -> map unLoc lnames    SigD (PatSynSig lname _ _ _ _) -> [unLoc lname]    ForD (ForeignImport (L _ n) _ _ _) -> [n]    ForD (ForeignExport (L _ n) _ _ _) -> [n] @@ -293,7 +293,7 @@ ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of  --    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode  -- Family instances happen via FamInst now    TyClD d@(ClassDecl {})         -> ppClassDecl instances loc doc subdocs d unicode -  SigD (TypeSig lnames (L _ t))  -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames) t unicode +  SigD (TypeSig lnames (L _ t) _) -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames) t unicode    SigD (PatSynSig lname qtvs prov req ty) ->        ppLPatSig loc (doc, fnArgsDoc) lname qtvs prov req ty unicode    ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode @@ -393,15 +393,15 @@ ppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)       arg_doc n = rDoc (Map.lookup n argDocs)       do_args :: Int -> LaTeX -> (HsType DocName) -> LaTeX -     do_args n leader (HsForAllTy Explicit tvs lctxt ltype) +     do_args n leader (HsForAllTy Explicit _ tvs lctxt ltype)         = decltt leader <->               decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>                  ppLContextNoArrow lctxt unicode) <+> nl $$           do_largs n (darrow unicode) ltype -     do_args n leader (HsForAllTy Qualified a lctxt ltype) -       = do_args n leader (HsForAllTy Implicit a lctxt ltype) -     do_args n leader (HsForAllTy Implicit _ lctxt ltype) +     do_args n leader (HsForAllTy Qualified e a lctxt ltype) +       = do_args n leader (HsForAllTy Implicit e a lctxt ltype) +     do_args n leader (HsForAllTy Implicit _ _ lctxt ltype)         | not (null (unLoc lctxt))         = decltt leader <-> decltt (ppLContextNoArrow lctxt unicode) <+> nl $$           do_largs n (darrow unicode) ltype @@ -521,7 +521,7 @@ ppClassDecl instances loc doc subdocs      methodTable =        text "\\haddockpremethods{}\\textbf{Methods}" $$        vcat  [ ppFunSig loc doc names typ unicode -            | L _ (TypeSig lnames (L _ typ)) <- lsigs +            | L _ (TypeSig lnames (L _ typ) _) <- lsigs              , let doc = lookupAnySubdoc (head names) subdocs                    names = map unLoc lnames ]                -- FIXME: is taking just the first name ok? Is it possible that @@ -895,9 +895,12 @@ ppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode  ppr_mono_ty :: Int -> HsType DocName -> Bool -> LaTeX -ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode +ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode    = maybeParen ctxt_prec pREC_FUN $ -    hsep [ppForAll expl tvs ctxt unicode, ppr_mono_lty pREC_TOP ty unicode] +    hsep [ppForAll expl tvs ctxt' unicode, ppr_mono_lty pREC_TOP ty unicode] + where ctxt' = case extra of +                 Just loc -> (++ [L loc HsWildcardTy]) `fmap` ctxt +                 Nothing  -> ctxt  ppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty  ppr_mono_ty _         (HsTyVar name)      _ = ppDocName name @@ -937,6 +940,10 @@ ppr_mono_ty ctxt_prec (HsParTy ty) unicode  ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode    = ppr_mono_lty ctxt_prec ty unicode +ppr_mono_ty _ HsWildcardTy _ = char '_' + +ppr_mono_ty _ (HsNamedWildcardTy name) _ = ppDocName name +  ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index 85d2652a..49f835c8 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -587,7 +587,7 @@ processForMiniSynopsis mdl unicode qual ExportDecl { expItemDecl = L _loc decl0          (DataDecl{})   -> [keyword "data" <+> b]          (SynDecl{})    -> [keyword "type" <+> b]          (ClassDecl {}) -> [keyword "class" <+> b] -    SigD (TypeSig lnames (L _ _)) -> +    SigD (TypeSig lnames (L _ _) _) ->        map (ppNameMini Prefix mdl . nameOccName . getName . unLoc) lnames      _ -> []  processForMiniSynopsis _ _ qual (ExportGroup lvl _id txt) = diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 0cb5ffb4..2c0a124a 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -43,11 +43,11 @@ ppDecl :: Bool -> LinksInfo -> LHsDecl DocName         -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)]         -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode -> Qualification -> Html  ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode qual = case decl of -  TyClD (FamDecl d)         -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual -  TyClD d@(DataDecl {})     -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual -  TyClD d@(SynDecl {})      -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual -  TyClD d@(ClassDecl {})    -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual -  SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames lty fixities splice unicode qual +  TyClD (FamDecl d)           -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual +  TyClD d@(DataDecl {})       -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual +  TyClD d@(SynDecl {})        -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual +  TyClD d@(ClassDecl {})      -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual +  SigD (TypeSig lnames lty _) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames lty fixities splice unicode qual    SigD (PatSynSig lname qtvs prov req ty) ->        ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname qtvs prov req ty fixities splice unicode qual    ForD d                         -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual @@ -132,13 +132,13 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)      do_largs n leader (L _ t) = do_args n leader t      do_args :: Int -> Html -> HsType DocName -> [SubDecl] -    do_args n leader (HsForAllTy Explicit tvs lctxt ltype) +    do_args n leader (HsForAllTy Explicit _ tvs lctxt ltype)        = (leader <+>            hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>            ppLContextNoArrow lctxt unicode qual,            Nothing, [])          : do_largs n (darrow unicode) ltype -    do_args n leader (HsForAllTy Implicit _ lctxt ltype) +    do_args n leader (HsForAllTy Implicit _ _ lctxt ltype)        | not (null (unLoc lctxt))        = (leader <+> ppLContextNoArrow lctxt unicode qual,            Nothing, []) @@ -416,7 +416,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t                  -- ToDo: add associated type defaults              [ ppFunSig summary links loc doc names typ [] splice unicode qual -              | L _ (TypeSig lnames (L _ typ)) <- sigs +              | L _ (TypeSig lnames (L _ typ) _) <- sigs                , let doc = lookupAnySubdoc (head names) subdocs                      names = map unLoc lnames ]                -- FIXME: is taking just the first name ok? Is it possible that @@ -461,7 +461,7 @@ ppClassDecl summary links instances fixities loc d subdocs                              subfixs = [ f | f@(n',_) <- fixities, n == n' ] ]      methodBit = subMethods [ ppFunSig summary links loc doc names typ subfixs splice unicode qual -                           | L _ (TypeSig lnames (L _ typ)) <- lsigs +                           | L _ (TypeSig lnames (L _ typ) _) <- lsigs                             , let doc = lookupAnySubdoc (head names) subdocs                                   subfixs = [ f | n <- names                                                 , f@(n',_) <- fixities @@ -474,12 +474,12 @@ ppClassDecl summary links instances fixities loc d subdocs      minimalBit = case [ s | L _ (MinimalSig s) <- lsigs ] of        -- Miminal complete definition = every shown method        And xs : _ | sort [getName n | Var (L _ n) <- xs] == -                   sort [getName n | L _ (TypeSig ns _) <- lsigs, L _ n <- ns] +                   sort [getName n | L _ (TypeSig ns _ _) <- lsigs, L _ n <- ns]          -> noHtml        -- Minimal complete definition = the only shown method        Var (L _ n) : _ | [getName n] == -                        [getName n' | L _ (TypeSig ns _) <- lsigs, L _ n' <- ns] +                        [getName n' | L _ (TypeSig ns _ _) <- lsigs, L _ n' <- ns]          -> noHtml        -- Minimal complete definition = nothing @@ -850,9 +850,12 @@ ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)  ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html -ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode qual +ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode qual    = maybeParen ctxt_prec pREC_FUN $ -    hsep [ppForAll expl tvs ctxt unicode qual, ppr_mono_lty pREC_TOP ty unicode qual] +    hsep [ppForAll expl tvs ctxt' unicode qual, ppr_mono_lty pREC_TOP ty unicode qual] + where ctxt' = case extra of +                 Just loc -> (++ [L loc HsWildcardTy]) `fmap` ctxt +                 Nothing  -> ctxt  -- UnicodeSyntax alternatives  ppr_mono_ty _ (HsTyVar name) True _ @@ -898,6 +901,10 @@ ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual  ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual    = ppr_mono_lty ctxt_prec ty unicode qual +ppr_mono_ty _ HsWildcardTy _ _ = char '_' + +ppr_mono_ty _ (HsNamedWildcardTy name) _ q = ppDocName q Prefix True name +  ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n  ppr_tylit :: HsTyLit -> Html diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index 2e8300d1..dd769c21 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -91,7 +91,7 @@ tyThingToLHsDecl t = noLoc $ case t of    -- a data-constructor alone just gets rendered as a function:    AConLike (RealDataCon dc) -> SigD (TypeSig [synifyName dc] -    (synifyType ImplicitizeForAll (dataConUserType dc))) +    (synifyType ImplicitizeForAll (dataConUserType dc)) [])    AConLike (PatSynCon ps) ->        let (univ_tvs, ex_tvs, req_theta, prov_theta, arg_tys, res_ty) = patSynSig ps @@ -112,7 +112,8 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })      in TyFamEqn { tfe_tycon = name                  , tfe_pats  = HsWB { hswb_cts = typats                                      , hswb_kvs = map tyVarName kvs -                                    , hswb_tvs = map tyVarName tvs } +                                    , hswb_tvs = map tyVarName tvs +                                    , hswb_wcs = [] }                  , tfe_rhs   = hs_rhs }  synifyAxiom :: CoAxiom br -> HsDecl Name @@ -277,7 +278,7 @@ synifyName = noLoc . getName  synifyIdSig :: SynifyTypeState -> Id -> Sig Name -synifyIdSig s i = TypeSig [synifyName i] (synifyType s (varType i)) +synifyIdSig s i = TypeSig [synifyName i] (synifyType s (varType i)) []  synifyCtx :: [PredType] -> LHsContext Name @@ -360,7 +361,7 @@ synifyType s forallty@(ForAllTy _tv _ty) =        sCtx = synifyCtx ctx        sTau = synifyType WithinType tau       in noLoc $ -           HsForAllTy forallPlicitness sTvs sCtx sTau +           HsForAllTy forallPlicitness Nothing sTvs sCtx sTau  synifyType _ (LitTy t) = noLoc $ HsTyLit $ synifyTyLit t  synifyTyLit :: TyLit -> HsTyLit diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs index e64d298f..5aa9b818 100644 --- a/src/Haddock/GhcUtils.hs +++ b/src/Haddock/GhcUtils.hs @@ -105,10 +105,10 @@ filterSigNames p (FixSig (FixitySig ns ty)) =      []       -> Nothing      filtered -> Just (FixSig (FixitySig filtered ty))  filterSigNames _ orig@(MinimalSig _)           = Just orig -filterSigNames p (TypeSig ns ty)               = +filterSigNames p (TypeSig ns ty nwcs)    =    case filter (p . unLoc) ns of      []       -> Nothing -    filtered -> Just (TypeSig filtered ty) +    filtered -> Just (TypeSig filtered ty nwcs)  filterSigNames _ _                           = Nothing  ifTrueJust :: Bool -> name -> Maybe name @@ -119,7 +119,7 @@ sigName :: LSig name -> [name]  sigName (L _ sig) = sigNameNoLoc sig  sigNameNoLoc :: Sig name -> [name] -sigNameNoLoc (TypeSig   ns _)          = map unLoc ns +sigNameNoLoc (TypeSig   ns _ _)        = map unLoc ns  sigNameNoLoc (PatSynSig n _ _ _ _)     = [unLoc n]  sigNameNoLoc (SpecSig   n _ _)         = [unLoc n]  sigNameNoLoc (InlineSig n _)           = [unLoc n] @@ -219,7 +219,7 @@ instance Parent (TyClDecl Name) where                                $ (dd_cons . tcdDataDefn) $ d      | isClassDecl d =          map (unL . fdLName . unL) (tcdATs d) ++ -        [ unL n | L _ (TypeSig ns _) <- tcdSigs d, n <- ns ] +        [ unL n | L _ (TypeSig ns _ _) <- tcdSigs d, n <- ns ]      | otherwise = [] diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index afff7e10..396c138f 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -340,7 +340,7 @@ typeDocs :: HsDecl Name -> Map Int HsDocString  typeDocs d =    let docs = go 0 in    case d of -    SigD (TypeSig _ ty) -> docs (unLoc ty) +    SigD (TypeSig _ ty _) -> docs (unLoc ty)      SigD (PatSynSig _ _ req prov ty) ->          let allTys = ty : concat [ unLoc req, unLoc prov ]          in F.foldMap (docs . unLoc) allTys @@ -348,7 +348,7 @@ typeDocs d =      TyClD (SynDecl { tcdRhs = ty }) -> docs (unLoc ty)      _ -> M.empty    where -    go n (HsForAllTy _ _ _ ty) = go n (unLoc ty) +    go n (HsForAllTy _ _ _ _ ty) = go n (unLoc ty)      go n (HsFunTy (L _ (HsDocTy _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty      go n (HsFunTy _ ty) = go (n+1) (unLoc ty)      go n (HsDocTy _ (L _ doc)) = M.singleton n doc @@ -713,7 +713,7 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap      expandSig = foldr f []        where          f :: LHsDecl name -> [LHsDecl name] -> [LHsDecl name] -        f (L l (SigD (TypeSig    names t)))          xs = foldr (\n acc -> L l (SigD (TypeSig    [n] t))          : acc) xs names +        f (L l (SigD (TypeSig    names t nwcs)))     xs = foldr (\n acc -> L l (SigD (TypeSig    [n] t nwcs))     : acc) xs names          f (L l (SigD (GenericSig names t)))          xs = foldr (\n acc -> L l (SigD (GenericSig [n] t))          : acc) xs names          f x xs = x : xs @@ -791,10 +791,10 @@ toTypeNoLoc = noLoc . HsTyVar . unLoc  extractClassDecl :: Name -> [Located Name] -> LSig Name -> LSig Name -extractClassDecl c tvs0 (L pos (TypeSig lname ltype)) = case ltype of -  L _ (HsForAllTy expl tvs (L _ preds) ty) -> -    L pos (TypeSig lname (noLoc (HsForAllTy expl tvs (lctxt preds) ty))) -  _ -> L pos (TypeSig lname (noLoc (HsForAllTy Implicit emptyHsQTvs (lctxt []) ltype))) +extractClassDecl c tvs0 (L pos (TypeSig lname ltype _)) = case ltype of +  L _ (HsForAllTy expl _ tvs (L _ preds) ty) -> +    L pos (TypeSig lname (noLoc (HsForAllTy expl Nothing tvs (lctxt preds) ty)) []) +  _ -> L pos (TypeSig lname (noLoc (HsForAllTy Implicit Nothing emptyHsQTvs (lctxt []) ltype)) [])    where      lctxt = noLoc . ctxt      ctxt preds = nlHsTyConApp c (map toTypeNoLoc tvs0) : preds @@ -808,7 +808,7 @@ extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found"  extractRecSel nm mdl t tvs (L _ con : rest) =    case con_details con of      RecCon fields | ((n,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields -> -      L (getLoc n) (TypeSig [noLoc nm] (noLoc (HsFunTy data_ty (getBangType ty)))) +      L (getLoc n) (TypeSig [noLoc nm] (noLoc (HsFunTy data_ty (getBangType ty))) [])      _ -> extractRecSel nm mdl t tvs rest   where    matching_fields flds = [ (n,f) | f@(L _ (ConDeclField ns _ _)) <- flds, n <- ns, unLoc n == nm ] diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index 566e3acb..b08cd275 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -183,11 +183,11 @@ renameMaybeLKind = traverse renameLKind  renameType :: HsType Name -> RnM (HsType DocName)  renameType t = case t of -  HsForAllTy expl tyvars lcontext ltype -> do +  HsForAllTy expl extra tyvars lcontext ltype -> do      tyvars'   <- renameLTyVarBndrs tyvars      lcontext' <- renameLContext lcontext      ltype'    <- renameLType ltype -    return (HsForAllTy expl tyvars' lcontext' ltype') +    return (HsForAllTy expl extra tyvars' lcontext' ltype')    HsTyVar n -> return . HsTyVar =<< rename n    HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype @@ -236,6 +236,8 @@ renameType t = case t of    HsExplicitTupleTy a b   -> HsExplicitTupleTy a <$> mapM renameLType b    HsQuasiQuoteTy a        -> HsQuasiQuoteTy <$> renameHsQuasiQuote a    HsSpliceTy _ _          -> error "renameType: HsSpliceTy" +  HsWildcardTy            -> pure HsWildcardTy +  HsNamedWildcardTy a     -> HsNamedWildcardTy <$> rename a  renameHsQuasiQuote :: HsQuasiQuote Name -> RnM (HsQuasiQuote DocName)  renameHsQuasiQuote (HsQuasiQuote a b c) = HsQuasiQuote <$> rename a <*> pure b <*> pure c @@ -400,10 +402,10 @@ renameConDeclFieldField (L l (ConDeclField names t doc)) = do  renameSig :: Sig Name -> RnM (Sig DocName)  renameSig sig = case sig of -  TypeSig lnames ltype -> do +  TypeSig lnames ltype _ -> do      lnames' <- mapM renameL lnames      ltype' <- renameLType ltype -    return (TypeSig lnames' ltype') +    return (TypeSig lnames' ltype' PlaceHolder)    PatSynSig lname (flag, qtvs) lreq lprov lty -> do      lname' <- renameL lname      qtvs' <- renameLTyVarBndrs qtvs @@ -466,7 +468,7 @@ renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats_w_bndrs,         ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)         ; rhs' <- renameLType rhs         ; return (L loc (TyFamEqn { tfe_tycon = tc' -                                 , tfe_pats = HsWB pats' PlaceHolder PlaceHolder +                                 , tfe_pats = HsWB pats' PlaceHolder PlaceHolder PlaceHolder                                   , tfe_rhs = rhs' })) }  renameLTyFamDefltEqn :: LTyFamDefltEqn Name -> RnM (LTyFamDefltEqn DocName) @@ -485,7 +487,7 @@ renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats_w_bndrs,         ; defn' <- renameDataDefn defn         ; return (DataFamInstDecl { dfid_tycon = tc'                                   , dfid_pats -                                       = HsWB pats' PlaceHolder PlaceHolder +                                       = HsWB pats' PlaceHolder PlaceHolder PlaceHolder                                   , dfid_defn = defn', dfid_fvs = placeHolderNames }) }  renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)  | 
