-- | Extract docs from the renamer output so they can be serialized.
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BangPatterns #-}

module GHC.HsToCore.Docs where

import GHC.Prelude
import GHC.Data.Bag
import GHC.Hs.Binds
import GHC.Hs.Doc
import GHC.Hs.Decls
import Language.Haskell.Syntax.Extension
import GHC.Hs.Extension
import GHC.Hs.Type
import GHC.Hs.Utils
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.SrcLoc
import GHC.Tc.Types
import GHC.Parser.Annotation

import Control.Applicative
import Control.Monad.IO.Class
import Data.Bifunctor (first)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.Map.Strict (Map)
import qualified Data.Map as M
import qualified Data.Set as Set
import Data.Maybe
import Data.Semigroup
import GHC.IORef (readIORef)
import GHC.Unit.Types
import GHC.Hs
import GHC.Types.Avail
import GHC.Unit.Module
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty ((:|)))
import GHC.Unit.Module.Imported
import GHC.Driver.Session
import GHC.Types.TypeEnv
import GHC.Types.Id
import GHC.Types.Unique.Map

-- | 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'.
extractDocs :: MonadIO m
            => DynFlags -> TcGblEnv
            -> m (Maybe Docs)
            -- ^
            -- 1. Module header
            -- 2. Docs on top level declarations
            -- 3. Docs on arguments
