-- | 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 :: 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 GhcRn)
tcg_rn_decls = Just HsGroup GhcRn
rn_decls
               , tcg_rn_exports :: TcGblEnv -> Maybe [(LIE GhcRn, Avails)]
tcg_rn_exports = Maybe [(LIE GhcRn, 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 GhcRn)
tcg_doc_hdr = Maybe (LHsDoc GhcRn)
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 <- IO THDocs -> m THDocs
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO THDocs -> m THDocs) -> IO THDocs -> m THDocs
forall a b. (a -> b) -> a -> b
$ TcRef THDocs -> IO THDocs
forall a. IORef a -> IO a
readIORef TcRef THDocs
th_docs_var
    let doc_hdr :: Maybe (HsDoc GhcRn)
doc_hdr = (LHsDoc GhcRn -> HsDoc GhcRn
forall l e. GenLocated l e -> e
unLoc (LHsDoc GhcRn -> HsDoc GhcRn)
-> Maybe (LHsDoc GhcRn) -> Maybe (HsDoc GhcRn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LHsDoc GhcRn)
mb_doc_hdr)
        ExtractedTHDocs Maybe (HsDoc GhcRn)
th_hdr UniqMap Name (HsDoc GhcRn)
th_decl_docs UniqMap Name (IntMap (HsDoc GhcRn))
th_arg_docs UniqMap Name (HsDoc GhcRn)
th_inst_docs = THDocs -> ExtractedTHDocs
extractTHDocs THDocs
th_docs
        mod_docs :: Docs
mod_docs
         =  Docs :: Maybe (HsDoc GhcRn)
-> UniqMap Name [HsDoc GhcRn]
-> UniqMap Name (IntMap (HsDoc GhcRn))
-> DocStructure
-> Map String (HsDoc GhcRn)
-> Maybe String
-> Maybe Language
-> EnumSet Extension
-> Docs
Docs
         { docs_mod_hdr :: Maybe (HsDoc GhcRn)
docs_mod_hdr = Maybe (HsDoc GhcRn)
th_hdr Maybe (HsDoc GhcRn) -> Maybe (HsDoc GhcRn) -> Maybe (HsDoc GhcRn)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (HsDoc GhcRn)
doc_hdr
         -- Left biased union (see #21220)
         , docs_decls :: UniqMap Name [HsDoc GhcRn]
docs_decls = ([HsDoc GhcRn] -> [HsDoc GhcRn] -> [HsDoc GhcRn])
-> UniqMap Name [HsDoc GhcRn]
-> UniqMap Name [HsDoc GhcRn]
-> UniqMap Name [HsDoc GhcRn]
forall a k.
(a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
plusUniqMap_C (\[HsDoc GhcRn]
a [HsDoc GhcRn]
_ -> [HsDoc GhcRn]
a)
                          ((HsDoc GhcRn -> [HsDoc GhcRn] -> [HsDoc GhcRn]
forall a. a -> [a] -> [a]
:[]) (HsDoc GhcRn -> [HsDoc GhcRn])
-> UniqMap Name (HsDoc GhcRn) -> UniqMap Name [HsDoc GhcRn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqMap Name (HsDoc GhcRn)
th_decl_docs UniqMap Name (HsDoc GhcRn)
-> UniqMap Name (HsDoc GhcRn) -> UniqMap Name (HsDoc GhcRn)
forall k a. UniqMap k a -> UniqMap k a -> UniqMap k a
`plusUniqMap` UniqMap Name (HsDoc GhcRn)
th_inst_docs)
                          -- These will not clash so safe to use plusUniqMap
                          UniqMap Name [HsDoc GhcRn]
doc_map
         , docs_args :: UniqMap Name (IntMap (HsDoc GhcRn))
docs_args = UniqMap Name (IntMap (HsDoc GhcRn))
th_arg_docs UniqMap Name (IntMap (HsDoc GhcRn))
-> UniqMap Name (IntMap (HsDoc GhcRn))
-> UniqMap Name (IntMap (HsDoc GhcRn))
forall b.
UniqMap Name (IntMap b)
-> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b)
`unionArgMaps` UniqMap Name (IntMap (HsDoc GhcRn))
arg_map
         , docs_structure :: DocStructure
docs_structure = DocStructure
doc_structure
         , docs_named_chunks :: Map String (HsDoc GhcRn)
docs_named_chunks = Map String (HsDoc GhcRn)
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
         }
    Maybe Docs -> m (Maybe Docs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Docs -> Maybe Docs
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 = [(OccName, Name)] -> OccEnv Name
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 GhcRn]
doc_map, UniqMap Name (IntMap (HsDoc GhcRn))
arg_map) = OccEnv Name
-> [Name]
-> [(LHsDecl GhcRn, [HsDoc GhcRn])]
-> (UniqMap Name [HsDoc GhcRn],
    UniqMap Name (IntMap (HsDoc GhcRn)))
mkMaps OccEnv Name
def_meths_env [Name]
local_insts [(LHsDecl GhcRn, [HsDoc GhcRn])]
decls_with_docs
    decls_with_docs :: [(LHsDecl GhcRn, [HsDoc GhcRn])]
decls_with_docs = HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])]
topDecls HsGroup GhcRn
rn_decls
    local_insts :: [Name]
local_insts = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Module -> Name -> Bool
nameIsLocalOrFrom Module
semantic_mdl)
                         ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ (ClsInst -> Name) -> [ClsInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> Name
forall a. NamedThing a => a -> Name
getName [ClsInst]
insts [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FamInst -> Name) -> [FamInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FamInst -> Name
forall a. NamedThing a => a -> Name
getName [FamInst]
fam_insts
    doc_structure :: DocStructure
doc_structure = Module
-> ImportAvails
-> Maybe [(LIE GhcRn, Avails)]
-> HsGroup GhcRn
-> Avails
-> OccEnv Name
-> DocStructure
mkDocStructure Module
mdl ImportAvails
import_avails Maybe [(LIE GhcRn, Avails)]
mb_rn_exports HsGroup GhcRn
rn_decls
                                   Avails
all_exports OccEnv Name
def_meths_env
    named_chunks :: Map String (HsDoc GhcRn)
named_chunks = Bool -> HsGroup GhcRn -> Map String (HsDoc GhcRn)
forall (pass :: Pass).
Bool -> HsGroup (GhcPass pass) -> Map String (HsDoc (GhcPass pass))
getNamedChunks (Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [(LIE GhcRn, Avails)]
Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)]
mb_rn_exports) HsGroup GhcRn
rn_decls
extractDocs DynFlags
_ TcGblEnv
_ = Maybe Docs -> m (Maybe Docs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Docs
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 GhcRn, Avails)]
-> HsGroup GhcRn
-> Avails
-> OccEnv Name
-> DocStructure
mkDocStructure Module
mdl ImportAvails
import_avails (Just [(LIE GhcRn, Avails)]
export_list) HsGroup GhcRn
_ Avails
_ OccEnv Name
_ =
    Module -> ImportAvails -> [(LIE GhcRn, Avails)] -> DocStructure
