aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
authorAdam Gundry <adam@well-typed.com>2015-10-16 16:26:42 +0100
committerAdam Gundry <adam@well-typed.com>2015-10-16 16:26:42 +0100
commit85b7ed6147c18611b5ef6b606f157086a8203e7d (patch)
tree3b87f61a410388ee377bf2e7d822a6f210fa1665 /haddock-api/src/Haddock/Interface
parentc7a8a8b32c9075873d666f7d0fc8a99828e17344 (diff)
Roughly fix up haddock for DuplicateRecordFields changes
This compiles, but will probably need more work to produce good documentation when the DuplicateRecordFields extension is used.
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs17
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs8
2 files changed, 16 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 75702b50..8f3b9f9a 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -331,15 +331,16 @@ subordinates instMap decl = case decl of
classSubs dd = [ (name, doc, typeDocs d) | (L _ d, doc) <- classDecls dd
, name <- getMainDeclBinder d, not (isValD d)
]
+ dataSubs :: HsDataDefn Name -> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs dd = constrs ++ fields
where
cons = map unL $ (dd_cons dd)
constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty)
| c <- cons, cname <- con_names c ]
- fields = [ (unL n, maybeToList $ fmap unL doc, M.empty)
+ fields = [ (selectorFieldOcc n, maybeToList $ fmap unL doc, M.empty)
| RecCon flds <- map con_details cons
, L _ (ConDeclField ns _ doc) <- (unLoc flds)
- , n <- ns ]
+ , L _ n <- ns ]
-- | Extract function argument docs from inside types.
typeDocs :: HsDecl Name -> Map Int HsDocString
@@ -501,7 +502,7 @@ mkExportItems
lookupExport (IEVar (L _ x)) = declWith x
lookupExport (IEThingAbs (L _ t)) = declWith t
lookupExport (IEThingAll (L _ t)) = declWith t
- lookupExport (IEThingWith (L _ t) _) = declWith t
+ lookupExport (IEThingWith (L _ t) _ _) = declWith t
lookupExport (IEModuleContents (L _ m)) =
moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices
lookupExport (IEGroup lev docStr) = return $
@@ -790,7 +791,7 @@ extractDecl name mdl decl
, L _ ConDecl { con_details = RecCon rec } <- dd_cons (dfid_defn d)
, ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
, L _ n <- ns
- , n == name
+ , selectorFieldOcc n == name
]
in case matches of
[d0] -> extractDecl name mdl (noLoc . InstD $ DataFamInstD d0)
@@ -821,11 +822,13 @@ extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found"
extractRecSel nm mdl t tvs (L _ con : rest) =
case con_details con of
- RecCon (L _ fields) | ((n,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
- L (getLoc n) (TypeSig [noLoc nm] (noLoc (HsFunTy data_ty (getBangType ty))) [])
+ RecCon (L _ fields) | ((l,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
+ L l (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 ]
+ matching_fields :: [LConDeclField Name] -> [(SrcSpan, LConDeclField Name)]
+ matching_fields flds = [ (l,f) | f@(L _ (ConDeclField ns _ _)) <- flds
+ , L l n <- ns, selectorFieldOcc n == nm ]
data_ty
| ResTyGADT _ ty <- con_res con = ty
| otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) tvs
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index b8fac887..033246a8 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -273,7 +273,7 @@ renameLContext (L loc context) = do
return (L loc context')
renameWildCardInfo :: HsWildCardInfo Name -> RnM (HsWildCardInfo DocName)
-renameWildCardInfo (AnonWildCard _) = pure (AnonWildCard PlaceHolder)
+renameWildCardInfo (AnonWildCard name) = AnonWildCard <$> rename name
renameWildCardInfo (NamedWildCard name) = NamedWildCard <$> rename name
renameInstHead :: InstHead Name -> RnM (InstHead DocName)
@@ -411,11 +411,15 @@ renameCon decl@(ConDecl { con_names = lnames, con_qvars = ltyvars
renameConDeclFieldField :: LConDeclField Name -> RnM (LConDeclField DocName)
renameConDeclFieldField (L l (ConDeclField names t doc)) = do
- names' <- mapM renameL names
+ names' <- mapM renameLFieldOcc names
t' <- renameLType t
doc' <- mapM renameLDocHsSyn doc
return $ L l (ConDeclField names' t' doc')
+renameLFieldOcc :: LFieldOcc Name -> RnM (LFieldOcc DocName)
+renameLFieldOcc (L l (FieldOcc lbl sel)) = do
+ sel' <- rename sel
+ return $ L l (FieldOcc lbl sel')
renameSig :: Sig Name -> RnM (Sig DocName)
renameSig sig = case sig of