diff options
Diffstat (limited to 'haddock-api')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 1 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 1 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 33 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 10 | 
4 files changed, 34 insertions, 11 deletions
| diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 81a23a1b..85716f33 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -300,6 +300,7 @@ ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of        ppLPatSig loc (doc, fnArgsDoc) lname ty unicode    ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode    InstD _                        -> empty +  DerivD _                       -> empty    _                              -> error "declaration not supported by ppDecl"    where      unicode = False diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index fab6bf8d..2bd8c4ad 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -54,6 +54,7 @@ ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs spl                                           ty fixities splice unicode qual    ForD d                         -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual    InstD _                        -> noHtml +  DerivD _                       -> noHtml    _                              -> error "declaration not supported by ppDecl" diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index ffcc28d4..2c8b0b7e 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -306,16 +306,16 @@ mkMaps dflags gre instances decls =        where loc = case d of                TyFamInstD _ -> l -- The CoAx's loc is the whole line, but only for TFs                _ -> getInstLoc d +    names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2].      names _ decl = getMainDeclBinder decl  -- Note [2]:  ------------ --- We relate ClsInsts to InstDecls using the SrcSpans buried inside them. --- That should work for normal user-written instances (from looking at GHC --- sources). We can assume that commented instances are user-written. --- This lets us relate Names (from ClsInsts) to comments (associated --- with InstDecls). - +-- We relate ClsInsts to InstDecls and DerivDecls using the SrcSpans buried +-- inside them. That should work for normal user-written instances (from +-- looking at GHC sources). We can assume that commented instances are +-- user-written. This lets us relate Names (from ClsInsts) to comments +-- (associated with InstDecls and DerivDecls).  --------------------------------------------------------------------------------  -- Declarations @@ -339,7 +339,7 @@ subordinates instMap decl = case decl of                     , name <- getMainDeclBinder d, not (isValD d)                     ]      dataSubs :: HsDataDefn Name -> [(Name, [HsDocString], Map Int HsDocString)] -    dataSubs dd = constrs ++ fields +    dataSubs dd = constrs ++ fields ++ derivs        where          cons = map unL $ (dd_cons dd)          constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty) @@ -348,6 +348,10 @@ subordinates instMap decl = case decl of                    | RecCon flds <- map getConDetails cons                    , L _ (ConDeclField ns _ doc) <- (unLoc flds)                    , L _ n <- ns ] +        derivs  = [ (instName, [unL doc], M.empty) +                  | Just (L _ tys) <- [dd_derivs dd] +                  , HsIB { hsib_body = L l (HsDocTy _ doc) } <- tys +                  , Just instName <- [M.lookup l instMap] ]  -- | Extract function argument docs from inside types.  typeDocs :: HsDecl Name -> Map Int HsDocString @@ -434,8 +438,9 @@ filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]  filterDecls = filter (isHandled . unL . fst)    where      isHandled (ForD (ForeignImport {})) = True -    isHandled (TyClD {}) = True -    isHandled (InstD {}) = True +    isHandled (TyClD {})  = True +    isHandled (InstD {})  = True +    isHandled (DerivD {}) = True      isHandled (SigD d) = isUserLSig (reL d)      isHandled (ValD _) = True      -- we keep doc declarations to be able to get at named docs @@ -757,8 +762,10 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap        | otherwise = return Nothing      mkExportItem decl@(L l (InstD d))        | Just name <- M.lookup (getInstLoc d) instMap = -        let (doc, subs) = lookupDocs name warnings docMap argMap subMap in -        return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices)) +        expInst decl l name +    mkExportItem decl@(L l (DerivD {})) +      | Just name <- M.lookup l instMap = +        expInst decl l name      mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do        mdef <- liftGhcToErrMsgGhc $ minimalDef name        let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . noLoc . fmap noLoc) mdef @@ -773,6 +780,10 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap      expDecl decl l name = return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))        where (doc, subs) = lookupDocs name warnings docMap argMap subMap +    expInst decl l name = +        let (doc, subs) = lookupDocs name warnings docMap argMap subMap in +        return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices)) +  -- | Sometimes the declaration we want to export is not the "main" declaration:  -- it might be an individual record selector or a class method.  In these diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 3054e2f9..1f3f2aab 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -328,6 +328,9 @@ renameDecl decl = case decl of    InstD d -> do      d' <- renameInstD d      return (InstD d') +  DerivD d -> do +    d' <- renameDerivD d +    return (DerivD d')    _ -> error "renameDecl"  renameLThing :: (a Name -> RnM (a DocName)) -> Located (a Name) -> RnM (Located (a DocName)) @@ -503,6 +506,13 @@ renameInstD (DataFamInstD { dfid_inst = d }) = do    d' <- renameDataFamInstD d    return (DataFamInstD { dfid_inst = d' }) +renameDerivD :: DerivDecl Name -> RnM (DerivDecl DocName) +renameDerivD (DerivDecl { deriv_type = ty +                        , deriv_overlap_mode = omode }) = do +  ty' <- renameLSigType ty +  return (DerivDecl { deriv_type = ty' +                    , deriv_overlap_mode = omode }) +  renameClsInstD :: ClsInstDecl Name -> RnM (ClsInstDecl DocName)  renameClsInstD (ClsInstDecl { cid_overlap_mode = omode                              , cid_poly_ty =ltype, cid_tyfam_insts = lATs | 