mkDocStructureFromExportList Module
mdl ImportAvails
import_avails [(LIE GhcRn, Avails)]
export_list
mkDocStructure Module
_ ImportAvails
_ Maybe [(LIE GhcRn, Avails)]
Nothing HsGroup GhcRn
rn_decls Avails
all_exports OccEnv Name
def_meths_env =
    OccEnv Name -> Avails -> HsGroup GhcRn -> DocStructure
mkDocStructureFromDecls OccEnv Name
def_meths_env Avails
all_exports HsGroup GhcRn
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 GhcRn, Avails)] -> DocStructure
mkDocStructureFromExportList Module
mdl ImportAvails
import_avails [(LIE GhcRn, Avails)]
export_list =
    (IE GhcRn, Avails) -> DocStructureItem
toDocStructure ((IE GhcRn, Avails) -> DocStructureItem)
-> ((GenLocated SrcSpanAnnA (IE GhcRn), Avails)
    -> (IE GhcRn, Avails))
-> (GenLocated SrcSpanAnnA (IE GhcRn), Avails)
-> DocStructureItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (IE GhcRn) -> IE GhcRn)
-> (GenLocated SrcSpanAnnA (IE GhcRn), Avails)
-> (IE GhcRn, Avails)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GenLocated SrcSpanAnnA (IE GhcRn) -> IE GhcRn
forall l e. GenLocated l e -> e
unLoc ((GenLocated SrcSpanAnnA (IE GhcRn), Avails) -> DocStructureItem)
-> [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)] -> DocStructure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(LIE GhcRn, Avails)]
[(GenLocated SrcSpanAnnA (IE GhcRn), Avails)]
export_list
  where
    toDocStructure :: (IE GhcRn, Avails) -> DocStructureItem
    toDocStructure :: (IE GhcRn, Avails) -> DocStructureItem
toDocStructure = \case
      (IEModuleContents XIEModuleContents GhcRn
_ XRec GhcRn ModuleName
lmn, Avails
avails) -> ModuleName -> Avails -> DocStructureItem
moduleExport (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc XRec GhcRn ModuleName
GenLocated SrcSpanAnnA ModuleName
lmn) Avails
avails
      (IEGroup XIEGroup GhcRn
_ Int
level LHsDoc GhcRn
doc, Avails
_)         -> Int -> HsDoc GhcRn -> DocStructureItem
DsiSectionHeading Int
level (LHsDoc GhcRn -> HsDoc GhcRn
forall l e. GenLocated l e -> e
unLoc LHsDoc GhcRn
doc)
      (IEDoc XIEDoc GhcRn
_ LHsDoc GhcRn
doc, Avails
_)                 -> HsDoc GhcRn -> DocStructureItem
DsiDocChunk (LHsDoc GhcRn -> HsDoc GhcRn
forall l e. GenLocated l e -> e
unLoc LHsDoc GhcRn
doc)
      (IEDocNamed XIEDocNamed GhcRn
_ String
name, Avails
_)           -> String -> DocStructureItem
DsiNamedChunkRef String
name
      (IE GhcRn
_, 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 = NonEmpty ModuleName
-> ModuleName
-> Map ModuleName (NonEmpty ModuleName)
-> NonEmpty ModuleName
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 = String -> NonEmpty ModuleName
forall a. HasCallStack => String -> a
error (String -> NonEmpty ModuleName) -> String -> NonEmpty ModuleName
forall a b. (a -> b) -> a -> b
$ String
"mkDocStructureFromExportList: "
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ModuleName -> String
moduleNameString (ModuleName -> String)
-> (Module -> ModuleName) -> Module -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName) Module
mdl
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Can't find alias " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
moduleNameString ModuleName
alias
        nubSortNE :: NonEmpty ModuleName -> NonEmpty ModuleName
nubSortNE = [ModuleName] -> NonEmpty ModuleName
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([ModuleName] -> NonEmpty ModuleName)
-> (NonEmpty ModuleName -> [ModuleName])
-> NonEmpty ModuleName
-> NonEmpty ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Set ModuleName -> [ModuleName]
forall a. Set a -> [a]
Set.toList (Set ModuleName -> [ModuleName])
-> (NonEmpty ModuleName -> Set ModuleName)
-> NonEmpty ModuleName
-> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList ([ModuleName] -> Set ModuleName)
-> (NonEmpty ModuleName -> [ModuleName])
-> NonEmpty ModuleName
-> Set ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    NonEmpty ModuleName -> [ModuleName]
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 =
        (NonEmpty ModuleName -> NonEmpty ModuleName -> NonEmpty ModuleName)
-> [(ModuleName, NonEmpty ModuleName)]
-> Map ModuleName (NonEmpty ModuleName)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith NonEmpty ModuleName -> NonEmpty ModuleName -> NonEmpty ModuleName
forall a. Semigroup a => a -> a -> a
(<>) ([(ModuleName, NonEmpty ModuleName)]
 -> Map ModuleName (NonEmpty ModuleName))
-> [(ModuleName, NonEmpty ModuleName)]
-> Map ModuleName (NonEmpty ModuleName)
forall a b. (a -> b) -> a -> b
$
          (ModuleName
this_mdl_name, ModuleName
this_mdl_name ModuleName -> [ModuleName] -> NonEmpty ModuleName
forall a. a -> [a] -> NonEmpty a
:| [])
          (ModuleName, NonEmpty ModuleName)
-> [(ModuleName, NonEmpty ModuleName)]
-> [(ModuleName, NonEmpty ModuleName)]
forall a. a -> [a] -> [a]
: ((((Module, [ImportedModsVal])
  -> [(ModuleName, NonEmpty ModuleName)])
 -> [(Module, [ImportedModsVal])]
 -> [(ModuleName, NonEmpty ModuleName)])
-> [(Module, [ImportedModsVal])]
-> ((Module, [ImportedModsVal])
    -> [(ModuleName, NonEmpty ModuleName)])
-> [(ModuleName, NonEmpty ModuleName)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Module, [ImportedModsVal])
 -> [(ModuleName, NonEmpty ModuleName)])
-> [(Module, [ImportedModsVal])]
-> [(ModuleName, NonEmpty ModuleName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModuleEnv [ImportedModsVal] -> [(Module, [ImportedModsVal])]
forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList ModuleEnv [ImportedModsVal]
imported) (((Module, [ImportedModsVal])
  -> [(ModuleName, NonEmpty ModuleName)])
 -> [(ModuleName, NonEmpty ModuleName)])
-> ((Module, [ImportedModsVal])
    -> [(ModuleName, NonEmpty ModuleName)])
-> [(ModuleName, NonEmpty ModuleName)]
forall a b. (a -> b) -> a -> b
$ \(Module
mdl, [ImportedModsVal]
imvs) ->
              [(ImportedModsVal -> ModuleName
imv_name ImportedModsVal
imv, Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mdl ModuleName -> [ModuleName] -> NonEmpty ModuleName
forall a. a -> [a] -> NonEmpty a
:| []) | ImportedModsVal
imv <- [ImportedModsVal]
imvs])
      where
        this_mdl_name :: ModuleName