extractDocs :: forall (m :: * -> *).
MonadIO m =>
DynFlags -> TcGblEnv -> m (Maybe Docs)
extractDocs DynFlags
dflags
      TcGblEnv { tcg_semantic_mod :: TcGblEnv -> Module
tcg_semantic_mod = Module
semantic_mdl
               , tcg_mod :: TcGblEnv -> Module
tcg_mod = Module
mdl
               , tcg_rn_decls :: TcGblEnv -> Maybe (HsGroup (GhcPass 'Renamed))
tcg_rn_decls = Just HsGroup (GhcPass 'Renamed)
rn_decls
               , tcg_rn_exports :: TcGblEnv -> Maybe [(LIE (GhcPass 'Renamed), Avails)]
tcg_rn_exports = Maybe [(LIE (GhcPass 'Renamed), Avails)]
mb_rn_exports
               , tcg_exports :: TcGblEnv -> Avails
tcg_exports = Avails
all_exports
               , tcg_imports :: TcGblEnv -> ImportAvails
tcg_imports = ImportAvails
import_avails
               , tcg_insts :: TcGblEnv -> [ClsInst]
tcg_insts = [ClsInst]
insts
               , tcg_fam_insts :: TcGblEnv -> [FamInst]
tcg_fam_insts = [FamInst]
fam_insts
               , tcg_doc_hdr :: TcGblEnv -> Maybe (LHsDoc (GhcPass 'Renamed))
tcg_doc_hdr = Maybe (LHsDoc (GhcPass 'Renamed))
mb_doc_hdr
               , tcg_th_docs :: TcGblEnv -> TcRef THDocs
tcg_th_docs = TcRef THDocs
th_docs_var
               , tcg_type_env :: TcGblEnv -> TypeEnv
tcg_type_env = TypeEnv
ty_env
               } = do
    THDocs
th_docs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef TcRef THDocs
th_docs_var
    let doc_hdr :: Maybe (HsDoc (GhcPass 'Renamed))
doc_hdr = (forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LHsDoc (GhcPass 'Renamed))
mb_doc_hdr)
        ExtractedTHDocs Maybe (HsDoc (GhcPass 'Renamed))
th_hdr UniqMap Name (HsDoc (GhcPass 'Renamed))
th_decl_docs UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
th_arg_docs UniqMap Name (HsDoc (GhcPass 'Renamed))
th_inst_docs = THDocs -> ExtractedTHDocs
extractTHDocs THDocs
th_docs
        mod_docs :: Docs
mod_docs
         =  Docs
         { docs_mod_hdr :: Maybe (HsDoc (GhcPass 'Renamed))
docs_mod_hdr = Maybe (HsDoc (GhcPass 'Renamed))
th_hdr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (HsDoc (GhcPass 'Renamed))
doc_hdr
         -- Left biased union (see #21220)
         , docs_decls :: UniqMap Name [HsDoc (GhcPass 'Renamed)]
docs_decls = forall a k.
(a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
plusUniqMap_C (\[HsDoc (GhcPass 'Renamed)]
a [HsDoc (GhcPass 'Renamed)]
_ -> [HsDoc (GhcPass 'Renamed)]
a)
                          ((forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqMap Name (HsDoc (GhcPass 'Renamed))
th_decl_docs forall k a. UniqMap k a -> UniqMap k a -> UniqMap k a
`plusUniqMap` UniqMap Name (HsDoc (GhcPass 'Renamed))
th_inst_docs)
                          -- These will not clash so safe to use plusUniqMap
                          UniqMap Name [HsDoc (GhcPass 'Renamed)]
doc_map
         , docs_args :: UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
docs_args = UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
th_arg_docs forall b.
UniqMap Name (IntMap b)
-> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b)
`unionArgMaps` UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
arg_map
         , docs_structure :: DocStructure
docs_structure = DocStructure
doc_structure
         , docs_named_chunks :: Map String (HsDoc (GhcPass 'Renamed))
docs_named_chunks = Map String (HsDoc (GhcPass 'Renamed))
named_chunks
         , docs_haddock_opts :: Maybe String
docs_haddock_opts = DynFlags -> Maybe String
haddockOptions DynFlags
dflags
         , docs_language :: Maybe Language
docs_language = Maybe Language
language_
         , docs_extensions :: EnumSet Extension
docs_extensions = EnumSet Extension
exts
         }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Docs
mod_docs)
  where
    exts :: EnumSet Extension
exts = DynFlags -> EnumSet Extension
extensionFlags DynFlags
dflags
    language_ :: Maybe Language
language_ = DynFlags -> Maybe Language
language DynFlags
dflags

    -- We need to lookup the Names for default methods, so we
    -- can put them in the correct map
    -- See Note [default method Name] in GHC.Iface.Recomp
    def_meths_env :: OccEnv Name
def_meths_env = forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [(OccName
occ, Name
nm)
                             | Id
id <- TypeEnv -> [Id]
typeEnvIds TypeEnv
ty_env
                             , let nm :: Name
nm = Id -> Name
idName Id
id
                                   occ :: OccName
occ = Name -> OccName
nameOccName Name
nm
                             , OccName -> Bool
isDefaultMethodOcc OccName
occ
                             ]

    (UniqMap Name [HsDoc (GhcPass 'Renamed)]
doc_map, UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
arg_map) = OccEnv Name
-> [Name]
-> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
-> (UniqMap Name [HsDoc (GhcPass 'Renamed)],
    UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))))
mkMaps OccEnv Name
def_meths_env [Name]
local_insts [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
decls_with_docs
    decls_with_docs :: [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
decls_with_docs = HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
topDecls HsGroup (GhcPass 'Renamed)
rn_decls
    local_insts :: [Name]
local_insts = forall a. (a -> Bool) -> [a] -> [a]
filter (Module -> Name -> Bool
nameIsLocalOrFrom Module
semantic_mdl)
                         forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. NamedThing a => a -> Name
getName [ClsInst]
insts forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. NamedThing a => a -> Name
getName [FamInst]
fam_insts
    doc_structure :: DocStructure
doc_structure = Module
-> ImportAvails
-> Maybe [(LIE (GhcPass 'Renamed), Avails)]
-> HsGroup (GhcPass 'Renamed)
-> Avails
-> OccEnv Name
-> DocStructure
mkDocStructure Module
mdl ImportAvails
import_avails Maybe [(LIE (GhcPass 'Renamed), Avails)]
mb_rn_exports HsGroup (GhcPass 'Renamed)
rn_decls
                                   Avails
all_exports OccEnv Name
def_meths_env
    named_chunks :: Map String (HsDoc (GhcPass 'Renamed))
named_chunks = forall (pass :: Pass).
Bool -> HsGroup (GhcPass pass) -> Map String (HsDoc (GhcPass pass))
getNamedChunks (forall a. Maybe a -> Bool
isJust Maybe [(LIE (GhcPass 'Renamed), Avails)]
mb_rn_exports) HsGroup (GhcPass 'Renamed)
rn_decls
extractDocs DynFlags
_ TcGblEnv
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- | If we have an explicit export list, we extract the documentation structure
-- from that.
-- Otherwise we use the renamed exports and declarations.
mkDocStructure :: Module                               -- ^ The current module
               -> ImportAvails                         -- ^ Imports
               -> Maybe [(LIE GhcRn, Avails)] -- ^ Explicit export list
               -> HsGroup GhcRn
               -> [AvailInfo]                          -- ^ All exports
               -> OccEnv Name                          -- ^ Default Methods
               -> DocStructure
mkDocStructure :: Module
-> ImportAvails
-> Maybe [(LIE (GhcPass 'Renamed), Avails)]
-> HsGroup (GhcPass 'Renamed)
-> Avails
-> OccEnv Name
-> DocStructure
mkDocStructure Module
mdl ImportAvails
import_avails (Just [(LIE (GhcPass 'Renamed), Avails)]
export_list) HsGroup (GhcPass 'Renamed)
_ Avails
_ OccEnv Name
_ =
    Module
-> ImportAvails
-> [(LIE (GhcPass 'Renamed), Avails)]
-> DocStructure
mkDocStructureFromExportList Module
mdl ImportAvails
import_avails [(LIE (GhcPass 'Renamed), Avails)]
export_list
mkDocStructure Module
_ ImportAvails
_ Maybe [(LIE (GhcPass 'Renamed), Avails)]
Nothing HsGroup (GhcPass 'Renamed)
rn_decls Avails
all_exports OccEnv Name
def_meths_env =
    OccEnv Name -> Avails -> HsGroup (GhcPass 'Renamed) -> DocStructure
mkDocStructureFromDecls OccEnv Name
def_meths_env Avails
all_exports HsGroup (GhcPass 'Renamed)
rn_decls

-- TODO:
-- * Maybe remove items that export nothing?
-- * Combine sequences of DsiExports?
-- * Check the ordering of avails in DsiModExport
mkDocStructureFromExportList
  :: Module                         -- ^ The current module
  -> ImportAvails
  -> [(LIE GhcRn, Avails)] -- ^ Explicit export list
  -> DocStructure
mkDocStructureFromExportList :: Module
-> ImportAvails
-> [(LIE (GhcPass 'Renamed), Avails)]
-> DocStructure
mkDocStructureFromExportList Module
mdl ImportAvails
import_avails [(LIE (GhcPass 'Renamed), Avails)]
export_list =
    (IE (GhcPass 'Renamed), Avails) -> DocStructureItem
toDocStructure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(LIE (GhcPass 'Renamed), Avails)]
export_list
  where
    toDocStructure :: (IE GhcRn, Avails) -> DocStructureItem
    toDocStructure :: (IE (GhcPass 'Renamed), Avails) -> DocStructureItem
toDocStructure = \case
      (IEModuleContents XIEModuleContents (GhcPass 'Renamed)
_ XRec (GhcPass 'Renamed) ModuleName
lmn, Avails
avails) -> ModuleName -> Avails -> DocStructureItem
moduleExport (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass 'Renamed) ModuleName
lmn) Avails
avails
      (IEGroup XIEGroup (GhcPass 'Renamed)
_ Key
level LHsDoc (GhcPass 'Renamed)
doc, Avails
_)         -> Key -> HsDoc (GhcPass 'Renamed) -> DocStructureItem
DsiSectionHeading Key
level (forall l e. GenLocated l e -> e
unLoc LHsDoc (GhcPass 'Renamed)
doc)
      (IEDoc XIEDoc (GhcPass 'Renamed)
_ LHsDoc (GhcPass 'Renamed)
doc, Avails
_)                 -> HsDoc (GhcPass 'Renamed) -> DocStructureItem
DsiDocChunk (forall l e. GenLocated l e -> e
unLoc LHsDoc (GhcPass 'Renamed)
doc)
      (IEDocNamed XIEDocNamed (GhcPass 'Renamed)
_ String
name, Avails
_)           -> String -> DocStructureItem
DsiNamedChunkRef String
name
      (IE (GhcPass 'Renamed)
_, Avails
avails)                      -> Avails -> DocStructureItem
DsiExports (Avails -> Avails
nubAvails Avails
avails)

    moduleExport :: ModuleName -- Alias
                 -> Avails
                 -> DocStructureItem
    moduleExport :: ModuleName -> Avails -> DocStructureItem
moduleExport ModuleName
alias Avails
avails =
        NonEmpty ModuleName -> Avails -> DocStructureItem
DsiModExport (NonEmpty ModuleName -> NonEmpty ModuleName
nubSortNE NonEmpty ModuleName
orig_names) (Avails -> Avails
nubAvails Avails
avails)
      where
        orig_names :: NonEmpty ModuleName
orig_names = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault NonEmpty ModuleName
aliasErr ModuleName
alias Map ModuleName (NonEmpty ModuleName)
aliasMap
        aliasErr :: NonEmpty ModuleName
aliasErr = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"mkDocStructureFromExportList: "
                           forall a. [a] -> [a] -> [a]
++ (ModuleName -> String
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
moduleName) Module
mdl
                           forall a. [a] -> [a] -> [a]
++ String
": Can't find alias " forall a. [a] -> [a] -> [a]
++ ModuleName -> String
moduleNameString ModuleName
alias
        nubSortNE :: NonEmpty ModuleName -> NonEmpty ModuleName
nubSortNE = forall a. [a] -> NonEmpty a
NonEmpty.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall a. NonEmpty a -> [a]
NonEmpty.toList

    -- Map from aliases to true module names.
    aliasMap :: Map ModuleName (NonEmpty ModuleName)
    aliasMap :: Map ModuleName (NonEmpty ModuleName)
aliasMap =
        forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$
          (ModuleName
this_mdl_name, ModuleName
this_mdl_name forall a. a -> [a] -> NonEmpty a
:| [])
          forall a. a -> [a] -> [a]
: (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList ModuleEnv [ImportedModsVal]
imported) forall a b. (a -> b) -> a -> b
$ \(Module
mdl, [ImportedModsVal]
imvs) ->
              [(ImportedModsVal -> ModuleName
imv_name ImportedModsVal
imv, forall unit. GenModule unit -> ModuleName
moduleName Module
mdl forall a. a -> [a] -> NonEmpty a
:| []) | ImportedModsVal
imv <- [ImportedModsVal]
imvs])
      where
        this_mdl_name :: ModuleName
this_mdl_name = forall unit. GenModule unit -> ModuleName
moduleName Module
mdl

    imported :: ModuleEnv [ImportedModsVal]
    imported :: ModuleEnv [ImportedModsVal]
imported = forall a b. (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv [ImportedBy] -> [ImportedModsVal]
importedByUser (ImportAvails -> ImportedMods
imp_mods ImportAvails
import_avails)

-- | Figure out the documentation structure by correlating
-- the module exports with the located declarations.
mkDocStructureFromDecls :: OccEnv Name -- ^ The default method environment
                        -> [AvailInfo] -- ^ All exports, unordered
                        -> HsGroup GhcRn
                        -> DocStructure
mkDocStructureFromDecls :: OccEnv Name -> Avails -> HsGroup (GhcPass 'Renamed) -> DocStructure
mkDocStructureFromDecls OccEnv Name
env Avails
all_exports HsGroup (GhcPass 'Renamed)
decls =
    forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc (forall a. [Located a] -> [Located a]
sortLocated ([Located DocStructureItem]
docs forall a. [a] -> [a] -> [a]
++ [Located DocStructureItem]
avails))
  where
    avails :: [Located DocStructureItem]
    avails :: [Located DocStructureItem]
avails = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Avails
all_exports forall a b. (a -> b) -> a -> b
$ \AvailInfo
avail ->
      case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (AvailInfo -> Name
availName AvailInfo
avail) Map Name SrcSpan
name_locs of
        Just SrcSpan
loc -> forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (Avails -> DocStructureItem
DsiExports [AvailInfo
avail])
        -- FIXME: This is just a workaround that we use when handling e.g.
        -- associated data families like in the html-test Instances.hs.
        Maybe SrcSpan
Nothing -> forall e. e -> Located e
noLoc (Avails -> DocStructureItem
DsiExports [AvailInfo
avail])
        -- Nothing -> panicDoc "mkDocStructureFromDecls: No loc found for"
        --                     (ppr avail)

    docs :: [Located DocStructureItem]
docs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LDocDecl (GhcPass 'Renamed) -> Maybe (Located DocStructureItem)
structuralDoc (forall p. HsGroup p -> [LDocDecl p]
hs_docs HsGroup (GhcPass 'Renamed)
decls)

    structuralDoc :: LDocDecl GhcRn
                  -> Maybe (Located DocStructureItem)
    structuralDoc :: LDocDecl (GhcPass 'Renamed) -> Maybe (Located DocStructureItem)
structuralDoc = \case
      L SrcSpanAnnA
loc (DocCommentNamed String
_name LHsDoc (GhcPass 'Renamed)
doc) ->
        -- TODO: Is this correct?
        -- NB: There is no export list where we could reference the named chunk.
        forall a. a -> Maybe a
Just (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) (HsDoc (GhcPass 'Renamed) -> DocStructureItem
DsiDocChunk (forall l e. GenLocated l e -> e
unLoc LHsDoc (GhcPass 'Renamed)
doc)))

      L SrcSpanAnnA
loc (DocGroup Key
level LHsDoc (GhcPass 'Renamed)
doc) ->
        forall a. a -> Maybe a
Just (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) (Key -> HsDoc (GhcPass 'Renamed) -> DocStructureItem
DsiSectionHeading Key
level (forall l e. GenLocated l e -> e
unLoc LHsDoc (GhcPass 'Renamed)
doc)))

      LDocDecl (GhcPass 'Renamed)
_ -> forall a. Maybe a
Nothing

    name_locs :: Map Name SrcSpan
name_locs = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))
-> [(Name, SrcSpan)]
ldeclNames (HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)]
ungroup HsGroup (GhcPass 'Renamed)
decls))
    ldeclNames :: GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))
-> [(Name, SrcSpan)]
ldeclNames (L SrcSpanAnnA
loc HsDecl (GhcPass 'Renamed)
d) = forall a b. [a] -> [b] -> [(a, b)]
zip (OccEnv Name -> HsDecl (GhcPass 'Renamed) -> [Name]
getMainDeclBinder OccEnv Name
env HsDecl (GhcPass 'Renamed)
d) (forall a. a -> [a]
repeat (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc))

-- | 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.
getNamedChunks :: Bool -- ^ Do we have an explicit export list?
               -> HsGroup (GhcPass pass)
               -> Map String (HsDoc (GhcPass pass))
getNamedChunks :: forall (pass :: Pass).
Bool -> HsGroup (GhcPass pass) -> Map String (HsDoc (GhcPass pass))
getNamedChunks Bool
True HsGroup (GhcPass pass)
decls =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p. HsGroup p -> [LDocDecl p]
hs_docs HsGroup (GhcPass pass)
decls) forall a b. (a -> b) -> a -> b
$ \case
    DocCommentNamed String
name LHsDoc (GhcPass pass)
doc -> forall a. a -> Maybe a
Just (String
name, forall l e. GenLocated l e -> e
unLoc LHsDoc (GhcPass pass)
doc)
    DocDecl (GhcPass pass)
_                        -> forall a. Maybe a
Nothing
getNamedChunks Bool
False HsGroup (GhcPass pass)
_ = forall k a. Map k a
M.empty

-- | Create decl and arg doc-maps by looping through the declarations.
-- For each declaration, find its names, its subordinates, and its doc strings.
mkMaps :: OccEnv Name
       -> [Name]
       -> [(LHsDecl GhcRn, [HsDoc GhcRn])]
       -> (UniqMap Name [HsDoc GhcRn], UniqMap Name (IntMap (HsDoc GhcRn)))
mkMaps :: OccEnv Name
-> [Name]
-> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
-> (UniqMap Name [HsDoc (GhcPass 'Renamed)],
    UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))))
mkMaps OccEnv Name
env [Name]
instances [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
decls =
    ( forall {k} {t :: * -> *} {a}.
(Uniquable k, Foldable t) =>
(a -> a -> a) -> t [(k, a)] -> UniqMap k a
listsToMapWith forall a. [a] -> [a] -> [a]
(++) (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Name) -> [a] -> [a]
nubByName forall a b. (a, b) -> a
fst) [[(Name, [HsDoc (GhcPass 'Renamed)])]]
decls')
    , forall {k} {t :: * -> *} {a}.
(Uniquable k, Foldable t) =>
(a -> a -> a) -> t [(k, a)] -> UniqMap k a
listsToMapWith forall a. Semigroup a => a -> a -> a
(<>) (forall b a. (b -> Bool) -> [[(a, b)]] -> [[(a, b)]]
filterMapping (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> Bool
IM.null) [[(Name, IntMap (HsDoc (GhcPass 'Renamed)))]]
args)
    )
  where
    ([[(Name, [HsDoc (GhcPass 'Renamed)])]]
decls', [[(Name, IntMap (HsDoc (GhcPass 'Renamed)))]]
args) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall a b. (a -> b) -> [a] -> [b]
map (LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])
-> ([(Name, [HsDoc (GhcPass 'Renamed)])],
    [(Name, IntMap (HsDoc (GhcPass 'Renamed)))])
mappings [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
decls)

    listsToMapWith :: (a -> a -> a) -> t [(k, a)] -> UniqMap k a
listsToMapWith a -> a -> a
f = forall k a. Uniquable k => (a -> a -> a) -> [(k, a)] -> UniqMap k a
listToUniqMap_C a -> a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

    filterMapping :: (b -> Bool) ->  [[(a, b)]] -> [[(a, b)]]
    filterMapping :: forall b a. (b -> Bool) -> [[(a, b)]] -> [[(a, b)]]
filterMapping b -> Bool
p = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
filter (b -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd))

    mappings :: (LHsDecl GhcRn, [HsDoc GhcRn])
             -> ( [(Name, [HsDoc GhcRn])]
                , [(Name, IntMap (HsDoc GhcRn))]
                )
    mappings :: (LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])
-> ([(Name, [HsDoc (GhcPass 'Renamed)])],
    [(Name, IntMap (HsDoc (GhcPass 'Renamed)))])
mappings (L (SrcSpanAnn EpAnn AnnListItem
_ (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) HsDecl (GhcPass 'Renamed)
decl, [HsDoc (GhcPass 'Renamed)]
doc) =
           ([(Name, [HsDoc (GhcPass 'Renamed)])]
dm, [(Name, IntMap (HsDoc (GhcPass 'Renamed)))]
am)
      where
        args :: IntMap (HsDoc (GhcPass 'Renamed))
args = HsDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
declTypeDocs HsDecl (GhcPass 'Renamed)
decl

        subs :: [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
        subs :: [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
subs = OccEnv Name
-> Map RealSrcSpan Name
-> HsDecl (GhcPass 'Renamed)
-> [(Name, [HsDoc (GhcPass 'Renamed)],
     IntMap (HsDoc (GhcPass 'Renamed)))]
subordinates OccEnv Name
env Map RealSrcSpan Name
instanceMap HsDecl (GhcPass 'Renamed)
decl

        ([Name]
subNs, [[HsDoc (GhcPass 'Renamed)]]
subDocs, [IntMap (HsDoc (GhcPass 'Renamed))]
subArgs) =
          forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
subs

        ns :: [Name]
ns = RealSrcSpan -> HsDecl (GhcPass 'Renamed) -> [Name]
names RealSrcSpan
l HsDecl (GhcPass 'Renamed)
decl
        dm :: [(Name, [HsDoc (GhcPass 'Renamed)])]
dm = [(Name
n, [HsDoc (GhcPass 'Renamed)]
d) | (Name
n, [HsDoc (GhcPass 'Renamed)]
d) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
ns (forall a. a -> [a]
repeat [HsDoc (GhcPass 'Renamed)]
doc) forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
subNs [[HsDoc (GhcPass 'Renamed)]]
subDocs, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (HsDocString -> Bool
isEmptyDocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString) [HsDoc (GhcPass 'Renamed)]
d]
        am :: [(Name, IntMap (HsDoc (GhcPass 'Renamed)))]
am = [(Name
n, IntMap (HsDoc (GhcPass 'Renamed))
args) | Name
n <- [Name]
ns] forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
subNs [IntMap (HsDoc (GhcPass 'Renamed))]
subArgs
    mappings (L (SrcSpanAnn EpAnn AnnListItem
_ (UnhelpfulSpan UnhelpfulSpanReason
_)) HsDecl (GhcPass 'Renamed)
_, [HsDoc (GhcPass 'Renamed)]
_) = ([], [])

    instanceMap :: Map RealSrcSpan Name
    instanceMap :: Map RealSrcSpan Name
instanceMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(RealSrcSpan
l, Name
n) | Name
n <- [Name]
instances, RealSrcSpan RealSrcSpan
l Maybe BufSpan
_ <- [forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
n] ]

    names :: RealSrcSpan -> HsDecl GhcRn -> [Name]
    names :: RealSrcSpan -> HsDecl (GhcPass 'Renamed) -> [Name]
names RealSrcSpan
_ (InstD XInstD (GhcPass 'Renamed)
_ InstDecl (GhcPass 'Renamed)
d) = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan (forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
InstDecl (GhcPass p) -> SrcSpan
getInstLoc InstDecl (GhcPass 'Renamed)
d) Map RealSrcSpan Name
instanceMap
    names RealSrcSpan
l (DerivD {}) = forall a. Maybe a -> [a]
maybeToList (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup RealSrcSpan
l Map RealSrcSpan Name
instanceMap) -- See Note [1].
    names RealSrcSpan
_ HsDecl (GhcPass 'Renamed)
decl = OccEnv Name -> HsDecl (GhcPass 'Renamed) -> [Name]
getMainDeclBinder OccEnv Name
env HsDecl (GhcPass 'Renamed)
decl

{-
Note [1]:
---------
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).
-}

getMainDeclBinder
  :: OccEnv Name -- ^ Default method environment for this module. See Note [default method Name] in GHC.Iface.Recomp
  -> HsDecl GhcRn -> [Name]
getMainDeclBinder :: OccEnv Name -> HsDecl (GhcPass 'Renamed) -> [Name]
getMainDeclBinder OccEnv Name
_ (TyClD XTyClD (GhcPass 'Renamed)
_ TyClDecl (GhcPass 'Renamed)
d) = [forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
TyClDecl (GhcPass p) -> IdP (GhcPass p)
tcdName TyClDecl (GhcPass 'Renamed)
d]
getMainDeclBinder OccEnv Name
_ (ValD XValD (GhcPass 'Renamed)
_ HsBind (GhcPass 'Renamed)
d) =
  case forall p idR.
CollectPass p =>
CollectFlag p -> HsBindLR p idR -> [IdP p]
collectHsBindBinders forall p. CollectFlag p
CollNoDictBinders HsBind (GhcPass 'Renamed)
d of
    []       -> []
    (IdP (GhcPass 'Renamed)
name:[IdP (GhcPass 'Renamed)]
_) -> [IdP (GhcPass 'Renamed)
name]
getMainDeclBinder OccEnv Name
env (SigD XSigD (GhcPass 'Renamed)
_ Sig (GhcPass 'Renamed)
d) = forall a.
(UnXRec a, HasOccName (IdP a)) =>
OccEnv (IdP a) -> Sig a -> [IdP a]
sigNameNoLoc OccEnv Name
env Sig (GhcPass 'Renamed)
d
getMainDeclBinder OccEnv Name
_   (ForD XForD (GhcPass 'Renamed)
_ (ForeignImport XForeignImport (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
name LHsSigType (GhcPass 'Renamed)
_ ForeignImport
_)) = [forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass 'Renamed)
name]
getMainDeclBinder OccEnv Name
_   (ForD XForD (GhcPass 'Renamed)
_ (ForeignExport XForeignExport (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
_ LHsSigType (GhcPass 'Renamed)
_ ForeignExport
_)) = []
getMainDeclBinder OccEnv Name
_ HsDecl (GhcPass 'Renamed)
_ = []


-- | 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
sigNameNoLoc :: forall a . (UnXRec a, HasOccName (IdP a)) => OccEnv (IdP a) -> Sig a -> [IdP a]
sigNameNoLoc :: forall a.
(UnXRec a, HasOccName (IdP a)) =>
OccEnv (IdP a) -> Sig a -> [IdP a]
sigNameNoLoc OccEnv (IdP a)
_   (TypeSig    XTypeSig a
_   [LIdP a]
ns LHsSigWcType a
_)         = forall a b. (a -> b) -> [a] -> [b]
map (forall p a. UnXRec p => XRec p a -> a
unXRec @a) [LIdP a]
ns
sigNameNoLoc OccEnv (IdP a)
_   (ClassOpSig XClassOpSig a
_ Bool
False [LIdP a]
ns LHsSigType a
_)     = forall a b. (a -> b) -> [a] -> [b]
map (forall p a. UnXRec p => XRec p a -> a
unXRec @a) [LIdP a]
ns
sigNameNoLoc OccEnv (IdP a)
env (ClassOpSig XClassOpSig a
_ Bool
True  [LIdP a]
ns LHsSigType a
_)     = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (IdP a)
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> OccName
mkDefaultMethodOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name. HasOccName name => name -> OccName
occName) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall p a. UnXRec p => XRec p a -> a
unXRec @a) [LIdP a]
ns
sigNameNoLoc OccEnv (IdP a)
_   (PatSynSig  XPatSynSig a
_   [LIdP a]
ns LHsSigType a
_)         = forall a b. (a -> b) -> [a] -> [b]
map (forall p a. UnXRec p => XRec p a -> a
unXRec @a) [LIdP a]
ns
sigNameNoLoc OccEnv (IdP a)
_   (SpecSig    XSpecSig a
_   LIdP a
n [LHsSigType a]
_ InlinePragma
_)        = [forall p a. UnXRec p => XRec p a -> a
unXRec @a LIdP a
n]
sigNameNoLoc OccEnv (IdP a)
_   (InlineSig  XInlineSig a
_   LIdP a
n InlinePragma
_)          = [forall p a. UnXRec p => XRec p a -> a
unXRec @a LIdP a
n]
sigNameNoLoc OccEnv (IdP a)
_   (FixSig XFixSig a
_ (FixitySig XFixitySig a
_ [LIdP a]
ns Fixity
_)) = forall a b. (a -> b) -> [a] -> [b]
map (forall p a. UnXRec p => XRec p a -> a
unXRec @a) [LIdP a]
ns
sigNameNoLoc OccEnv (IdP a)
_   Sig a
_                             = []

-- Extract the source location where an instance is defined. This is used
-- to correlate InstDecls with their Instance/CoAxiom Names, via the
-- instanceMap.
getInstLoc :: Anno (IdGhcP p) ~ SrcSpanAnnN => InstDecl (GhcPass p) -> SrcSpan
getInstLoc :: forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
InstDecl (GhcPass p) -> SrcSpan
getInstLoc = \case
  ClsInstD XClsInstD (GhcPass p)
_ (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType (GhcPass p)
ty }) -> forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsSigType (GhcPass p)
ty
  -- The Names of data and type family instances have their SrcSpan's attached
  -- to the *type constructor*. For example, the Name "D:R:Foo:Int" would have
  -- its SrcSpan attached here:
  --   type family Foo a
  --   type instance Foo Int = Bool
  --                 ^^^
  DataFamInstD XDataFamInstD (GhcPass p)
_ (DataFamInstDecl
    { dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = L SrcSpanAnnN
l IdGhcP p
_ }}) -> forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l
  -- Since CoAxioms' Names refer to the whole line for type family instances
  -- in particular, we need to dig a bit deeper to pull out the entire
  -- equation. This does not happen for data family instances, for some reason.
  TyFamInstD XTyFamInstD (GhcPass p)
_ (TyFamInstDecl
    { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = L SrcSpanAnnN
l IdGhcP p
_ }}) -> forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l

-- | 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.
subordinates :: OccEnv Name -- ^ The default method environment
             -> Map RealSrcSpan Name
             -> HsDecl GhcRn
             -> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
subordinates :: OccEnv Name
-> Map RealSrcSpan Name
-> HsDecl (GhcPass 'Renamed)
-> [(Name, [HsDoc (GhcPass 'Renamed)],
     IntMap (HsDoc (GhcPass 'Renamed)))]
subordinates OccEnv Name
env Map RealSrcSpan Name
instMap HsDecl (GhcPass 'Renamed)
decl = case HsDecl (GhcPass 'Renamed)
decl of
  InstD XInstD (GhcPass 'Renamed)
_ (ClsInstD XClsInstD (GhcPass 'Renamed)
_ ClsInstDecl (GhcPass 'Renamed)
d) -> let
    data_fams :: [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
data_fams = do
      DataFamInstDecl { dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn =
        FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = L SrcSpanAnnN
l Name
_
               , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs   = HsDataDefn (GhcPass 'Renamed)
defn }} <- forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts ClsInstDecl (GhcPass 'Renamed)
d
      [ (Name
n, [], forall a. IntMap a
IM.empty) | Just Name
n <- [forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l) Map RealSrcSpan Name
instMap] ] forall a. [a] -> [a] -> [a]
++ HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDoc (GhcPass 'Renamed)],
     IntMap (HsDoc (GhcPass 'Renamed)))]
dataSubs HsDataDefn (GhcPass 'Renamed)
defn
    ty_fams :: [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
ty_fams = do
      TyFamInstDecl { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = L SrcSpanAnnN
l Name
_ } } <- forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts ClsInstDecl (GhcPass 'Renamed)
d
      [ (Name
n, [], forall a. IntMap a
IM.empty) | Just Name
n <- [forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l) Map RealSrcSpan Name
instMap] ]
    in [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
data_fams forall a. [a] -> [a] -> [a]
++ [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
ty_fams

  InstD XInstD (GhcPass 'Renamed)
_ (DataFamInstD XDataFamInstD (GhcPass 'Renamed)
_ (DataFamInstDecl FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
d))
    -> HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDoc (GhcPass 'Renamed)],
     IntMap (HsDoc (GhcPass 'Renamed)))]
dataSubs (forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
d)
  TyClD XTyClD (GhcPass 'Renamed)
_ TyClDecl (GhcPass 'Renamed)
d | forall pass. TyClDecl pass -> Bool
isClassDecl TyClDecl (GhcPass 'Renamed)
d -> TyClDecl (GhcPass 'Renamed)
-> [(Name, [HsDoc (GhcPass 'Renamed)],
     IntMap (HsDoc (GhcPass 'Renamed)))]
classSubs TyClDecl (GhcPass 'Renamed)
d
            | forall pass. TyClDecl pass -> Bool
isDataDecl  TyClDecl (GhcPass 'Renamed)
d -> HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDoc (GhcPass 'Renamed)],
     IntMap (HsDoc (GhcPass 'Renamed)))]
dataSubs (forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl (GhcPass 'Renamed)
d)
  HsDecl (GhcPass 'Renamed)
_ -> []
  where
    classSubs :: TyClDecl (GhcPass 'Renamed)
-> [(Name, [HsDoc (GhcPass 'Renamed)],
     IntMap (HsDoc (GhcPass 'Renamed)))]
classSubs TyClDecl (GhcPass 'Renamed)
dd = [ (Name
name, [HsDoc (GhcPass 'Renamed)]
doc, HsDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
declTypeDocs HsDecl (GhcPass 'Renamed)
d)
                   | (L SrcSpanAnnA
_ HsDecl (GhcPass 'Renamed)
d, [HsDoc (GhcPass 'Renamed)]
doc) <- TyClDecl (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
classDecls TyClDecl (GhcPass 'Renamed)
dd
                   , Name
name <- OccEnv Name -> HsDecl (GhcPass 'Renamed) -> [Name]
getMainDeclBinder OccEnv Name
env HsDecl (GhcPass 'Renamed)
d, Bool -> Bool
not (forall a. HsDecl a -> Bool
isValD HsDecl (GhcPass 'Renamed)
d)
                   ]
    dataSubs :: HsDataDefn GhcRn
             -> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
    dataSubs :: HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDoc (GhcPass 'Renamed)],
     IntMap (HsDoc (GhcPass 'Renamed)))]
dataSubs HsDataDefn (GhcPass 'Renamed)
dd = [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
constrs forall a. [a] -> [a] -> [a]
++ [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
fields  forall a. [a] -> [a] -> [a]
++ [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
derivs
      where
        cons :: [ConDecl (GhcPass 'Renamed)]
cons = forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ (forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn (GhcPass 'Renamed)
dd)
        constrs :: [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
constrs = [ ( forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN Name
cname
                    , forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_doc ConDecl (GhcPass 'Renamed)
c
                    , ConDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
conArgDocs ConDecl (GhcPass 'Renamed)
c)
                  | ConDecl (GhcPass 'Renamed)
c <- [ConDecl (GhcPass 'Renamed)]
cons, GenLocated SrcSpanAnnN Name
cname <- ConDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnN Name]
getConNames ConDecl (GhcPass 'Renamed)
c ]
        fields :: [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
fields  = [ (forall pass. FieldOcc pass -> XCFieldOcc pass
foExt FieldOcc (GhcPass 'Renamed)
n, forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l e. GenLocated l e -> e
unLoc Maybe (LHsDoc (GhcPass 'Renamed))
doc, forall a. IntMap a
IM.empty)
                  | Just GenLocated
  SrcSpanAnnL
  [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))]
flds <- forall a b. (a -> b) -> [a] -> [b]
map ConDecl (GhcPass 'Renamed)
-> Maybe (LocatedL [LConDeclField (GhcPass 'Renamed)])
getRecConArgs_maybe [ConDecl (GhcPass 'Renamed)]
cons
                  , (L SrcSpanAnnA
_ (ConDeclField XConDeclField (GhcPass 'Renamed)
_ [LFieldOcc (GhcPass 'Renamed)]
ns XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))
_ Maybe (LHsDoc (GhcPass 'Renamed))
doc)) <- (forall l e. GenLocated l e -> e
unLoc GenLocated
  SrcSpanAnnL
  [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))]
flds)
                  , (L SrcAnn NoEpAnns
_ FieldOcc (GhcPass 'Renamed)
n) <- [LFieldOcc (GhcPass 'Renamed)]
ns ]
        derivs :: [(Name, [HsDoc (GhcPass 'Renamed)],
  IntMap (HsDoc (GhcPass 'Renamed)))]
derivs  = [ (Name
instName, [forall l e. GenLocated l e -> e
unLoc LHsDoc (GhcPass 'Renamed)
doc], forall a. IntMap a
IM.empty)
                  | (SrcSpan
l, LHsDoc (GhcPass 'Renamed)
doc) <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LDerivClauseTys (GhcPass 'Renamed)
-> [(SrcSpan, LHsDoc (GhcPass 'Renamed))]
extract_deriv_clause_tys forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                           forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_tys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall a b. (a -> b) -> a -> b
$
                                -- unLoc $ dd_derivs dd
                                forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs HsDataDefn (GhcPass 'Renamed)
dd
                  , Just Name
instName <- [forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan SrcSpan
l Map RealSrcSpan Name
instMap] ]

        extract_deriv_clause_tys :: LDerivClauseTys GhcRn -> [(SrcSpan, LHsDoc GhcRn)]
        extract_deriv_clause_tys :: LDerivClauseTys (GhcPass 'Renamed)
-> [(SrcSpan, LHsDoc (GhcPass 'Renamed))]
extract_deriv_clause_tys (L SrcSpanAnnC
_ DerivClauseTys (GhcPass 'Renamed)
dct) =
          case DerivClauseTys (GhcPass 'Renamed)
dct of
            DctSingle XDctSingle (GhcPass 'Renamed)
_ LHsSigType (GhcPass 'Renamed)
ty -> forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ LHsSigType (GhcPass 'Renamed)
-> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed))
extract_deriv_ty LHsSigType (GhcPass 'Renamed)
ty
            DctMulti XDctMulti (GhcPass 'Renamed)
_ [LHsSigType (GhcPass 'Renamed)]
tys -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LHsSigType (GhcPass 'Renamed)
-> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed))
extract_deriv_ty [LHsSigType (GhcPass 'Renamed)]
tys

        extract_deriv_ty :: LHsSigType GhcRn -> Maybe (SrcSpan, LHsDoc GhcRn)
        extract_deriv_ty :: LHsSigType (GhcPass 'Renamed)
-> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed))
extract_deriv_ty (L SrcSpanAnnA
l (HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = L SrcSpanAnnA
_ HsType (GhcPass 'Renamed)
ty})) =
          case HsType (GhcPass 'Renamed)
ty of
            -- deriving (C a {- ^ Doc comment -})
            HsDocTy XDocTy (GhcPass 'Renamed)
_ XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))
_ LHsDoc (GhcPass 'Renamed)
doc -> forall a. a -> Maybe a
Just (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l, LHsDoc (GhcPass 'Renamed)
doc)
            HsType (GhcPass 'Renamed)
_               -> forall a. Maybe a
Nothing

-- | Extract constructor argument docs from inside constructor decls.
conArgDocs :: ConDecl GhcRn -> IntMap (HsDoc GhcRn)
conArgDocs :: ConDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
conArgDocs (ConDeclH98{con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details (GhcPass 'Renamed)
args}) =
  HsConDeclH98Details (GhcPass 'Renamed)
-> IntMap (HsDoc (GhcPass 'Renamed))
h98ConArgDocs HsConDeclH98Details (GhcPass 'Renamed)
args
conArgDocs (ConDeclGADT{con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails (GhcPass 'Renamed)
args, con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty = XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))
res_ty}) =
  HsConDeclGADTDetails (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
gadtConArgDocs HsConDeclGADTDetails (GhcPass 'Renamed)
args (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))
res_ty)

h98ConArgDocs :: HsConDeclH98Details GhcRn -> IntMap (HsDoc GhcRn)
h98ConArgDocs :: HsConDeclH98Details (GhcPass 'Renamed)
-> IntMap (HsDoc (GhcPass 'Renamed))
h98ConArgDocs HsConDeclH98Details (GhcPass 'Renamed)
con_args = case HsConDeclH98Details (GhcPass 'Renamed)
con_args of
  PrefixCon [Void]
_ [HsScaled
   (GhcPass 'Renamed)
   (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))]
args   -> Key
-> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed))
con_arg_docs Key
0 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass a. HsScaled pass a -> a
hsScaledThing) [HsScaled
   (GhcPass 'Renamed)
   (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))]
args
  InfixCon HsScaled
  (GhcPass 'Renamed)
  (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))
arg1 HsScaled
  (GhcPass 'Renamed)
  (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))
arg2 -> Key
-> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed))
con_arg_docs Key
0 [ forall l e. GenLocated l e -> e
unLoc (forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled
  (GhcPass 'Renamed)
  (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))
arg1)
                                       , forall l e. GenLocated l e -> e
unLoc (forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled
  (GhcPass 'Renamed)
  (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))
arg2) ]
  RecCon XRec (GhcPass 'Renamed) [LConDeclField (GhcPass 'Renamed)]
_           -> forall a. IntMap a
IM.empty

gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> IntMap (HsDoc GhcRn)
gadtConArgDocs :: HsConDeclGADTDetails (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
gadtConArgDocs HsConDeclGADTDetails (GhcPass 'Renamed)
con_args HsType (GhcPass 'Renamed)
res_ty = case HsConDeclGADTDetails (GhcPass 'Renamed)
con_args of
  PrefixConGADT [HsScaled
   (GhcPass 'Renamed)
   (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))]
args -> Key
-> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed))
con_arg_docs Key
0 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass a. HsScaled pass a -> a
hsScaledThing) [HsScaled
   (GhcPass 'Renamed)
   (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))]
args forall a. [a] -> [a] -> [a]
++ [HsType (GhcPass 'Renamed)
res_ty]
  RecConGADT XRec (GhcPass 'Renamed) [LConDeclField (GhcPass 'Renamed)]
_ LHsUniToken "->" "\8594" (GhcPass 'Renamed)
_     -> Key
-> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed))
con_arg_docs Key
1 [HsType (GhcPass 'Renamed)
res_ty]

con_arg_docs :: Int -> [HsType GhcRn] -> IntMap (HsDoc GhcRn)
con_arg_docs :: Key
-> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed))
con_arg_docs Key
n = forall a. [(Key, a)] -> IntMap a
IM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {pass} {l} {a}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
a -> HsType pass -> Maybe (a, HsDoc pass)
f [Key
n..]
  where
    f :: a -> HsType pass -> Maybe (a, HsDoc pass)
f a
n (HsDocTy XDocTy pass
_ XRec pass (HsType pass)
_ LHsDoc pass
lds) = forall a. a -> Maybe a
Just (a
n, forall l e. GenLocated l e -> e
unLoc LHsDoc pass
lds)
    f a
n (HsBangTy XBangTy pass
_ HsSrcBang
_ (L l
_ (HsDocTy XDocTy pass
_ XRec pass (HsType pass)
_ LHsDoc pass
lds))) = forall a. a -> Maybe a
Just (a
n, forall l e. GenLocated l e -> e
unLoc LHsDoc pass
lds)
    f a
_ HsType pass
_ = forall a. Maybe a
Nothing

isValD :: HsDecl a -> Bool
isValD :: forall a. HsDecl a -> Bool
isValD (ValD XValD a
_ HsBind a
_) = Bool
True
isValD HsDecl a
_ = Bool
False

-- | All the sub declarations of a class (that we handle), ordered by
-- source location, with documentation attached if it exists.
classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])]
classDecls :: TyClDecl (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
classDecls TyClDecl (GhcPass 'Renamed)
class_ = forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterDecls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
collectDocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e.
[GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e]
sortLocatedA forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
decls
  where
    decls :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
decls = [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
docs forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
defs forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
sigs forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
ats
    docs :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
docs  = forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls forall pass. TyClDecl pass -> [LDocDecl pass]
tcdDocs (forall p. XDocD p -> DocDecl p -> HsDecl p
DocD NoExtField
noExtField) TyClDecl (GhcPass 'Renamed)
class_
    defs :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
defs  = forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls (forall a. Bag a -> [a]
bagToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths) (forall p. XValD p -> HsBind p -> HsDecl p
ValD NoExtField
noExtField) TyClDecl (GhcPass 'Renamed)
class_
    sigs :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
sigs  = forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls forall pass. TyClDecl pass -> [LSig pass]
tcdSigs (forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
noExtField) TyClDecl (GhcPass 'Renamed)
class_
    ats :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]
ats   = forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs (forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
noExtField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl NoExtField
noExtField) TyClDecl (GhcPass 'Renamed)
class_

-- | Extract function argument docs from inside top-level decls.
declTypeDocs :: HsDecl GhcRn -> IntMap (HsDoc GhcRn)
declTypeDocs :: HsDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
declTypeDocs = \case
  SigD  XSigD (GhcPass 'Renamed)
_ (TypeSig XTypeSig (GhcPass 'Renamed)
_ [LIdP (GhcPass 'Renamed)]
_ LHsSigWcType (GhcPass 'Renamed)
ty)          -> HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
sigTypeDocs (forall l e. GenLocated l e -> e
unLoc (forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType (GhcPass 'Renamed)
ty))
  SigD  XSigD (GhcPass 'Renamed)
_ (ClassOpSig XClassOpSig (GhcPass 'Renamed)
_ Bool
_ [LIdP (GhcPass 'Renamed)]
_ LHsSigType (GhcPass 'Renamed)
ty)     -> HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
sigTypeDocs (forall l e. GenLocated l e -> e
unLoc LHsSigType (GhcPass 'Renamed)
ty)
  SigD  XSigD (GhcPass 'Renamed)
_ (PatSynSig XPatSynSig (GhcPass 'Renamed)
_ [LIdP (GhcPass 'Renamed)]
_ LHsSigType (GhcPass 'Renamed)
ty)        -> HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
sigTypeDocs (forall l e. GenLocated l e -> e
unLoc LHsSigType (GhcPass 'Renamed)
ty)
  ForD  XForD (GhcPass 'Renamed)
_ (ForeignImport XForeignImport (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
_ LHsSigType (GhcPass 'Renamed)
ty ForeignImport
_)  -> HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
sigTypeDocs (forall l e. GenLocated l e -> e
unLoc LHsSigType (GhcPass 'Renamed)
ty)
  TyClD XTyClD (GhcPass 'Renamed)
_ (SynDecl { tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))
ty }) -> HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
typeDocs (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))
ty)
  HsDecl (GhcPass 'Renamed)
_                                 -> forall a. IntMap a
IM.empty

nubByName :: (a -> Name) -> [a] -> [a]
nubByName :: forall a. (a -> Name) -> [a] -> [a]
nubByName a -> Name
f [a]
ns = NameSet -> [a] -> [a]
go NameSet
emptyNameSet [a]
ns
  where
    go :: NameSet -> [a] -> [a]
go NameSet
_ [] = []
    go NameSet
s (a
x:[a]
xs)
      | Name
y Name -> NameSet -> Bool
`elemNameSet` NameSet
s = NameSet -> [a] -> [a]
go NameSet
s [a]
xs
      | Bool
otherwise         = let !s' :: NameSet
s' = NameSet -> Name -> NameSet
extendNameSet NameSet
s Name
y
                            in a
x forall a. a -> [a] -> [a]
: NameSet -> [a] -> [a]
go NameSet
s' [a]
xs
      where
        y :: Name
y = a -> Name
f a
x

-- | Extract function argument docs from inside types.
typeDocs :: HsType GhcRn -> IntMap (HsDoc GhcRn)
typeDocs :: HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
typeDocs = forall {pass} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
Key -> HsType pass -> IntMap (HsDoc pass)
go Key
0
  where
    go :: Key -> HsType pass -> IntMap (HsDoc pass)
go Key
n = \case
      HsForAllTy { hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = XRec pass (HsType pass)
ty }          -> Key -> HsType pass -> IntMap (HsDoc pass)
go Key
n (forall l e. GenLocated l e -> e
unLoc XRec pass (HsType pass)
ty)
      HsQualTy   { hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = XRec pass (HsType pass)
ty }          -> Key -> HsType pass -> IntMap (HsDoc pass)
go Key
n (forall l e. GenLocated l e -> e
unLoc XRec pass (HsType pass)
ty)
      HsFunTy XFunTy pass
_ HsArrow pass
_ (forall l e. GenLocated l e -> e
unLoc->HsDocTy XDocTy pass
_ XRec pass (HsType pass)
_ LHsDoc pass
x) XRec pass (HsType pass)
ty -> forall a. Key -> a -> IntMap a -> IntMap a
IM.insert Key
n (forall l e. GenLocated l e -> e
unLoc LHsDoc pass
x) forall a b. (a -> b) -> a -> b
$ Key -> HsType pass -> IntMap (HsDoc pass)
go (Key
nforall a. Num a => a -> a -> a
+Key
1) (forall l e. GenLocated l e -> e
unLoc XRec pass (HsType pass)
ty)
      HsFunTy XFunTy pass
_ HsArrow pass
_ XRec pass (HsType pass)
_ XRec pass (HsType pass)
ty                      -> Key -> HsType pass -> IntMap (HsDoc pass)
go (Key
nforall a. Num a => a -> a -> a
+Key
1) (forall l e. GenLocated l e -> e
unLoc XRec pass (HsType pass)
ty)
      HsDocTy XDocTy pass
_ XRec pass (HsType pass)
_ LHsDoc pass
doc                       -> forall a. Key -> a -> IntMap a
IM.singleton Key
n (forall l e. GenLocated l e -> e
unLoc LHsDoc pass
doc)
      HsType pass
_                                     -> forall a. IntMap a
IM.empty

-- | Extract function argument docs from inside types.
sigTypeDocs :: HsSigType GhcRn -> IntMap (HsDoc GhcRn)
sigTypeDocs :: HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
sigTypeDocs (HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))
body}) = HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed))
typeDocs (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))
body)

-- | The top-level declarations of a module that we care about,
-- ordered by source location, with documentation attached if it exists.
topDecls :: HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])]
topDecls :: HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]
topDecls = forall (p :: Pass) doc.
IsPass p =>
[(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)]
filterClasses forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterDecls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
collectDocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e.
[GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e]
sortLocatedA forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)]
ungroup

-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]
ungroup :: HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)]
ungroup HsGroup (GhcPass 'Renamed)
group_ =
  forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls (forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsGroup p -> [TyClGroup p]
hs_tyclds) (forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
noExtField)  HsGroup (GhcPass 'Renamed)
group_ forall a. [a] -> [a] -> [a]
++
  forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls forall p. HsGroup p -> [LDerivDecl p]
hs_derivds             (forall p. XDerivD p -> DerivDecl p -> HsDecl p
DerivD NoExtField
noExtField) HsGroup (GhcPass 'Renamed)
group_ forall a. [a] -> [a] -> [a]
++
  forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls forall p. HsGroup p -> [LDefaultDecl p]
hs_defds               (forall p. XDefD p -> DefaultDecl p -> HsDecl p
DefD NoExtField
noExtField)   HsGroup (GhcPass 'Renamed)
group_ forall a. [a] -> [a] -> [a]
++
  forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls forall p. HsGroup p -> [LForeignDecl p]
hs_fords               (forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD NoExtField
noExtField)   HsGroup (GhcPass 'Renamed)
group_ forall a. [a] -> [a] -> [a]
++
  forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls forall p. HsGroup p -> [LDocDecl p]
hs_docs                (forall p. XDocD p -> DocDecl p -> HsDecl p
DocD NoExtField
noExtField)   HsGroup (GhcPass 'Renamed)
group_ forall a. [a] -> [a] -> [a]
++
  forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls (forall pass. [TyClGroup pass] -> [LInstDecl pass]
tyClGroupInstDecls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsGroup p -> [TyClGroup p]
hs_tyclds) (forall p. XInstD p -> InstDecl p -> HsDecl p
InstD NoExtField
noExtField)  HsGroup (GhcPass 'Renamed)
group_ forall a. [a] -> [a] -> [a]
++
  forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls (HsValBinds (GhcPass 'Renamed) -> [LSig (GhcPass 'Renamed)]
typesigs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsGroup p -> HsValBinds p
hs_valds)  (forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
noExtField)   HsGroup (GhcPass 'Renamed)
group_ forall a. [a] -> [a] -> [a]
++
  forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls (HsValBinds (GhcPass 'Renamed) -> [LHsBind (GhcPass 'Renamed)]
valbinds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsGroup p -> HsValBinds p
hs_valds)  (forall p. XValD p -> HsBind p -> HsDecl p
ValD NoExtField
noExtField)   HsGroup (GhcPass 'Renamed)
group_
  where
    typesigs :: HsValBinds GhcRn -> [LSig GhcRn]
    typesigs :: HsValBinds (GhcPass 'Renamed) -> [LSig (GhcPass 'Renamed)]
typesigs (XValBindsLR (NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
_ [LSig (GhcPass 'Renamed)]
sig)) = forall a. (a -> Bool) -> [a] -> [a]
filter (forall name. Sig name -> Bool
isUserSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [LSig (GhcPass 'Renamed)]
sig
    typesigs ValBinds{} = forall a. HasCallStack => String -> a
error String
"expected XValBindsLR"

    valbinds :: HsValBinds GhcRn -> [LHsBind GhcRn]
    valbinds :: HsValBinds (GhcPass 'Renamed) -> [LHsBind (GhcPass 'Renamed)]
valbinds (XValBindsLR (NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
binds [LSig (GhcPass 'Renamed)]
_)) =
      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Bag a -> [a]
bagToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ [(RecFlag, LHsBinds (GhcPass 'Renamed))]
binds
    valbinds ValBinds{} = forall a. HasCallStack => String -> a
error String
"expected XValBindsLR"

-- | Collect docs and attach them to the right declarations.
--
-- A declaration may have multiple doc strings attached to it.
collectDocs :: forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
-- ^ This is an example.
collectDocs :: forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
collectDocs = [HsDoc p]
-> Maybe (XRec p (HsDecl p))
-> [XRec p (HsDecl p)]
-> [(XRec p (HsDecl p), [HsDoc p])]
go [] forall a. Maybe a
Nothing
  where
    go :: [HsDoc p]
-> Maybe (XRec p (HsDecl p))
-> [XRec p (HsDecl p)]
-> [(XRec p (HsDecl p), [HsDoc p])]
go [HsDoc p]
docs Maybe (XRec p (HsDecl p))
mprev [XRec p (HsDecl p)]
decls = case ([XRec p (HsDecl p)]
decls, Maybe (XRec p (HsDecl p))
mprev) of
      ((forall p a. UnXRec p => XRec p a -> a
unXRec @p -> DocD XDocD p
_ (DocCommentNext LHsDoc p
s)) : [XRec p (HsDecl p)]
ds, Maybe (XRec p (HsDecl p))
Nothing)   -> [HsDoc p]
-> Maybe (XRec p (HsDecl p))
-> [XRec p (HsDecl p)]
-> [(XRec p (HsDecl p), [HsDoc p])]
go (forall l e. GenLocated l e -> e
unLoc LHsDoc p
sforall a. a -> [a] -> [a]
:[HsDoc p]
docs) forall a. Maybe a
Nothing [XRec p (HsDecl p)]
ds
      ((forall p a. UnXRec p => XRec p a -> a
unXRec @p -> DocD XDocD p
_ (DocCommentNext LHsDoc p
s)) : [XRec p (HsDecl p)]
ds, Just XRec p (HsDecl p)
prev) -> forall {a} {a}. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished XRec p (HsDecl p)
prev [HsDoc p]
docs forall a b. (a -> b) -> a -> b
$ [HsDoc p]
-> Maybe (XRec p (HsDecl p))
-> [XRec p (HsDecl p)]
-> [(XRec p (HsDecl p), [HsDoc p])]
go [forall l e. GenLocated l e -> e
unLoc LHsDoc p
s] forall a. Maybe a
Nothing [XRec p (HsDecl p)]
ds
      ((forall p a. UnXRec p => XRec p a -> a
unXRec @p -> DocD XDocD p
_ (DocCommentPrev LHsDoc p
s)) : [XRec p (HsDecl p)]
ds, Maybe (XRec p (HsDecl p))
mprev)     -> [HsDoc p]
-> Maybe (XRec p (HsDecl p))
-> [XRec p (HsDecl p)]
-> [(XRec p (HsDecl p), [HsDoc p])]
go (forall l e. GenLocated l e -> e
unLoc LHsDoc p
sforall a. a -> [a] -> [a]
:[HsDoc p]
docs) Maybe (XRec p (HsDecl p))
mprev [XRec p (HsDecl p)]
ds
      (XRec p (HsDecl p)
d                                  : [XRec p (HsDecl p)]
ds, Maybe (XRec p (HsDecl p))
Nothing)   -> [HsDoc p]
-> Maybe (XRec p (HsDecl p))
-> [XRec p (HsDecl p)]
-> [(XRec p (HsDecl p), [HsDoc p])]
go [HsDoc p]
docs (forall a. a -> Maybe a
Just XRec p (HsDecl p)
d) [XRec p (HsDecl p)]
ds
      (XRec p (HsDecl p)
d                                  : [XRec p (HsDecl p)]
ds, Just XRec p (HsDecl p)
prev) -> forall {a} {a}. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished XRec p (HsDecl p)
prev [HsDoc p]
docs forall a b. (a -> b) -> a -> b
$ [HsDoc p]
-> Maybe (XRec p (HsDecl p))
-> [XRec p (HsDecl p)]
-> [(XRec p (HsDecl p), [HsDoc p])]
go [] (forall a. a -> Maybe a
Just XRec p (HsDecl p)
d) [XRec p (HsDecl p)]
ds
      ([]                                     , Maybe (XRec p (HsDecl p))
Nothing)   -> []
      ([]                                     , Just XRec p (HsDecl p)
prev) -> forall {a} {a}. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished XRec p (HsDecl p)
prev [HsDoc p]
docs []

    finished :: a -> [a] -> [(a, [a])] -> [(a, [a])]
finished a
decl [a]
docs [(a, [a])]
rest = (a
decl, forall a. [a] -> [a]
reverse [a]
docs) forall a. a -> [a] -> [a]
: [(a, [a])]
rest

-- | Filter out declarations that we don't handle in Haddock
filterDecls :: forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterDecls :: forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterDecls = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. HsDecl a -> Bool
isHandled forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
  where
    isHandled :: HsDecl name -> Bool
isHandled (ForD XForD name
_ (ForeignImport {})) = Bool
True
    isHandled (TyClD {})  = Bool
True
    isHandled (InstD {})  = Bool
True
    isHandled (DerivD {}) = Bool
True
    isHandled (SigD XSigD name
_ Sig name
d)  = forall name. Sig name -> Bool
isUserSig Sig name
d
    isHandled (ValD {})   = Bool
True
    -- we keep doc declarations to be able to get at named docs
    isHandled (DocD {})   = Bool
True
    isHandled HsDecl name
_ = Bool
False


-- | Go through all class declarations and filter their sub-declarations
filterClasses :: forall p doc. (IsPass p) => [(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)]
filterClasses :: forall (p :: Pass) doc.
IsPass p =>
[(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)]
filterClasses = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc forall {p} {l}.
(XRec p (Sig p) ~ XRec p (Sig p),
 XRec p (Sig p) ~ GenLocated l (Sig p), UnXRec p) =>
HsDecl p -> HsDecl p
filterClass))
  where
    filterClass :: HsDecl p -> HsDecl p
filterClass (TyClD XTyClD p
x c :: TyClDecl p
c@(ClassDecl {})) =
      forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD p
x forall a b. (a -> b) -> a -> b
$ TyClDecl p
c { tcdSigs :: [XRec p (Sig p)]
tcdSigs =
        forall a. (a -> Bool) -> [a] -> [a]
filter (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (forall name. Sig name -> Bool
isUserSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall p. UnXRec p => LSig p -> Bool
isMinimalLSig) (forall pass. TyClDecl pass -> [LSig pass]
tcdSigs TyClDecl p
c) }
    filterClass HsDecl p
d = HsDecl p
d

-- | Was this signature given by the user?
isUserSig :: Sig name -> Bool
isUserSig :: forall name. Sig name -> Bool
isUserSig TypeSig {}    = Bool
True
isUserSig ClassOpSig {} = Bool
True
isUserSig PatSynSig {}  = Bool
True
isUserSig Sig name
_             = Bool
False

-- | Take a field of declarations from a data structure and create HsDecls
-- using the given constructor
mkDecls :: (struct -> [GenLocated l decl])
        -> (decl -> hsDecl)
        -> struct
        -> [GenLocated l hsDecl]
mkDecls :: forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls struct -> [GenLocated l decl]
field decl -> hsDecl
con = forall a b. (a -> b) -> [a] -> [b]
map (forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc decl -> hsDecl
con) forall b c a. (b -> c) -> (a -> b) -> a -> c
. struct -> [GenLocated l decl]
field

-- | Extracts out individual maps of documentation added via Template Haskell's
-- @putDoc@.
extractTHDocs :: THDocs
              -> ExtractedTHDocs
extractTHDocs :: THDocs -> ExtractedTHDocs
extractTHDocs THDocs
docs =
  -- Split up docs into separate maps for each 'DocLoc' type
  ExtractedTHDocs
    { ethd_mod_header :: Maybe (HsDoc (GhcPass 'Renamed))
ethd_mod_header = Maybe (HsDoc (GhcPass 'Renamed))
docHeader
    , ethd_decl_docs :: UniqMap Name (HsDoc (GhcPass 'Renamed))
ethd_decl_docs  = forall a.
(UniqMap Name a
 -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a)
-> UniqMap Name a
searchDocs forall {a}. UniqMap Name a -> (DocLoc, a) -> UniqMap Name a
decl
    , ethd_arg_docs :: UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
ethd_arg_docs   = forall a.
(UniqMap Name a
 -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a)
-> UniqMap Name a
searchDocs UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
-> (DocLoc, HsDoc (GhcPass 'Renamed))
-> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
args
    , ethd_inst_docs :: UniqMap Name (HsDoc (GhcPass 'Renamed))
ethd_inst_docs  = forall a.
(UniqMap Name a
 -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a)
-> UniqMap Name a
searchDocs forall {a}. UniqMap Name a -> (DocLoc, a) -> UniqMap Name a
insts
    }
  where
    docHeader :: Maybe (HsDoc GhcRn)
    docHeader :: Maybe (HsDoc (GhcPass 'Renamed))
docHeader
      | ((DocLoc
_, HsDoc (GhcPass 'Renamed)
s):[(DocLoc, HsDoc (GhcPass 'Renamed))]
_) <- forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. (DocLoc, b) -> Bool
isModDoc (forall k a. Map k a -> [(k, a)]
M.toList THDocs
docs) = forall a. a -> Maybe a
Just HsDoc (GhcPass 'Renamed)
s
      | Bool
otherwise = forall a. Maybe a
Nothing

    isModDoc :: (DocLoc, b) -> Bool
isModDoc (DocLoc
ModuleDoc, b
_) = Bool
True
    isModDoc (DocLoc, b)
_ = Bool
False

    -- Folds over the docs, applying 'f' as the accumulating function.
    -- We use different accumulating functions to sift out the specific types of
    -- documentation
    searchDocs :: (UniqMap Name a -> (DocLoc, HsDoc GhcRn) -> UniqMap Name a) -> UniqMap Name a
    searchDocs :: forall a.
(UniqMap Name a
 -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a)
-> UniqMap Name a
searchDocs UniqMap Name a
-> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UniqMap Name a
-> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a
f forall k a. UniqMap k a
emptyUniqMap forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList THDocs
docs

    -- Pick out the declaration docs
    decl :: UniqMap Name a -> (DocLoc, a) -> UniqMap Name a
decl UniqMap Name a
acc ((DeclDoc Name
name), a
s) = forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap UniqMap Name a
acc Name
name a
s
    decl UniqMap Name a
acc (DocLoc, a)
_ = UniqMap Name a
acc

    -- Pick out the instance docs
    insts :: UniqMap Name a -> (DocLoc, a) -> UniqMap Name a
insts UniqMap Name a
acc ((InstDoc Name
name), a
s) = forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap UniqMap Name a
acc Name
name a
s
    insts UniqMap Name a
acc (DocLoc, a)
_ = UniqMap Name a
acc

    -- Pick out the argument docs
    args :: UniqMap Name (IntMap (HsDoc GhcRn))
         -> (DocLoc, HsDoc GhcRn)
         -> UniqMap Name (IntMap (HsDoc GhcRn))
    args :: UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
-> (DocLoc, HsDoc (GhcPass 'Renamed))
-> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
args UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
acc ((ArgDoc Name
name Key
i), HsDoc (GhcPass 'Renamed)
s) =
      -- Insert the doc for the arg into the argument map for the function. This
      -- means we have to search to see if an map already exists for the
      -- function, and insert the new argument if it exists, or create a new map
       forall k a.
Uniquable k =>
(a -> a -> a) -> UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap_C (\IntMap (HsDoc (GhcPass 'Renamed))
_ IntMap (HsDoc (GhcPass 'Renamed))
m -> forall a. Key -> a -> IntMap a -> IntMap a
IM.insert Key
i HsDoc (GhcPass 'Renamed)
s IntMap (HsDoc (GhcPass 'Renamed))
m) UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
acc Name
name (forall a. Key -> a -> IntMap a
IM.singleton Key
i HsDoc (GhcPass 'Renamed)
s)
    args UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
acc (DocLoc, HsDoc (GhcPass 'Renamed))
_ = UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))
acc

-- | Unions together two 'ArgDocMaps' (or ArgMaps in haddock-api), such that two
-- maps with values for the same key merge the inner map as well.
-- Left biased so @unionArgMaps a b@ prefers @a@ over @b@.

unionArgMaps :: forall b . UniqMap Name (IntMap b)
             -> UniqMap Name (IntMap b)
             -> UniqMap Name (IntMap b)
unionArgMaps :: forall b.
UniqMap Name (IntMap b)
-> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b)
unionArgMaps UniqMap Name (IntMap b)
a UniqMap Name (IntMap b)
b = forall k a b. ((k, a) -> b -> b) -> b -> UniqMap k a -> b
nonDetFoldUniqMap (Name, IntMap b)
-> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b)
go UniqMap Name (IntMap b)
b UniqMap Name (IntMap b)
a
  where
    go :: (Name, IntMap b)
            -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b)
    go :: (Name, IntMap b)
-> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b)
go (Name
n, IntMap b
newArgMap) UniqMap Name (IntMap b)
acc
      | Just IntMap b
oldArgMap <- forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
lookupUniqMap UniqMap Name (IntMap b)
acc Name
n =
          forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap UniqMap Name (IntMap b)
acc Name
n (IntMap b
newArgMap forall a. IntMap a -> IntMap a -> IntMap a
`IM.union` IntMap b
oldArgMap)
      | Bool
otherwise = forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap UniqMap Name (IntMap b)
acc Name
n IntMap b
newArgMap