Safe Haskell | None |
---|---|
Language | GHC2021 |
Extract docs from the renamer output so they can be serialized.
Synopsis
- extractDocs :: MonadIO m => DynFlags -> TcGblEnv -> m (Maybe Docs)
- mkExportsDocs :: [(LIE GhcRn, Avails)] -> UniqMap Name (HsDoc GhcRn)
- mkDocStructure :: Module -> ImportAvails -> Maybe [(LIE GhcRn, Avails)] -> HsGroup GhcRn -> [AvailInfo] -> OccEnv Name -> DocStructure
- mkDocStructureFromExportList :: Module -> ImportAvails -> [(LIE GhcRn, Avails)] -> DocStructure
- mkDocStructureFromDecls :: OccEnv Name -> [AvailInfo] -> HsGroup GhcRn -> DocStructure
- getNamedChunks :: forall (pass :: Pass). Bool -> HsGroup (GhcPass pass) -> Map String (HsDoc (GhcPass pass))
- mkMaps :: OccEnv Name -> [Name] -> [(LHsDecl GhcRn, [HsDoc GhcRn])] -> (UniqMap Name [HsDoc GhcRn], UniqMap Name (IntMap (HsDoc GhcRn)))
- getMainDeclBinder :: OccEnv Name -> HsDecl GhcRn -> [Name]
- sigNameNoLoc :: (UnXRec a, HasOccName (IdP a)) => OccEnv (IdP a) -> Sig a -> [IdP a]
- getInstLoc :: forall (p :: Pass). Anno (IdGhcP p) ~ SrcSpanAnnN => InstDecl (GhcPass p) -> SrcSpan
- subordinates :: OccEnv Name -> Map RealSrcSpan Name -> HsDecl GhcRn -> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
- conArgDocs :: ConDecl GhcRn -> IntMap (HsDoc GhcRn)
- h98ConArgDocs :: HsConDeclH98Details GhcRn -> IntMap (HsDoc GhcRn)
- gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> IntMap (HsDoc GhcRn)
- con_arg_docs :: Int -> [HsType GhcRn] -> IntMap (HsDoc GhcRn)
- isValD :: HsDecl a -> Bool
- classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])]
- declTypeDocs :: HsDecl GhcRn -> IntMap (HsDoc GhcRn)
- nubByName :: (a -> Name) -> [a] -> [a]
- typeDocs :: HsType GhcRn -> IntMap (HsDoc GhcRn)
- sigTypeDocs :: HsSigType GhcRn -> IntMap (HsDoc GhcRn)
- topDecls :: HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])]
- ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]
- collectDocs :: UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
- filterDecls :: UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
- filterClasses :: forall (p :: Pass) doc. IsPass p => [(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)]
- isUserSig :: Sig name -> Bool
- mkDecls :: (decl -> hsDecl) -> [GenLocated l decl] -> [GenLocated l hsDecl]
- extractTHDocs :: THDocs -> ExtractedTHDocs
- unionArgMaps :: UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b)
Documentation
:: MonadIO m | |
=> DynFlags | |
-> TcGblEnv | |
-> m (Maybe Docs) |
|
Extract docs from renamer output.
This is monadic since we need to be able to read documentation added from
Template Haskell's putDoc
, which is stored in tcg_th_docs
.
:: Module | The current module |
-> ImportAvails | Imports |
-> Maybe [(LIE GhcRn, Avails)] | Explicit export list |
-> HsGroup GhcRn | |
-> [AvailInfo] | All exports |
-> OccEnv Name | Default Methods |
-> DocStructure |
If we have an explicit export list, we extract the documentation structure from that. Otherwise we use the renamed exports and declarations.
Maybe remove items that export nothing?
Combine sequences of DsiExports?
mkDocStructureFromExportList Source #
:: Module | The current module |
-> ImportAvails | |
-> [(LIE GhcRn, Avails)] | Explicit export list |
-> DocStructure |
mkDocStructureFromDecls Source #
:: OccEnv Name | The default method environment |
-> [AvailInfo] | All exports, unordered |
-> HsGroup GhcRn | |
-> DocStructure |
Figure out the documentation structure by correlating the module exports with the located declarations.
:: forall (pass :: Pass). Bool | Do we have an explicit export list? |
-> HsGroup (GhcPass pass) | |
-> Map String (HsDoc (GhcPass pass)) |
Extract named documentation chunks from the renamed declarations.
If there is no explicit export list, we simply return an empty map since there would be no way to link to a named chunk.
mkMaps :: OccEnv Name -> [Name] -> [(LHsDecl GhcRn, [HsDoc GhcRn])] -> (UniqMap Name [HsDoc GhcRn], UniqMap Name (IntMap (HsDoc GhcRn))) Source #
Create decl and arg doc-maps by looping through the declarations. For each declaration, find its names, its subordinates, and its doc strings.
sigNameNoLoc :: (UnXRec a, HasOccName (IdP a)) => OccEnv (IdP a) -> Sig a -> [IdP a] Source #
The "OccEnv Name" is the default method environment for this module
Ultimately, the a special "defaultMethodOcc" name is used for
the signatures on bindings for default methods. Unfortunately, this
name isn't generated until typechecking, so it is not in the renamed AST.
We have to look it up from the OccEnv
parameter constructed from the typechecked
AST.
See also Note [default method Name] in GHC.Iface.Recomp
getInstLoc :: forall (p :: Pass). Anno (IdGhcP p) ~ SrcSpanAnnN => InstDecl (GhcPass p) -> SrcSpan Source #
:: OccEnv Name | The default method environment |
-> Map RealSrcSpan Name | |
-> HsDecl GhcRn | |
-> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))] |
Get all subordinate declarations inside a declaration, and their docs. A subordinate declaration is something like the associate type or data family of a type class.
conArgDocs :: ConDecl GhcRn -> IntMap (HsDoc GhcRn) Source #
Extract constructor argument docs from inside constructor decls.
h98ConArgDocs :: HsConDeclH98Details GhcRn -> IntMap (HsDoc GhcRn) Source #
gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> IntMap (HsDoc GhcRn) Source #
classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])] Source #
All the sub declarations of a class (that we handle), ordered by source location, with documentation attached if it exists.
declTypeDocs :: HsDecl GhcRn -> IntMap (HsDoc GhcRn) Source #
Extract function argument docs from inside top-level decls.
typeDocs :: HsType GhcRn -> IntMap (HsDoc GhcRn) Source #
Extract function argument docs from inside types.
sigTypeDocs :: HsSigType GhcRn -> IntMap (HsDoc GhcRn) Source #
Extract function argument docs from inside types.
topDecls :: HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])] Source #
The top-level declarations of a module that we care about, ordered by source location, with documentation attached if it exists.
ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn] Source #
Take all declarations except pragmas, infix decls, rules from an HsGroup
.
collectDocs :: UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])] Source #
Collect docs and attach them to the right declarations.
A declaration may have multiple doc strings attached to it.
This is an example.
filterDecls :: UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)] Source #
Filter out declarations that we don't handle in Haddock
filterClasses :: forall (p :: Pass) doc. IsPass p => [(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)] Source #
Go through all class declarations and filter their sub-declarations
mkDecls :: (decl -> hsDecl) -> [GenLocated l decl] -> [GenLocated l hsDecl] Source #
Take a field of declarations from a data structure and create HsDecls using the given constructor
extractTHDocs :: THDocs -> ExtractedTHDocs Source #
Extracts out individual maps of documentation added via Template Haskell's
putDoc
.