this_mdl_name = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mdl

    imported :: ModuleEnv [ImportedModsVal]
    imported :: ModuleEnv [ImportedModsVal]
imported = ([ImportedBy] -> [ImportedModsVal])
-> ModuleEnv [ImportedBy] -> ModuleEnv [ImportedModsVal]
forall a b. (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv [ImportedBy] -> [ImportedModsVal]
importedByUser (ImportAvails -> ModuleEnv [ImportedBy]
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 GhcRn -> DocStructure
mkDocStructureFromDecls OccEnv Name
env Avails
all_exports HsGroup GhcRn
decls =
    (GenLocated SrcSpan DocStructureItem -> DocStructureItem)
-> [GenLocated SrcSpan DocStructureItem] -> DocStructure
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan DocStructureItem -> DocStructureItem
forall l e. GenLocated l e -> e
unLoc ([GenLocated SrcSpan DocStructureItem]
-> [GenLocated SrcSpan DocStructureItem]
forall a. [Located a] -> [Located a]
sortLocated ([GenLocated SrcSpan DocStructureItem]
docs [GenLocated SrcSpan DocStructureItem]
-> [GenLocated SrcSpan DocStructureItem]
-> [GenLocated SrcSpan DocStructureItem]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpan DocStructureItem]
avails))
  where
    avails :: [Located DocStructureItem]
    avails :: [GenLocated SrcSpan DocStructureItem]
avails = ((AvailInfo -> GenLocated SrcSpan DocStructureItem)
 -> Avails -> [GenLocated SrcSpan DocStructureItem])
-> Avails
-> (AvailInfo -> GenLocated SrcSpan DocStructureItem)
-> [GenLocated SrcSpan DocStructureItem]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (AvailInfo -> GenLocated SrcSpan DocStructureItem)
-> Avails -> [GenLocated SrcSpan DocStructureItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Avails
all_exports ((AvailInfo -> GenLocated SrcSpan DocStructureItem)
 -> [GenLocated SrcSpan DocStructureItem])
-> (AvailInfo -> GenLocated SrcSpan DocStructureItem)
-> [GenLocated SrcSpan DocStructureItem]
forall a b. (a -> b) -> a -> b
$ \AvailInfo
avail ->
      case Name -> Map Name SrcSpan -> Maybe SrcSpan
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 -> SrcSpan -> DocStructureItem -> GenLocated SrcSpan DocStructureItem
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 -> DocStructureItem -> GenLocated SrcSpan DocStructureItem
forall e. e -> Located e
noLoc (Avails -> DocStructureItem
DsiExports [AvailInfo
avail])
        -- Nothing -> panicDoc "mkDocStructureFromDecls: No loc found for"
        --                     (ppr avail)

    docs :: [GenLocated SrcSpan DocStructureItem]
docs = (GenLocated SrcSpanAnnA (DocDecl GhcRn)
 -> Maybe (GenLocated SrcSpan DocStructureItem))
-> [GenLocated SrcSpanAnnA (DocDecl GhcRn)]
-> [GenLocated SrcSpan DocStructureItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LDocDecl GhcRn -> Maybe (GenLocated SrcSpan DocStructureItem)
GenLocated SrcSpanAnnA (DocDecl GhcRn)
-> Maybe (GenLocated SrcSpan DocStructureItem)
structuralDoc (HsGroup GhcRn -> [LDocDecl GhcRn]
forall p. HsGroup p -> [LDocDecl p]
hs_docs HsGroup GhcRn
decls)

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

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

      LDocDecl GhcRn
_ -> Maybe (GenLocated SrcSpan DocStructureItem)
forall a. Maybe a
Nothing

    name_locs :: Map Name SrcSpan
name_locs = [(Name, SrcSpan)] -> Map Name SrcSpan
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((GenLocated SrcSpanAnnA (HsDecl GhcRn) -> [(Name, SrcSpan)])
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)] -> [(Name, SrcSpan)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (HsDecl GhcRn) -> [(Name, SrcSpan)]
ldeclNames (HsGroup GhcRn -> [LHsDecl GhcRn]
ungroup HsGroup GhcRn
decls))
    ldeclNames :: GenLocated SrcSpanAnnA (HsDecl GhcRn) -> [(Name, SrcSpan)]
ldeclNames (L SrcSpanAnnA
loc HsDecl GhcRn
d) = [Name] -> [SrcSpan] -> [(Name, SrcSpan)]
forall a b. [a] -> [b] -> [(a, b)]
zip (OccEnv Name -> HsDecl GhcRn -> [Name]
getMainDeclBinder OccEnv Name
env HsDecl GhcRn
d) (SrcSpan -> [SrcSpan]
forall a. a -> [a]
repeat (SrcSpanAnnA -> SrcSpan
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 :: Bool -> HsGroup (GhcPass pass) -> Map String (HsDoc (GhcPass pass))
getNamedChunks Bool
True HsGroup (GhcPass pass)
decls =
  [(String, HsDoc (GhcPass pass))]
-> Map String (HsDoc (GhcPass pass))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, HsDoc (GhcPass pass))]
 -> Map String (HsDoc (GhcPass pass)))
-> [(String, HsDoc (GhcPass pass))]
-> Map String (HsDoc (GhcPass pass))
forall a b. (a -> b) -> a -> b
$ ((DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass)))
 -> [DocDecl (GhcPass pass)] -> [(String, HsDoc (GhcPass pass))])
-> [DocDecl (GhcPass pass)]
-> (DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass)))
-> [(String, HsDoc (GhcPass pass))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass)))
-> [DocDecl (GhcPass pass)] -> [(String, HsDoc (GhcPass pass))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (GenLocated SrcSpanAnnA (DocDecl (GhcPass pass))
-> DocDecl (GhcPass pass)
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (DocDecl (GhcPass pass))
 -> DocDecl (GhcPass pass))
-> [GenLocated SrcSpanAnnA (DocDecl (GhcPass pass))]
-> [DocDecl (GhcPass pass)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsGroup (GhcPass pass) -> [LDocDecl (GhcPass pass)]
forall p. HsGroup p -> [LDocDecl p]
hs_docs HsGroup (GhcPass pass)
decls) ((DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass)))
 -> [(String, HsDoc (GhcPass pass))])
-> (DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass)))
-> [(String, HsDoc (GhcPass pass))]
forall a b. (a -> b) -> a -> b
$ \case
    DocCommentNamed String
name LHsDoc (GhcPass pass)
doc -> (String, HsDoc (GhcPass pass))
-> Maybe (String, HsDoc (GhcPass pass))
forall a. a -> Maybe a
Just (String
name, LHsDoc (GhcPass pass) -> HsDoc (GhcPass pass)
forall l e. GenLocated l e -> e
unLoc LHsDoc (GhcPass pass)
doc)
    DocDecl (GhcPass pass)
_                        -> Maybe (String, HsDoc (GhcPass pass))
forall a. Maybe a
Nothing
getNamedChunks Bool
False HsGroup (GhcPass pass)
_ = Map String (HsDoc (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 GhcRn, [HsDoc GhcRn])]
-> (UniqMap Name [HsDoc GhcRn],
    UniqMap Name (IntMap (HsDoc GhcRn)))
mkMaps OccEnv Name
env [Name]
instances [(LHsDecl GhcRn, [HsDoc GhcRn])]
decls =
    ( ([HsDoc GhcRn] -> [HsDoc GhcRn] -> [HsDoc GhcRn])
-> [[(Name, [HsDoc GhcRn])]] -> UniqMap Name [HsDoc GhcRn]
forall k (t :: * -> *) a.
(Uniquable k, Foldable t) =>
(a -> a -> a) -> t [(k, a)] -> UniqMap k a
listsToMapWith [HsDoc GhcRn] -> [HsDoc GhcRn] -> [HsDoc GhcRn]
forall a. [a] -> [a] -> [a]
(++) (([(Name, [HsDoc GhcRn])] -> [(Name, [HsDoc GhcRn])])
-> [[(Name, [HsDoc GhcRn])]] -> [[(Name, [HsDoc GhcRn])]]
forall a b. (a -> b) -> [a] -> [b]
map (((Name, [HsDoc GhcRn]) -> Name)
-> [(Name, [HsDoc GhcRn])] -> [(Name, [HsDoc GhcRn])]
forall a. (a -> Name) -> [a] -> [a]
nubByName (Name, [HsDoc GhcRn]) -> Name
forall a b. (a, b) -> a
fst) [[(Name, [HsDoc GhcRn])]]
decls')
    , (IntMap (HsDoc GhcRn)
 -> IntMap (HsDoc GhcRn) -> IntMap (HsDoc GhcRn))
-> [[(Name, IntMap (HsDoc GhcRn))]]
-> UniqMap Name (IntMap (HsDoc GhcRn))
forall k (t :: * -> *) a.
(Uniquable k, Foldable t) =>
(a -> a -> a) -> t [(k, a)] -> UniqMap k a
listsToMapWith IntMap (HsDoc GhcRn)
-> IntMap (HsDoc GhcRn) -> IntMap (HsDoc GhcRn)
forall a. Semigroup a => a -> a -> a
(<>) ((IntMap (HsDoc GhcRn) -> Bool)
-> [[(Name, IntMap (HsDoc GhcRn))]]
-> [[(Name, IntMap (HsDoc GhcRn))]]
forall b a. (b -> Bool) -> [[(a, b)]] -> [[(a, b)]]
filterMapping (Bool -> Bool
not (Bool -> Bool)
-> (IntMap (HsDoc GhcRn) -> Bool) -> IntMap (HsDoc GhcRn) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (HsDoc GhcRn) -> Bool
forall a. IntMap a -> Bool
IM.null) [[(Name, IntMap (HsDoc GhcRn))]]
args)
    )
  where
    ([[(Name, [HsDoc GhcRn])]]
decls', [[(Name, IntMap (HsDoc GhcRn))]]
args) = [([(Name, [HsDoc GhcRn])], [(Name, IntMap (HsDoc GhcRn))])]
-> ([[(Name, [HsDoc GhcRn])]], [[(Name, IntMap (HsDoc GhcRn))]])
forall a b. [(a, b)] -> ([a], [b])
unzip (((GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])
 -> ([(Name, [HsDoc GhcRn])], [(Name, IntMap (HsDoc GhcRn))]))
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
-> [([(Name, [HsDoc GhcRn])], [(Name, IntMap (HsDoc GhcRn))])]
forall a b. (a -> b) -> [a] -> [b]
map (LHsDecl GhcRn, [HsDoc GhcRn])
-> ([(Name, [HsDoc GhcRn])], [(Name, IntMap (HsDoc GhcRn))])
(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])
-> ([(Name, [HsDoc GhcRn])], [(Name, IntMap (HsDoc GhcRn))])
mappings [(LHsDecl GhcRn, [HsDoc GhcRn])]
[(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
decls)

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

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

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

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

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

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

    instanceMap :: Map RealSrcSpan Name
    instanceMap :: Map RealSrcSpan Name
instanceMap = [(RealSrcSpan, Name)] -> Map RealSrcSpan Name
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
_ <- [Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
n] ]

    names :: RealSrcSpan -> HsDecl GhcRn -> [Name]
    names :: RealSrcSpan -> HsDecl GhcRn -> [Name]
names RealSrcSpan
_ (InstD XInstD GhcRn
_ InstDecl GhcRn
d) = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan (InstDecl GhcRn -> SrcSpan
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
InstDecl (GhcPass p) -> SrcSpan
getInstLoc InstDecl GhcRn
d) Map RealSrcSpan Name
instanceMap
    names RealSrcSpan
l (DerivD {}) = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (RealSrcSpan -> Map RealSrcSpan Name -> Maybe Name
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 GhcRn
decl = OccEnv Name -> HsDecl GhcRn -> [Name]
getMainDeclBinder OccEnv Name
env HsDecl GhcRn
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 GhcRn -> [Name]
getMainDeclBinder OccEnv Name
_ (TyClD XTyClD GhcRn
_ TyClDecl GhcRn
d) = [TyClDecl GhcRn -> IdP GhcRn
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
TyClDecl (GhcPass p) -> IdP (GhcPass p)
tcdName TyClDecl GhcRn
d]
getMainDeclBinder OccEnv Name
_ (ValD XValD GhcRn
_ HsBind GhcRn
d) =
  case CollectFlag GhcRn -> HsBind GhcRn -> [IdP GhcRn]
forall p idR.
CollectPass p =>
CollectFlag p -> HsBindLR p idR -> [IdP p]
collectHsBindBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders HsBind GhcRn
d of
    []       -> []
    (IdP GhcRn
name:[IdP GhcRn]
_) -> [IdP GhcRn
Name
name]
getMainDeclBinder OccEnv Name
env (SigD XSigD GhcRn
_ Sig GhcRn
d) = OccEnv (IdP GhcRn) -> Sig GhcRn -> [IdP GhcRn]
forall a.
(UnXRec a, HasOccName (IdP a)) =>
OccEnv (IdP a) -> Sig a -> [IdP a]
sigNameNoLoc OccEnv (IdP GhcRn)
OccEnv Name
env Sig GhcRn
d
getMainDeclBinder OccEnv Name
_   (ForD XForD GhcRn
_ (ForeignImport XForeignImport GhcRn
_ LIdP GhcRn
name LHsSigType GhcRn
_ ForeignImport
_)) = [GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
name]
getMainDeclBinder OccEnv Name
_   (ForD XForD GhcRn
_ (ForeignExport XForeignExport GhcRn
_ LIdP GhcRn
_ LHsSigType GhcRn
_ ForeignExport
_)) = []
getMainDeclBinder OccEnv Name
_ HsDecl GhcRn
_ = []


-- | 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 :: OccEnv (IdP a) -> Sig a -> [IdP a]
sigNameNoLoc OccEnv (IdP a)
_   (TypeSig    XTypeSig a
_   [LIdP a]
ns LHsSigWcType a
_)         = (LIdP a -> IdP a) -> [LIdP a] -> [IdP a]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. UnXRec a => XRec a a -> a
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
_)     = (LIdP a -> IdP a) -> [LIdP a] -> [IdP a]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. UnXRec a => XRec a a -> a
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
_)     = (IdP a -> Maybe (IdP a)) -> [IdP a] -> [IdP a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (OccEnv (IdP a) -> OccName -> Maybe (IdP a)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (IdP a)
env (OccName -> Maybe (IdP a))
-> (IdP a -> OccName) -> IdP a -> Maybe (IdP a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> OccName
mkDefaultMethodOcc (OccName -> OccName) -> (IdP a -> OccName) -> IdP a -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdP a -> OccName
forall name. HasOccName name => name -> OccName
occName) ([IdP a] -> [IdP a]) -> [IdP a] -> [IdP a]
forall a b. (a -> b) -> a -> b
$ (LIdP a -> IdP a) -> [LIdP a] -> [IdP a]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. UnXRec a => XRec a a -> a
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
_)         = (LIdP a -> IdP a) -> [LIdP a] -> [IdP a]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. UnXRec a => XRec a a -> a
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
_)        = [LIdP a -> IdP a
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
_)          = [LIdP a -> IdP a
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
_)) = (LIdP a -> IdP a) -> [LIdP a] -> [IdP a]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. UnXRec a => XRec a a -> a
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 :: 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 }) -> GenLocated SrcSpanAnnA (HsSigType (GhcPass p)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsSigType (GhcPass p)
GenLocated SrcSpanAnnA (HsSigType (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 l _ }}) -> SrcSpanAnnN -> SrcSpan
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 l _ }}) -> SrcSpanAnnN -> SrcSpan
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 GhcRn
-> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
subordinates OccEnv Name
env Map RealSrcSpan Name
instMap HsDecl GhcRn
decl = case HsDecl GhcRn
decl of
  InstD XInstD GhcRn
_ (ClsInstD XClsInstD GhcRn
_ ClsInstDecl GhcRn
d) -> let
    data_fams :: [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
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 l _
               , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs   = HsDataDefn GhcRn
defn }} <- GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)
-> DataFamInstDecl GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)
 -> DataFamInstDecl GhcRn)
-> [GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)]
-> [DataFamInstDecl GhcRn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClsInstDecl GhcRn -> [LDataFamInstDecl GhcRn]
forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts ClsInstDecl GhcRn
d
      [ (Name
n, [], IntMap (HsDoc GhcRn)
forall a. IntMap a
IM.empty) | Just Name
n <- [SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l) Map RealSrcSpan Name
instMap] ] [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
-> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
-> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
forall a. [a] -> [a] -> [a]
++ HsDataDefn GhcRn -> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
dataSubs HsDataDefn GhcRn
defn
    ty_fams :: [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
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 l _ } } <- GenLocated SrcSpanAnnA (TyFamInstDecl GhcRn) -> TyFamInstDecl GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (TyFamInstDecl GhcRn)
 -> TyFamInstDecl GhcRn)
-> [GenLocated SrcSpanAnnA (TyFamInstDecl GhcRn)]
-> [TyFamInstDecl GhcRn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClsInstDecl GhcRn -> [LTyFamInstDecl GhcRn]
forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts ClsInstDecl GhcRn
d
      [ (Name
n, [], IntMap (HsDoc GhcRn)
forall a. IntMap a
IM.empty) | Just Name
n <- [SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l) Map RealSrcSpan Name
instMap] ]
    in [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
data_fams [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
-> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
-> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
ty_fams

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

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

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

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

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

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

isValD :: HsDecl a -> Bool
isValD :: 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 GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])]
classDecls TyClDecl GhcRn
class_ = [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterDecls ([(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])])
-> ([GenLocated SrcSpanAnnA (HsDecl GhcRn)]
    -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])])
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
collectDocs ([GenLocated SrcSpanAnnA (HsDecl GhcRn)]
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])])
-> ([GenLocated SrcSpanAnnA (HsDecl GhcRn)]
    -> [GenLocated SrcSpanAnnA (HsDecl GhcRn)])
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall a e.
[GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e]
sortLocatedA ([GenLocated SrcSpanAnnA (HsDecl GhcRn)]
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])])
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
decls
  where
    decls :: [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
decls = [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
docs [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
defs [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
sigs [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
ats
    docs :: [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
docs  = (TyClDecl GhcRn -> [GenLocated SrcSpanAnnA (DocDecl GhcRn)])
-> (DocDecl GhcRn -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls TyClDecl GhcRn -> [GenLocated SrcSpanAnnA (DocDecl GhcRn)]
forall pass. TyClDecl pass -> [LDocDecl pass]
tcdDocs (XDocD GhcRn -> DocDecl GhcRn -> HsDecl GhcRn
forall p. XDocD p -> DocDecl p -> HsDecl p
DocD NoExtField
XDocD GhcRn
noExtField) TyClDecl GhcRn
class_
    defs :: [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
defs  = (TyClDecl GhcRn -> [GenLocated SrcSpanAnnA (HsBind GhcRn)])
-> (HsBind GhcRn -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls (Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
forall a. Bag a -> [a]
bagToList (Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))
 -> [GenLocated SrcSpanAnnA (HsBind GhcRn)])
-> (TyClDecl GhcRn -> Bag (GenLocated SrcSpanAnnA (HsBind GhcRn)))
-> TyClDecl GhcRn
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyClDecl GhcRn -> Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))
forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths) (XValD GhcRn -> HsBind GhcRn -> HsDecl GhcRn
forall p. XValD p -> HsBind p -> HsDecl p
ValD NoExtField
XValD GhcRn
noExtField) TyClDecl GhcRn
class_
    sigs :: [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
sigs  = (TyClDecl GhcRn -> [GenLocated SrcSpanAnnA (Sig GhcRn)])
-> (Sig GhcRn -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls TyClDecl GhcRn -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
forall pass. TyClDecl pass -> [LSig pass]
tcdSigs (XSigD GhcRn -> Sig GhcRn -> HsDecl GhcRn
forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
XSigD GhcRn
noExtField) TyClDecl GhcRn
class_
    ats :: [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
ats   = (TyClDecl GhcRn -> [GenLocated SrcSpanAnnA (FamilyDecl GhcRn)])
-> (FamilyDecl GhcRn -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall struct l decl hsDecl.
(struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls TyClDecl GhcRn -> [GenLocated SrcSpanAnnA (FamilyDecl GhcRn)]
forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs (XTyClD GhcRn -> TyClDecl GhcRn -> HsDecl GhcRn
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
XTyClD GhcRn
noExtField (TyClDecl GhcRn -> HsDecl GhcRn)
-> (FamilyDecl GhcRn -> TyClDecl GhcRn)
-> FamilyDecl GhcRn
-> HsDecl GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFamDecl GhcRn -> FamilyDecl GhcRn -> TyClDecl GhcRn
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl NoExtField
XFamDecl GhcRn
noExtField) TyClDecl GhcRn
class_

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

nubByName :: (a -> Name) -> [a] -> [a]
nubByName :: (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 a -> [a] -> [a]
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 GhcRn -> IntMap (HsDoc GhcRn)
typeDocs = Int -> HsType GhcRn -> IntMap (HsDoc GhcRn)
forall pass l.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
Int -> HsType pass -> IntMap (HsDoc pass)
go Int
0
  where
    go :: Int -> HsType pass -> IntMap (HsDoc pass)
go Int
n = \case
      HsForAllTy { hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = XRec pass (HsType pass)
ty }          -> Int -> HsType pass -> IntMap (HsDoc pass)
go Int
n (GenLocated l (HsType pass) -> HsType pass
forall l e. GenLocated l e -> e
unLoc XRec pass (HsType pass)
GenLocated l (HsType pass)
ty)
      HsQualTy   { hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = XRec pass (HsType pass)
ty }          -> Int -> HsType pass -> IntMap (HsDoc pass)
go Int
n (GenLocated l (HsType pass) -> HsType pass
forall l e. GenLocated l e -> e
unLoc XRec pass (HsType pass)
GenLocated l (HsType pass)
ty)
      HsFunTy XFunTy pass
_ HsArrow pass
_ (XRec pass (HsType pass) -> HsType pass
forall l e. GenLocated l e -> e
unLoc->HsDocTy XDocTy pass
_ XRec pass (HsType pass)
_ LHsDoc pass
x) XRec pass (HsType pass)
ty -> Int -> HsDoc pass -> IntMap (HsDoc pass) -> IntMap (HsDoc pass)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
n (LHsDoc pass -> HsDoc pass
forall l e. GenLocated l e -> e
unLoc LHsDoc pass
x) (IntMap (HsDoc pass) -> IntMap (HsDoc pass))
-> IntMap (HsDoc pass) -> IntMap (HsDoc pass)
forall a b. (a -> b) -> a -> b
$ Int -> HsType pass -> IntMap (HsDoc pass)
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (GenLocated l (HsType pass) -> HsType pass
forall l e. GenLocated l e -> e
unLoc XRec pass (HsType pass)
GenLocated l (HsType pass)
ty)
      HsFunTy XFunTy pass
_ HsArrow pass
_ XRec pass (HsType pass)
_ XRec pass (HsType pass)
ty                      -> Int -> HsType pass -> IntMap (HsDoc pass)
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (GenLocated l (HsType pass) -> HsType pass
forall l e. GenLocated l e -> e
unLoc XRec pass (HsType pass)
GenLocated l (HsType pass)
ty)
      HsDocTy XDocTy pass
_ XRec pass (HsType pass)
_ LHsDoc pass
doc                       -> Int -> HsDoc pass -> IntMap (HsDoc pass)
forall a. Int -> a -> IntMap a
IM.singleton Int
n (LHsDoc pass -> HsDoc pass
forall l e. GenLocated l e -> e
unLoc LHsDoc pass
doc)
      HsType pass
_                                     -> IntMap (HsDoc pass)
forall a. IntMap a
IM.empty

-- | Extract function argument docs from inside types.
sigTypeDocs :: HsSigType GhcRn -> IntMap (HsDoc GhcRn)
sigTypeDocs :: HsSigType GhcRn -> IntMap (HsDoc GhcRn)
sigTypeDocs (HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcRn
body}) = HsType GhcRn -> IntMap (HsDoc GhcRn)
typeDocs (GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
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 GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])]
topDecls = [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall (p :: Pass) doc.
IsPass p =>
[(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)]
filterClasses ([(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])])
-> (HsGroup GhcRn
    -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])])
-> HsGroup GhcRn
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterDecls ([(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])])
-> (HsGroup GhcRn
    -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])])
-> HsGroup GhcRn
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
collectDocs ([GenLocated SrcSpanAnnA (HsDecl GhcRn)]
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])])
-> (HsGroup GhcRn -> [GenLocated SrcSpanAnnA (HsDecl GhcRn)])
-> HsGroup GhcRn
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDoc GhcRn])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall a e.
[GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e]
sortLocatedA ([GenLocated SrcSpanAnnA (HsDecl GhcRn)]
 -> [GenLocated SrcSpanAnnA (HsDecl GhcRn)])
-> (HsGroup GhcRn -> [GenLocated SrcSpanAnnA (HsDecl GhcRn)])
-> HsGroup GhcRn
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup GhcRn -> [LHsDecl GhcRn]
HsGroup GhcRn -> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
ungroup

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

    valbinds :: HsValBinds GhcRn -> [LHsBind GhcRn]
    valbinds :: HsValBinds GhcRn -> [LHsBind GhcRn]
valbinds (XValBindsLR (NValBinds binds _)) =
      (Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))
 -> [GenLocated SrcSpanAnnA (HsBind GhcRn)])
-> [Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))]
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
forall a. Bag a -> [a]
bagToList ([Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))]
 -> [GenLocated SrcSpanAnnA (HsBind GhcRn)])
-> ([(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcRn)))]
    -> [Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))])
-> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcRn)))]
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RecFlag], [Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))])
-> [Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))]
forall a b. (a, b) -> b
snd (([RecFlag], [Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))])
 -> [Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))])
-> ([(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcRn)))]
    -> ([RecFlag], [Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))]))
-> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcRn)))]
-> [Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcRn)))]
-> ([RecFlag], [Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcRn)))]
 -> [GenLocated SrcSpanAnnA (HsBind GhcRn)])
-> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcRn)))]
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
forall a b. (a -> b) -> a -> b
$ [(RecFlag, LHsBinds GhcRn)]
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcRn)))]
binds
    valbinds ValBinds{} = String -> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
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 :: [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
collectDocs = [HsDoc p]
-> Maybe (LHsDecl p) -> [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
go [] Maybe (LHsDecl p)
forall a. Maybe a
Nothing
  where
    go :: [HsDoc p]
-> Maybe (LHsDecl p) -> [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
go [HsDoc p]
docs Maybe (LHsDecl p)
mprev [LHsDecl p]
decls = case ([LHsDecl p]
decls, Maybe (LHsDecl p)
mprev) of
      ((forall a. UnXRec p => XRec p a -> a
forall p a. UnXRec p => XRec p a -> a
unXRec @p -> DocD XDocD p
_ (DocCommentNext LHsDoc p
s)) : [LHsDecl p]
ds, Maybe (LHsDecl p)
Nothing)   -> [HsDoc p]
-> Maybe (LHsDecl p) -> [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
go (LHsDoc p -> HsDoc p
forall l e. GenLocated l e -> e
unLoc LHsDoc p
sHsDoc p -> [HsDoc p] -> [HsDoc p]
forall a. a -> [a] -> [a]
:[HsDoc p]
docs) Maybe (LHsDecl p)
forall a. Maybe a
Nothing [LHsDecl p]
ds
      ((forall a. UnXRec p => XRec p a -> a
forall p a. UnXRec p => XRec p a -> a
unXRec @p -> DocD XDocD p
_ (DocCommentNext LHsDoc p
s)) : [LHsDecl p]
ds, Just LHsDecl p
prev) -> LHsDecl p
-> [HsDoc p]
-> [(LHsDecl p, [HsDoc p])]
-> [(LHsDecl p, [HsDoc p])]
forall a a. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished LHsDecl p
prev [HsDoc p]
docs ([(LHsDecl p, [HsDoc p])] -> [(LHsDecl p, [HsDoc p])])
-> [(LHsDecl p, [HsDoc p])] -> [(LHsDecl p, [HsDoc p])]
forall a b. (a -> b) -> a -> b
$ [HsDoc p]
-> Maybe (LHsDecl p) -> [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
go [LHsDoc p -> HsDoc p
forall l e. GenLocated l e -> e
unLoc LHsDoc p
s] Maybe (LHsDecl p)
forall a. Maybe a
Nothing [LHsDecl p]
ds
      ((forall a. UnXRec p => XRec p a -> a
forall p a. UnXRec p => XRec p a -> a
unXRec @p -> DocD XDocD p
_ (DocCommentPrev LHsDoc p
s)) : [LHsDecl p]
ds, Maybe (LHsDecl p)
mprev)     -> [HsDoc p]
-> Maybe (LHsDecl p) -> [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
go (LHsDoc p -> HsDoc p
forall l e. GenLocated l e -> e
unLoc LHsDoc p
sHsDoc p -> [HsDoc p] -> [HsDoc p]
forall a. a -> [a] -> [a]
:[HsDoc p]
docs) Maybe (LHsDecl p)
mprev [LHsDecl p]
ds
      (LHsDecl p
d                                  : [LHsDecl p]
ds, Maybe (LHsDecl p)
Nothing)   -> [HsDoc p]
-> Maybe (LHsDecl p) -> [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
go [HsDoc p]
docs (LHsDecl p -> Maybe (LHsDecl p)
forall a. a -> Maybe a
Just LHsDecl p
d) [LHsDecl p]
ds
      (LHsDecl p
d                                  : [LHsDecl p]
ds, Just LHsDecl p
prev) -> LHsDecl p
-> [HsDoc p]
-> [(LHsDecl p, [HsDoc p])]
-> [(LHsDecl p, [HsDoc p])]
forall a a. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished LHsDecl p
prev [HsDoc p]
docs ([(LHsDecl p, [HsDoc p])] -> [(LHsDecl p, [HsDoc p])])
-> [(LHsDecl p, [HsDoc p])] -> [(LHsDecl p, [HsDoc p])]
forall a b. (a -> b) -> a -> b
$ [HsDoc p]
-> Maybe (LHsDecl p) -> [LHsDecl p] -> [(LHsDecl p, [HsDoc p])]
go [] (LHsDecl p -> Maybe (LHsDecl p)
forall a. a -> Maybe a
Just LHsDecl p
d) [LHsDecl p]
ds
      ([]                                     , Maybe (LHsDecl p)
Nothing)   -> []
      ([]                                     , Just LHsDecl p
prev) -> LHsDecl p
-> [HsDoc p]
-> [(LHsDecl p, [HsDoc p])]
-> [(LHsDecl p, [HsDoc p])]
forall a a. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished LHsDecl p
prev [HsDoc p]
docs []

    finished :: a -> [a] -> [(a, [a])] -> [(a, [a])]
finished a
decl [a]
docs [(a, [a])]
rest = (a
decl, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
docs) (a, [a]) -> [(a, [a])] -> [(a, [a])]
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 :: [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterDecls = ((LHsDecl p, doc) -> Bool)
-> [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
forall a. (a -> Bool) -> [a] -> [a]
filter (HsDecl p -> Bool
forall a. HsDecl a -> Bool
isHandled (HsDecl p -> Bool)
-> ((LHsDecl p, doc) -> HsDecl p) -> (LHsDecl p, doc) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. UnXRec p => XRec p a -> a
forall p a. UnXRec p => XRec p a -> a
unXRec @p (LHsDecl p -> HsDecl p)
-> ((LHsDecl p, doc) -> LHsDecl p) -> (LHsDecl p, doc) -> HsDecl p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsDecl p, doc) -> LHsDecl p
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)  = Sig name -> Bool
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 :: [(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)]
filterClasses = ((GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc)
 -> (GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc))
-> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc)]
-> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc)]
forall a b. (a -> b) -> [a] -> [b]
map ((GenLocated SrcSpanAnnA (HsDecl (GhcPass p))
 -> GenLocated SrcSpanAnnA (HsDecl (GhcPass p)))
-> (GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc)
-> (GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((HsDecl (GhcPass p) -> HsDecl (GhcPass p))
-> GenLocated SrcSpanAnnA (HsDecl (GhcPass p))
-> GenLocated SrcSpanAnnA (HsDecl (GhcPass p))
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc HsDecl (GhcPass p) -> HsDecl (GhcPass p)
forall p l.
(UnXRec p, XRec p (Sig p) ~ GenLocated l (Sig p)) =>
HsDecl p -> HsDecl p
filterClass))
  where
    filterClass :: HsDecl p -> HsDecl p
filterClass (TyClD XTyClD p
x c :: TyClDecl p
c@(ClassDecl {})) =
      XTyClD p -> TyClDecl p -> HsDecl p
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD p
x (TyClDecl p -> HsDecl p) -> TyClDecl p -> HsDecl p
forall a b. (a -> b) -> a -> b
$ TyClDecl p
c { tcdSigs :: [XRec p (Sig p)]
tcdSigs =
        (GenLocated l (Sig p) -> Bool)
-> [GenLocated l (Sig p)] -> [GenLocated l (Sig p)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool)
-> (GenLocated l (Sig p) -> Bool)
-> (GenLocated l (Sig p) -> Bool)
-> GenLocated l (Sig p)
-> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Sig p -> Bool
forall name. Sig name -> Bool
isUserSig (Sig p -> Bool)
-> (GenLocated l (Sig p) -> Sig p) -> GenLocated l (Sig p) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (Sig p) -> Sig p
forall l e. GenLocated l e -> e
unLoc) GenLocated l (Sig p) -> Bool
forall p. UnXRec p => LSig p -> Bool
isMinimalLSig) (TyClDecl p -> [XRec p (Sig p)]
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 :: 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 :: (struct -> [GenLocated l decl])
-> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
mkDecls struct -> [GenLocated l decl]
field decl -> hsDecl
con = (GenLocated l decl -> GenLocated l hsDecl)
-> [GenLocated l decl] -> [GenLocated l hsDecl]
forall a b. (a -> b) -> [a] -> [b]
map ((decl -> hsDecl) -> GenLocated l decl -> GenLocated l hsDecl
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc decl -> hsDecl
con) ([GenLocated l decl] -> [GenLocated l hsDecl])
-> (struct -> [GenLocated l decl])
-> struct
-> [GenLocated l hsDecl]
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 :: Maybe (HsDoc GhcRn)
-> UniqMap Name (HsDoc GhcRn)
-> UniqMap Name (IntMap (HsDoc GhcRn))
-> UniqMap Name (HsDoc GhcRn)
-> ExtractedTHDocs
ExtractedTHDocs
    { ethd_mod_header :: Maybe (HsDoc GhcRn)
ethd_mod_header = Maybe (HsDoc GhcRn)
docHeader
    , ethd_decl_docs :: UniqMap Name (HsDoc GhcRn)
ethd_decl_docs  = (UniqMap Name (HsDoc GhcRn)
 -> (DocLoc, HsDoc GhcRn) -> UniqMap Name (HsDoc GhcRn))
-> UniqMap Name (HsDoc GhcRn)
forall a.
(UniqMap Name a -> (DocLoc, HsDoc GhcRn) -> UniqMap Name a)
-> UniqMap Name a
searchDocs UniqMap Name (HsDoc GhcRn)
-> (DocLoc, HsDoc GhcRn) -> UniqMap Name (HsDoc GhcRn)
forall a. UniqMap Name a -> (DocLoc, a) -> UniqMap Name a
decl
    , ethd_arg_docs :: UniqMap Name (IntMap (HsDoc GhcRn))
ethd_arg_docs   = (UniqMap Name (IntMap (HsDoc GhcRn))
 -> (DocLoc, HsDoc GhcRn) -> UniqMap Name (IntMap (HsDoc GhcRn)))
-> UniqMap Name (IntMap (HsDoc GhcRn))
forall a.
(UniqMap Name a -> (DocLoc, HsDoc GhcRn) -> UniqMap Name a)
-> UniqMap Name a
searchDocs UniqMap Name (IntMap (HsDoc GhcRn))
-> (DocLoc, HsDoc GhcRn) -> UniqMap Name (IntMap (HsDoc GhcRn))
args
    , ethd_inst_docs :: UniqMap Name (HsDoc GhcRn)
ethd_inst_docs  = (UniqMap Name (HsDoc GhcRn)
 -> (DocLoc, HsDoc GhcRn) -> UniqMap Name (HsDoc GhcRn))
-> UniqMap Name (HsDoc GhcRn)
forall a.
(UniqMap Name a -> (DocLoc, HsDoc GhcRn) -> UniqMap Name a)
-> UniqMap Name a
searchDocs UniqMap Name (HsDoc GhcRn)
-> (DocLoc, HsDoc GhcRn) -> UniqMap Name (HsDoc GhcRn)
forall a. UniqMap Name a -> (DocLoc, a) -> UniqMap Name a
insts
    }
  where
    docHeader :: Maybe (HsDoc GhcRn)
    docHeader :: Maybe (HsDoc GhcRn)
docHeader
      | ((DocLoc
_, HsDoc GhcRn
s):[(DocLoc, HsDoc GhcRn)]
_) <- ((DocLoc, HsDoc GhcRn) -> Bool)
-> [(DocLoc, HsDoc GhcRn)] -> [(DocLoc, HsDoc GhcRn)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocLoc, HsDoc GhcRn) -> Bool
forall b. (DocLoc, b) -> Bool
isModDoc (THDocs -> [(DocLoc, HsDoc GhcRn)]
forall k a. Map k a -> [(k, a)]
M.toList THDocs
docs) = HsDoc GhcRn -> Maybe (HsDoc GhcRn)
forall a. a -> Maybe a
Just HsDoc GhcRn
s
      | Bool
otherwise = Maybe (HsDoc GhcRn)
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 :: (UniqMap Name a -> (DocLoc, HsDoc GhcRn) -> UniqMap Name a)
-> UniqMap Name a
searchDocs UniqMap Name a -> (DocLoc, HsDoc GhcRn) -> UniqMap Name a
f = (UniqMap Name a -> (DocLoc, HsDoc GhcRn) -> UniqMap Name a)
-> UniqMap Name a -> [(DocLoc, HsDoc GhcRn)] -> UniqMap Name a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UniqMap Name a -> (DocLoc, HsDoc GhcRn) -> UniqMap Name a
f UniqMap Name a
forall k a. UniqMap k a
emptyUniqMap ([(DocLoc, HsDoc GhcRn)] -> UniqMap Name a)
-> [(DocLoc, HsDoc GhcRn)] -> UniqMap Name a
forall a b. (a -> b) -> a -> b
$ THDocs -> [(DocLoc, HsDoc GhcRn)]
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) = UniqMap Name a -> Name -> a -> UniqMap Name a
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) = UniqMap Name a -> Name -> a -> UniqMap Name a
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 GhcRn))
-> (DocLoc, HsDoc GhcRn) -> UniqMap Name (IntMap (HsDoc GhcRn))
args UniqMap Name (IntMap (HsDoc GhcRn))
acc ((ArgDoc Name
name Int
i), HsDoc GhcRn
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
       (IntMap (HsDoc GhcRn)
 -> IntMap (HsDoc GhcRn) -> IntMap (HsDoc GhcRn))
-> UniqMap Name (IntMap (HsDoc GhcRn))
-> Name
-> IntMap (HsDoc GhcRn)
-> UniqMap Name (IntMap (HsDoc GhcRn))
forall k a.
Uniquable k =>
(a -> a -> a) -> UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap_C (\IntMap (HsDoc GhcRn)
_ IntMap (HsDoc GhcRn)
m -> Int -> HsDoc GhcRn -> IntMap (HsDoc GhcRn) -> IntMap (HsDoc GhcRn)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
i HsDoc GhcRn
s IntMap (HsDoc GhcRn)
m) UniqMap Name (IntMap (HsDoc GhcRn))
acc Name
name (Int -> HsDoc GhcRn -> IntMap (HsDoc GhcRn)
forall a. Int -> a -> IntMap a
IM.singleton Int
i HsDoc GhcRn
s)
    args UniqMap Name (IntMap (HsDoc GhcRn))
acc (DocLoc, HsDoc GhcRn)
_ = UniqMap Name (IntMap (HsDoc GhcRn))
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 :: UniqMap Name (IntMap b)
-> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b)
unionArgMaps UniqMap Name (IntMap b)
a UniqMap Name (IntMap b)
b = ((Name, IntMap b)
 -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b))
-> UniqMap Name (IntMap b)
-> UniqMap Name (IntMap b)
-> UniqMap Name (IntMap 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 <- UniqMap Name (IntMap b) -> Name -> Maybe (IntMap b)
forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
lookupUniqMap UniqMap Name (IntMap b)
acc Name
n =
          UniqMap Name (IntMap b)
-> Name -> IntMap b -> UniqMap Name (IntMap b)
forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap UniqMap Name (IntMap b)
acc Name
n (IntMap b
newArgMap IntMap b -> IntMap b -> IntMap b
forall a. IntMap a -> IntMap a -> IntMap a
`IM.union` IntMap b
oldArgMap)
      | Bool
otherwise = UniqMap Name (IntMap b)
-> Name -> IntMap b -> UniqMap Name (IntMap b)
forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap UniqMap Name (IntMap b)
acc Name
n IntMap b
newArgMap