{-# LANGUAGE CPP, TupleSections, BangPatterns, LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wwarn #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.Interface.Create
-- Copyright   :  (c) Simon Marlow      2003-2006,
--                    David Waern       2006-2009,
--                    Mateusz Kowalczyk 2013
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- This module provides a single function 'createInterface',
-- which creates a Haddock 'Interface' from the typechecking
-- results 'TypecheckedModule' from GHC.
-----------------------------------------------------------------------------
module Haddock.Interface.Create (createInterface) where

import Documentation.Haddock.Doc (metaDocAppend)
import Haddock.Types
import Haddock.Options
import Haddock.GhcUtils
import Haddock.Utils
import Haddock.Convert
import Haddock.Interface.LexParseRn

import Data.Bifunctor
import Data.Bitraversable
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Map (Map)
import Data.List (find, foldl', sortBy)
import Data.Maybe
import Data.Ord
import Control.Applicative
import Control.Monad
import Data.Traversable
import GHC.Stack (HasCallStack)

import Avail hiding (avail)
import qualified Avail
import qualified Module
import qualified SrcLoc
import ConLike (ConLike(..))
import GHC
import HscTypes
import Name
import NameSet
import NameEnv
import Packages   ( lookupModuleInAllPackages, PackageName(..) )
import Bag
import RdrName
import TcRnTypes
import FastString ( unpackFS, bytesFS )
import BasicTypes ( StringLiteral(..), SourceText(..), PromotionFlag(..) )
import qualified Outputable as O

mkExceptionContext :: TypecheckedModule -> String
mkExceptionContext :: TypecheckedModule -> String
mkExceptionContext =
  (String
"creating Haddock interface for " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (TypecheckedModule -> String) -> TypecheckedModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString (ModuleName -> String)
-> (TypecheckedModule -> ModuleName) -> TypecheckedModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> ModuleName
ms_mod_name (ModSummary -> ModuleName)
-> (TypecheckedModule -> ModSummary)
-> TypecheckedModule
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary (ParsedModule -> ModSummary)
-> (TypecheckedModule -> ParsedModule)
-> TypecheckedModule
-> ModSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypecheckedModule -> ParsedModule
tm_parsed_module

-- | Use a 'TypecheckedModule' to produce an 'Interface'.
-- To do this, we need access to already processed modules in the topological
-- sort. That's what's in the 'IfaceMap'.
createInterface :: HasCallStack
                => TypecheckedModule
                -> [Flag]       -- Boolean flags
                -> IfaceMap     -- Locally processed modules
                -> InstIfaceMap -- External, already installed interfaces
                -> ErrMsgGhc Interface
createInterface :: TypecheckedModule
-> [Flag] -> IfaceMap -> InstIfaceMap -> ErrMsgGhc Interface
createInterface TypecheckedModule
tm [Flag]
flags IfaceMap
modMap InstIfaceMap
instIfaceMap =
 String -> ErrMsgGhc Interface -> ErrMsgGhc Interface
forall (m :: * -> *) a. ExceptionMonad m => String -> m a -> m a
withExceptionContext (TypecheckedModule -> String
mkExceptionContext TypecheckedModule
tm) (ErrMsgGhc Interface -> ErrMsgGhc Interface)
-> ErrMsgGhc Interface -> ErrMsgGhc Interface
forall a b. (a -> b) -> a -> b
$ do

  let ms :: ModSummary
ms             = ParsedModule -> ModSummary
pm_mod_summary (ParsedModule -> ModSummary)
-> (TypecheckedModule -> ParsedModule)
-> TypecheckedModule
-> ModSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypecheckedModule -> ParsedModule
tm_parsed_module (TypecheckedModule -> ModSummary)
-> TypecheckedModule -> ModSummary
forall a b. (a -> b) -> a -> b
$ TypecheckedModule
tm
      mi :: ModuleInfo
mi             = TypecheckedModule -> ModuleInfo
forall m. TypecheckedMod m => m -> ModuleInfo
moduleInfo TypecheckedModule
tm
      L SrcSpan
_ HsModule GhcPs
hsm        = TypecheckedModule -> GenLocated SrcSpan (HsModule GhcPs)
forall m. ParsedMod m => m -> GenLocated SrcSpan (HsModule GhcPs)
parsedSource TypecheckedModule
tm
      !safety :: SafeHaskellMode
safety        = ModuleInfo -> SafeHaskellMode
modInfoSafe ModuleInfo
mi
      mdl :: Module
mdl            = ModSummary -> Module
ms_mod ModSummary
ms
      sem_mdl :: Module
sem_mdl        = TcGblEnv -> Module
tcg_semantic_mod ((TcGblEnv, ModDetails) -> TcGblEnv
forall a b. (a, b) -> a
fst (TypecheckedModule -> (TcGblEnv, ModDetails)
tm_internals_ TypecheckedModule
tm))
      is_sig :: Bool
is_sig         = ModSummary -> HscSource
ms_hsc_src ModSummary
ms HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsigFile
      dflags :: DynFlags
dflags         = ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms
      !instances :: [ClsInst]
instances     = ModuleInfo -> [ClsInst]
modInfoInstances ModuleInfo
mi
      !fam_instances :: [FamInst]
fam_instances = ModDetails -> [FamInst]
md_fam_insts ModDetails
md
      !exportedNames :: [Name]
exportedNames = ModuleInfo -> [Name]
modInfoExportsWithSelectors ModuleInfo
mi
      (Maybe PackageName
pkgNameFS, Maybe Version
_) = DynFlags
-> [Flag] -> Maybe Module -> (Maybe PackageName, Maybe Version)
modulePackageInfo DynFlags
dflags [Flag]
flags (Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mdl)
      pkgName :: Maybe String
pkgName        = (PackageName -> String) -> Maybe PackageName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FastString -> String
unpackFS (FastString -> String)
-> (PackageName -> FastString) -> PackageName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(PackageName FastString
n) -> FastString
n)) Maybe PackageName
pkgNameFS

      (TcGblEnv { tcg_rdr_env :: TcGblEnv -> GlobalRdrEnv
tcg_rdr_env = GlobalRdrEnv
gre
                , tcg_warns :: TcGblEnv -> Warnings
tcg_warns   = Warnings
warnings
                , tcg_exports :: TcGblEnv -> [AvailInfo]
tcg_exports = [AvailInfo]
all_exports0
                }, ModDetails
md) = TypecheckedModule -> (TcGblEnv, ModDetails)
tm_internals_ TypecheckedModule
tm
      all_local_avails :: [AvailInfo]
all_local_avails = [GlobalRdrElt] -> [AvailInfo]
gresToAvailInfo ([GlobalRdrElt] -> [AvailInfo])
-> (GlobalRdrEnv -> [GlobalRdrElt]) -> GlobalRdrEnv -> [AvailInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
isLocalGRE ([GlobalRdrElt] -> [GlobalRdrElt])
-> (GlobalRdrEnv -> [GlobalRdrElt])
-> GlobalRdrEnv
-> [GlobalRdrElt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts (GlobalRdrEnv -> [AvailInfo]) -> GlobalRdrEnv -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv
gre

  -- The 'pkgName' is necessary to decide what package to mention in "@since"
  -- annotations. Not having it is not fatal though.
  --
  -- Cabal can be trusted to pass the right flags, so this warning should be
  -- mostly encountered when running Haddock outside of Cabal.
  Bool -> ErrMsgGhc () -> ErrMsgGhc ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
pkgName) (ErrMsgGhc () -> ErrMsgGhc ()) -> ErrMsgGhc () -> ErrMsgGhc ()
forall a b. (a -> b) -> a -> b
$
    ErrMsgM () -> ErrMsgGhc ()
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM () -> ErrMsgGhc ()) -> ErrMsgM () -> ErrMsgGhc ()
forall a b. (a -> b) -> a -> b
$ [String] -> ErrMsgM ()
tell [ String
"Warning: Package name is not available." ]

  -- The renamed source should always be available to us, but it's best
  -- to be on the safe side.
  (HsGroup (GhcPass 'Renamed)
group_, [LImportDecl (GhcPass 'Renamed)]
imports, Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])]
mayExports, Maybe LHsDocString
mayDocHeader) <-
    case TypecheckedModule
-> Maybe
     (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
      Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
forall m.
TypecheckedMod m =>
m
-> Maybe
     (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
      Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
renamedSource TypecheckedModule
tm of
      Maybe
  (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
   Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
Nothing -> do
        ErrMsgM () -> ErrMsgGhc ()
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM () -> ErrMsgGhc ()) -> ErrMsgM () -> ErrMsgGhc ()
forall a b. (a -> b) -> a -> b
$ [String] -> ErrMsgM ()
tell [ String
"Warning: Renamed source is not available." ]
        (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
 Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
-> ErrMsgGhc
     (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
      Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsGroup (GhcPass 'Renamed)
forall (p :: Pass). HsGroup (GhcPass p)
emptyRnGroup, [], Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])]
forall a. Maybe a
Nothing, Maybe LHsDocString
forall a. Maybe a
Nothing)
      Just (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
 Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
x -> (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
 Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
-> ErrMsgGhc
     (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
      Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
 Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
x

  [DocOption]
opts <- ErrMsgM [DocOption] -> ErrMsgGhc [DocOption]
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM [DocOption] -> ErrMsgGhc [DocOption])
-> ErrMsgM [DocOption] -> ErrMsgGhc [DocOption]
forall a b. (a -> b) -> a -> b
$ Maybe String -> [Flag] -> Module -> ErrMsgM [DocOption]
mkDocOpts (DynFlags -> Maybe String
haddockOptions DynFlags
dflags) [Flag]
flags Module
mdl

  -- Process the top-level module header documentation.
  (!HaddockModInfo Name
info, Maybe (MDoc Name)
mbDoc) <- ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name))
-> ErrMsgGhc (HaddockModInfo Name, Maybe (MDoc Name))
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name))
 -> ErrMsgGhc (HaddockModInfo Name, Maybe (MDoc Name)))
-> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name))
-> ErrMsgGhc (HaddockModInfo Name, Maybe (MDoc Name))
forall a b. (a -> b) -> a -> b
$ DynFlags
-> Maybe String
-> GlobalRdrEnv
-> SafeHaskellMode
-> Maybe LHsDocString
-> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name))
processModuleHeader DynFlags
dflags Maybe String
pkgName GlobalRdrEnv
gre SafeHaskellMode
safety Maybe LHsDocString
mayDocHeader

  let declsWithDocs :: [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
declsWithDocs = HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
topDecls HsGroup (GhcPass 'Renamed)
group_

      exports0 :: Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
exports0 = ([(LIE (GhcPass 'Renamed), [AvailInfo])]
 -> [(IE (GhcPass 'Renamed), [AvailInfo])])
-> Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])]
-> Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((LIE (GhcPass 'Renamed), [AvailInfo])
 -> (IE (GhcPass 'Renamed), [AvailInfo]))
-> [(LIE (GhcPass 'Renamed), [AvailInfo])]
-> [(IE (GhcPass 'Renamed), [AvailInfo])]
forall a b. (a -> b) -> [a] -> [b]
map ((LIE (GhcPass 'Renamed) -> IE (GhcPass 'Renamed))
-> (LIE (GhcPass 'Renamed), [AvailInfo])
-> (IE (GhcPass 'Renamed), [AvailInfo])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first LIE (GhcPass 'Renamed) -> IE (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)) Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])]
mayExports
      ([AvailInfo]
all_exports, Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
exports)
        | DocOption
OptIgnoreExports DocOption -> [DocOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DocOption]
opts = ([AvailInfo]
all_local_avails, Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
forall a. Maybe a
Nothing)
        | Bool
otherwise = ([AvailInfo]
all_exports0, Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
exports0)

      unrestrictedImportedMods :: Map ModuleName [ModuleName]
unrestrictedImportedMods
        -- module re-exports are only possible with
        -- explicit export list
        | Just{} <- Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
exports
        = [ImportDecl (GhcPass 'Renamed)] -> Map ModuleName [ModuleName]
forall name. [ImportDecl name] -> Map ModuleName [ModuleName]
unrestrictedModuleImports ((LImportDecl (GhcPass 'Renamed) -> ImportDecl (GhcPass 'Renamed))
-> [LImportDecl (GhcPass 'Renamed)]
-> [ImportDecl (GhcPass 'Renamed)]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl (GhcPass 'Renamed) -> ImportDecl (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LImportDecl (GhcPass 'Renamed)]
imports)
        | Bool
otherwise = Map ModuleName [ModuleName]
forall k a. Map k a
M.empty

      fixMap :: FixMap
fixMap = HsGroup (GhcPass 'Renamed) -> FixMap
mkFixMap HsGroup (GhcPass 'Renamed)
group_
      ([LHsDecl (GhcPass 'Renamed)]
decls, [[HsDocString]]
_) = [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> ([LHsDecl (GhcPass 'Renamed)], [[HsDocString]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
declsWithDocs
      localInsts :: [Name]
localInsts = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Module -> Name -> Bool
nameIsLocalOrFrom Module
sem_mdl)
                        ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$  (FamInst -> Name) -> [FamInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FamInst -> Name
forall a. NamedThing a => a -> Name
getName [FamInst]
fam_instances
                        [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (ClsInst -> Name) -> [ClsInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> Name
forall a. NamedThing a => a -> Name
getName [ClsInst]
instances
      -- Locations of all TH splices
      splices :: [SrcSpan]
splices = [ SrcSpan
l | L SrcSpan
l (SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
_) <- HsModule GhcPs -> [GenLocated SrcSpan (HsDecl GhcPs)]
forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls HsModule GhcPs
hsm ]

  WarningMap
warningMap <- ErrMsgM WarningMap -> ErrMsgGhc WarningMap
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (DynFlags
-> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap
mkWarningMap DynFlags
dflags Warnings
warnings GlobalRdrEnv
gre [Name]
exportedNames)

  maps :: Maps
maps@(!DocMap Name
docMap, !ArgMap Name
argMap, !DeclMap
declMap, InstMap
_) <-
    ErrMsgM Maps -> ErrMsgGhc Maps
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (DynFlags
-> Maybe String
-> GlobalRdrEnv
-> [Name]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> ErrMsgM Maps
mkMaps DynFlags
dflags Maybe String
pkgName GlobalRdrEnv
gre [Name]
localInsts [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
declsWithDocs)

  let allWarnings :: WarningMap
allWarnings = [WarningMap] -> WarningMap
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions (WarningMap
warningMap WarningMap -> [WarningMap] -> [WarningMap]
forall a. a -> [a] -> [a]
: (Interface -> WarningMap) -> [Interface] -> [WarningMap]
forall a b. (a -> b) -> [a] -> [b]
map Interface -> WarningMap
ifaceWarningMap (IfaceMap -> [Interface]
forall k a. Map k a -> [a]
M.elems IfaceMap
modMap))

  -- The MAIN functionality: compute the export items which will
  -- each be the actual documentation of this module.
  [ExportItem (GhcPass 'Renamed)]
exportItems <- HasCallStack =>
Bool
-> IfaceMap
-> Maybe String
-> Module
-> Module
-> WarningMap
-> GlobalRdrEnv
-> [Name]
-> [LHsDecl (GhcPass 'Renamed)]
-> Maps
-> FixMap
-> Map ModuleName [ModuleName]
-> [SrcSpan]
-> Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
-> [AvailInfo]
-> InstIfaceMap
-> DynFlags
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
Bool
-> IfaceMap
-> Maybe String
-> Module
-> Module
-> WarningMap
-> GlobalRdrEnv
-> [Name]
-> [LHsDecl (GhcPass 'Renamed)]
-> Maps
-> FixMap
-> Map ModuleName [ModuleName]
-> [SrcSpan]
-> Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
-> [AvailInfo]
-> InstIfaceMap
-> DynFlags
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
mkExportItems Bool
is_sig IfaceMap
modMap Maybe String
pkgName Module
mdl Module
sem_mdl WarningMap
allWarnings GlobalRdrEnv
gre
                   [Name]
exportedNames [LHsDecl (GhcPass 'Renamed)]
decls Maps
maps FixMap
fixMap Map ModuleName [ModuleName]
unrestrictedImportedMods
                   [SrcSpan]
splices Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
exports [AvailInfo]
all_exports InstIfaceMap
instIfaceMap DynFlags
dflags

  let !visibleNames :: [Name]
visibleNames = Maps -> [ExportItem (GhcPass 'Renamed)] -> [DocOption] -> [Name]
mkVisibleNames Maps
maps [ExportItem (GhcPass 'Renamed)]
exportItems [DocOption]
opts

  -- Measure haddock documentation coverage.
  let prunedExportItems0 :: [ExportItem (GhcPass 'Renamed)]
prunedExportItems0 = [ExportItem (GhcPass 'Renamed)] -> [ExportItem (GhcPass 'Renamed)]
pruneExportItems [ExportItem (GhcPass 'Renamed)]
exportItems
      !haddockable :: Int
haddockable = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ExportItem (GhcPass 'Renamed)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExportItem (GhcPass 'Renamed)]
exportItems -- module + exports
      !haddocked :: Int
haddocked = (if Maybe (MDoc Name) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (MDoc Name)
mbDoc then Int
1 else Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ExportItem (GhcPass 'Renamed)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExportItem (GhcPass 'Renamed)]
prunedExportItems0
      !coverage :: (Int, Int)
coverage = (Int
haddockable, Int
haddocked)

  -- Prune the export list to just those declarations that have
  -- documentation, if the 'prune' option is on.
  let prunedExportItems' :: [ExportItem (GhcPass 'Renamed)]
prunedExportItems'
        | DocOption
OptPrune DocOption -> [DocOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DocOption]
opts = [ExportItem (GhcPass 'Renamed)]
prunedExportItems0
        | Bool
otherwise = [ExportItem (GhcPass 'Renamed)]
exportItems
      !prunedExportItems :: [ExportItem (GhcPass 'Renamed)]
prunedExportItems = [ExportItem (GhcPass 'Renamed)] -> ()
forall a. [a] -> ()
seqList [ExportItem (GhcPass 'Renamed)]
prunedExportItems' ()
-> [ExportItem (GhcPass 'Renamed)]
-> [ExportItem (GhcPass 'Renamed)]
`seq` [ExportItem (GhcPass 'Renamed)]
prunedExportItems'

  let !aliases :: Map Module ModuleName
aliases =
        DynFlags
-> Maybe
     (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
      Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
-> Map Module ModuleName
mkAliasMap DynFlags
dflags (Maybe
   (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
    Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
 -> Map Module ModuleName)
-> Maybe
     (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
      Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
-> Map Module ModuleName
forall a b. (a -> b) -> a -> b
$ TypecheckedModule
-> Maybe
     (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
      Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
tm_renamed_source TypecheckedModule
tm

  Maybe (Doc Name)
modWarn <- ErrMsgM (Maybe (Doc Name)) -> ErrMsgGhc (Maybe (Doc Name))
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name))
moduleWarning DynFlags
dflags GlobalRdrEnv
gre Warnings
warnings)

  -- Prune the docstring 'Map's to keep only docstrings that are not private.
  --
  -- Besides all the names that GHC has told us this module exports, we also
  -- keep the docs for locally defined class instances. This is more names than
  -- we need, but figuring out which instances are fully private is tricky.
  --
  -- We do this pruning to avoid having to rename, emit warnings, and save
  -- docstrings which will anyways never be rendered.
  let !localVisibleNames :: Set Name
localVisibleNames = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList ([Name]
localInsts [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
exportedNames)
      !prunedDocMap :: DocMap Name
prunedDocMap = DocMap Name -> Set Name -> DocMap Name
forall k a. Ord k => Map k a -> Set k -> Map k a
M.restrictKeys DocMap Name
docMap Set Name
localVisibleNames
      !prunedArgMap :: ArgMap Name
prunedArgMap = ArgMap Name -> Set Name -> ArgMap Name
forall k a. Ord k => Map k a -> Set k -> Map k a
M.restrictKeys ArgMap Name
argMap Set Name
localVisibleNames

  Interface -> ErrMsgGhc Interface
forall (m :: * -> *) a. Monad m => a -> m a
return (Interface -> ErrMsgGhc Interface)
-> Interface -> ErrMsgGhc Interface
forall a b. (a -> b) -> a -> b
$! Interface :: Module
-> Bool
-> String
-> HaddockModInfo Name
-> Documentation Name
-> Documentation DocName
-> [DocOption]
-> DeclMap
-> DocMap Name
-> ArgMap Name
-> DocMap DocName
-> ArgMap DocName
-> FixMap
-> [ExportItem (GhcPass 'Renamed)]
-> [ExportItem DocNameI]
-> [Name]
-> [Name]
-> Map Module ModuleName
-> [ClsInst]
-> [FamInst]
-> [DocInstance (GhcPass 'Renamed)]
-> [DocInstance DocNameI]
-> (Int, Int)
-> WarningMap
-> Maybe String
-> DynFlags
-> Interface
Interface {
    ifaceMod :: Module
ifaceMod               = Module
mdl
  , ifaceIsSig :: Bool
ifaceIsSig             = Bool
is_sig
  , ifaceOrigFilename :: String
ifaceOrigFilename      = ModSummary -> String
msHsFilePath ModSummary
ms
  , ifaceInfo :: HaddockModInfo Name
ifaceInfo              = HaddockModInfo Name
info
  , ifaceDoc :: Documentation Name
ifaceDoc               = Maybe (MDoc Name) -> Maybe (Doc Name) -> Documentation Name
forall name.
Maybe (MDoc name) -> Maybe (Doc name) -> Documentation name
Documentation Maybe (MDoc Name)
mbDoc Maybe (Doc Name)
modWarn
  , ifaceRnDoc :: Documentation DocName
ifaceRnDoc             = Maybe (MDoc DocName)
-> Maybe (Doc DocName) -> Documentation DocName
forall name.
Maybe (MDoc name) -> Maybe (Doc name) -> Documentation name
Documentation Maybe (MDoc DocName)
forall a. Maybe a
Nothing Maybe (Doc DocName)
forall a. Maybe a
Nothing
  , ifaceOptions :: [DocOption]
ifaceOptions           = [DocOption]
opts
  , ifaceDocMap :: DocMap Name
ifaceDocMap            = DocMap Name
prunedDocMap
  , ifaceArgMap :: ArgMap Name
ifaceArgMap            = ArgMap Name
prunedArgMap
  , ifaceRnDocMap :: DocMap DocName
ifaceRnDocMap          = DocMap DocName
forall k a. Map k a
M.empty -- Filled in `renameInterface`
  , ifaceRnArgMap :: ArgMap DocName
ifaceRnArgMap          = ArgMap DocName
forall k a. Map k a
M.empty -- Filled in `renameInterface`
  , ifaceExportItems :: [ExportItem (GhcPass 'Renamed)]
ifaceExportItems       = [ExportItem (GhcPass 'Renamed)]
prunedExportItems
  , ifaceRnExportItems :: [ExportItem DocNameI]
ifaceRnExportItems     = [] -- Filled in `renameInterface`
  , ifaceExports :: [Name]
ifaceExports           = [Name]
exportedNames
  , ifaceVisibleExports :: [Name]
ifaceVisibleExports    = [Name]
visibleNames
  , ifaceDeclMap :: DeclMap
ifaceDeclMap           = DeclMap
declMap
  , ifaceFixMap :: FixMap
ifaceFixMap            = FixMap
fixMap
  , ifaceModuleAliases :: Map Module ModuleName
ifaceModuleAliases     = Map Module ModuleName
aliases
  , ifaceInstances :: [ClsInst]
ifaceInstances         = [ClsInst]
instances
  , ifaceFamInstances :: [FamInst]
ifaceFamInstances      = [FamInst]
fam_instances
  , ifaceOrphanInstances :: [DocInstance (GhcPass 'Renamed)]
ifaceOrphanInstances   = [] -- Filled in `attachInstances`
  , ifaceRnOrphanInstances :: [DocInstance DocNameI]
ifaceRnOrphanInstances = [] -- Filled in `renameInterface`
  , ifaceHaddockCoverage :: (Int, Int)
ifaceHaddockCoverage   = (Int, Int)
coverage
  , ifaceWarningMap :: WarningMap
ifaceWarningMap        = WarningMap
warningMap
  , ifaceHieFile :: Maybe String
ifaceHieFile           = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ModLocation -> String
ml_hie_file (ModLocation -> String) -> ModLocation -> String
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms
  , ifaceDynFlags :: DynFlags
ifaceDynFlags          = DynFlags
dflags
  }

-- | Given all of the @import M as N@ declarations in a package,
-- create a mapping from the module identity of M, to an alias N
-- (if there are multiple aliases, we pick the last one.)  This
-- will go in 'ifaceModuleAliases'.
mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
mkAliasMap :: DynFlags
-> Maybe
     (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
      Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
-> Map Module ModuleName
mkAliasMap DynFlags
dflags Maybe
  (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
   Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
mRenamedSource =
  case Maybe
  (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
   Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
mRenamedSource of
    Maybe
  (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
   Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])], Maybe LHsDocString)
Nothing -> Map Module ModuleName
forall k a. Map k a
M.empty
    Just (HsGroup (GhcPass 'Renamed)
_,[LImportDecl (GhcPass 'Renamed)]
impDecls,Maybe [(LIE (GhcPass 'Renamed), [AvailInfo])]
_,Maybe LHsDocString
_) ->
      [(Module, ModuleName)] -> Map Module ModuleName
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Module, ModuleName)] -> Map Module ModuleName)
-> [(Module, ModuleName)] -> Map Module ModuleName
forall a b. (a -> b) -> a -> b
$
      (LImportDecl (GhcPass 'Renamed) -> Maybe (Module, ModuleName))
-> [LImportDecl (GhcPass 'Renamed)] -> [(Module, ModuleName)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(SrcLoc.L SrcSpan
_ ImportDecl (GhcPass 'Renamed)
impDecl) -> do
        SrcLoc.L SrcSpan
_ ModuleName
alias <- ImportDecl (GhcPass 'Renamed)
-> Maybe (GenLocated SrcSpan ModuleName)
forall pass.
ImportDecl pass -> Maybe (GenLocated SrcSpan ModuleName)
ideclAs ImportDecl (GhcPass 'Renamed)
impDecl
        (Module, ModuleName) -> Maybe (Module, ModuleName)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Module, ModuleName) -> Maybe (Module, ModuleName))
-> (Module, ModuleName) -> Maybe (Module, ModuleName)
forall a b. (a -> b) -> a -> b
$
          (DynFlags -> Maybe UnitId -> ModuleName -> Module
lookupModuleDyn DynFlags
dflags
             -- TODO: This is supremely dodgy, because in general the
             -- UnitId isn't going to look anything like the package
             -- qualifier (even with old versions of GHC, the
             -- IPID would be p-0.1, but a package qualifier never
             -- has a version number it.  (Is it possible that in
             -- Haddock-land, the UnitIds never have version numbers?
             -- I, ezyang, have not quite understand Haddock's package
             -- identifier model.)
             --
             -- Additionally, this is simulating some logic GHC already
             -- has for deciding how to qualify names when it outputs
             -- them to the user.  We should reuse that information;
             -- or at least reuse the renamed imports, which know what
             -- they import!
             ((FastString -> UnitId) -> Maybe FastString -> Maybe UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FastString -> UnitId
Module.fsToUnitId (Maybe FastString -> Maybe UnitId)
-> Maybe FastString -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$
              (StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> FastString
sl_fs (Maybe StringLiteral -> Maybe FastString)
-> Maybe StringLiteral -> Maybe FastString
forall a b. (a -> b) -> a -> b
$ ImportDecl (GhcPass 'Renamed) -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl (GhcPass 'Renamed)
impDecl)
             (case ImportDecl (GhcPass 'Renamed) -> GenLocated SrcSpan ModuleName
forall pass. ImportDecl pass -> GenLocated SrcSpan ModuleName
ideclName ImportDecl (GhcPass 'Renamed)
impDecl of SrcLoc.L SrcSpan
_ ModuleName
name -> ModuleName
name),
           ModuleName
alias))
        [LImportDecl (GhcPass 'Renamed)]
impDecls

-- We want to know which modules are imported without any qualification. This
-- way we can display module reexports more compactly. This mapping also looks
-- through aliases:
--
-- module M (module X) where
--   import M1 as X
--   import M2 as X
--
-- With our mapping we know that we can display exported modules M1 and M2.
--
unrestrictedModuleImports :: [ImportDecl name] -> M.Map ModuleName [ModuleName]
unrestrictedModuleImports :: [ImportDecl name] -> Map ModuleName [ModuleName]
unrestrictedModuleImports [ImportDecl name]
idecls =
  ([ImportDecl name] -> [ModuleName])
-> Map ModuleName [ImportDecl name] -> Map ModuleName [ModuleName]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((ImportDecl name -> ModuleName)
-> [ImportDecl name] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpan ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (GenLocated SrcSpan ModuleName -> ModuleName)
-> (ImportDecl name -> GenLocated SrcSpan ModuleName)
-> ImportDecl name
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl name -> GenLocated SrcSpan ModuleName
forall pass. ImportDecl pass -> GenLocated SrcSpan ModuleName
ideclName))
  (Map ModuleName [ImportDecl name] -> Map ModuleName [ModuleName])
-> Map ModuleName [ImportDecl name] -> Map ModuleName [ModuleName]
forall a b. (a -> b) -> a -> b
$ ([ImportDecl name] -> Bool)
-> Map ModuleName [ImportDecl name]
-> Map ModuleName [ImportDecl name]
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((ImportDecl name -> Bool) -> [ImportDecl name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ImportDecl name -> Bool
forall pass. ImportDecl pass -> Bool
isInteresting) Map ModuleName [ImportDecl name]
impModMap
  where
    impModMap :: Map ModuleName [ImportDecl name]
impModMap =
      ([ImportDecl name] -> [ImportDecl name] -> [ImportDecl name])
-> [(ModuleName, [ImportDecl name])]
-> Map ModuleName [ImportDecl name]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [ImportDecl name] -> [ImportDecl name] -> [ImportDecl name]
forall a. [a] -> [a] -> [a]
(++) ((ImportDecl name -> [(ModuleName, [ImportDecl name])])
-> [ImportDecl name] -> [(ModuleName, [ImportDecl name])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ImportDecl name -> [(ModuleName, [ImportDecl name])]
forall pass. ImportDecl pass -> [(ModuleName, [ImportDecl pass])]
moduleMapping [ImportDecl name]
idecls)

    moduleMapping :: ImportDecl pass -> [(ModuleName, [ImportDecl pass])]
moduleMapping ImportDecl pass
idecl =
      [[(ModuleName, [ImportDecl pass])]]
-> [(ModuleName, [ImportDecl pass])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ (GenLocated SrcSpan ModuleName
-> SrcSpanLess (GenLocated SrcSpan ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ImportDecl pass -> GenLocated SrcSpan ModuleName
forall pass. ImportDecl pass -> GenLocated SrcSpan ModuleName
ideclName ImportDecl pass
idecl), [ImportDecl pass
idecl]) ]
             , [ (GenLocated SrcSpan ModuleName
-> SrcSpanLess (GenLocated SrcSpan ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc GenLocated SrcSpan ModuleName
mod_name, [ImportDecl pass
idecl])
               | Just GenLocated SrcSpan ModuleName
mod_name <- [ImportDecl pass -> Maybe (GenLocated SrcSpan ModuleName)
forall pass.
ImportDecl pass -> Maybe (GenLocated SrcSpan ModuleName)
ideclAs ImportDecl pass
idecl]
               ]
             ]

    isInteresting :: ImportDecl pass -> Bool
isInteresting ImportDecl pass
idecl =
      case ImportDecl pass -> Maybe (Bool, Located [LIE pass])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl pass
idecl of
        -- i) no subset selected
        Maybe (Bool, Located [LIE pass])
Nothing             -> Bool
True
        -- ii) an import with a hiding clause
        -- without any names
        Just (Bool
True, L SrcSpan
_ []) -> Bool
True
        -- iii) any other case of qualification
        Maybe (Bool, Located [LIE pass])
_                   -> Bool
False

-- Similar to GHC.lookupModule
-- ezyang: Not really...
lookupModuleDyn ::
  DynFlags -> Maybe UnitId -> ModuleName -> Module
lookupModuleDyn :: DynFlags -> Maybe UnitId -> ModuleName -> Module
lookupModuleDyn DynFlags
_ (Just UnitId
pkgId) ModuleName
mdlName =
  UnitId -> ModuleName -> Module
Module.mkModule UnitId
pkgId ModuleName
mdlName
lookupModuleDyn DynFlags
dflags Maybe UnitId
Nothing ModuleName
mdlName =
  case DynFlags -> ModuleName -> [(Module, PackageConfig)]
lookupModuleInAllPackages DynFlags
dflags ModuleName
mdlName of
    (Module
m,PackageConfig
_):[(Module, PackageConfig)]
_ -> Module
m
    [] -> UnitId -> ModuleName -> Module
Module.mkModule UnitId
Module.mainUnitId ModuleName
mdlName


-------------------------------------------------------------------------------
-- Warnings
-------------------------------------------------------------------------------

mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap
mkWarningMap :: DynFlags
-> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap
mkWarningMap DynFlags
dflags Warnings
warnings GlobalRdrEnv
gre [Name]
exps = case Warnings
warnings of
  Warnings
NoWarnings  -> WarningMap -> ErrMsgM WarningMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure WarningMap
forall k a. Map k a
M.empty
  WarnAll WarningTxt
_   -> WarningMap -> ErrMsgM WarningMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure WarningMap
forall k a. Map k a
M.empty
  WarnSome [(OccName, WarningTxt)]
ws ->
    let ws' :: [(Name, WarningTxt)]
ws' = [ (Name
n, WarningTxt
w)
              | (OccName
occ, WarningTxt
w) <- [(OccName, WarningTxt)]
ws
              , GlobalRdrElt
elt <- GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
gre OccName
occ
              , let n :: Name
n = GlobalRdrElt -> Name
gre_name GlobalRdrElt
elt, Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
exps ]
    in [(Name, Doc Name)] -> WarningMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Doc Name)] -> WarningMap)
-> ErrMsgM [(Name, Doc Name)] -> ErrMsgM WarningMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, WarningTxt) -> ErrMsgM (Name, Doc Name))
-> [(Name, WarningTxt)] -> ErrMsgM [(Name, Doc Name)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Name -> ErrMsgM Name)
-> (WarningTxt -> ErrMsgM (Doc Name))
-> (Name, WarningTxt)
-> ErrMsgM (Name, Doc Name)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Name -> ErrMsgM Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)
parseWarning DynFlags
dflags GlobalRdrEnv
gre)) [(Name, WarningTxt)]
ws'

moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name))
moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name))
moduleWarning DynFlags
_ GlobalRdrEnv
_ Warnings
NoWarnings = Maybe (Doc Name) -> ErrMsgM (Maybe (Doc Name))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Doc Name)
forall a. Maybe a
Nothing
moduleWarning DynFlags
_ GlobalRdrEnv
_ (WarnSome [(OccName, WarningTxt)]
_) = Maybe (Doc Name) -> ErrMsgM (Maybe (Doc Name))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Doc Name)
forall a. Maybe a
Nothing
moduleWarning DynFlags
dflags GlobalRdrEnv
gre (WarnAll WarningTxt
w) = Doc Name -> Maybe (Doc Name)
forall a. a -> Maybe a
Just (Doc Name -> Maybe (Doc Name))
-> ErrMsgM (Doc Name) -> ErrMsgM (Maybe (Doc Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)
parseWarning DynFlags
dflags GlobalRdrEnv
gre WarningTxt
w

parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)
parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)
parseWarning DynFlags
dflags GlobalRdrEnv
gre WarningTxt
w = case WarningTxt
w of
  DeprecatedTxt Located SourceText
_ [Located StringLiteral]
msg -> String -> ByteString -> ErrMsgM (Doc Name)
format String
"Deprecated: " ((Located StringLiteral -> ByteString)
-> [Located StringLiteral] -> ByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (FastString -> ByteString
bytesFS (FastString -> ByteString)
-> (Located StringLiteral -> FastString)
-> Located StringLiteral
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located StringLiteral -> StringLiteral)
-> Located StringLiteral
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located StringLiteral -> StringLiteral
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located StringLiteral]
msg)
  WarningTxt    Located SourceText
_ [Located StringLiteral]
msg -> String -> ByteString -> ErrMsgM (Doc Name)
format String
"Warning: "    ((Located StringLiteral -> ByteString)
-> [Located StringLiteral] -> ByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (FastString -> ByteString
bytesFS (FastString -> ByteString)
-> (Located StringLiteral -> FastString)
-> Located StringLiteral
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located StringLiteral -> StringLiteral)
-> Located StringLiteral
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located StringLiteral -> StringLiteral
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located StringLiteral]
msg)
  where
    format :: String -> ByteString -> ErrMsgM (Doc Name)
format String
x ByteString
bs = Doc Name -> Doc Name
forall mod id. DocH mod id -> DocH mod id
DocWarning (Doc Name -> Doc Name)
-> (Doc Name -> Doc Name) -> Doc Name -> Doc Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Name -> Doc Name
forall mod id. DocH mod id -> DocH mod id
DocParagraph (Doc Name -> Doc Name)
-> (Doc Name -> Doc Name) -> Doc Name -> Doc Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Name -> Doc Name -> Doc Name
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
DocAppend (String -> Doc Name
forall mod id. String -> DocH mod id
DocString String
x)
                  (Doc Name -> Doc Name) -> ErrMsgM (Doc Name) -> ErrMsgM (Doc Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name)
processDocString DynFlags
dflags GlobalRdrEnv
gre (ByteString -> HsDocString
mkHsDocStringUtf8ByteString ByteString
bs)


-------------------------------------------------------------------------------
-- Doc options
--
-- Haddock options that are embedded in the source file
-------------------------------------------------------------------------------


mkDocOpts :: Maybe String -> [Flag] -> Module -> ErrMsgM [DocOption]
mkDocOpts :: Maybe String -> [Flag] -> Module -> ErrMsgM [DocOption]
mkDocOpts Maybe String
mbOpts [Flag]
flags Module
mdl = do
  [DocOption]
opts <- case Maybe String
mbOpts of
    Just String
opts -> case String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Char -> Char -> String -> String
forall a. Eq a => a -> a -> [a] -> [a]
replace Char
',' Char
' ' String
opts of
      [] -> [String] -> ErrMsgM ()
tell [String
"No option supplied to DOC_OPTION/doc_option"] ErrMsgM () -> ErrMsgM [DocOption] -> ErrMsgM [DocOption]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [DocOption] -> ErrMsgM [DocOption]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      [String]
xs -> ([Maybe DocOption] -> [DocOption])
-> ErrMsgM [Maybe DocOption] -> ErrMsgM [DocOption]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Maybe DocOption] -> [DocOption]
forall a. [Maybe a] -> [a]
catMaybes ((String -> ErrMsgM (Maybe DocOption))
-> [String] -> ErrMsgM [Maybe DocOption]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> ErrMsgM (Maybe DocOption)
parseOption [String]
xs)
    Maybe String
Nothing -> [DocOption] -> ErrMsgM [DocOption]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  [DocOption] -> ErrMsgM [DocOption]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([DocOption] -> Flag -> [DocOption])
-> [DocOption] -> [Flag] -> [DocOption]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [DocOption] -> Flag -> [DocOption]
go [DocOption]
opts [Flag]
flags)
  where
    mdlStr :: String
mdlStr = Module -> String
moduleString Module
mdl

    -- Later flags override earlier ones
    go :: [DocOption] -> Flag -> [DocOption]
go [DocOption]
os Flag
m | Flag
m Flag -> Flag -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Flag
Flag_HideModule String
mdlStr     = DocOption
OptHide DocOption -> [DocOption] -> [DocOption]
forall a. a -> [a] -> [a]
: [DocOption]
os
            | Flag
m Flag -> Flag -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Flag
Flag_ShowModule String
mdlStr     = (DocOption -> Bool) -> [DocOption] -> [DocOption]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocOption -> DocOption -> Bool
forall a. Eq a => a -> a -> Bool
/= DocOption
OptHide) [DocOption]
os
            | Flag
m Flag -> Flag -> Bool
forall a. Eq a => a -> a -> Bool
== Flag
Flag_ShowAllModules        = (DocOption -> Bool) -> [DocOption] -> [DocOption]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocOption -> DocOption -> Bool
forall a. Eq a => a -> a -> Bool
/= DocOption
OptHide) [DocOption]
os
            | Flag
m Flag -> Flag -> Bool
forall a. Eq a => a -> a -> Bool
== Flag
Flag_IgnoreAllExports      = DocOption
OptIgnoreExports DocOption -> [DocOption] -> [DocOption]
forall a. a -> [a] -> [a]
: [DocOption]
os
            | Flag
m Flag -> Flag -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Flag
Flag_ShowExtensions String
mdlStr = DocOption
OptIgnoreExports DocOption -> [DocOption] -> [DocOption]
forall a. a -> [a] -> [a]
: [DocOption]
os
            | Bool
otherwise                       = [DocOption]
os

parseOption :: String -> ErrMsgM (Maybe DocOption)
parseOption :: String -> ErrMsgM (Maybe DocOption)
parseOption String
"hide"            = Maybe DocOption -> ErrMsgM (Maybe DocOption)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocOption -> Maybe DocOption
forall a. a -> Maybe a
Just DocOption
OptHide)
parseOption String
"prune"           = Maybe DocOption -> ErrMsgM (Maybe DocOption)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocOption -> Maybe DocOption
forall a. a -> Maybe a
Just DocOption
OptPrune)
parseOption String
"ignore-exports"  = Maybe DocOption -> ErrMsgM (Maybe DocOption)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocOption -> Maybe DocOption
forall a. a -> Maybe a
Just DocOption
OptIgnoreExports)
parseOption String
"not-home"        = Maybe DocOption -> ErrMsgM (Maybe DocOption)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocOption -> Maybe DocOption
forall a. a -> Maybe a
Just DocOption
OptNotHome)
parseOption String
"show-extensions" = Maybe DocOption -> ErrMsgM (Maybe DocOption)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocOption -> Maybe DocOption
forall a. a -> Maybe a
Just DocOption
OptShowExtensions)
parseOption String
other = [String] -> ErrMsgM ()
tell [String
"Unrecognised option: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
other] ErrMsgM ()
-> ErrMsgM (Maybe DocOption) -> ErrMsgM (Maybe DocOption)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe DocOption -> ErrMsgM (Maybe DocOption)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DocOption
forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
-- Maps
--------------------------------------------------------------------------------


type Maps = (DocMap Name, ArgMap Name, DeclMap, InstMap)

-- | Create 'Maps' by looping through the declarations. For each declaration,
-- find its names, its subordinates, and its doc strings. Process doc strings
-- into 'Doc's.
mkMaps :: DynFlags
       -> Maybe Package  -- this package
       -> GlobalRdrEnv
       -> [Name]
       -> [(LHsDecl GhcRn, [HsDocString])]
       -> ErrMsgM Maps
mkMaps :: DynFlags
-> Maybe String
-> GlobalRdrEnv
-> [Name]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> ErrMsgM Maps
mkMaps DynFlags
dflags Maybe String
pkgName GlobalRdrEnv
gre [Name]
instances [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
decls = do
  ([[(Name, MDoc Name)]]
a, [[(Name, Map Int (MDoc Name))]]
b, [[(Name, [LHsDecl (GhcPass 'Renamed)])]]
c) <- [([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
  [(Name, [LHsDecl (GhcPass 'Renamed)])])]
-> ([[(Name, MDoc Name)]], [[(Name, Map Int (MDoc Name))]],
    [[(Name, [LHsDecl (GhcPass 'Renamed)])]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
   [(Name, [LHsDecl (GhcPass 'Renamed)])])]
 -> ([[(Name, MDoc Name)]], [[(Name, Map Int (MDoc Name))]],
     [[(Name, [LHsDecl (GhcPass 'Renamed)])]]))
-> ErrMsgM
     [([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
       [(Name, [LHsDecl (GhcPass 'Renamed)])])]
-> ErrMsgM
     ([[(Name, MDoc Name)]], [[(Name, Map Int (MDoc Name))]],
      [[(Name, [LHsDecl (GhcPass 'Renamed)])]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((LHsDecl (GhcPass 'Renamed), [HsDocString])
 -> ErrMsgM
      ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
       [(Name, [LHsDecl (GhcPass 'Renamed)])]))
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> ErrMsgM
     [([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
       [(Name, [LHsDecl (GhcPass 'Renamed)])])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (LHsDecl (GhcPass 'Renamed), [HsDocString])
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
mappings [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
decls
  Maps -> ErrMsgM Maps
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( [[(Name, MDoc Name)]] -> DocMap Name
f' (([(Name, MDoc Name)] -> [(Name, MDoc Name)])
-> [[(Name, MDoc Name)]] -> [[(Name, MDoc Name)]]
forall a b. (a -> b) -> [a] -> [b]
map (((Name, MDoc Name) -> Name)
-> [(Name, MDoc Name)] -> [(Name, MDoc Name)]
forall a. (a -> Name) -> [a] -> [a]
nubByName (Name, MDoc Name) -> Name
forall a b. (a, b) -> a
fst) [[(Name, MDoc Name)]]
a)
       , [[(Name, Map Int (MDoc Name))]] -> ArgMap Name
forall a b. (Ord a, Monoid b) => [[(a, b)]] -> Map a b
f  ((Map Int (MDoc Name) -> Bool)
-> [[(Name, Map Int (MDoc Name))]]
-> [[(Name, Map Int (MDoc Name))]]
forall b a. (b -> Bool) -> [[(a, b)]] -> [[(a, b)]]
filterMapping (Bool -> Bool
not (Bool -> Bool)
-> (Map Int (MDoc Name) -> Bool) -> Map Int (MDoc Name) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int (MDoc Name) -> Bool
forall k a. Map k a -> Bool
M.null) [[(Name, Map Int (MDoc Name))]]
b)
       , [[(Name, [LHsDecl (GhcPass 'Renamed)])]] -> DeclMap
forall a b. (Ord a, Monoid b) => [[(a, b)]] -> Map a b
f  (([LHsDecl (GhcPass 'Renamed)] -> Bool)
-> [[(Name, [LHsDecl (GhcPass 'Renamed)])]]
-> [[(Name, [LHsDecl (GhcPass 'Renamed)])]]
forall b a. (b -> Bool) -> [[(a, b)]] -> [[(a, b)]]
filterMapping (Bool -> Bool
not (Bool -> Bool)
-> ([LHsDecl (GhcPass 'Renamed)] -> Bool)
-> [LHsDecl (GhcPass 'Renamed)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl (GhcPass 'Renamed)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[(Name, [LHsDecl (GhcPass 'Renamed)])]]
c)
       , InstMap
instanceMap
       )
  where
    f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
    f :: [[(a, b)]] -> Map a b
f = (b -> b -> b) -> [(a, b)] -> Map a b
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>) ([(a, b)] -> Map a b)
-> ([[(a, b)]] -> [(a, b)]) -> [[(a, b)]] -> Map a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(a, b)]] -> [(a, b)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

    f' :: [[(Name, MDoc Name)]] -> Map Name (MDoc Name)
    f' :: [[(Name, MDoc Name)]] -> DocMap Name
f' = (MDoc Name -> MDoc Name -> MDoc Name)
-> [(Name, MDoc Name)] -> DocMap Name
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith MDoc Name -> MDoc Name -> MDoc Name
forall mod id. MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id
metaDocAppend ([(Name, MDoc Name)] -> DocMap Name)
-> ([[(Name, MDoc Name)]] -> [(Name, MDoc Name)])
-> [[(Name, MDoc Name)]]
-> DocMap Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Name, MDoc Name)]] -> [(Name, MDoc Name)]
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, [HsDocString])
             -> ErrMsgM ( [(Name, MDoc Name)]
                        , [(Name, Map Int (MDoc Name))]
                        , [(Name,  [LHsDecl GhcRn])]
                        )
    mappings :: (LHsDecl (GhcPass 'Renamed), [HsDocString])
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
mappings (LHsDecl (GhcPass 'Renamed)
ldecl, [HsDocString]
docStrs) = do
      let L SrcSpan
l HsDecl (GhcPass 'Renamed)
decl = LHsDecl (GhcPass 'Renamed)
ldecl
          declDoc :: [HsDocString] -> Map Int HsDocString
                  -> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))
          declDoc :: [HsDocString]
-> Map Int HsDocString
-> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))
declDoc [HsDocString]
strs Map Int HsDocString
m = do
            Maybe (MDoc Name)
doc' <- DynFlags
-> Maybe String
-> GlobalRdrEnv
-> [HsDocString]
-> ErrMsgM (Maybe (MDoc Name))
processDocStrings DynFlags
dflags Maybe String
pkgName GlobalRdrEnv
gre [HsDocString]
strs
            Map Int (MDoc Name)
m'   <- (HsDocString -> ErrMsgM (MDoc Name))
-> Map Int HsDocString -> ErrMsgM (Map Int (MDoc Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (DynFlags
-> Maybe String
-> GlobalRdrEnv
-> HsDocString
-> ErrMsgM (MDoc Name)
processDocStringParas DynFlags
dflags Maybe String
pkgName GlobalRdrEnv
gre) Map Int HsDocString
m
            (Maybe (MDoc Name), Map Int (MDoc Name))
-> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (MDoc Name)
doc', Map Int (MDoc Name)
m')

      (Maybe (MDoc Name)
doc, Map Int (MDoc Name)
args) <- [HsDocString]
-> Map Int HsDocString
-> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))
declDoc [HsDocString]
docStrs (HsDecl (GhcPass 'Renamed) -> Map Int HsDocString
declTypeDocs HsDecl (GhcPass 'Renamed)
decl)

      let
          subs :: [(Name, [HsDocString], Map Int HsDocString)]
          subs :: [(Name, [HsDocString], Map Int HsDocString)]
subs = InstMap
-> HsDecl (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
subordinates InstMap
instanceMap HsDecl (GhcPass 'Renamed)
decl

      ([Maybe (MDoc Name)]
subDocs, [Map Int (MDoc Name)]
subArgs) <- [(Maybe (MDoc Name), Map Int (MDoc Name))]
-> ([Maybe (MDoc Name)], [Map Int (MDoc Name)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe (MDoc Name), Map Int (MDoc Name))]
 -> ([Maybe (MDoc Name)], [Map Int (MDoc Name)]))
-> ErrMsgM [(Maybe (MDoc Name), Map Int (MDoc Name))]
-> ErrMsgM ([Maybe (MDoc Name)], [Map Int (MDoc Name)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, [HsDocString], Map Int HsDocString)
 -> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name)))
-> [(Name, [HsDocString], Map Int HsDocString)]
-> ErrMsgM [(Maybe (MDoc Name), Map Int (MDoc Name))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Name
_, [HsDocString]
strs, Map Int HsDocString
m) -> [HsDocString]
-> Map Int HsDocString
-> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))
declDoc [HsDocString]
strs Map Int HsDocString
m) [(Name, [HsDocString], Map Int HsDocString)]
subs

      let
          ns :: [Name]
ns = SrcSpan -> HsDecl (GhcPass 'Renamed) -> [Name]
names SrcSpan
l HsDecl (GhcPass 'Renamed)
decl
          subNs :: [Name]
subNs = [ Name
n | (Name
n, [HsDocString]
_, Map Int HsDocString
_) <- [(Name, [HsDocString], Map Int HsDocString)]
subs ]
          dm :: [(Name, MDoc Name)]
dm = [ (Name
n, MDoc Name
d) | (Name
n, Just MDoc Name
d) <- [Name] -> [Maybe (MDoc Name)] -> [(Name, Maybe (MDoc Name))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
ns (Maybe (MDoc Name) -> [Maybe (MDoc Name)]
forall a. a -> [a]
repeat Maybe (MDoc Name)
doc) [(Name, Maybe (MDoc Name))]
-> [(Name, Maybe (MDoc Name))] -> [(Name, Maybe (MDoc Name))]
forall a. [a] -> [a] -> [a]
++ [Name] -> [Maybe (MDoc Name)] -> [(Name, Maybe (MDoc Name))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
subNs [Maybe (MDoc Name)]
subDocs ]
          am :: [(Name, Map Int (MDoc Name))]
am = [ (Name
n, Map Int (MDoc Name)
args) | Name
n <- [Name]
ns ] [(Name, Map Int (MDoc Name))]
-> [(Name, Map Int (MDoc Name))] -> [(Name, Map Int (MDoc Name))]
forall a. [a] -> [a] -> [a]
++ [Name] -> [Map Int (MDoc Name)] -> [(Name, Map Int (MDoc Name))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
subNs [Map Int (MDoc Name)]
subArgs
          cm :: [(Name, [LHsDecl (GhcPass 'Renamed)])]
cm = [ (Name
n, [LHsDecl (GhcPass 'Renamed)
ldecl]) | Name
n <- [Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
subNs ]

      [Name] -> ()
forall a. [a] -> ()
seqList [Name]
ns ()
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
`seq`
        [Name] -> ()
forall a. [a] -> ()
seqList [Name]
subNs ()
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
`seq`
        Maybe (MDoc Name)
doc Maybe (MDoc Name)
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
`seq`
        [Maybe (MDoc Name)] -> ()
forall a. [a] -> ()
seqList [Maybe (MDoc Name)]
subDocs ()
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
`seq`
        [Map Int (MDoc Name)] -> ()
forall a. [a] -> ()
seqList [Map Int (MDoc Name)]
subArgs ()
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
`seq`
        ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
 [(Name, [LHsDecl (GhcPass 'Renamed)])])
-> ErrMsgM
     ([(Name, MDoc Name)], [(Name, Map Int (MDoc Name))],
      [(Name, [LHsDecl (GhcPass 'Renamed)])])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Name, MDoc Name)]
dm, [(Name, Map Int (MDoc Name))]
am, [(Name, [LHsDecl (GhcPass 'Renamed)])]
cm)

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

    names :: SrcSpan -> HsDecl GhcRn -> [Name]
    names :: SrcSpan -> HsDecl (GhcPass 'Renamed) -> [Name]
names SrcSpan
_ (InstD XInstD (GhcPass 'Renamed)
_ InstDecl (GhcPass 'Renamed)
d) = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (SrcSpan -> InstMap -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SrcSpan
loc InstMap
instanceMap) -- See note [2].
      where loc :: SrcSpan
loc = case InstDecl (GhcPass 'Renamed)
d of
              -- The CoAx's loc is the whole line, but only for TFs. The
              -- workaround is to dig into the family instance declaration and
              -- get the identifier with the right location.
              TyFamInstD XTyFamInstD (GhcPass 'Renamed)
_ (TyFamInstDecl TyFamInstEqn (GhcPass 'Renamed)
d') -> Located Name -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (FamEqn (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
-> Located (IdP (GhcPass 'Renamed))
forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon (TyFamInstEqn (GhcPass 'Renamed)
-> FamEqn (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body TyFamInstEqn (GhcPass 'Renamed)
d'))
              InstDecl (GhcPass 'Renamed)
_ -> InstDecl (GhcPass 'Renamed) -> SrcSpan
forall (p :: Pass). InstDecl (GhcPass p) -> SrcSpan
getInstLoc InstDecl (GhcPass 'Renamed)
d
    names SrcSpan
l (DerivD {}) = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (SrcSpan -> InstMap -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SrcSpan
l InstMap
instanceMap) -- See note [2].
    names SrcSpan
_ HsDecl (GhcPass 'Renamed)
decl = HsDecl (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (p :: Pass). HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder HsDecl (GhcPass 'Renamed)
decl

-- Note [2]:
------------
-- We relate ClsInsts to InstDecls and DerivDecls using the SrcSpans buried
-- inside them. That should work for normal user-written instances (from
-- looking at GHC sources). We can assume that commented instances are
-- user-written. This lets us relate Names (from ClsInsts) to comments
-- (associated with InstDecls and DerivDecls).

--------------------------------------------------------------------------------
-- Declarations
--------------------------------------------------------------------------------


-- | 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 :: InstMap
             -> HsDecl GhcRn
             -> [(Name, [HsDocString], Map Int HsDocString)]
subordinates :: InstMap
-> HsDecl (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
subordinates InstMap
instMap HsDecl (GhcPass 'Renamed)
decl = case HsDecl (GhcPass 'Renamed)
decl of
  InstD XInstD (GhcPass 'Renamed)
_ (ClsInstD XClsInstD (GhcPass 'Renamed)
_ ClsInstDecl (GhcPass 'Renamed)
d) -> do
    DataFamInstDecl { dfid_eqn :: forall pass.
DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body =
      FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = L SrcSpan
l IdP (GhcPass 'Renamed)
_
             , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs   = HsDataDefn (GhcPass 'Renamed)
defn }}} <- LDataFamInstDecl (GhcPass 'Renamed)
-> DataFamInstDecl (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LDataFamInstDecl (GhcPass 'Renamed)
 -> DataFamInstDecl (GhcPass 'Renamed))
-> [LDataFamInstDecl (GhcPass 'Renamed)]
-> [DataFamInstDecl (GhcPass 'Renamed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClsInstDecl (GhcPass 'Renamed)
-> [LDataFamInstDecl (GhcPass 'Renamed)]
forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts ClsInstDecl (GhcPass 'Renamed)
d
    [ (Name
n, [], Map Int HsDocString
forall k a. Map k a
M.empty) | Just Name
n <- [SrcSpan -> InstMap -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SrcSpan
l InstMap
instMap] ] [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs HsDataDefn (GhcPass 'Renamed)
defn

  InstD XInstD (GhcPass 'Renamed)
_ (DataFamInstD XDataFamInstD (GhcPass 'Renamed)
_ (DataFamInstDecl (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
d })))
    -> HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
-> HsDataDefn (GhcPass 'Renamed)
forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
d)
  TyClD XTyClD (GhcPass 'Renamed)
_ TyClDecl (GhcPass 'Renamed)
d | TyClDecl (GhcPass 'Renamed) -> Bool
forall pass. TyClDecl pass -> Bool
isClassDecl TyClDecl (GhcPass 'Renamed)
d -> TyClDecl (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
classSubs TyClDecl (GhcPass 'Renamed)
d
            | TyClDecl (GhcPass 'Renamed) -> Bool
forall pass. TyClDecl pass -> Bool
isDataDecl  TyClDecl (GhcPass 'Renamed)
d -> HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs (TyClDecl (GhcPass 'Renamed) -> HsDataDefn (GhcPass 'Renamed)
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl (GhcPass 'Renamed)
d)
  HsDecl (GhcPass 'Renamed)
_ -> []
  where
    classSubs :: TyClDecl (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
classSubs TyClDecl (GhcPass 'Renamed)
dd = [ (Name
name, [HsDocString]
doc, HsDecl (GhcPass 'Renamed) -> Map Int HsDocString
declTypeDocs HsDecl (GhcPass 'Renamed)
d) | (L SrcSpan
_ HsDecl (GhcPass 'Renamed)
d, [HsDocString]
doc) <- TyClDecl (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
classDecls TyClDecl (GhcPass 'Renamed)
dd
                   , Name
name <- HsDecl (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (p :: Pass). HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder HsDecl (GhcPass 'Renamed)
d, Bool -> Bool
not (HsDecl (GhcPass 'Renamed) -> Bool
forall a. HsDecl a -> Bool
isValD HsDecl (GhcPass 'Renamed)
d)
                   ]
    dataSubs :: HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
    dataSubs :: HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs HsDataDefn (GhcPass 'Renamed)
dd = [(Name, [HsDocString], Map Int HsDocString)]
constrs [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], Map Int HsDocString)]
fields [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], Map Int HsDocString)]
derivs
      where
        cons :: [ConDecl (GhcPass 'Renamed)]
cons = (LConDecl (GhcPass 'Renamed) -> ConDecl (GhcPass 'Renamed))
-> [LConDecl (GhcPass 'Renamed)] -> [ConDecl (GhcPass 'Renamed)]
forall a b. (a -> b) -> [a] -> [b]
map LConDecl (GhcPass 'Renamed) -> ConDecl (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([LConDecl (GhcPass 'Renamed)] -> [ConDecl (GhcPass 'Renamed)])
-> [LConDecl (GhcPass 'Renamed)] -> [ConDecl (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ (HsDataDefn (GhcPass 'Renamed) -> [LConDecl (GhcPass 'Renamed)]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn (GhcPass 'Renamed)
dd)
        constrs :: [(Name, [HsDocString], Map Int HsDocString)]
constrs = [ (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
cname, Maybe HsDocString -> [HsDocString]
forall a. Maybe a -> [a]
maybeToList (Maybe HsDocString -> [HsDocString])
-> Maybe HsDocString -> [HsDocString]
forall a b. (a -> b) -> a -> b
$ (LHsDocString -> HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsDocString -> HsDocString
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Maybe LHsDocString -> Maybe HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall a b. (a -> b) -> a -> b
$ ConDecl (GhcPass 'Renamed) -> Maybe LHsDocString
forall pass. ConDecl pass -> Maybe LHsDocString
con_doc ConDecl (GhcPass 'Renamed)
c, ConDecl (GhcPass 'Renamed) -> Map Int HsDocString
conArgDocs ConDecl (GhcPass 'Renamed)
c)
                  | ConDecl (GhcPass 'Renamed)
c <- [ConDecl (GhcPass 'Renamed)]
cons, Located Name
cname <- ConDecl (GhcPass 'Renamed) -> [Located (IdP (GhcPass 'Renamed))]
forall (p :: Pass).
ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames ConDecl (GhcPass 'Renamed)
c ]
        fields :: [(Name, [HsDocString], Map Int HsDocString)]
fields  = [ (FieldOcc (GhcPass 'Renamed) -> XCFieldOcc (GhcPass 'Renamed)
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc FieldOcc (GhcPass 'Renamed)
n, Maybe HsDocString -> [HsDocString]
forall a. Maybe a -> [a]
maybeToList (Maybe HsDocString -> [HsDocString])
-> Maybe HsDocString -> [HsDocString]
forall a b. (a -> b) -> a -> b
$ (LHsDocString -> HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsDocString -> HsDocString
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Maybe LHsDocString
doc, Map Int HsDocString
forall k a. Map k a
M.empty)
                  | RecCon Located [LConDeclField (GhcPass 'Renamed)]
flds <- (ConDecl (GhcPass 'Renamed)
 -> HsConDetails
      (LHsType (GhcPass 'Renamed))
      (Located [LConDeclField (GhcPass 'Renamed)]))
-> [ConDecl (GhcPass 'Renamed)]
-> [HsConDetails
      (LHsType (GhcPass 'Renamed))
      (Located [LConDeclField (GhcPass 'Renamed)])]
forall a b. (a -> b) -> [a] -> [b]
map ConDecl (GhcPass 'Renamed)
-> HsConDetails
     (LHsType (GhcPass 'Renamed))
     (Located [LConDeclField (GhcPass 'Renamed)])
forall pass. ConDecl pass -> HsConDeclDetails pass
getConArgs [ConDecl (GhcPass 'Renamed)]
cons
                  , L SrcSpan
_ (ConDeclField XConDeclField (GhcPass 'Renamed)
_ [LFieldOcc (GhcPass 'Renamed)]
ns LHsType (GhcPass 'Renamed)
_ Maybe LHsDocString
doc) <- (Located [LConDeclField (GhcPass 'Renamed)]
-> SrcSpanLess (Located [LConDeclField (GhcPass 'Renamed)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LConDeclField (GhcPass 'Renamed)]
flds)
                  , L SrcSpan
_ FieldOcc (GhcPass 'Renamed)
n <- [LFieldOcc (GhcPass 'Renamed)]
ns ]
        derivs :: [(Name, [HsDocString], Map Int HsDocString)]
derivs  = [ (Name
instName, [LHsDocString -> SrcSpanLess LHsDocString
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDocString
doc], Map Int HsDocString
forall k a. Map k a
M.empty)
                  | (SrcSpan
l, LHsDocString
doc) <- (HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
 -> Maybe (SrcSpan, LHsDocString))
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
-> [(SrcSpan, LHsDocString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LHsType (GhcPass 'Renamed) -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty (LHsType (GhcPass 'Renamed) -> Maybe (SrcSpan, LHsDocString))
-> (HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    -> LHsType (GhcPass 'Renamed))
-> HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
-> Maybe (SrcSpan, LHsDocString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body) ([HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
 -> [(SrcSpan, LHsDocString)])
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
-> [(SrcSpan, LHsDocString)]
forall a b. (a -> b) -> a -> b
$
                                (LHsDerivingClause (GhcPass 'Renamed)
 -> [HsImplicitBndrs
       (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))])
-> [LHsDerivingClause (GhcPass 'Renamed)]
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Located
  [HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located
   [HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
 -> [HsImplicitBndrs
       (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))])
-> (LHsDerivingClause (GhcPass 'Renamed)
    -> Located
         [HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))])
-> LHsDerivingClause (GhcPass 'Renamed)
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDerivingClause (GhcPass 'Renamed)
-> Located
     [HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
forall pass. HsDerivingClause pass -> Located [LHsSigType pass]
deriv_clause_tys (HsDerivingClause (GhcPass 'Renamed)
 -> Located
      [HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))])
-> (LHsDerivingClause (GhcPass 'Renamed)
    -> HsDerivingClause (GhcPass 'Renamed))
-> LHsDerivingClause (GhcPass 'Renamed)
-> Located
     [HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDerivingClause (GhcPass 'Renamed)
-> HsDerivingClause (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([LHsDerivingClause (GhcPass 'Renamed)]
 -> [HsImplicitBndrs
       (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))])
-> [LHsDerivingClause (GhcPass 'Renamed)]
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))]
forall a b. (a -> b) -> a -> b
$
                                HsDeriving (GhcPass 'Renamed)
-> SrcSpanLess (HsDeriving (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsDeriving (GhcPass 'Renamed)
 -> SrcSpanLess (HsDeriving (GhcPass 'Renamed)))
-> HsDeriving (GhcPass 'Renamed)
-> SrcSpanLess (HsDeriving (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ HsDataDefn (GhcPass 'Renamed) -> HsDeriving (GhcPass 'Renamed)
forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs HsDataDefn (GhcPass 'Renamed)
dd
                  , Just Name
instName <- [SrcSpan -> InstMap -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SrcSpan
l InstMap
instMap] ]

        extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString)
        extract_deriv_ty :: LHsType (GhcPass 'Renamed) -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty LHsType (GhcPass 'Renamed)
ty =
          case LHsType (GhcPass 'Renamed)
-> Located (SrcSpanLess (LHsType (GhcPass 'Renamed)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL LHsType (GhcPass 'Renamed)
ty of
            -- deriving (forall a. C a {- ^ Doc comment -})
            L SrcSpan
l (HsForAllTy{ hst_fvf = ForallInvis
                           , hst_body = dL->L _ (HsDocTy _ _ doc) })
                                  -> (SrcSpan, LHsDocString) -> Maybe (SrcSpan, LHsDocString)
forall a. a -> Maybe a
Just (SrcSpan
l, LHsDocString
doc)
            -- deriving (C a {- ^ Doc comment -})
            L SrcSpan
l (HsDocTy _ _ doc) -> (SrcSpan, LHsDocString) -> Maybe (SrcSpan, LHsDocString)
forall a. a -> Maybe a
Just (SrcSpan
l, LHsDocString
doc)
            Located (SrcSpanLess (LHsType (GhcPass 'Renamed)))
_                     -> Maybe (SrcSpan, LHsDocString)
forall a. Maybe a
Nothing

-- | Extract constructor argument docs from inside constructor decls.
conArgDocs :: ConDecl GhcRn -> Map Int HsDocString
conArgDocs :: ConDecl (GhcPass 'Renamed) -> Map Int HsDocString
conArgDocs ConDecl (GhcPass 'Renamed)
con = case ConDecl (GhcPass 'Renamed)
-> HsConDetails
     (LHsType (GhcPass 'Renamed))
     (Located [LConDeclField (GhcPass 'Renamed)])
forall pass. ConDecl pass -> HsConDeclDetails pass
getConArgs ConDecl (GhcPass 'Renamed)
con of
                   PrefixCon [LHsType (GhcPass 'Renamed)]
args -> Int -> [HsType (GhcPass 'Renamed)] -> Map Int HsDocString
forall a pass.
(Ord a, Num a) =>
a -> [HsType pass] -> Map a HsDocString
go Int
0 ((LHsType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed))
-> [LHsType (GhcPass 'Renamed)] -> [HsType (GhcPass 'Renamed)]
forall a b. (a -> b) -> [a] -> [b]
map LHsType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LHsType (GhcPass 'Renamed)]
args [HsType (GhcPass 'Renamed)]
-> [HsType (GhcPass 'Renamed)] -> [HsType (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++ [HsType (GhcPass 'Renamed)]
ret)
                   InfixCon LHsType (GhcPass 'Renamed)
arg1 LHsType (GhcPass 'Renamed)
arg2 -> Int -> [HsType (GhcPass 'Renamed)] -> Map Int HsDocString
forall a pass.
(Ord a, Num a) =>
a -> [HsType pass] -> Map a HsDocString
go Int
0 ([LHsType (GhcPass 'Renamed)
-> SrcSpanLess (LHsType (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType (GhcPass 'Renamed)
arg1, LHsType (GhcPass 'Renamed)
-> SrcSpanLess (LHsType (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType (GhcPass 'Renamed)
arg2] [HsType (GhcPass 'Renamed)]
-> [HsType (GhcPass 'Renamed)] -> [HsType (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++ [HsType (GhcPass 'Renamed)]
ret)
                   RecCon Located [LConDeclField (GhcPass 'Renamed)]
_ -> Int -> [HsType (GhcPass 'Renamed)] -> Map Int HsDocString
forall a pass.
(Ord a, Num a) =>
a -> [HsType pass] -> Map a HsDocString
go Int
1 [HsType (GhcPass 'Renamed)]
ret
  where
    go :: a -> [HsType pass] -> Map a HsDocString
go a
n (HsDocTy XDocTy pass
_ LHsType pass
_ (L SrcSpan
_ HsDocString
ds) : [HsType pass]
tys) = a -> HsDocString -> Map a HsDocString -> Map a HsDocString
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
n HsDocString
ds (Map a HsDocString -> Map a HsDocString)
-> Map a HsDocString -> Map a HsDocString
forall a b. (a -> b) -> a -> b
$ a -> [HsType pass] -> Map a HsDocString
go (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) [HsType pass]
tys
    go a
n (HsBangTy XBangTy pass
_ HsSrcBang
_ (L SrcSpan
_ (HsDocTy XDocTy pass
_ LHsType pass
_ (L SrcSpan
_ HsDocString
ds))) : [HsType pass]
tys) = a -> HsDocString -> Map a HsDocString -> Map a HsDocString
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
n HsDocString
ds (Map a HsDocString -> Map a HsDocString)
-> Map a HsDocString -> Map a HsDocString
forall a b. (a -> b) -> a -> b
$ a -> [HsType pass] -> Map a HsDocString
go (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) [HsType pass]
tys
    go a
n (HsType pass
_ : [HsType pass]
tys) = a -> [HsType pass] -> Map a HsDocString
go (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) [HsType pass]
tys
    go a
_ [] = Map a HsDocString
forall k a. Map k a
M.empty

    ret :: [HsType (GhcPass 'Renamed)]
ret = case ConDecl (GhcPass 'Renamed)
con of
            ConDeclGADT { con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty = LHsType (GhcPass 'Renamed)
res_ty } -> [ LHsType (GhcPass 'Renamed)
-> SrcSpanLess (LHsType (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType (GhcPass 'Renamed)
res_ty ]
            ConDecl (GhcPass 'Renamed)
_ -> []

-- | Extract function argument docs from inside top-level decls.
declTypeDocs :: HsDecl GhcRn -> Map Int HsDocString
declTypeDocs :: HsDecl (GhcPass 'Renamed) -> Map Int HsDocString
declTypeDocs (SigD  XSigD (GhcPass 'Renamed)
_ (TypeSig XTypeSig (GhcPass 'Renamed)
_ [Located (IdP (GhcPass 'Renamed))]
_ LHsSigWcType (GhcPass 'Renamed)
ty))          = HsType (GhcPass 'Renamed) -> Map Int HsDocString
typeDocs (LHsType (GhcPass 'Renamed)
-> SrcSpanLess (LHsType (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsSigWcType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType (GhcPass 'Renamed)
ty))
declTypeDocs (SigD  XSigD (GhcPass 'Renamed)
_ (ClassOpSig XClassOpSig (GhcPass 'Renamed)
_ Bool
_ [Located (IdP (GhcPass 'Renamed))]
_ HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
ty))     = HsType (GhcPass 'Renamed) -> Map Int HsDocString
typeDocs (LHsType (GhcPass 'Renamed)
-> SrcSpanLess (LHsType (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
ty))
declTypeDocs (SigD  XSigD (GhcPass 'Renamed)
_ (PatSynSig XPatSynSig (GhcPass 'Renamed)
_ [Located (IdP (GhcPass 'Renamed))]
_ HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
ty))        = HsType (GhcPass 'Renamed) -> Map Int HsDocString
typeDocs (LHsType (GhcPass 'Renamed)
-> SrcSpanLess (LHsType (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
ty))
declTypeDocs (ForD  XForD (GhcPass 'Renamed)
_ (ForeignImport XForeignImport (GhcPass 'Renamed)
_ Located (IdP (GhcPass 'Renamed))
_ HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
ty ForeignImport
_))  = HsType (GhcPass 'Renamed) -> Map Int HsDocString
typeDocs (LHsType (GhcPass 'Renamed)
-> SrcSpanLess (LHsType (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
ty))
declTypeDocs (TyClD XTyClD (GhcPass 'Renamed)
_ (SynDecl { tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LHsType (GhcPass 'Renamed)
ty })) = HsType (GhcPass 'Renamed) -> Map Int HsDocString
typeDocs (LHsType (GhcPass 'Renamed)
-> SrcSpanLess (LHsType (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType (GhcPass 'Renamed)
ty)
declTypeDocs HsDecl (GhcPass 'Renamed)
_ = Map Int HsDocString
forall k a. Map k a
M.empty

-- | Extract function argument docs from inside types.
typeDocs :: HsType GhcRn -> Map Int HsDocString
typeDocs :: HsType (GhcPass 'Renamed) -> Map Int HsDocString
typeDocs = Int -> HsType (GhcPass 'Renamed) -> Map Int HsDocString
forall k pass.
(Ord k, Num k) =>
k -> HsType pass -> Map k HsDocString
go Int
0
  where
    go :: k -> HsType pass -> Map k HsDocString
go k
n (HsForAllTy { hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType pass
ty }) = k -> HsType pass -> Map k HsDocString
go k
n (LHsType pass -> SrcSpanLess (LHsType pass)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType pass
ty)
    go k
n (HsQualTy   { hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType pass
ty }) = k -> HsType pass -> Map k HsDocString
go k
n (LHsType pass -> SrcSpanLess (LHsType pass)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType pass
ty)
    go k
n (HsFunTy XFunTy pass
_ (L SrcSpan
_ (HsDocTy XDocTy pass
_ LHsType pass
_ (L SrcSpan
_ HsDocString
x))) (L SrcSpan
_ HsType pass
ty)) = k -> HsDocString -> Map k HsDocString -> Map k HsDocString
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
n HsDocString
x (Map k HsDocString -> Map k HsDocString)
-> Map k HsDocString -> Map k HsDocString
forall a b. (a -> b) -> a -> b
$ k -> HsType pass -> Map k HsDocString
go (k
nk -> k -> k
forall a. Num a => a -> a -> a
+k
1) HsType pass
ty
    go k
n (HsFunTy XFunTy pass
_ LHsType pass
_ LHsType pass
ty) = k -> HsType pass -> Map k HsDocString
go (k
nk -> k -> k
forall a. Num a => a -> a -> a
+k
1) (LHsType pass -> SrcSpanLess (LHsType pass)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType pass
ty)
    go k
n (HsDocTy XDocTy pass
_ LHsType pass
_ (L SrcSpan
_ HsDocString
doc)) = k -> HsDocString -> Map k HsDocString
forall k a. k -> a -> Map k a
M.singleton k
n HsDocString
doc
    go k
_ HsType pass
_ = Map k HsDocString
forall k a. Map k a
M.empty

-- | 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, [HsDocString])]
classDecls :: TyClDecl (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
classDecls TyClDecl (GhcPass 'Renamed)
class_ = [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls ([(LHsDecl (GhcPass 'Renamed), [HsDocString])]
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> ([LHsDecl (GhcPass 'Renamed)]
    -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> [LHsDecl (GhcPass 'Renamed)]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl (GhcPass 'Renamed)]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall a. [LHsDecl a] -> [(LHsDecl a, [HsDocString])]
collectDocs ([LHsDecl (GhcPass 'Renamed)]
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> ([LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)])
-> [LHsDecl (GhcPass 'Renamed)]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [Located a] -> [Located a]
sortByLoc ([LHsDecl (GhcPass 'Renamed)]
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> [LHsDecl (GhcPass 'Renamed)]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall a b. (a -> b) -> a -> b
$ [LHsDecl (GhcPass 'Renamed)]
decls
  where
    decls :: [LHsDecl (GhcPass 'Renamed)]
decls = [LHsDecl (GhcPass 'Renamed)]
docs [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++ [LHsDecl (GhcPass 'Renamed)]
defs [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++ [LHsDecl (GhcPass 'Renamed)]
sigs [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++ [LHsDecl (GhcPass 'Renamed)]
ats
    docs :: [LHsDecl (GhcPass 'Renamed)]
docs  = (TyClDecl (GhcPass 'Renamed) -> [Located DocDecl])
-> (DocDecl -> HsDecl (GhcPass 'Renamed))
-> TyClDecl (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls TyClDecl (GhcPass 'Renamed) -> [Located DocDecl]
forall pass. TyClDecl pass -> [Located DocDecl]
tcdDocs (XDocD (GhcPass 'Renamed) -> DocDecl -> HsDecl (GhcPass 'Renamed)
forall p. XDocD p -> DocDecl -> HsDecl p
DocD NoExtField
XDocD (GhcPass 'Renamed)
noExtField) TyClDecl (GhcPass 'Renamed)
class_
    defs :: [LHsDecl (GhcPass 'Renamed)]
defs  = (TyClDecl (GhcPass 'Renamed)
 -> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
-> (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> HsDecl (GhcPass 'Renamed))
-> TyClDecl (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls (Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall a. Bag a -> [a]
bagToList (Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
 -> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
-> (TyClDecl (GhcPass 'Renamed)
    -> Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> TyClDecl (GhcPass 'Renamed)
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyClDecl (GhcPass 'Renamed)
-> Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths) (XValD (GhcPass 'Renamed)
-> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsDecl (GhcPass 'Renamed)
forall p. XValD p -> HsBind p -> HsDecl p
ValD NoExtField
XValD (GhcPass 'Renamed)
noExtField) TyClDecl (GhcPass 'Renamed)
class_
    sigs :: [LHsDecl (GhcPass 'Renamed)]
sigs  = (TyClDecl (GhcPass 'Renamed) -> [Located (Sig (GhcPass 'Renamed))])
-> (Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> TyClDecl (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls TyClDecl (GhcPass 'Renamed) -> [Located (Sig (GhcPass 'Renamed))]
forall pass. TyClDecl pass -> [LSig pass]
tcdSigs (XSigD (GhcPass 'Renamed)
-> Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
XSigD (GhcPass 'Renamed)
noExtField) TyClDecl (GhcPass 'Renamed)
class_
    ats :: [LHsDecl (GhcPass 'Renamed)]
ats   = (TyClDecl (GhcPass 'Renamed)
 -> [Located (FamilyDecl (GhcPass 'Renamed))])
-> (FamilyDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> TyClDecl (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls TyClDecl (GhcPass 'Renamed)
-> [Located (FamilyDecl (GhcPass 'Renamed))]
forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs (XTyClD (GhcPass 'Renamed)
-> TyClDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
XTyClD (GhcPass 'Renamed)
noExtField (TyClDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> (FamilyDecl (GhcPass 'Renamed) -> TyClDecl (GhcPass 'Renamed))
-> FamilyDecl (GhcPass 'Renamed)
-> HsDecl (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFamDecl (GhcPass 'Renamed)
-> FamilyDecl (GhcPass 'Renamed) -> TyClDecl (GhcPass 'Renamed)
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl NoExtField
XFamDecl (GhcPass 'Renamed)
noExtField) TyClDecl (GhcPass 'Renamed)
class_


-- | 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, [HsDocString])]
topDecls :: HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
topDecls =
  [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterClasses ([(LHsDecl (GhcPass 'Renamed), [HsDocString])]
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> (HsGroup (GhcPass 'Renamed)
    -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls ([(LHsDecl (GhcPass 'Renamed), [HsDocString])]
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> (HsGroup (GhcPass 'Renamed)
    -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl (GhcPass 'Renamed)]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall a. [LHsDecl a] -> [(LHsDecl a, [HsDocString])]
collectDocs ([LHsDecl (GhcPass 'Renamed)]
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> (HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)])
-> HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [Located a] -> [Located a]
sortByLoc ([LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)])
-> (HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)])
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)]
ungroup

-- | Extract a map of fixity declarations only
mkFixMap :: HsGroup GhcRn -> FixMap
mkFixMap :: HsGroup (GhcPass 'Renamed) -> FixMap
mkFixMap HsGroup (GhcPass 'Renamed)
group_ = [(Name, Fixity)] -> FixMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Name
n,Fixity
f)
                             | L SrcSpan
_ (FixitySig XFixitySig (GhcPass 'Renamed)
_ [Located (IdP (GhcPass 'Renamed))]
ns Fixity
f) <- HsGroup (GhcPass 'Renamed)
-> [GenLocated SrcSpan (FixitySig (GhcPass 'Renamed))]
forall p. HsGroup p -> [LFixitySig p]
hs_fixds HsGroup (GhcPass 'Renamed)
group_,
                               L SrcSpan
_ Name
n <- [Located (IdP (GhcPass 'Renamed))]
[Located Name]
ns ]


-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]
ungroup :: HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)]
ungroup HsGroup (GhcPass 'Renamed)
group_ =
  (HsGroup (GhcPass 'Renamed)
 -> [Located (TyClDecl (GhcPass 'Renamed))])
-> (TyClDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls ([TyClGroup (GhcPass 'Renamed)]
-> [Located (TyClDecl (GhcPass 'Renamed))]
forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls ([TyClGroup (GhcPass 'Renamed)]
 -> [Located (TyClDecl (GhcPass 'Renamed))])
-> (HsGroup (GhcPass 'Renamed) -> [TyClGroup (GhcPass 'Renamed)])
-> HsGroup (GhcPass 'Renamed)
-> [Located (TyClDecl (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup (GhcPass 'Renamed) -> [TyClGroup (GhcPass 'Renamed)]
forall p. HsGroup p -> [TyClGroup p]
hs_tyclds) (XTyClD (GhcPass 'Renamed)
-> TyClDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
XTyClD (GhcPass 'Renamed)
noExtField)  HsGroup (GhcPass 'Renamed)
group_ [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup (GhcPass 'Renamed)
 -> [Located (DerivDecl (GhcPass 'Renamed))])
-> (DerivDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls HsGroup (GhcPass 'Renamed)
-> [Located (DerivDecl (GhcPass 'Renamed))]
forall p. HsGroup p -> [LDerivDecl p]
hs_derivds             (XDerivD (GhcPass 'Renamed)
-> DerivDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XDerivD p -> DerivDecl p -> HsDecl p
DerivD NoExtField
XDerivD (GhcPass 'Renamed)
noExtField) HsGroup (GhcPass 'Renamed)
group_ [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup (GhcPass 'Renamed)
 -> [Located (DefaultDecl (GhcPass 'Renamed))])
-> (DefaultDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls HsGroup (GhcPass 'Renamed)
-> [Located (DefaultDecl (GhcPass 'Renamed))]
forall p. HsGroup p -> [LDefaultDecl p]
hs_defds               (XDefD (GhcPass 'Renamed)
-> DefaultDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XDefD p -> DefaultDecl p -> HsDecl p
DefD NoExtField
XDefD (GhcPass 'Renamed)
noExtField)   HsGroup (GhcPass 'Renamed)
group_ [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup (GhcPass 'Renamed)
 -> [Located (ForeignDecl (GhcPass 'Renamed))])
-> (ForeignDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls HsGroup (GhcPass 'Renamed)
-> [Located (ForeignDecl (GhcPass 'Renamed))]
forall p. HsGroup p -> [LForeignDecl p]
hs_fords               (XForD (GhcPass 'Renamed)
-> ForeignDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD NoExtField
XForD (GhcPass 'Renamed)
noExtField)   HsGroup (GhcPass 'Renamed)
group_ [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup (GhcPass 'Renamed) -> [Located DocDecl])
-> (DocDecl -> HsDecl (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls HsGroup (GhcPass 'Renamed) -> [Located DocDecl]
forall p. HsGroup p -> [Located DocDecl]
hs_docs                (XDocD (GhcPass 'Renamed) -> DocDecl -> HsDecl (GhcPass 'Renamed)
forall p. XDocD p -> DocDecl -> HsDecl p
DocD NoExtField
XDocD (GhcPass 'Renamed)
noExtField)   HsGroup (GhcPass 'Renamed)
group_ [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup (GhcPass 'Renamed)
 -> [Located (InstDecl (GhcPass 'Renamed))])
-> (InstDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls ([TyClGroup (GhcPass 'Renamed)]
-> [Located (InstDecl (GhcPass 'Renamed))]
forall pass. [TyClGroup pass] -> [LInstDecl pass]
tyClGroupInstDecls ([TyClGroup (GhcPass 'Renamed)]
 -> [Located (InstDecl (GhcPass 'Renamed))])
-> (HsGroup (GhcPass 'Renamed) -> [TyClGroup (GhcPass 'Renamed)])
-> HsGroup (GhcPass 'Renamed)
-> [Located (InstDecl (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup (GhcPass 'Renamed) -> [TyClGroup (GhcPass 'Renamed)]
forall p. HsGroup p -> [TyClGroup p]
hs_tyclds) (XInstD (GhcPass 'Renamed)
-> InstDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD NoExtField
XInstD (GhcPass 'Renamed)
noExtField)  HsGroup (GhcPass 'Renamed)
group_ [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup (GhcPass 'Renamed) -> [Located (Sig (GhcPass 'Renamed))])
-> (Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls (HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> [Located (Sig (GhcPass 'Renamed))]
forall idL idR idL.
(XXValBindsLR idL idR ~ NHsValBindsLR idL) =>
HsValBindsLR idL idR -> [Located (Sig (GhcPass 'Renamed))]
typesigs (HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
 -> [Located (Sig (GhcPass 'Renamed))])
-> (HsGroup (GhcPass 'Renamed)
    -> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [Located (Sig (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
forall p. HsGroup p -> HsValBinds p
hs_valds)  (XSigD (GhcPass 'Renamed)
-> Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
XSigD (GhcPass 'Renamed)
noExtField)   HsGroup (GhcPass 'Renamed)
group_ [LHsDecl (GhcPass 'Renamed)]
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup (GhcPass 'Renamed)
 -> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
-> (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> HsDecl (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall a b c. (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls (HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall idL idR idL.
(XXValBindsLR idL idR ~ NHsValBindsLR idL) =>
HsValBindsLR idL idR -> [LHsBindLR idL idL]
valbinds (HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
 -> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
-> (HsGroup (GhcPass 'Renamed)
    -> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> HsGroup (GhcPass 'Renamed)
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
forall p. HsGroup p -> HsValBinds p
hs_valds)  (XValD (GhcPass 'Renamed)
-> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsDecl (GhcPass 'Renamed)
forall p. XValD p -> HsBind p -> HsDecl p
ValD NoExtField
XValD (GhcPass 'Renamed)
noExtField)   HsGroup (GhcPass 'Renamed)
group_
  where
    typesigs :: HsValBindsLR idL idR -> [Located (Sig (GhcPass 'Renamed))]
typesigs (XValBindsLR (NValBinds _ sigs)) = (Located (Sig (GhcPass 'Renamed)) -> Bool)
-> [Located (Sig (GhcPass 'Renamed))]
-> [Located (Sig (GhcPass 'Renamed))]
forall a. (a -> Bool) -> [a] -> [a]
filter Located (Sig (GhcPass 'Renamed)) -> Bool
forall name. LSig name -> Bool
isUserLSig [Located (Sig (GhcPass 'Renamed))]
sigs
    typesigs HsValBindsLR idL idR
_ = String -> [Located (Sig (GhcPass 'Renamed))]
forall a. HasCallStack => String -> a
error String
"expected ValBindsOut"

    valbinds :: HsValBindsLR idL idR -> [LHsBindLR idL idL]
valbinds (XValBindsLR (NValBinds binds _)) = (Bag (LHsBindLR idL idL) -> [LHsBindLR idL idL])
-> [Bag (LHsBindLR idL idL)] -> [LHsBindLR idL idL]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bag (LHsBindLR idL idL) -> [LHsBindLR idL idL]
forall a. Bag a -> [a]
bagToList ([Bag (LHsBindLR idL idL)] -> [LHsBindLR idL idL])
-> ([(RecFlag, Bag (LHsBindLR idL idL))]
    -> [Bag (LHsBindLR idL idL)])
-> [(RecFlag, Bag (LHsBindLR idL idL))]
-> [LHsBindLR idL idL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RecFlag], [Bag (LHsBindLR idL idL)]) -> [Bag (LHsBindLR idL idL)]
forall a b. (a, b) -> b
snd (([RecFlag], [Bag (LHsBindLR idL idL)])
 -> [Bag (LHsBindLR idL idL)])
-> ([(RecFlag, Bag (LHsBindLR idL idL))]
    -> ([RecFlag], [Bag (LHsBindLR idL idL)]))
-> [(RecFlag, Bag (LHsBindLR idL idL))]
-> [Bag (LHsBindLR idL idL)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RecFlag, Bag (LHsBindLR idL idL))]
-> ([RecFlag], [Bag (LHsBindLR idL idL)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(RecFlag, Bag (LHsBindLR idL idL))] -> [LHsBindLR idL idL])
-> [(RecFlag, Bag (LHsBindLR idL idL))] -> [LHsBindLR idL idL]
forall a b. (a -> b) -> a -> b
$ [(RecFlag, Bag (LHsBindLR idL idL))]
binds
    valbinds HsValBindsLR idL idR
_ = String -> [LHsBindLR idL idL]
forall a. HasCallStack => String -> a
error String
"expected ValBindsOut"


-- | Take a field of declarations from a data structure and create HsDecls
-- using the given constructor
mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]
mkDecls a -> [Located b]
field b -> c
con a
struct = [ SrcSpan -> c -> Located c
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (b -> c
con b
decl) | L SrcSpan
loc b
decl <- a -> [Located b]
field a
struct ]


-- | Sort by source location
sortByLoc :: [Located a] -> [Located a]
sortByLoc :: [Located a] -> [Located a]
sortByLoc = (Located a -> Located a -> Ordering) -> [Located a] -> [Located a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Located a -> SrcSpan) -> Located a -> Located a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Located a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc)


--------------------------------------------------------------------------------
-- Filtering of declarations
--
-- We filter out declarations that we don't intend to handle later.
--------------------------------------------------------------------------------


-- | Filter out declarations that we don't handle in Haddock
filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls = ((LHsDecl a, doc) -> Bool)
-> [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
forall a. (a -> Bool) -> [a] -> [a]
filter (HsDecl a -> Bool
forall a. HsDecl a -> Bool
isHandled (HsDecl a -> Bool)
-> ((LHsDecl a, doc) -> HsDecl a) -> (LHsDecl a, doc) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl a -> HsDecl a
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsDecl a -> HsDecl a)
-> ((LHsDecl a, doc) -> LHsDecl a) -> (LHsDecl a, doc) -> HsDecl a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsDecl a, doc) -> LHsDecl a
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)  = LSig name -> Bool
forall name. LSig name -> Bool
isUserLSig (SrcSpanLess (LSig name) -> LSig name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Sig name
SrcSpanLess (LSig 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 :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterClasses [(LHsDecl a, doc)]
decls = [ if HsDecl a -> Bool
forall a. HsDecl a -> Bool
isClassD HsDecl a
d then (SrcSpan -> HsDecl a -> LHsDecl a
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (HsDecl a -> HsDecl a
forall pass. HsDecl pass -> HsDecl pass
filterClass HsDecl a
d), doc
doc) else (LHsDecl a, doc)
x
                      | x :: (LHsDecl a, doc)
x@(L SrcSpan
loc HsDecl a
d, doc
doc) <- [(LHsDecl a, doc)]
decls ]
  where
    filterClass :: HsDecl pass -> HsDecl pass
filterClass (TyClD XTyClD pass
x TyClDecl pass
c) =
      XTyClD pass -> TyClDecl pass -> HsDecl pass
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD pass
x (TyClDecl pass -> HsDecl pass) -> TyClDecl pass -> HsDecl pass
forall a b. (a -> b) -> a -> b
$ TyClDecl pass
c { tcdSigs :: [LSig pass]
tcdSigs = (LSig pass -> Bool) -> [LSig pass] -> [LSig pass]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool)
-> (LSig pass -> Bool) -> (LSig pass -> Bool) -> LSig pass -> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) LSig pass -> Bool
forall name. LSig name -> Bool
isUserLSig LSig pass -> Bool
forall name. LSig name -> Bool
isMinimalLSig) ([LSig pass] -> [LSig pass]) -> [LSig pass] -> [LSig pass]
forall a b. (a -> b) -> a -> b
$ TyClDecl pass -> [LSig pass]
forall pass. TyClDecl pass -> [LSig pass]
tcdSigs TyClDecl pass
c }
    filterClass HsDecl pass
_ = String -> HsDecl pass
forall a. HasCallStack => String -> a
error String
"expected TyClD"


--------------------------------------------------------------------------------
-- Collect docs
--
-- To be able to attach the right Haddock comment to the right declaration,
-- we sort the declarations by their SrcLoc and "collect" the docs for each
-- declaration.
--------------------------------------------------------------------------------


-- | Collect docs and attach them to the right declarations.
collectDocs :: [LHsDecl a] -> [(LHsDecl a, [HsDocString])]
collectDocs :: [LHsDecl a] -> [(LHsDecl a, [HsDocString])]
collectDocs = Maybe (LHsDecl a)
-> [HsDocString] -> [LHsDecl a] -> [(LHsDecl a, [HsDocString])]
forall l p.
Maybe (GenLocated l (HsDecl p))
-> [HsDocString]
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go Maybe (LHsDecl a)
forall a. Maybe a
Nothing []
  where
    go :: Maybe (GenLocated l (HsDecl p))
-> [HsDocString]
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go Maybe (GenLocated l (HsDecl p))
Nothing [HsDocString]
_ [] = []
    go (Just GenLocated l (HsDecl p)
prev) [HsDocString]
docs [] = GenLocated l (HsDecl p)
-> [HsDocString]
-> [(GenLocated l (HsDecl p), [HsDocString])]
-> [(GenLocated l (HsDecl p), [HsDocString])]
forall a a. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished GenLocated l (HsDecl p)
prev [HsDocString]
docs []
    go Maybe (GenLocated l (HsDecl p))
prev [HsDocString]
docs (L l
_ (DocD XDocD p
_ (DocCommentNext HsDocString
str)) : [GenLocated l (HsDecl p)]
ds)
      | Maybe (GenLocated l (HsDecl p))
Nothing <- Maybe (GenLocated l (HsDecl p))
prev = Maybe (GenLocated l (HsDecl p))
-> [HsDocString]
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go Maybe (GenLocated l (HsDecl p))
forall a. Maybe a
Nothing (HsDocString
strHsDocString -> [HsDocString] -> [HsDocString]
forall a. a -> [a] -> [a]
:[HsDocString]
docs) [GenLocated l (HsDecl p)]
ds
      | Just GenLocated l (HsDecl p)
decl <- Maybe (GenLocated l (HsDecl p))
prev = GenLocated l (HsDecl p)
-> [HsDocString]
-> [(GenLocated l (HsDecl p), [HsDocString])]
-> [(GenLocated l (HsDecl p), [HsDocString])]
forall a a. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished GenLocated l (HsDecl p)
decl [HsDocString]
docs (Maybe (GenLocated l (HsDecl p))
-> [HsDocString]
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go Maybe (GenLocated l (HsDecl p))
forall a. Maybe a
Nothing [HsDocString
str] [GenLocated l (HsDecl p)]
ds)
    go Maybe (GenLocated l (HsDecl p))
prev [HsDocString]
docs (L l
_ (DocD XDocD p
_ (DocCommentPrev HsDocString
str)) : [GenLocated l (HsDecl p)]
ds) = Maybe (GenLocated l (HsDecl p))
-> [HsDocString]
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go Maybe (GenLocated l (HsDecl p))
prev (HsDocString
strHsDocString -> [HsDocString] -> [HsDocString]
forall a. a -> [a] -> [a]
:[HsDocString]
docs) [GenLocated l (HsDecl p)]
ds
    go Maybe (GenLocated l (HsDecl p))
Nothing [HsDocString]
docs (GenLocated l (HsDecl p)
d:[GenLocated l (HsDecl p)]
ds) = Maybe (GenLocated l (HsDecl p))
-> [HsDocString]
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go (GenLocated l (HsDecl p) -> Maybe (GenLocated l (HsDecl p))
forall a. a -> Maybe a
Just GenLocated l (HsDecl p)
d) [HsDocString]
docs [GenLocated l (HsDecl p)]
ds
    go (Just GenLocated l (HsDecl p)
prev) [HsDocString]
docs (GenLocated l (HsDecl p)
d:[GenLocated l (HsDecl p)]
ds) = GenLocated l (HsDecl p)
-> [HsDocString]
-> [(GenLocated l (HsDecl p), [HsDocString])]
-> [(GenLocated l (HsDecl p), [HsDocString])]
forall a a. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished GenLocated l (HsDecl p)
prev [HsDocString]
docs (Maybe (GenLocated l (HsDecl p))
-> [HsDocString]
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go (GenLocated l (HsDecl p) -> Maybe (GenLocated l (HsDecl p))
forall a. a -> Maybe a
Just GenLocated l (HsDecl p)
d) [] [GenLocated l (HsDecl p)]
ds)

    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


-- | Build the list of items that will become the documentation, from the
-- export list.  At this point, the list of ExportItems is in terms of
-- original names.
--
-- We create the export items even if the module is hidden, since they
-- might be useful when creating the export items for other modules.
mkExportItems
  :: HasCallStack
  => Bool               -- is it a signature
  -> IfaceMap
  -> Maybe Package      -- this package
  -> Module             -- this module
  -> Module             -- semantic module
  -> WarningMap
  -> GlobalRdrEnv
  -> [Name]             -- exported names (orig)
  -> [LHsDecl GhcRn]    -- renamed source declarations
  -> Maps
  -> FixMap
  -> M.Map ModuleName [ModuleName]
  -> [SrcSpan]          -- splice locations
  -> Maybe [(IE GhcRn, Avails)]
  -> Avails             -- exported stuff from this module
  -> InstIfaceMap
  -> DynFlags
  -> ErrMsgGhc [ExportItem GhcRn]
mkExportItems :: Bool
-> IfaceMap
-> Maybe String
-> Module
-> Module
-> WarningMap
-> GlobalRdrEnv
-> [Name]
-> [LHsDecl (GhcPass 'Renamed)]
-> Maps
-> FixMap
-> Map ModuleName [ModuleName]
-> [SrcSpan]
-> Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
-> [AvailInfo]
-> InstIfaceMap
-> DynFlags
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
mkExportItems
  Bool
is_sig IfaceMap
modMap Maybe String
pkgName Module
thisMod Module
semMod WarningMap
warnings GlobalRdrEnv
gre [Name]
exportedNames [LHsDecl (GhcPass 'Renamed)]
decls
  Maps
maps FixMap
fixMap Map ModuleName [ModuleName]
unrestricted_imp_mods [SrcSpan]
splices Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
exportList [AvailInfo]
allExports
  InstIfaceMap
instIfaceMap DynFlags
dflags =
  case Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
exportList of
    Maybe [(IE (GhcPass 'Renamed), [AvailInfo])]
Nothing      ->
      Bool
-> IfaceMap
-> Maybe String
-> Module
-> Module
-> WarningMap
-> GlobalRdrEnv
-> [Name]
-> [LHsDecl (GhcPass 'Renamed)]
-> Maps
-> FixMap
-> [SrcSpan]
-> InstIfaceMap
-> DynFlags
-> [AvailInfo]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
fullModuleContents Bool
is_sig IfaceMap
modMap Maybe String
pkgName Module
thisMod Module
semMod WarningMap
warnings GlobalRdrEnv
gre
        [Name]
exportedNames [LHsDecl (GhcPass 'Renamed)]
decls Maps
maps FixMap
fixMap [SrcSpan]
splices InstIfaceMap
instIfaceMap DynFlags
dflags
        [AvailInfo]
allExports
    Just [(IE (GhcPass 'Renamed), [AvailInfo])]
exports -> ([[ExportItem (GhcPass 'Renamed)]]
 -> [ExportItem (GhcPass 'Renamed)])
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[ExportItem (GhcPass 'Renamed)]]
-> [ExportItem (GhcPass 'Renamed)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
 -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ ((IE (GhcPass 'Renamed), [AvailInfo])
 -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> [(IE (GhcPass 'Renamed), [AvailInfo])]
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IE (GhcPass 'Renamed), [AvailInfo])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
lookupExport [(IE (GhcPass 'Renamed), [AvailInfo])]
exports
  where
    lookupExport :: (IE (GhcPass 'Renamed), [AvailInfo])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
lookupExport (IEGroup XIEGroup (GhcPass 'Renamed)
_ Int
lev HsDocString
docStr, [AvailInfo]
_)  = ErrMsgM [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM [ExportItem (GhcPass 'Renamed)]
 -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> ErrMsgM [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ do
      Doc Name
doc <- DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name)
processDocString DynFlags
dflags GlobalRdrEnv
gre HsDocString
docStr
      [ExportItem (GhcPass 'Renamed)]
-> ErrMsgM [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int
-> String
-> Doc (IdP (GhcPass 'Renamed))
-> ExportItem (GhcPass 'Renamed)
forall name. Int -> String -> Doc (IdP name) -> ExportItem name
ExportGroup Int
lev String
"" Doc (IdP (GhcPass 'Renamed))
Doc Name
doc]

    lookupExport (IEDoc XIEDoc (GhcPass 'Renamed)
_ HsDocString
docStr, [AvailInfo]
_)        = ErrMsgM [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM [ExportItem (GhcPass 'Renamed)]
 -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> ErrMsgM [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ do
      MDoc Name
doc <- DynFlags
-> Maybe String
-> GlobalRdrEnv
-> HsDocString
-> ErrMsgM (MDoc Name)
processDocStringParas DynFlags
dflags Maybe String
pkgName GlobalRdrEnv
gre HsDocString
docStr
      [ExportItem (GhcPass 'Renamed)]
-> ErrMsgM [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return [MDoc (IdP (GhcPass 'Renamed)) -> ExportItem (GhcPass 'Renamed)
forall name. MDoc (IdP name) -> ExportItem name
ExportDoc MDoc (IdP (GhcPass 'Renamed))
MDoc Name
doc]

    lookupExport (IEDocNamed XIEDocNamed (GhcPass 'Renamed)
_ String
str, [AvailInfo]
_)      = ErrMsgM [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM [ExportItem (GhcPass 'Renamed)]
 -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> ErrMsgM [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$
      String
-> [HsDecl (GhcPass 'Renamed)] -> ErrMsgM (Maybe HsDocString)
findNamedDoc String
str [ LHsDecl (GhcPass 'Renamed)
-> SrcSpanLess (LHsDecl (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDecl (GhcPass 'Renamed)
d | LHsDecl (GhcPass 'Renamed)
d <- [LHsDecl (GhcPass 'Renamed)]
decls ] ErrMsgM (Maybe HsDocString)
-> (Maybe HsDocString -> ErrMsgM [ExportItem (GhcPass 'Renamed)])
-> ErrMsgM [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe HsDocString
Nothing -> [ExportItem (GhcPass 'Renamed)]
-> ErrMsgM [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return  []
        Just HsDocString
docStr -> do
          MDoc Name
doc <- DynFlags
-> Maybe String
-> GlobalRdrEnv
-> HsDocString
-> ErrMsgM (MDoc Name)
processDocStringParas DynFlags
dflags Maybe String
pkgName GlobalRdrEnv
gre HsDocString
docStr
          [ExportItem (GhcPass 'Renamed)]
-> ErrMsgM [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return [MDoc (IdP (GhcPass 'Renamed)) -> ExportItem (GhcPass 'Renamed)
forall name. MDoc (IdP name) -> ExportItem name
ExportDoc MDoc (IdP (GhcPass 'Renamed))
MDoc Name
doc]

    lookupExport (IEModuleContents XIEModuleContents (GhcPass 'Renamed)
_ (L SrcSpan
_ ModuleName
mod_name), [AvailInfo]
_)
      -- only consider exporting a module if we are sure we
      -- are really exporting the whole module and not some
      -- subset. We also look through module aliases here.
      | Just [ModuleName]
mods <- ModuleName -> Map ModuleName [ModuleName] -> Maybe [ModuleName]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
mod_name Map ModuleName [ModuleName]
unrestricted_imp_mods
      , Bool -> Bool
not ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
mods)
      = [[ExportItem (GhcPass 'Renamed)]]
-> [ExportItem (GhcPass 'Renamed)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ExportItem (GhcPass 'Renamed)]]
 -> [ExportItem (GhcPass 'Renamed)])
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleName -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> [ModuleName] -> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Module
-> DynFlags
-> IfaceMap
-> InstIfaceMap
-> ModuleName
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
moduleExport Module
thisMod DynFlags
dflags IfaceMap
modMap InstIfaceMap
instIfaceMap) [ModuleName]
mods

    lookupExport (IE (GhcPass 'Renamed)
_, [AvailInfo]
avails) =
      [[ExportItem (GhcPass 'Renamed)]]
-> [ExportItem (GhcPass 'Renamed)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ExportItem (GhcPass 'Renamed)]]
 -> [ExportItem (GhcPass 'Renamed)])
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AvailInfo -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> [AvailInfo] -> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse AvailInfo -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExport ([AvailInfo] -> [AvailInfo]
nubAvails [AvailInfo]
avails)

    availExport :: AvailInfo -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExport AvailInfo
avail =
      HasCallStack =>
Bool
-> IfaceMap
-> Module
-> Module
-> WarningMap
-> [Name]
-> Maps
-> FixMap
-> [SrcSpan]
-> InstIfaceMap
-> DynFlags
-> AvailInfo
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
Bool
-> IfaceMap
-> Module
-> Module
-> WarningMap
-> [Name]
-> Maps
-> FixMap
-> [SrcSpan]
-> InstIfaceMap
-> DynFlags
-> AvailInfo
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExportItem Bool
is_sig IfaceMap
modMap Module
thisMod Module
semMod WarningMap
warnings [Name]
exportedNames
        Maps
maps FixMap
fixMap [SrcSpan]
splices InstIfaceMap
instIfaceMap DynFlags
dflags AvailInfo
avail

availExportItem :: HasCallStack
                => Bool               -- is it a signature
                -> IfaceMap
                -> Module             -- this module
                -> Module             -- semantic module
                -> WarningMap
                -> [Name]             -- exported names (orig)
                -> Maps
                -> FixMap
                -> [SrcSpan]          -- splice locations
                -> InstIfaceMap
                -> DynFlags
                -> AvailInfo
                -> ErrMsgGhc [ExportItem GhcRn]
availExportItem :: Bool
-> IfaceMap
-> Module
-> Module
-> WarningMap
-> [Name]
-> Maps
-> FixMap
-> [SrcSpan]
-> InstIfaceMap
-> DynFlags
-> AvailInfo
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExportItem Bool
is_sig IfaceMap
modMap Module
thisMod Module
semMod WarningMap
warnings [Name]
exportedNames
  (DocMap Name
docMap, ArgMap Name
argMap, DeclMap
declMap, InstMap
_) FixMap
fixMap [SrcSpan]
splices InstIfaceMap
instIfaceMap
  DynFlags
dflags AvailInfo
availInfo = AvailInfo -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
declWith AvailInfo
availInfo
  where
    declWith :: AvailInfo -> ErrMsgGhc [ ExportItem GhcRn ]
    declWith :: AvailInfo -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
declWith AvailInfo
avail = do
      let t :: Name
t = AvailInfo -> Name
availName AvailInfo
avail
      ([LHsDecl (GhcPass 'Renamed)],
 (DocForDecl Name, [(Name, DocForDecl Name)]))
r    <- AvailInfo
-> ErrMsgGhc
     ([LHsDecl (GhcPass 'Renamed)],
      (DocForDecl Name, [(Name, DocForDecl Name)]))
findDecl AvailInfo
avail
      case ([LHsDecl (GhcPass 'Renamed)],
 (DocForDecl Name, [(Name, DocForDecl Name)]))
r of
        ([L SrcSpan
l (ValD XValD (GhcPass 'Renamed)
_ HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
_)], (DocForDecl Name
doc, [(Name, DocForDecl Name)]
_)) -> do
          -- Top-level binding without type signature
          ExportItem (GhcPass 'Renamed)
export <- DynFlags
-> Name
-> SrcSpan
-> DocForDecl Name
-> Bool
-> Maybe Fixity
-> ErrMsgGhc (ExportItem (GhcPass 'Renamed))
hiValExportItem DynFlags
dflags Name
t SrcSpan
l DocForDecl Name
doc (SrcSpan
l SrcSpan -> [SrcSpan] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SrcSpan]
splices) (Maybe Fixity -> ErrMsgGhc (ExportItem (GhcPass 'Renamed)))
-> Maybe Fixity -> ErrMsgGhc (ExportItem (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ Name -> FixMap -> Maybe Fixity
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
t FixMap
fixMap
          [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ExportItem (GhcPass 'Renamed)
export]
        ([LHsDecl (GhcPass 'Renamed)]
ds, (DocForDecl Name, [(Name, DocForDecl Name)])
docs_) | LHsDecl (GhcPass 'Renamed)
decl : [LHsDecl (GhcPass 'Renamed)]
_ <- (LHsDecl (GhcPass 'Renamed) -> Bool)
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (LHsDecl (GhcPass 'Renamed) -> Bool)
-> LHsDecl (GhcPass 'Renamed)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDecl (GhcPass 'Renamed) -> Bool
forall a. HsDecl a -> Bool
isValD (HsDecl (GhcPass 'Renamed) -> Bool)
-> (LHsDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> LHsDecl (GhcPass 'Renamed)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LHsDecl (GhcPass 'Renamed)]
ds ->
          let declNames :: [IdP (GhcPass 'Renamed)]
declNames = HsDecl (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (p :: Pass). HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder (LHsDecl (GhcPass 'Renamed)
-> SrcSpanLess (LHsDecl (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDecl (GhcPass 'Renamed)
decl)
          in case () of
            ()
_
              -- We should not show a subordinate by itself if any of its
              -- parents is also exported. See note [1].
              | Name
t Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [IdP (GhcPass 'Renamed)]
[Name]
declNames,
                Just Name
p <- (Name -> Bool) -> [Name] -> Maybe Name
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Name -> Bool
isExported (Name -> HsDecl (GhcPass 'Renamed) -> [Name]
parents Name
t (HsDecl (GhcPass 'Renamed) -> [Name])
-> HsDecl (GhcPass 'Renamed) -> [Name]
forall a b. (a -> b) -> a -> b
$ LHsDecl (GhcPass 'Renamed)
-> SrcSpanLess (LHsDecl (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDecl (GhcPass 'Renamed)
decl) ->
                do ErrMsgM () -> ErrMsgGhc ()
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM () -> ErrMsgGhc ()) -> ErrMsgM () -> ErrMsgGhc ()
forall a b. (a -> b) -> a -> b
$ [String] -> ErrMsgM ()
tell [
                     String
"Warning: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Module -> String
moduleString Module
thisMod String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     DynFlags -> OccName -> String
forall a. Outputable a => DynFlags -> a -> String
pretty DynFlags
dflags (Name -> OccName
nameOccName Name
t) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is exported separately but " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
"will be documented under " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> OccName -> String
forall a. Outputable a => DynFlags -> a -> String
pretty DynFlags
dflags (Name -> OccName
nameOccName Name
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
". Consider exporting it together with its parent(s)" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
" for code clarity." ]
                   [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return []

              -- normal case
              | Bool
otherwise -> case LHsDecl (GhcPass 'Renamed)
decl of
                  -- A single signature might refer to many names, but we
                  -- create an export item for a single name only.  So we
                  -- modify the signature to contain only that single name.
                  L SrcSpan
loc (SigD XSigD (GhcPass 'Renamed)
_ Sig (GhcPass 'Renamed)
sig) ->
                    -- fromJust is safe since we already checked in guards
                    -- that 't' is a name declared in this declaration.
                    let newDecl :: LHsDecl (GhcPass 'Renamed)
newDecl = SrcSpan -> HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed))
-> (Maybe (Sig (GhcPass 'Renamed)) -> HsDecl (GhcPass 'Renamed))
-> Maybe (Sig (GhcPass 'Renamed))
-> LHsDecl (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XSigD (GhcPass 'Renamed)
-> Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
XSigD (GhcPass 'Renamed)
noExtField (Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> (Maybe (Sig (GhcPass 'Renamed)) -> Sig (GhcPass 'Renamed))
-> Maybe (Sig (GhcPass 'Renamed))
-> HsDecl (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Sig (GhcPass 'Renamed)) -> Sig (GhcPass 'Renamed)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Sig (GhcPass 'Renamed)) -> LHsDecl (GhcPass 'Renamed))
-> Maybe (Sig (GhcPass 'Renamed)) -> LHsDecl (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ (IdP (GhcPass 'Renamed) -> Bool)
-> Sig (GhcPass 'Renamed) -> Maybe (Sig (GhcPass 'Renamed))
forall (p :: Pass).
(IdP (GhcPass p) -> Bool)
-> Sig (GhcPass p) -> Maybe (Sig (GhcPass p))
filterSigNames (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
t) Sig (GhcPass 'Renamed)
sig
                    in HasCallStack =>
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExportDecl AvailInfo
avail LHsDecl (GhcPass 'Renamed)
newDecl (DocForDecl Name, [(Name, DocForDecl Name)])
docs_

                  L SrcSpan
loc (TyClD XTyClD (GhcPass 'Renamed)
_ cl :: TyClDecl (GhcPass 'Renamed)
cl@ClassDecl{}) -> do
                    Maybe ClassMinimalDef
mdef <- Ghc (Maybe ClassMinimalDef) -> ErrMsgGhc (Maybe ClassMinimalDef)
forall a. Ghc a -> ErrMsgGhc a
liftGhcToErrMsgGhc (Ghc (Maybe ClassMinimalDef) -> ErrMsgGhc (Maybe ClassMinimalDef))
-> Ghc (Maybe ClassMinimalDef) -> ErrMsgGhc (Maybe ClassMinimalDef)
forall a b. (a -> b) -> a -> b
$ Name -> Ghc (Maybe ClassMinimalDef)
forall (m :: * -> *).
GhcMonad m =>
Name -> m (Maybe ClassMinimalDef)
minimalDef Name
t
                    let sig :: [Located (Sig (GhcPass 'Renamed))]
sig = Maybe (Located (Sig (GhcPass 'Renamed)))
-> [Located (Sig (GhcPass 'Renamed))]
forall a. Maybe a -> [a]
maybeToList (Maybe (Located (Sig (GhcPass 'Renamed)))
 -> [Located (Sig (GhcPass 'Renamed))])
-> Maybe (Located (Sig (GhcPass 'Renamed)))
-> [Located (Sig (GhcPass 'Renamed))]
forall a b. (a -> b) -> a -> b
$ (ClassMinimalDef -> Located (Sig (GhcPass 'Renamed)))
-> Maybe ClassMinimalDef
-> Maybe (Located (Sig (GhcPass 'Renamed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig (GhcPass 'Renamed) -> Located (Sig (GhcPass 'Renamed))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Sig (GhcPass 'Renamed) -> Located (Sig (GhcPass 'Renamed)))
-> (ClassMinimalDef -> Sig (GhcPass 'Renamed))
-> ClassMinimalDef
-> Located (Sig (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XMinimalSig (GhcPass 'Renamed)
-> SourceText
-> LBooleanFormula (Located (IdP (GhcPass 'Renamed)))
-> Sig (GhcPass 'Renamed)
forall pass.
XMinimalSig pass
-> SourceText -> LBooleanFormula (Located (IdP pass)) -> Sig pass
MinimalSig NoExtField
XMinimalSig (GhcPass 'Renamed)
noExtField SourceText
NoSourceText (GenLocated SrcSpan (BooleanFormula (Located Name))
 -> Sig (GhcPass 'Renamed))
-> (ClassMinimalDef
    -> GenLocated SrcSpan (BooleanFormula (Located Name)))
-> ClassMinimalDef
-> Sig (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BooleanFormula (Located Name)
-> GenLocated SrcSpan (BooleanFormula (Located Name))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (BooleanFormula (Located Name)
 -> GenLocated SrcSpan (BooleanFormula (Located Name)))
-> (ClassMinimalDef -> BooleanFormula (Located Name))
-> ClassMinimalDef
-> GenLocated SrcSpan (BooleanFormula (Located Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Located Name)
-> ClassMinimalDef -> BooleanFormula (Located Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc) Maybe ClassMinimalDef
mdef
                    HasCallStack =>
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExportDecl AvailInfo
avail
                      (SrcSpan -> HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed))
-> HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ XTyClD (GhcPass 'Renamed)
-> TyClDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
XTyClD (GhcPass 'Renamed)
noExtField TyClDecl (GhcPass 'Renamed)
cl { tcdSigs :: [Located (Sig (GhcPass 'Renamed))]
tcdSigs = [Located (Sig (GhcPass 'Renamed))]
sig [Located (Sig (GhcPass 'Renamed))]
-> [Located (Sig (GhcPass 'Renamed))]
-> [Located (Sig (GhcPass 'Renamed))]
forall a. [a] -> [a] -> [a]
++ TyClDecl (GhcPass 'Renamed) -> [Located (Sig (GhcPass 'Renamed))]
forall pass. TyClDecl pass -> [LSig pass]
tcdSigs TyClDecl (GhcPass 'Renamed)
cl }) (DocForDecl Name, [(Name, DocForDecl Name)])
docs_

                  LHsDecl (GhcPass 'Renamed)
_ -> HasCallStack =>
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExportDecl AvailInfo
avail LHsDecl (GhcPass 'Renamed)
decl (DocForDecl Name, [(Name, DocForDecl Name)])
docs_

        -- Declaration from another package
        ([], (DocForDecl Name, [(Name, DocForDecl Name)])
_) -> do
          Maybe (LHsDecl (GhcPass 'Renamed))
mayDecl <- DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
hiDecl DynFlags
dflags Name
t
          case Maybe (LHsDecl (GhcPass 'Renamed))
mayDecl of
            Maybe (LHsDecl (GhcPass 'Renamed))
Nothing -> [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ IdP (GhcPass 'Renamed)
-> [IdP (GhcPass 'Renamed)] -> ExportItem (GhcPass 'Renamed)
forall name. IdP name -> [IdP name] -> ExportItem name
ExportNoDecl IdP (GhcPass 'Renamed)
Name
t [] ]
            Just LHsDecl (GhcPass 'Renamed)
decl ->
              -- We try to get the subs and docs
              -- from the installed .haddock file for that package.
              -- TODO: This needs to be more sophisticated to deal
              -- with signature inheritance
              case Module -> InstIfaceMap -> Maybe InstalledInterface
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
t) InstIfaceMap
instIfaceMap of
                Maybe InstalledInterface
Nothing -> do
                   ErrMsgM () -> ErrMsgGhc ()
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM () -> ErrMsgGhc ()) -> ErrMsgM () -> ErrMsgGhc ()
forall a b. (a -> b) -> a -> b
$ [String] -> ErrMsgM ()
tell
                      [String
"Warning: Couldn't find .haddock for export " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> Name -> String
forall a. Outputable a => DynFlags -> a -> String
pretty DynFlags
dflags Name
t]
                   let subs_ :: [(Name, DocForDecl Name)]
subs_ = AvailInfo -> [(Name, DocForDecl Name)]
availNoDocs AvailInfo
avail
                   HasCallStack =>
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExportDecl AvailInfo
avail LHsDecl (GhcPass 'Renamed)
decl (DocForDecl Name
forall name. DocForDecl name
noDocForDecl, [(Name, DocForDecl Name)]
subs_)
                Just InstalledInterface
iface ->
                  HasCallStack =>
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExportDecl AvailInfo
avail LHsDecl (GhcPass 'Renamed)
decl (AvailInfo
-> WarningMap
-> DocMap Name
-> ArgMap Name
-> (DocForDecl Name, [(Name, DocForDecl Name)])
lookupDocs AvailInfo
avail WarningMap
warnings (InstalledInterface -> DocMap Name
instDocMap InstalledInterface
iface) (InstalledInterface -> ArgMap Name
instArgMap InstalledInterface
iface))

        ([LHsDecl (GhcPass 'Renamed)],
 (DocForDecl Name, [(Name, DocForDecl Name)]))
_ -> [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    -- Tries 'extractDecl' first then falls back to 'hiDecl' if that fails
    availDecl :: Name -> LHsDecl GhcRn -> ErrMsgGhc (LHsDecl GhcRn)
    availDecl :: Name
-> LHsDecl (GhcPass 'Renamed)
-> ErrMsgGhc (LHsDecl (GhcPass 'Renamed))
availDecl Name
declName LHsDecl (GhcPass 'Renamed)
parentDecl =
      case HasCallStack =>
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
extractDecl DeclMap
declMap Name
declName LHsDecl (GhcPass 'Renamed)
parentDecl of
        Right LHsDecl (GhcPass 'Renamed)
d -> LHsDecl (GhcPass 'Renamed)
-> ErrMsgGhc (LHsDecl (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsDecl (GhcPass 'Renamed)
d
        Left String
err -> do
          Maybe (LHsDecl (GhcPass 'Renamed))
synifiedDeclOpt <- DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
hiDecl DynFlags
dflags Name
declName
          case Maybe (LHsDecl (GhcPass 'Renamed))
synifiedDeclOpt of
            Just LHsDecl (GhcPass 'Renamed)
synifiedDecl -> LHsDecl (GhcPass 'Renamed)
-> ErrMsgGhc (LHsDecl (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsDecl (GhcPass 'Renamed)
synifiedDecl
            Maybe (LHsDecl (GhcPass 'Renamed))
Nothing -> String -> SDoc -> ErrMsgGhc (LHsDecl (GhcPass 'Renamed))
forall a. HasCallStack => String -> SDoc -> a
O.pprPanic String
"availExportItem" (String -> SDoc
O.text String
err)

    availExportDecl :: HasCallStack => AvailInfo -> LHsDecl GhcRn
                    -> (DocForDecl Name, [(Name, DocForDecl Name)])
                    -> ErrMsgGhc [ ExportItem GhcRn ]
    availExportDecl :: AvailInfo
-> LHsDecl (GhcPass 'Renamed)
-> (DocForDecl Name, [(Name, DocForDecl Name)])
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExportDecl AvailInfo
avail LHsDecl (GhcPass 'Renamed)
decl (DocForDecl Name
doc, [(Name, DocForDecl Name)]
subs)
      | AvailInfo -> Bool
availExportsDecl AvailInfo
avail = do
          LHsDecl (GhcPass 'Renamed)
extractedDecl <- Name
-> LHsDecl (GhcPass 'Renamed)
-> ErrMsgGhc (LHsDecl (GhcPass 'Renamed))
availDecl (AvailInfo -> Name
availName AvailInfo
avail) LHsDecl (GhcPass 'Renamed)
decl

          -- bundled pattern synonyms only make sense if the declaration is
          -- exported (otherwise there would be nothing to bundle to)
          [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
bundledPatSyns <- AvailInfo
-> ErrMsgGhc [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
findBundledPatterns AvailInfo
avail

          let
            patSynNames :: [Name]
patSynNames =
              ((HsDecl (GhcPass 'Renamed), DocForDecl Name) -> [Name])
-> [(HsDecl (GhcPass 'Renamed), DocForDecl Name)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HsDecl (GhcPass 'Renamed) -> [Name]
forall (p :: Pass). HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder (HsDecl (GhcPass 'Renamed) -> [Name])
-> ((HsDecl (GhcPass 'Renamed), DocForDecl Name)
    -> HsDecl (GhcPass 'Renamed))
-> (HsDecl (GhcPass 'Renamed), DocForDecl Name)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsDecl (GhcPass 'Renamed), DocForDecl Name)
-> HsDecl (GhcPass 'Renamed)
forall a b. (a, b) -> a
fst) [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
bundledPatSyns

            fixities :: [(Name, Fixity)]
fixities =
                [ (Name
n, Fixity
f)
                | Name
n <- AvailInfo -> Name
availName AvailInfo
avail Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: ((Name, DocForDecl Name) -> Name)
-> [(Name, DocForDecl Name)] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, DocForDecl Name) -> Name
forall a b. (a, b) -> a
fst [(Name, DocForDecl Name)]
subs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
patSynNames
                , Just Fixity
f <- [Name -> FixMap -> Maybe Fixity
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n FixMap
fixMap]
                ]

          [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ ExportDecl :: forall name.
LHsDecl name
-> [(HsDecl name, DocForDecl (IdP name))]
-> DocForDecl (IdP name)
-> [(IdP name, DocForDecl (IdP name))]
-> [DocInstance name]
-> [(IdP name, Fixity)]
-> Bool
-> ExportItem name
ExportDecl {
                       expItemDecl :: LHsDecl (GhcPass 'Renamed)
expItemDecl      = [Name] -> LHsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
restrictTo (((Name, DocForDecl Name) -> Name)
-> [(Name, DocForDecl Name)] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, DocForDecl Name) -> Name
forall a b. (a, b) -> a
fst [(Name, DocForDecl Name)]
subs) LHsDecl (GhcPass 'Renamed)
extractedDecl
                     , expItemPats :: [(HsDecl (GhcPass 'Renamed), DocForDecl (IdP (GhcPass 'Renamed)))]
expItemPats      = [(HsDecl (GhcPass 'Renamed), DocForDecl (IdP (GhcPass 'Renamed)))]
[(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
bundledPatSyns
                     , expItemMbDoc :: DocForDecl (IdP (GhcPass 'Renamed))
expItemMbDoc     = DocForDecl (IdP (GhcPass 'Renamed))
DocForDecl Name
doc
                     , expItemSubDocs :: [(IdP (GhcPass 'Renamed), DocForDecl (IdP (GhcPass 'Renamed)))]
expItemSubDocs   = [(IdP (GhcPass 'Renamed), DocForDecl (IdP (GhcPass 'Renamed)))]
[(Name, DocForDecl Name)]
subs
                     , expItemInstances :: [DocInstance (GhcPass 'Renamed)]
expItemInstances = []
                     , expItemFixities :: [(IdP (GhcPass 'Renamed), Fixity)]
expItemFixities  = [(IdP (GhcPass 'Renamed), Fixity)]
[(Name, Fixity)]
fixities
                     , expItemSpliced :: Bool
expItemSpliced   = Bool
False
                     }
                 ]

      | Bool
otherwise = [(Name, DocForDecl Name)]
-> ((Name, DocForDecl Name)
    -> ErrMsgGhc (ExportItem (GhcPass 'Renamed)))
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Name, DocForDecl Name)]
subs (((Name, DocForDecl Name)
  -> ErrMsgGhc (ExportItem (GhcPass 'Renamed)))
 -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> ((Name, DocForDecl Name)
    -> ErrMsgGhc (ExportItem (GhcPass 'Renamed)))
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ \(Name
sub, DocForDecl Name
sub_doc) -> do
          LHsDecl (GhcPass 'Renamed)
extractedDecl <- Name
-> LHsDecl (GhcPass 'Renamed)
-> ErrMsgGhc (LHsDecl (GhcPass 'Renamed))
availDecl Name
sub LHsDecl (GhcPass 'Renamed)
decl

          ExportItem (GhcPass 'Renamed)
-> ErrMsgGhc (ExportItem (GhcPass 'Renamed))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ExportDecl :: forall name.
LHsDecl name
-> [(HsDecl name, DocForDecl (IdP name))]
-> DocForDecl (IdP name)
-> [(IdP name, DocForDecl (IdP name))]
-> [DocInstance name]
-> [(IdP name, Fixity)]
-> Bool
-> ExportItem name
ExportDecl {
                       expItemDecl :: LHsDecl (GhcPass 'Renamed)
expItemDecl      = LHsDecl (GhcPass 'Renamed)
extractedDecl
                     , expItemPats :: [(HsDecl (GhcPass 'Renamed), DocForDecl (IdP (GhcPass 'Renamed)))]
expItemPats      = []
                     , expItemMbDoc :: DocForDecl (IdP (GhcPass 'Renamed))
expItemMbDoc     = DocForDecl (IdP (GhcPass 'Renamed))
DocForDecl Name
sub_doc
                     , expItemSubDocs :: [(IdP (GhcPass 'Renamed), DocForDecl (IdP (GhcPass 'Renamed)))]
expItemSubDocs   = []
                     , expItemInstances :: [DocInstance (GhcPass 'Renamed)]
expItemInstances = []
                     , expItemFixities :: [(IdP (GhcPass 'Renamed), Fixity)]
expItemFixities  = [ (IdP (GhcPass 'Renamed)
Name
sub, Fixity
f) | Just Fixity
f <- [Name -> FixMap -> Maybe Fixity
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
sub FixMap
fixMap] ]
                     , expItemSpliced :: Bool
expItemSpliced   = Bool
False
                     } )

    exportedNameSet :: NameSet
exportedNameSet = [Name] -> NameSet
mkNameSet [Name]
exportedNames
    isExported :: Name -> Bool
isExported Name
n = Name -> NameSet -> Bool
elemNameSet Name
n NameSet
exportedNameSet

    findDecl :: AvailInfo -> ErrMsgGhc ([LHsDecl GhcRn], (DocForDecl Name, [(Name, DocForDecl Name)]))
    findDecl :: AvailInfo
-> ErrMsgGhc
     ([LHsDecl (GhcPass 'Renamed)],
      (DocForDecl Name, [(Name, DocForDecl Name)]))
findDecl AvailInfo
avail
      | Module
m Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
semMod =
          case Name -> DeclMap -> Maybe [LHsDecl (GhcPass 'Renamed)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n DeclMap
declMap of
            Just [LHsDecl (GhcPass 'Renamed)]
ds -> ([LHsDecl (GhcPass 'Renamed)],
 (DocForDecl Name, [(Name, DocForDecl Name)]))
-> ErrMsgGhc
     ([LHsDecl (GhcPass 'Renamed)],
      (DocForDecl Name, [(Name, DocForDecl Name)]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl (GhcPass 'Renamed)]
ds, AvailInfo
-> WarningMap
-> DocMap Name
-> ArgMap Name
-> (DocForDecl Name, [(Name, DocForDecl Name)])
lookupDocs AvailInfo
avail WarningMap
warnings DocMap Name
docMap ArgMap Name
argMap)
            Maybe [LHsDecl (GhcPass 'Renamed)]
Nothing
              | Bool
is_sig -> do
                -- OK, so it wasn't in the local declaration map.  It could
                -- have been inherited from a signature.  Reconstitute it
                -- from the type.
                Maybe (LHsDecl (GhcPass 'Renamed))
mb_r <- DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
hiDecl DynFlags
dflags Name
n
                case Maybe (LHsDecl (GhcPass 'Renamed))
mb_r of
                    Maybe (LHsDecl (GhcPass 'Renamed))
Nothing -> ([LHsDecl (GhcPass 'Renamed)],
 (DocForDecl Name, [(Name, DocForDecl Name)]))
-> ErrMsgGhc
     ([LHsDecl (GhcPass 'Renamed)],
      (DocForDecl Name, [(Name, DocForDecl Name)]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (DocForDecl Name
forall name. DocForDecl name
noDocForDecl, AvailInfo -> [(Name, DocForDecl Name)]
availNoDocs AvailInfo
avail))
                    -- TODO: If we try harder, we might be able to find
                    -- a Haddock!  Look in the Haddocks for each thing in
                    -- requirementContext (pkgState)
                    Just LHsDecl (GhcPass 'Renamed)
decl -> ([LHsDecl (GhcPass 'Renamed)],
 (DocForDecl Name, [(Name, DocForDecl Name)]))
-> ErrMsgGhc
     ([LHsDecl (GhcPass 'Renamed)],
      (DocForDecl Name, [(Name, DocForDecl Name)]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl (GhcPass 'Renamed)
decl], (DocForDecl Name
forall name. DocForDecl name
noDocForDecl, AvailInfo -> [(Name, DocForDecl Name)]
availNoDocs AvailInfo
avail))
              | Bool
otherwise ->
                ([LHsDecl (GhcPass 'Renamed)],
 (DocForDecl Name, [(Name, DocForDecl Name)]))
-> ErrMsgGhc
     ([LHsDecl (GhcPass 'Renamed)],
      (DocForDecl Name, [(Name, DocForDecl Name)]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (DocForDecl Name
forall name. DocForDecl name
noDocForDecl, AvailInfo -> [(Name, DocForDecl Name)]
availNoDocs AvailInfo
avail))
      | Just Interface
iface <- Module -> IfaceMap -> Maybe Interface
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (UnitId -> Module -> Module
semToIdMod (Module -> UnitId
moduleUnitId Module
thisMod) Module
m) IfaceMap
modMap
      , Just [LHsDecl (GhcPass 'Renamed)]
ds <- Name -> DeclMap -> Maybe [LHsDecl (GhcPass 'Renamed)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n (Interface -> DeclMap
ifaceDeclMap Interface
iface) =
          ([LHsDecl (GhcPass 'Renamed)],
 (DocForDecl Name, [(Name, DocForDecl Name)]))
-> ErrMsgGhc
     ([LHsDecl (GhcPass 'Renamed)],
      (DocForDecl Name, [(Name, DocForDecl Name)]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsDecl (GhcPass 'Renamed)]
ds, AvailInfo
-> WarningMap
-> DocMap Name
-> ArgMap Name
-> (DocForDecl Name, [(Name, DocForDecl Name)])
lookupDocs AvailInfo
avail WarningMap
warnings
                            (Interface -> DocMap Name
ifaceDocMap Interface
iface)
                            (Interface -> ArgMap Name
ifaceArgMap Interface
iface))
      | Bool
otherwise = ([LHsDecl (GhcPass 'Renamed)],
 (DocForDecl Name, [(Name, DocForDecl Name)]))
-> ErrMsgGhc
     ([LHsDecl (GhcPass 'Renamed)],
      (DocForDecl Name, [(Name, DocForDecl Name)]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (DocForDecl Name
forall name. DocForDecl name
noDocForDecl, AvailInfo -> [(Name, DocForDecl Name)]
availNoDocs AvailInfo
avail))
      where
        n :: Name
n = AvailInfo -> Name
availName AvailInfo
avail
        m :: Module
m = HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
n

    findBundledPatterns :: AvailInfo -> ErrMsgGhc [(HsDecl GhcRn, DocForDecl Name)]
    findBundledPatterns :: AvailInfo
-> ErrMsgGhc [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
findBundledPatterns AvailInfo
avail = do
      [[(HsDecl (GhcPass 'Renamed), DocForDecl Name)]]
patsyns <- [Name]
-> (Name
    -> ErrMsgGhc [(HsDecl (GhcPass 'Renamed), DocForDecl Name)])
-> ErrMsgGhc [[(HsDecl (GhcPass 'Renamed), DocForDecl Name)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Name]
constructor_names ((Name -> ErrMsgGhc [(HsDecl (GhcPass 'Renamed), DocForDecl Name)])
 -> ErrMsgGhc [[(HsDecl (GhcPass 'Renamed), DocForDecl Name)]])
-> (Name
    -> ErrMsgGhc [(HsDecl (GhcPass 'Renamed), DocForDecl Name)])
-> ErrMsgGhc [[(HsDecl (GhcPass 'Renamed), DocForDecl Name)]]
forall a b. (a -> b) -> a -> b
$ \Name
name -> do
        Maybe TyThing
mtyThing <- Ghc (Maybe TyThing) -> ErrMsgGhc (Maybe TyThing)
forall a. Ghc a -> ErrMsgGhc a
liftGhcToErrMsgGhc (Name -> Ghc (Maybe TyThing)
forall (m :: * -> *). GhcMonad m => Name -> m (Maybe TyThing)
lookupName Name
name)
        case Maybe TyThing
mtyThing of
          Just (AConLike PatSynCon{}) -> do
            [ExportItem (GhcPass 'Renamed)]
export_items <- AvailInfo -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
declWith (Name -> AvailInfo
Avail.avail Name
name)
            [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
-> ErrMsgGhc [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ (LHsDecl (GhcPass 'Renamed)
-> SrcSpanLess (LHsDecl (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDecl (GhcPass 'Renamed)
patsyn_decl, DocForDecl (IdP (GhcPass 'Renamed))
DocForDecl Name
patsyn_doc)
                 | ExportDecl {
                       expItemDecl :: forall name. ExportItem name -> LHsDecl name
expItemDecl  = LHsDecl (GhcPass 'Renamed)
patsyn_decl
                     , expItemMbDoc :: forall name. ExportItem name -> DocForDecl (IdP name)
expItemMbDoc = DocForDecl (IdP (GhcPass 'Renamed))
patsyn_doc
                     } <- [ExportItem (GhcPass 'Renamed)]
export_items
                 ]
          Maybe TyThing
_ -> [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
-> ErrMsgGhc [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
-> ErrMsgGhc [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[(HsDecl (GhcPass 'Renamed), DocForDecl Name)]]
-> [(HsDecl (GhcPass 'Renamed), DocForDecl Name)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(HsDecl (GhcPass 'Renamed), DocForDecl Name)]]
patsyns)
      where
        constructor_names :: [Name]
constructor_names =
          (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
isDataConName (AvailInfo -> [Name]
availSubordinates AvailInfo
avail)

-- this heavily depends on the invariants stated in Avail
availExportsDecl :: AvailInfo -> Bool
availExportsDecl :: AvailInfo -> Bool
availExportsDecl (AvailTC Name
ty_name [Name]
names [FieldLabel]
_)
  | Name
n : [Name]
_ <- [Name]
names = Name
ty_name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n
  | Bool
otherwise      = Bool
False
availExportsDecl AvailInfo
_ = Bool
True

availSubordinates :: AvailInfo -> [Name]
availSubordinates :: AvailInfo -> [Name]
availSubordinates AvailInfo
avail =
  (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= AvailInfo -> Name
availName AvailInfo
avail) (AvailInfo -> [Name]
availNamesWithSelectors AvailInfo
avail)

availNoDocs :: AvailInfo -> [(Name, DocForDecl Name)]
availNoDocs :: AvailInfo -> [(Name, DocForDecl Name)]
availNoDocs AvailInfo
avail =
  [Name] -> [DocForDecl Name] -> [(Name, DocForDecl Name)]
forall a b. [a] -> [b] -> [(a, b)]
zip (AvailInfo -> [Name]
availSubordinates AvailInfo
avail) (DocForDecl Name -> [DocForDecl Name]
forall a. a -> [a]
repeat DocForDecl Name
forall name. DocForDecl name
noDocForDecl)

-- | Given a 'Module' from a 'Name', convert it into a 'Module' that
-- we can actually find in the 'IfaceMap'.
semToIdMod :: UnitId -> Module -> Module
semToIdMod :: UnitId -> Module -> Module
semToIdMod UnitId
this_uid Module
m
    | Module -> Bool
Module.isHoleModule Module
m = UnitId -> ModuleName -> Module
mkModule UnitId
this_uid (Module -> ModuleName
moduleName Module
m)
    | Bool
otherwise      = Module
m

-- | Reify a declaration from the GHC internal 'TyThing' representation.
hiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl GhcRn))
hiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
hiDecl DynFlags
dflags Name
t = do
  Maybe TyThing
mayTyThing <- Ghc (Maybe TyThing) -> ErrMsgGhc (Maybe TyThing)
forall a. Ghc a -> ErrMsgGhc a
liftGhcToErrMsgGhc (Ghc (Maybe TyThing) -> ErrMsgGhc (Maybe TyThing))
-> Ghc (Maybe TyThing) -> ErrMsgGhc (Maybe TyThing)
forall a b. (a -> b) -> a -> b
$ Name -> Ghc (Maybe TyThing)
forall (m :: * -> *). GhcMonad m => Name -> m (Maybe TyThing)
lookupName Name
t
  case Maybe TyThing
mayTyThing of
    Maybe TyThing
Nothing -> do
      ErrMsgM () -> ErrMsgGhc ()
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM () -> ErrMsgGhc ()) -> ErrMsgM () -> ErrMsgGhc ()
forall a b. (a -> b) -> a -> b
$ [String] -> ErrMsgM ()
tell [String
"Warning: Not found in environment: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> Name -> String
forall a. Outputable a => DynFlags -> a -> String
pretty DynFlags
dflags Name
t]
      Maybe (LHsDecl (GhcPass 'Renamed))
-> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LHsDecl (GhcPass 'Renamed))
forall a. Maybe a
Nothing
    Just TyThing
x -> case PrintRuntimeReps
-> TyThing -> Either String ([String], HsDecl (GhcPass 'Renamed))
tyThingToLHsDecl PrintRuntimeReps
ShowRuntimeRep TyThing
x of
      Left String
m -> ErrMsgM () -> ErrMsgGhc ()
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg ([String] -> ErrMsgM ()
tell [String -> String
bugWarn String
m]) ErrMsgGhc ()
-> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
-> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (LHsDecl (GhcPass 'Renamed))
-> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LHsDecl (GhcPass 'Renamed))
forall a. Maybe a
Nothing
      Right ([String]
m, HsDecl (GhcPass 'Renamed)
t') -> ErrMsgM () -> ErrMsgGhc ()
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg ([String] -> ErrMsgM ()
tell ([String] -> ErrMsgM ()) -> [String] -> ErrMsgM ()
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
bugWarn [String]
m)
                      ErrMsgGhc ()
-> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
-> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (LHsDecl (GhcPass 'Renamed))
-> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsDecl (GhcPass 'Renamed) -> Maybe (LHsDecl (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (LHsDecl (GhcPass 'Renamed) -> Maybe (LHsDecl (GhcPass 'Renamed)))
-> LHsDecl (GhcPass 'Renamed) -> Maybe (LHsDecl (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (LHsDecl (GhcPass 'Renamed))
-> LHsDecl (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsDecl (GhcPass 'Renamed)
SrcSpanLess (LHsDecl (GhcPass 'Renamed))
t')
    where
      warnLine :: String -> SDoc
warnLine String
x = String -> SDoc
O.text String
"haddock-bug:" SDoc -> SDoc -> SDoc
O.<+> String -> SDoc
O.text String
x SDoc -> SDoc -> SDoc
O.<>
                   SDoc
O.comma SDoc -> SDoc -> SDoc
O.<+> SDoc -> SDoc
O.quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr Name
t) SDoc -> SDoc -> SDoc
O.<+>
                   String -> SDoc
O.text String
"-- Please report this on Haddock issue tracker!"
      bugWarn :: String -> String
bugWarn = DynFlags -> SDoc -> String
O.showSDoc DynFlags
dflags (SDoc -> String) -> (String -> SDoc) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
warnLine

-- | This function is called for top-level bindings without type signatures.
-- It gets the type signature from GHC and that means it's not going to
-- have a meaningful 'SrcSpan'. So we pass down 'SrcSpan' for the
-- declaration and use it instead - 'nLoc' here.
hiValExportItem :: DynFlags -> Name -> SrcSpan -> DocForDecl Name -> Bool
                -> Maybe Fixity -> ErrMsgGhc (ExportItem GhcRn)
hiValExportItem :: DynFlags
-> Name
-> SrcSpan
-> DocForDecl Name
-> Bool
-> Maybe Fixity
-> ErrMsgGhc (ExportItem (GhcPass 'Renamed))
hiValExportItem DynFlags
dflags Name
name SrcSpan
nLoc DocForDecl Name
doc Bool
splice Maybe Fixity
fixity = do
  Maybe (LHsDecl (GhcPass 'Renamed))
mayDecl <- DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl (GhcPass 'Renamed)))
hiDecl DynFlags
dflags Name
name
  case Maybe (LHsDecl (GhcPass 'Renamed))
mayDecl of
    Maybe (LHsDecl (GhcPass 'Renamed))
Nothing -> ExportItem (GhcPass 'Renamed)
-> ErrMsgGhc (ExportItem (GhcPass 'Renamed))
forall (m :: * -> *) a. Monad m => a -> m a
return (IdP (GhcPass 'Renamed)
-> [IdP (GhcPass 'Renamed)] -> ExportItem (GhcPass 'Renamed)
forall name. IdP name -> [IdP name] -> ExportItem name
ExportNoDecl IdP (GhcPass 'Renamed)
Name
name [])
    Just LHsDecl (GhcPass 'Renamed)
decl -> ExportItem (GhcPass 'Renamed)
-> ErrMsgGhc (ExportItem (GhcPass 'Renamed))
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsDecl (GhcPass 'Renamed)
-> [(HsDecl (GhcPass 'Renamed),
     DocForDecl (IdP (GhcPass 'Renamed)))]
-> DocForDecl (IdP (GhcPass 'Renamed))
-> [(IdP (GhcPass 'Renamed), DocForDecl (IdP (GhcPass 'Renamed)))]
-> [DocInstance (GhcPass 'Renamed)]
-> [(IdP (GhcPass 'Renamed), Fixity)]
-> Bool
-> ExportItem (GhcPass 'Renamed)
forall name.
LHsDecl name
-> [(HsDecl name, DocForDecl (IdP name))]
-> DocForDecl (IdP name)
-> [(IdP name, DocForDecl (IdP name))]
-> [DocInstance name]
-> [(IdP name, Fixity)]
-> Bool
-> ExportItem name
ExportDecl (LHsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
fixSpan LHsDecl (GhcPass 'Renamed)
decl) [] DocForDecl (IdP (GhcPass 'Renamed))
DocForDecl Name
doc [] [] [(IdP (GhcPass 'Renamed), Fixity)]
[(Name, Fixity)]
fixities Bool
splice)
  where
    fixSpan :: LHsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
fixSpan (L SrcSpan
l HsDecl (GhcPass 'Renamed)
t) = SrcSpan -> HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpan -> SrcSpan
SrcLoc.combineSrcSpans SrcSpan
l SrcSpan
nLoc) HsDecl (GhcPass 'Renamed)
t
    fixities :: [(Name, Fixity)]
fixities = case Maybe Fixity
fixity of
      Just Fixity
f  -> [(Name
name, Fixity
f)]
      Maybe Fixity
Nothing -> []


-- | Lookup docs for a declaration from maps.
lookupDocs :: AvailInfo -> WarningMap -> DocMap Name -> ArgMap Name
           -> (DocForDecl Name, [(Name, DocForDecl Name)])
lookupDocs :: AvailInfo
-> WarningMap
-> DocMap Name
-> ArgMap Name
-> (DocForDecl Name, [(Name, DocForDecl Name)])
lookupDocs AvailInfo
avail WarningMap
warnings DocMap Name
docMap ArgMap Name
argMap =
  let n :: Name
n = AvailInfo -> Name
availName AvailInfo
avail in
  let lookupArgDoc :: Name -> Map Int (MDoc Name)
lookupArgDoc Name
x = Map Int (MDoc Name) -> Name -> ArgMap Name -> Map Int (MDoc Name)
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Map Int (MDoc Name)
forall k a. Map k a
M.empty Name
x ArgMap Name
argMap in
  let doc :: DocForDecl Name
doc = (Name -> Documentation Name
lookupDoc Name
n, Name -> Map Int (MDoc Name)
lookupArgDoc Name
n) in
  let subDocs :: [(Name, DocForDecl Name)]
subDocs = [ (Name
s, (Name -> Documentation Name
lookupDoc Name
s, Name -> Map Int (MDoc Name)
lookupArgDoc Name
s))
                | Name
s <- AvailInfo -> [Name]
availSubordinates AvailInfo
avail
                ] in
  (DocForDecl Name
doc, [(Name, DocForDecl Name)]
subDocs)
  where
    lookupDoc :: Name -> Documentation Name
lookupDoc Name
name = Maybe (MDoc Name) -> Maybe (Doc Name) -> Documentation Name
forall name.
Maybe (MDoc name) -> Maybe (Doc name) -> Documentation name
Documentation (Name -> DocMap Name -> Maybe (MDoc Name)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name DocMap Name
docMap) (Name -> WarningMap -> Maybe (Doc Name)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name WarningMap
warnings)


-- | Export the given module as `ExportModule`. We are not concerned with the
-- single export items of the given module.
moduleExport :: Module           -- ^ Module A (identity, NOT semantic)
             -> DynFlags         -- ^ The flags used when typechecking A
             -> IfaceMap         -- ^ Already created interfaces
             -> InstIfaceMap     -- ^ Interfaces in other packages
             -> ModuleName       -- ^ The exported module
             -> ErrMsgGhc [ExportItem GhcRn] -- ^ Resulting export items
moduleExport :: Module
-> DynFlags
-> IfaceMap
-> InstIfaceMap
-> ModuleName
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
moduleExport Module
thisMod DynFlags
dflags IfaceMap
ifaceMap InstIfaceMap
instIfaceMap ModuleName
expMod =
    -- NB: we constructed the identity module when looking up in
    -- the IfaceMap.
    case Module -> IfaceMap -> Maybe Interface
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Module
m IfaceMap
ifaceMap of
      Just Interface
iface
        | DocOption
OptHide DocOption -> [DocOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Interface -> [DocOption]
ifaceOptions Interface
iface -> [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Interface -> [ExportItem (GhcPass 'Renamed)]
ifaceExportItems Interface
iface)
        | Bool
otherwise -> [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Module -> ExportItem (GhcPass 'Renamed)
forall name. Module -> ExportItem name
ExportModule Module
m ]

      Maybe Interface
Nothing -> -- We have to try to find it in the installed interfaces
                 -- (external packages).
        case ModuleName
-> Map ModuleName InstalledInterface -> Maybe InstalledInterface
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
expMod ((Module -> ModuleName)
-> InstIfaceMap -> Map ModuleName InstalledInterface
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Module -> ModuleName
moduleName InstIfaceMap
instIfaceMap) of
          Just InstalledInterface
iface -> [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Module -> ExportItem (GhcPass 'Renamed)
forall name. Module -> ExportItem name
ExportModule (InstalledInterface -> Module
instMod InstalledInterface
iface) ]
          Maybe InstalledInterface
Nothing -> do
            ErrMsgM () -> ErrMsgGhc ()
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (ErrMsgM () -> ErrMsgGhc ()) -> ErrMsgM () -> ErrMsgGhc ()
forall a b. (a -> b) -> a -> b
$
              [String] -> ErrMsgM ()
tell [String
"Warning: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> Module -> String
forall a. Outputable a => DynFlags -> a -> String
pretty DynFlags
dflags Module
thisMod String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Could not find " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
"documentation for exported module: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> ModuleName -> String
forall a. Outputable a => DynFlags -> a -> String
pretty DynFlags
dflags ModuleName
expMod]
            [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    m :: Module
m = UnitId -> ModuleName -> Module
mkModule UnitId
unitId ModuleName
expMod -- Identity module!
    unitId :: UnitId
unitId = Module -> UnitId
moduleUnitId Module
thisMod

-- Note [1]:
------------
-- It is unnecessary to document a subordinate by itself at the top level if
-- any of its parents is also documented. Furthermore, if the subordinate is a
-- record field or a class method, documenting it under its parent
-- indicates its special status.
--
-- A user might expect that it should show up separately, so we issue a
-- warning. It's a fine opportunity to also tell the user she might want to
-- export the subordinate through the parent export item for clarity.
--
-- The code removes top-level subordinates also when the parent is exported
-- through a 'module' export. I think that is fine.
--
-- (For more information, see Trac #69)


-- | Simplified variant of 'mkExportItems', where we can assume that
-- every locally defined declaration is exported; thus, we just
-- zip through the renamed declarations.

fullModuleContents :: Bool               -- is it a signature
                   -> IfaceMap
                   -> Maybe Package      -- this package
                   -> Module             -- this module
                   -> Module             -- semantic module
                   -> WarningMap
                   -> GlobalRdrEnv      -- ^ The renaming environment
                   -> [Name]             -- exported names (orig)
                   -> [LHsDecl GhcRn]    -- renamed source declarations
                   -> Maps
                   -> FixMap
                   -> [SrcSpan]          -- splice locations
                   -> InstIfaceMap
                   -> DynFlags
                   -> Avails
                   -> ErrMsgGhc [ExportItem GhcRn]
fullModuleContents :: Bool
-> IfaceMap
-> Maybe String
-> Module
-> Module
-> WarningMap
-> GlobalRdrEnv
-> [Name]
-> [LHsDecl (GhcPass 'Renamed)]
-> Maps
-> FixMap
-> [SrcSpan]
-> InstIfaceMap
-> DynFlags
-> [AvailInfo]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
fullModuleContents Bool
is_sig IfaceMap
modMap Maybe String
pkgName Module
thisMod Module
semMod WarningMap
warnings GlobalRdrEnv
gre [Name]
exportedNames
  [LHsDecl (GhcPass 'Renamed)]
decls maps :: Maps
maps@(DocMap Name
_, ArgMap Name
_, DeclMap
declMap, InstMap
_) FixMap
fixMap [SrcSpan]
splices InstIfaceMap
instIfaceMap DynFlags
dflags [AvailInfo]
avails = do
  let availEnv :: NameEnv AvailInfo
availEnv = [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv ([AvailInfo] -> [AvailInfo]
nubAvails [AvailInfo]
avails)
  ([[ExportItem (GhcPass 'Renamed)]]
-> [ExportItem (GhcPass 'Renamed)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ExportItem (GhcPass 'Renamed)]]
 -> [ExportItem (GhcPass 'Renamed)])
-> ([[[ExportItem (GhcPass 'Renamed)]]]
    -> [[ExportItem (GhcPass 'Renamed)]])
-> [[[ExportItem (GhcPass 'Renamed)]]]
-> [ExportItem (GhcPass 'Renamed)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[ExportItem (GhcPass 'Renamed)]]]
-> [[ExportItem (GhcPass 'Renamed)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[[ExportItem (GhcPass 'Renamed)]]]
 -> [ExportItem (GhcPass 'Renamed)])
-> ErrMsgGhc [[[ExportItem (GhcPass 'Renamed)]]]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([LHsDecl (GhcPass 'Renamed)]
-> (LHsDecl (GhcPass 'Renamed)
    -> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]])
-> ErrMsgGhc [[[ExportItem (GhcPass 'Renamed)]]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [LHsDecl (GhcPass 'Renamed)]
decls ((LHsDecl (GhcPass 'Renamed)
  -> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]])
 -> ErrMsgGhc [[[ExportItem (GhcPass 'Renamed)]]])
-> (LHsDecl (GhcPass 'Renamed)
    -> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]])
-> ErrMsgGhc [[[ExportItem (GhcPass 'Renamed)]]]
forall a b. (a -> b) -> a -> b
$ \LHsDecl (GhcPass 'Renamed)
decl -> do
    case LHsDecl (GhcPass 'Renamed)
decl of
      (L SrcSpan
_ (DocD XDocD (GhcPass 'Renamed)
_ (DocGroup Int
lev HsDocString
docStr))) -> do
        Doc Name
doc <- ErrMsgM (Doc Name) -> ErrMsgGhc (Doc Name)
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name)
processDocString DynFlags
dflags GlobalRdrEnv
gre HsDocString
docStr)
        [[ExportItem (GhcPass 'Renamed)]]
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Int
-> String
-> Doc (IdP (GhcPass 'Renamed))
-> ExportItem (GhcPass 'Renamed)
forall name. Int -> String -> Doc (IdP name) -> ExportItem name
ExportGroup Int
lev String
"" Doc (IdP (GhcPass 'Renamed))
Doc Name
doc]]
      (L SrcSpan
_ (DocD XDocD (GhcPass 'Renamed)
_ (DocCommentNamed String
_ HsDocString
docStr))) -> do
        MDoc Name
doc <- ErrMsgM (MDoc Name) -> ErrMsgGhc (MDoc Name)
forall a. ErrMsgM a -> ErrMsgGhc a
liftErrMsg (DynFlags
-> Maybe String
-> GlobalRdrEnv
-> HsDocString
-> ErrMsgM (MDoc Name)
processDocStringParas DynFlags
dflags Maybe String
pkgName GlobalRdrEnv
gre HsDocString
docStr)
        [[ExportItem (GhcPass 'Renamed)]]
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[MDoc (IdP (GhcPass 'Renamed)) -> ExportItem (GhcPass 'Renamed)
forall name. MDoc (IdP name) -> ExportItem name
ExportDoc MDoc (IdP (GhcPass 'Renamed))
MDoc Name
doc]]
      (L SrcSpan
_ (ValD XValD (GhcPass 'Renamed)
_ HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
valDecl))
        | IdP (GhcPass 'Renamed)
name:[IdP (GhcPass 'Renamed)]
_ <- HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> [IdP (GhcPass 'Renamed)]
forall p idR.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p)) =>
HsBindLR p idR -> [IdP p]
collectHsBindBinders HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
valDecl
        , Just (L SrcSpan
_ SigD{}:[LHsDecl (GhcPass 'Renamed)]
_) <- (LHsDecl (GhcPass 'Renamed) -> Bool)
-> [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. (a -> Bool) -> [a] -> [a]
filter LHsDecl (GhcPass 'Renamed) -> Bool
forall l p. GenLocated l (HsDecl p) -> Bool
isSigD ([LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)])
-> Maybe [LHsDecl (GhcPass 'Renamed)]
-> Maybe [LHsDecl (GhcPass 'Renamed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> DeclMap -> Maybe [LHsDecl (GhcPass 'Renamed)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup IdP (GhcPass 'Renamed)
Name
name DeclMap
declMap
        -> [[ExportItem (GhcPass 'Renamed)]]
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      LHsDecl (GhcPass 'Renamed)
_ ->
        [Name]
-> (Name -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HsDecl (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (p :: Pass). HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder (LHsDecl (GhcPass 'Renamed)
-> SrcSpanLess (LHsDecl (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDecl (GhcPass 'Renamed)
decl)) ((Name -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
 -> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]])
-> (Name -> ErrMsgGhc [ExportItem (GhcPass 'Renamed)])
-> ErrMsgGhc [[ExportItem (GhcPass 'Renamed)]]
forall a b. (a -> b) -> a -> b
$ \Name
nm -> do
          case NameEnv AvailInfo -> Name -> Maybe AvailInfo
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv AvailInfo
availEnv Name
nm of
            Just AvailInfo
avail ->
              HasCallStack =>
Bool
-> IfaceMap
-> Module
-> Module
-> WarningMap
-> [Name]
-> Maps
-> FixMap
-> [SrcSpan]
-> InstIfaceMap
-> DynFlags
-> AvailInfo
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
Bool
-> IfaceMap
-> Module
-> Module
-> WarningMap
-> [Name]
-> Maps
-> FixMap
-> [SrcSpan]
-> InstIfaceMap
-> DynFlags
-> AvailInfo
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
availExportItem Bool
is_sig IfaceMap
modMap Module
thisMod
                Module
semMod WarningMap
warnings [Name]
exportedNames Maps
maps FixMap
fixMap
                [SrcSpan]
splices InstIfaceMap
instIfaceMap DynFlags
dflags AvailInfo
avail
            Maybe AvailInfo
Nothing -> [ExportItem (GhcPass 'Renamed)]
-> ErrMsgGhc [ExportItem (GhcPass 'Renamed)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
  where
    isSigD :: GenLocated l (HsDecl p) -> Bool
isSigD (L l
_ SigD{}) = Bool
True
    isSigD GenLocated l (HsDecl p)
_            = Bool
False


-- | Sometimes the declaration we want to export is not the "main" declaration:
-- it might be an individual record selector or a class method.  In these
-- cases we have to extract the required declaration (and somehow cobble
-- together a type signature for it...).
--
-- This function looks through the declarations in this module to try to find
-- the one with the right name.
extractDecl
  :: HasCallStack
  => DeclMap                   -- ^ all declarations in the file
  -> Name                      -- ^ name of the declaration to extract
  -> LHsDecl GhcRn             -- ^ parent declaration
  -> Either ErrMsg (LHsDecl GhcRn)
extractDecl :: DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
extractDecl DeclMap
declMap Name
name LHsDecl (GhcPass 'Renamed)
decl
  | Name
name Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HsDecl (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (p :: Pass). HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder (LHsDecl (GhcPass 'Renamed)
-> SrcSpanLess (LHsDecl (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDecl (GhcPass 'Renamed)
decl) = LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsDecl (GhcPass 'Renamed)
decl
  | Bool
otherwise  =
    case LHsDecl (GhcPass 'Renamed)
-> SrcSpanLess (LHsDecl (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDecl (GhcPass 'Renamed)
decl of
      TyClD _ d@ClassDecl { tcdLName = L _ clsNm
                          , tcdSigs = clsSigs
                          , tcdATs = clsATs } ->
        let
          matchesMethod :: [Located (Sig (GhcPass 'Renamed))]
matchesMethod =
            [ Located (Sig (GhcPass 'Renamed))
lsig
            | Located (Sig (GhcPass 'Renamed))
lsig <- [Located (Sig (GhcPass 'Renamed))]
clsSigs
            , ClassOpSig XClassOpSig (GhcPass 'Renamed)
_ Bool
False [Located (IdP (GhcPass 'Renamed))]
_ HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
_ <- Sig (GhcPass 'Renamed) -> [Sig (GhcPass 'Renamed)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sig (GhcPass 'Renamed) -> [Sig (GhcPass 'Renamed)])
-> Sig (GhcPass 'Renamed) -> [Sig (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ Located (Sig (GhcPass 'Renamed))
-> SrcSpanLess (Located (Sig (GhcPass 'Renamed)))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (Sig (GhcPass 'Renamed))
lsig
              -- Note: exclude `default` declarations (see #505)
            , Name
name Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Located (Sig (GhcPass 'Renamed)) -> [IdP (GhcPass 'Renamed)]
forall name. LSig name -> [IdP name]
sigName Located (Sig (GhcPass 'Renamed))
lsig
            ]

          matchesAssociatedType :: [Located (FamilyDecl (GhcPass 'Renamed))]
matchesAssociatedType =
            [ Located (FamilyDecl (GhcPass 'Renamed))
lfam_decl
            | Located (FamilyDecl (GhcPass 'Renamed))
lfam_decl <- [Located (FamilyDecl (GhcPass 'Renamed))]
clsATs
            , Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (FamilyDecl (GhcPass 'Renamed) -> Located (IdP (GhcPass 'Renamed))
forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName (Located (FamilyDecl (GhcPass 'Renamed))
-> SrcSpanLess (Located (FamilyDecl (GhcPass 'Renamed)))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (FamilyDecl (GhcPass 'Renamed))
lfam_decl))
            ]

            -- TODO: document fixity
        in case ([Located (Sig (GhcPass 'Renamed))]
matchesMethod, [Located (FamilyDecl (GhcPass 'Renamed))]
matchesAssociatedType)  of
          ([Located (Sig (GhcPass 'Renamed))
s0], [Located (FamilyDecl (GhcPass 'Renamed))]
_) -> let tyvar_names :: LHsQTyVars (GhcPass 'Renamed)
tyvar_names = TyClDecl (GhcPass 'Renamed) -> LHsQTyVars (GhcPass 'Renamed)
forall pass. TyClDecl pass -> LHsQTyVars pass
tyClDeclTyVars TyClDecl (GhcPass 'Renamed)
d
                           L SrcSpan
pos Sig (GhcPass 'Renamed)
sig = Name
-> LHsQTyVars (GhcPass 'Renamed)
-> Located (Sig (GhcPass 'Renamed))
-> Located (Sig (GhcPass 'Renamed))
addClassContext IdP (GhcPass 'Renamed)
Name
clsNm LHsQTyVars (GhcPass 'Renamed)
tyvar_names Located (Sig (GhcPass 'Renamed))
s0
                       in LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan -> HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
forall l e. l -> e -> GenLocated l e
L SrcSpan
pos (XSigD (GhcPass 'Renamed)
-> Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
XSigD (GhcPass 'Renamed)
noExtField Sig (GhcPass 'Renamed)
sig))
          ([Located (Sig (GhcPass 'Renamed))]
_, [L SrcSpan
pos FamilyDecl (GhcPass 'Renamed)
fam_decl]) -> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan -> HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
forall l e. l -> e -> GenLocated l e
L SrcSpan
pos (XTyClD (GhcPass 'Renamed)
-> TyClDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
XTyClD (GhcPass 'Renamed)
noExtField (XFamDecl (GhcPass 'Renamed)
-> FamilyDecl (GhcPass 'Renamed) -> TyClDecl (GhcPass 'Renamed)
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl NoExtField
XFamDecl (GhcPass 'Renamed)
noExtField FamilyDecl (GhcPass 'Renamed)
fam_decl)))

          ([], [])
            | Just (LHsDecl (GhcPass 'Renamed)
famInstDecl:[LHsDecl (GhcPass 'Renamed)]
_) <- Name -> DeclMap -> Maybe [LHsDecl (GhcPass 'Renamed)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name DeclMap
declMap
            -> HasCallStack =>
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
extractDecl DeclMap
declMap Name
name LHsDecl (GhcPass 'Renamed)
famInstDecl
          ([Located (Sig (GhcPass 'Renamed))],
 [Located (FamilyDecl (GhcPass 'Renamed))])
_ -> String -> Either String (LHsDecl (GhcPass 'Renamed))
forall a b. a -> Either a b
Left ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Ambiguous decl for ", Name -> String
forall a. NamedThing a => a -> String
getOccString Name
name
                            , String
" in class ", Name -> String
forall a. NamedThing a => a -> String
getOccString IdP (GhcPass 'Renamed)
Name
clsNm ])

      TyClD _ d@DataDecl { tcdLName = L _ dataNm
                         , tcdDataDefn = HsDataDefn { dd_cons = dataCons } } -> do
        let ty_args :: [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
ty_args = (LHsType (GhcPass 'Renamed)
 -> HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed)))
-> [LHsType (GhcPass 'Renamed)]
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
forall a b. (a -> b) -> [a] -> [b]
map LHsType (GhcPass 'Renamed)
-> HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
forall tm ty. tm -> HsArg tm ty
HsValArg (LHsQTyVars (GhcPass 'Renamed) -> [LHsType (GhcPass 'Renamed)]
lHsQTyVarsToTypes (TyClDecl (GhcPass 'Renamed) -> LHsQTyVars (GhcPass 'Renamed)
forall pass. TyClDecl pass -> LHsQTyVars pass
tyClDeclTyVars TyClDecl (GhcPass 'Renamed)
d))
        Located (Sig (GhcPass 'Renamed))
lsig <- if Name -> Bool
isDataConName Name
name
                  then HasCallStack =>
Name
-> Name
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> [LConDecl (GhcPass 'Renamed)]
-> Either String (Located (Sig (GhcPass 'Renamed)))
Name
-> Name
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> [LConDecl (GhcPass 'Renamed)]
-> Either String (Located (Sig (GhcPass 'Renamed)))
extractPatternSyn Name
name IdP (GhcPass 'Renamed)
Name
dataNm [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
ty_args [LConDecl (GhcPass 'Renamed)]
dataCons
                  else Name
-> Name
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> [LConDecl (GhcPass 'Renamed)]
-> Either String (Located (Sig (GhcPass 'Renamed)))
extractRecSel Name
name IdP (GhcPass 'Renamed)
Name
dataNm [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
ty_args [LConDecl (GhcPass 'Renamed)]
dataCons
        LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XSigD (GhcPass 'Renamed)
-> Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
XSigD (GhcPass 'Renamed)
noExtField (Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> Located (Sig (GhcPass 'Renamed)) -> LHsDecl (GhcPass 'Renamed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Located (Sig (GhcPass 'Renamed))
lsig)

      TyClD _ FamDecl {}
        | Name -> Bool
isValName Name
name
        , Just (LHsDecl (GhcPass 'Renamed)
famInst:[LHsDecl (GhcPass 'Renamed)]
_) <- Name -> DeclMap -> Maybe [LHsDecl (GhcPass 'Renamed)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name DeclMap
declMap
        -> HasCallStack =>
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
extractDecl DeclMap
declMap Name
name LHsDecl (GhcPass 'Renamed)
famInst
      InstD _ (DataFamInstD _ (DataFamInstDecl (HsIB { hsib_body =
          FamEqn { feqn_tycon = L _ famName
                 , feqn_pats  = ty_args
                 , feqn_rhs   = HsDataDefn { dd_cons = dataCons } }}))) -> do
        Located (Sig (GhcPass 'Renamed))
lsig <- if Name -> Bool
isDataConName Name
name
                  then HasCallStack =>
Name
-> Name
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> [LConDecl (GhcPass 'Renamed)]
-> Either String (Located (Sig (GhcPass 'Renamed)))
Name
-> Name
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> [LConDecl (GhcPass 'Renamed)]
-> Either String (Located (Sig (GhcPass 'Renamed)))
extractPatternSyn Name
name IdP (GhcPass 'Renamed)
Name
famName [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
ty_args [LConDecl (GhcPass 'Renamed)]
dataCons
                  else Name
-> Name
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> [LConDecl (GhcPass 'Renamed)]
-> Either String (Located (Sig (GhcPass 'Renamed)))
extractRecSel Name
name IdP (GhcPass 'Renamed)
Name
famName [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
ty_args [LConDecl (GhcPass 'Renamed)]
dataCons
        LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XSigD (GhcPass 'Renamed)
-> Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
XSigD (GhcPass 'Renamed)
noExtField (Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> Located (Sig (GhcPass 'Renamed)) -> LHsDecl (GhcPass 'Renamed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Located (Sig (GhcPass 'Renamed))
lsig)
      InstD _ (ClsInstD _ ClsInstDecl { cid_datafam_insts = insts })
        | Name -> Bool
isDataConName Name
name ->
            let matches :: [DataFamInstDecl (GhcPass 'Renamed)]
matches = [ DataFamInstDecl (GhcPass 'Renamed)
d' | L SrcSpan
_ d' :: DataFamInstDecl (GhcPass 'Renamed)
d'@(DataFamInstDecl (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body =
                                          FamEqn { feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs   = HsDataDefn { dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons = [LConDecl (GhcPass 'Renamed)]
dataCons }
                                                 }
                                         })) <- [LDataFamInstDecl (GhcPass 'Renamed)]
insts
                               , Name
name Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Located Name -> Name) -> [Located Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ((LConDecl (GhcPass 'Renamed) -> [Located Name])
-> [LConDecl (GhcPass 'Renamed)] -> [Located Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConDecl (GhcPass 'Renamed) -> [Located Name]
forall (p :: Pass).
ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames (ConDecl (GhcPass 'Renamed) -> [Located Name])
-> (LConDecl (GhcPass 'Renamed) -> ConDecl (GhcPass 'Renamed))
-> LConDecl (GhcPass 'Renamed)
-> [Located Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LConDecl (GhcPass 'Renamed) -> ConDecl (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LConDecl (GhcPass 'Renamed)]
dataCons)
                               ]
            in case [DataFamInstDecl (GhcPass 'Renamed)]
matches of
                [DataFamInstDecl (GhcPass 'Renamed)
d0] -> HasCallStack =>
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
extractDecl DeclMap
declMap Name
name (SrcSpanLess (LHsDecl (GhcPass 'Renamed))
-> LHsDecl (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XInstD (GhcPass 'Renamed)
-> InstDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD NoExtField
XInstD (GhcPass 'Renamed)
noExtField (XDataFamInstD (GhcPass 'Renamed)
-> DataFamInstDecl (GhcPass 'Renamed)
-> InstDecl (GhcPass 'Renamed)
forall pass.
XDataFamInstD pass -> DataFamInstDecl pass -> InstDecl pass
DataFamInstD NoExtField
XDataFamInstD (GhcPass 'Renamed)
noExtField DataFamInstDecl (GhcPass 'Renamed)
d0)))
                [DataFamInstDecl (GhcPass 'Renamed)]
_    -> String -> Either String (LHsDecl (GhcPass 'Renamed))
forall a b. a -> Either a b
Left String
"internal: extractDecl (ClsInstD)"
        | Bool
otherwise ->
            let matches :: [DataFamInstDecl (GhcPass 'Renamed)]
matches = [ DataFamInstDecl (GhcPass 'Renamed)
d' | L SrcSpan
_ d' :: DataFamInstDecl (GhcPass 'Renamed)
d'@(DataFamInstDecl (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
d }))
                                   <- [LDataFamInstDecl (GhcPass 'Renamed)]
insts
                                 -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (feqn_rhs d)
                               , RecCon Located [LConDeclField (GhcPass 'Renamed)]
rec <- (LConDecl (GhcPass 'Renamed)
 -> HsConDetails
      (LHsType (GhcPass 'Renamed))
      (Located [LConDeclField (GhcPass 'Renamed)]))
-> [LConDecl (GhcPass 'Renamed)]
-> [HsConDetails
      (LHsType (GhcPass 'Renamed))
      (Located [LConDeclField (GhcPass 'Renamed)])]
forall a b. (a -> b) -> [a] -> [b]
map (ConDecl (GhcPass 'Renamed)
-> HsConDetails
     (LHsType (GhcPass 'Renamed))
     (Located [LConDeclField (GhcPass 'Renamed)])
forall pass. ConDecl pass -> HsConDeclDetails pass
getConArgs (ConDecl (GhcPass 'Renamed)
 -> HsConDetails
      (LHsType (GhcPass 'Renamed))
      (Located [LConDeclField (GhcPass 'Renamed)]))
-> (LConDecl (GhcPass 'Renamed) -> ConDecl (GhcPass 'Renamed))
-> LConDecl (GhcPass 'Renamed)
-> HsConDetails
     (LHsType (GhcPass 'Renamed))
     (Located [LConDeclField (GhcPass 'Renamed)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LConDecl (GhcPass 'Renamed) -> ConDecl (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) (HsDataDefn (GhcPass 'Renamed) -> [LConDecl (GhcPass 'Renamed)]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
-> HsDataDefn (GhcPass 'Renamed)
forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
d))
                               , ConDeclField { cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names = [LFieldOcc (GhcPass 'Renamed)]
ns } <- (LConDeclField (GhcPass 'Renamed)
 -> ConDeclField (GhcPass 'Renamed))
-> [LConDeclField (GhcPass 'Renamed)]
-> [ConDeclField (GhcPass 'Renamed)]
forall a b. (a -> b) -> [a] -> [b]
map LConDeclField (GhcPass 'Renamed) -> ConDeclField (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located [LConDeclField (GhcPass 'Renamed)]
-> SrcSpanLess (Located [LConDeclField (GhcPass 'Renamed)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LConDeclField (GhcPass 'Renamed)]
rec)
                               , L SrcSpan
_ FieldOcc (GhcPass 'Renamed)
n <- [LFieldOcc (GhcPass 'Renamed)]
ns
                               , FieldOcc (GhcPass 'Renamed) -> XCFieldOcc (GhcPass 'Renamed)
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc FieldOcc (GhcPass 'Renamed)
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name
                          ]
            in case [DataFamInstDecl (GhcPass 'Renamed)]
matches of
              [DataFamInstDecl (GhcPass 'Renamed)
d0] -> HasCallStack =>
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
DeclMap
-> Name
-> LHsDecl (GhcPass 'Renamed)
-> Either String (LHsDecl (GhcPass 'Renamed))
extractDecl DeclMap
declMap Name
name (HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (HsDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed))
-> (InstDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed))
-> InstDecl (GhcPass 'Renamed)
-> LHsDecl (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XInstD (GhcPass 'Renamed)
-> InstDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD NoExtField
XInstD (GhcPass 'Renamed)
noExtField (InstDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed))
-> InstDecl (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ XDataFamInstD (GhcPass 'Renamed)
-> DataFamInstDecl (GhcPass 'Renamed)
-> InstDecl (GhcPass 'Renamed)
forall pass.
XDataFamInstD pass -> DataFamInstDecl pass -> InstDecl pass
DataFamInstD NoExtField
XDataFamInstD (GhcPass 'Renamed)
noExtField DataFamInstDecl (GhcPass 'Renamed)
d0)
              [DataFamInstDecl (GhcPass 'Renamed)]
_ -> String -> Either String (LHsDecl (GhcPass 'Renamed))
forall a b. a -> Either a b
Left String
"internal: extractDecl (ClsInstD)"
      SrcSpanLess (LHsDecl (GhcPass 'Renamed))
_ -> String -> Either String (LHsDecl (GhcPass 'Renamed))
forall a b. a -> Either a b
Left (String
"extractDecl: Unhandled decl for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. NamedThing a => a -> String
getOccString Name
name)

extractPatternSyn :: HasCallStack => Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn] -> Either ErrMsg (LSig GhcRn)
extractPatternSyn :: Name
-> Name
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> [LConDecl (GhcPass 'Renamed)]
-> Either String (Located (Sig (GhcPass 'Renamed)))
extractPatternSyn Name
nm Name
t [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
tvs [LConDecl (GhcPass 'Renamed)]
cons =
  case (LConDecl (GhcPass 'Renamed) -> Bool)
-> [LConDecl (GhcPass 'Renamed)] -> [LConDecl (GhcPass 'Renamed)]
forall a. (a -> Bool) -> [a] -> [a]
filter LConDecl (GhcPass 'Renamed) -> Bool
matches [LConDecl (GhcPass 'Renamed)]
cons of
    [] -> String -> Either String (Located (Sig (GhcPass 'Renamed)))
forall a b. a -> Either a b
Left (String -> Either String (Located (Sig (GhcPass 'Renamed))))
-> (SDoc -> String)
-> SDoc
-> Either String (Located (Sig (GhcPass 'Renamed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
O.showSDocUnsafe (SDoc -> Either String (Located (Sig (GhcPass 'Renamed))))
-> SDoc -> Either String (Located (Sig (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$
          String -> SDoc
O.text String
"constructor pattern " SDoc -> SDoc -> SDoc
O.<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr Name
nm SDoc -> SDoc -> SDoc
O.<+> String -> SDoc
O.text String
"not found in type" SDoc -> SDoc -> SDoc
O.<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr Name
t
    LConDecl (GhcPass 'Renamed)
con:[LConDecl (GhcPass 'Renamed)]
_ -> Located (Sig (GhcPass 'Renamed))
-> Either String (Located (Sig (GhcPass 'Renamed)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConDecl (GhcPass 'Renamed) -> Sig (GhcPass 'Renamed)
extract (ConDecl (GhcPass 'Renamed) -> Sig (GhcPass 'Renamed))
-> LConDecl (GhcPass 'Renamed) -> Located (Sig (GhcPass 'Renamed))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LConDecl (GhcPass 'Renamed)
con)
 where
  matches :: LConDecl GhcRn -> Bool
  matches :: LConDecl (GhcPass 'Renamed) -> Bool
matches (L SrcSpan
_ ConDecl (GhcPass 'Renamed)
con) = Name
nm Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located Name -> Name) -> [Located Name] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConDecl (GhcPass 'Renamed) -> [Located (IdP (GhcPass 'Renamed))]
forall (p :: Pass).
ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames ConDecl (GhcPass 'Renamed)
con)
  extract :: ConDecl GhcRn -> Sig GhcRn
  extract :: ConDecl (GhcPass 'Renamed) -> Sig (GhcPass 'Renamed)
extract ConDecl (GhcPass 'Renamed)
con =
    let args :: [LHsType (GhcPass 'Renamed)]
args =
          case ConDecl (GhcPass 'Renamed)
-> HsConDetails
     (LHsType (GhcPass 'Renamed))
     (Located [LConDeclField (GhcPass 'Renamed)])
forall pass. ConDecl pass -> HsConDeclDetails pass
getConArgs ConDecl (GhcPass 'Renamed)
con of
            PrefixCon [LHsType (GhcPass 'Renamed)]
args' -> [LHsType (GhcPass 'Renamed)]
args'
            RecCon (L SrcSpan
_ [LConDeclField (GhcPass 'Renamed)]
fields) -> ConDeclField (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type (ConDeclField (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed))
-> (LConDeclField (GhcPass 'Renamed)
    -> ConDeclField (GhcPass 'Renamed))
-> LConDeclField (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LConDeclField (GhcPass 'Renamed) -> ConDeclField (GhcPass 'Renamed)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LConDeclField (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed))
-> [LConDeclField (GhcPass 'Renamed)]
-> [LHsType (GhcPass 'Renamed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LConDeclField (GhcPass 'Renamed)]
fields
            InfixCon LHsType (GhcPass 'Renamed)
arg1 LHsType (GhcPass 'Renamed)
arg2 -> [LHsType (GhcPass 'Renamed)
arg1, LHsType (GhcPass 'Renamed)
arg2]
        typ :: LHsType (GhcPass 'Renamed)
typ = [LHsType (GhcPass 'Renamed)]
-> LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
longArrow [LHsType (GhcPass 'Renamed)]
args (ConDecl (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
data_ty ConDecl (GhcPass 'Renamed)
con)
        typ' :: LHsType (GhcPass 'Renamed)
typ' =
          case ConDecl (GhcPass 'Renamed)
con of
            ConDeclH98 { con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Just LHsContext (GhcPass 'Renamed)
cxt } -> SrcSpanLess (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XQualTy (GhcPass 'Renamed)
-> LHsContext (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy (GhcPass 'Renamed)
noExtField LHsContext (GhcPass 'Renamed)
cxt LHsType (GhcPass 'Renamed)
typ)
            ConDecl (GhcPass 'Renamed)
_ -> LHsType (GhcPass 'Renamed)
typ
        typ'' :: LHsType (GhcPass 'Renamed)
typ'' = SrcSpanLess (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XQualTy (GhcPass 'Renamed)
-> LHsContext (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy (GhcPass 'Renamed)
noExtField (SrcSpanLess (LHsContext (GhcPass 'Renamed))
-> LHsContext (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc []) LHsType (GhcPass 'Renamed)
typ')
    in XPatSynSig (GhcPass 'Renamed)
-> [Located (IdP (GhcPass 'Renamed))]
-> HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
-> Sig (GhcPass 'Renamed)
forall pass.
XPatSynSig pass
-> [Located (IdP pass)] -> LHsSigType pass -> Sig pass
PatSynSig NoExtField
XPatSynSig (GhcPass 'Renamed)
noExtField [SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located Name)
Name
nm] (LHsType (GhcPass 'Renamed)
-> HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
forall thing. thing -> HsImplicitBndrs (GhcPass 'Renamed) thing
mkEmptyImplicitBndrs LHsType (GhcPass 'Renamed)
typ'')

  longArrow :: [LHsType GhcRn] -> LHsType GhcRn -> LHsType GhcRn
  longArrow :: [LHsType (GhcPass 'Renamed)]
-> LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
longArrow [LHsType (GhcPass 'Renamed)]
inputs LHsType (GhcPass 'Renamed)
output = (LHsType (GhcPass 'Renamed)
 -> LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
-> [LHsType (GhcPass 'Renamed)]
-> LHsType (GhcPass 'Renamed)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\LHsType (GhcPass 'Renamed)
x LHsType (GhcPass 'Renamed)
y -> SrcSpanLess (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XFunTy (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy NoExtField
XFunTy (GhcPass 'Renamed)
noExtField LHsType (GhcPass 'Renamed)
x LHsType (GhcPass 'Renamed)
y)) LHsType (GhcPass 'Renamed)
output [LHsType (GhcPass 'Renamed)]
inputs

  data_ty :: ConDecl (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
data_ty ConDecl (GhcPass 'Renamed)
con
    | ConDeclGADT{} <- ConDecl (GhcPass 'Renamed)
con = ConDecl (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall pass. ConDecl pass -> LHsType pass
con_res_ty ConDecl (GhcPass 'Renamed)
con
    | Bool
otherwise = (LHsType (GhcPass 'Renamed)
 -> HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
 -> LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> LHsType (GhcPass 'Renamed)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\LHsType (GhcPass 'Renamed)
x HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
y -> SrcSpanLess (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (LHsType (GhcPass 'Renamed)
-> HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
-> HsType (GhcPass 'Renamed)
mkAppTyArg LHsType (GhcPass 'Renamed)
x HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
y)) (SrcSpanLess (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XTyVar (GhcPass 'Renamed)
-> PromotionFlag
-> Located (IdP (GhcPass 'Renamed))
-> HsType (GhcPass 'Renamed)
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar (GhcPass 'Renamed)
noExtField PromotionFlag
NotPromoted (SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located Name)
Name
t))) [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
tvs
                    where mkAppTyArg :: LHsType GhcRn -> LHsTypeArg GhcRn -> HsType GhcRn
                          mkAppTyArg :: LHsType (GhcPass 'Renamed)
-> HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
-> HsType (GhcPass 'Renamed)
mkAppTyArg LHsType (GhcPass 'Renamed)
f (HsValArg LHsType (GhcPass 'Renamed)
ty) = XAppTy (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy NoExtField
XAppTy (GhcPass 'Renamed)
noExtField LHsType (GhcPass 'Renamed)
f LHsType (GhcPass 'Renamed)
ty
                          mkAppTyArg LHsType (GhcPass 'Renamed)
f (HsTypeArg SrcSpan
l LHsType (GhcPass 'Renamed)
ki) = XAppKindTy (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall pass.
XAppKindTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy (GhcPass 'Renamed)
SrcSpan
l LHsType (GhcPass 'Renamed)
f LHsType (GhcPass 'Renamed)
ki
                          mkAppTyArg LHsType (GhcPass 'Renamed)
f (HsArgPar SrcSpan
_) = XParTy (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy NoExtField
XParTy (GhcPass 'Renamed)
noExtField LHsType (GhcPass 'Renamed)
f

extractRecSel :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn]
              -> Either ErrMsg (LSig GhcRn)
extractRecSel :: Name
-> Name
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> [LConDecl (GhcPass 'Renamed)]
-> Either String (Located (Sig (GhcPass 'Renamed)))
extractRecSel Name
_ Name
_ [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
_ [] = String -> Either String (Located (Sig (GhcPass 'Renamed)))
forall a b. a -> Either a b
Left String
"extractRecSel: selector not found"

extractRecSel Name
nm Name
t [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
tvs (L SrcSpan
_ ConDecl (GhcPass 'Renamed)
con : [LConDecl (GhcPass 'Renamed)]
rest) =
  case ConDecl (GhcPass 'Renamed)
-> HsConDetails
     (LHsType (GhcPass 'Renamed))
     (Located [LConDeclField (GhcPass 'Renamed)])
forall pass. ConDecl pass -> HsConDeclDetails pass
getConArgs ConDecl (GhcPass 'Renamed)
con of
    RecCon (L SrcSpan
_ [LConDeclField (GhcPass 'Renamed)]
fields) | ((SrcSpan
l,L SrcSpan
_ (ConDeclField XConDeclField (GhcPass 'Renamed)
_ [LFieldOcc (GhcPass 'Renamed)]
_nn LHsType (GhcPass 'Renamed)
ty Maybe LHsDocString
_)) : [(SrcSpan, LConDeclField (GhcPass 'Renamed))]
_) <- [LConDeclField (GhcPass 'Renamed)]
-> [(SrcSpan, LConDeclField (GhcPass 'Renamed))]
matching_fields [LConDeclField (GhcPass 'Renamed)]
fields ->
      Located (Sig (GhcPass 'Renamed))
-> Either String (Located (Sig (GhcPass 'Renamed)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpan
-> Sig (GhcPass 'Renamed) -> Located (Sig (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XTypeSig (GhcPass 'Renamed)
-> [Located (IdP (GhcPass 'Renamed))]
-> LHsSigWcType (GhcPass 'Renamed)
-> Sig (GhcPass 'Renamed)
forall pass.
XTypeSig pass
-> [Located (IdP pass)] -> LHsSigWcType pass -> Sig pass
TypeSig NoExtField
XTypeSig (GhcPass 'Renamed)
noExtField [SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located Name)
Name
nm] (LHsType (GhcPass 'Renamed) -> LHsSigWcType (GhcPass 'Renamed)
mkEmptySigWcType (SrcSpanLess (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XFunTy (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy NoExtField
XFunTy (GhcPass 'Renamed)
noExtField LHsType (GhcPass 'Renamed)
data_ty (LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall a. LHsType a -> LHsType a
getBangType LHsType (GhcPass 'Renamed)
ty))))))
    HsConDetails
  (LHsType (GhcPass 'Renamed))
  (Located [LConDeclField (GhcPass 'Renamed)])
_ -> Name
-> Name
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> [LConDecl (GhcPass 'Renamed)]
-> Either String (Located (Sig (GhcPass 'Renamed)))
extractRecSel Name
nm Name
t [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
tvs [LConDecl (GhcPass 'Renamed)]
rest
 where
  matching_fields :: [LConDeclField GhcRn] -> [(SrcSpan, LConDeclField GhcRn)]
  matching_fields :: [LConDeclField (GhcPass 'Renamed)]
-> [(SrcSpan, LConDeclField (GhcPass 'Renamed))]
matching_fields [LConDeclField (GhcPass 'Renamed)]
flds = [ (SrcSpan
l,LConDeclField (GhcPass 'Renamed)
f) | f :: LConDeclField (GhcPass 'Renamed)
f@(L SrcSpan
_ (ConDeclField XConDeclField (GhcPass 'Renamed)
_ [LFieldOcc (GhcPass 'Renamed)]
ns LHsType (GhcPass 'Renamed)
_ Maybe LHsDocString
_)) <- [LConDeclField (GhcPass 'Renamed)]
flds
                                 , L SrcSpan
l FieldOcc (GhcPass 'Renamed)
n <- [LFieldOcc (GhcPass 'Renamed)]
ns, FieldOcc (GhcPass 'Renamed) -> XCFieldOcc (GhcPass 'Renamed)
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc FieldOcc (GhcPass 'Renamed)
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
nm ]
  data_ty :: LHsType (GhcPass 'Renamed)
data_ty
    -- ResTyGADT _ ty <- con_res con = ty
    | ConDeclGADT{} <- ConDecl (GhcPass 'Renamed)
con = ConDecl (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall pass. ConDecl pass -> LHsType pass
con_res_ty ConDecl (GhcPass 'Renamed)
con
    | Bool
otherwise = (LHsType (GhcPass 'Renamed)
 -> HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
 -> LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
-> [HsArg
      (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
-> LHsType (GhcPass 'Renamed)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\LHsType (GhcPass 'Renamed)
x HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
y -> SrcSpanLess (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (LHsType (GhcPass 'Renamed)
-> HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
-> HsType (GhcPass 'Renamed)
mkAppTyArg LHsType (GhcPass 'Renamed)
x HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
y)) (SrcSpanLess (LHsType (GhcPass 'Renamed))
-> LHsType (GhcPass 'Renamed)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XTyVar (GhcPass 'Renamed)
-> PromotionFlag
-> Located (IdP (GhcPass 'Renamed))
-> HsType (GhcPass 'Renamed)
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar (GhcPass 'Renamed)
noExtField PromotionFlag
NotPromoted (SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located Name)
Name
t))) [HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))]
tvs
                   where mkAppTyArg :: LHsType GhcRn -> LHsTypeArg GhcRn -> HsType GhcRn
                         mkAppTyArg :: LHsType (GhcPass 'Renamed)
-> HsArg (LHsType (GhcPass 'Renamed)) (LHsType (GhcPass 'Renamed))
-> HsType (GhcPass 'Renamed)
mkAppTyArg LHsType (GhcPass 'Renamed)
f (HsValArg LHsType (GhcPass 'Renamed)
ty) = XAppTy (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy NoExtField
XAppTy (GhcPass 'Renamed)
noExtField LHsType (GhcPass 'Renamed)
f LHsType (GhcPass 'Renamed)
ty
                         mkAppTyArg LHsType (GhcPass 'Renamed)
f (HsTypeArg SrcSpan
l LHsType (GhcPass 'Renamed)
ki) = XAppKindTy (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall pass.
XAppKindTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy (GhcPass 'Renamed)
SrcSpan
l LHsType (GhcPass 'Renamed)
f LHsType (GhcPass 'Renamed)
ki
                         mkAppTyArg LHsType (GhcPass 'Renamed)
f (HsArgPar SrcSpan
_) = XParTy (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy NoExtField
XParTy (GhcPass 'Renamed)
noExtField LHsType (GhcPass 'Renamed)
f

-- | Keep export items with docs.
pruneExportItems :: [ExportItem GhcRn] -> [ExportItem GhcRn]
pruneExportItems :: [ExportItem (GhcPass 'Renamed)] -> [ExportItem (GhcPass 'Renamed)]
pruneExportItems = (ExportItem (GhcPass 'Renamed) -> Bool)
-> [ExportItem (GhcPass 'Renamed)]
-> [ExportItem (GhcPass 'Renamed)]
forall a. (a -> Bool) -> [a] -> [a]
filter ExportItem (GhcPass 'Renamed) -> Bool
forall name. ExportItem name -> Bool
hasDoc
  where
    hasDoc :: ExportItem name -> Bool
hasDoc (ExportDecl{expItemMbDoc :: forall name. ExportItem name -> DocForDecl (IdP name)
expItemMbDoc = (Documentation Maybe (MDoc (IdP name))
d Maybe (Doc (IdP name))
_, FnArgsDoc (IdP name)
_)}) = Maybe (MDoc (IdP name)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (MDoc (IdP name))
d
    hasDoc ExportItem name
_ = Bool
True


mkVisibleNames :: Maps -> [ExportItem GhcRn] -> [DocOption] -> [Name]
mkVisibleNames :: Maps -> [ExportItem (GhcPass 'Renamed)] -> [DocOption] -> [Name]
mkVisibleNames (DocMap Name
_, ArgMap Name
_, DeclMap
_, InstMap
instMap) [ExportItem (GhcPass 'Renamed)]
exports [DocOption]
opts
  | DocOption
OptHide DocOption -> [DocOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DocOption]
opts = []
  | Bool
otherwise = let ns :: [Name]
ns = (ExportItem (GhcPass 'Renamed) -> [Name])
-> [ExportItem (GhcPass 'Renamed)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExportItem (GhcPass 'Renamed) -> [Name]
exportName [ExportItem (GhcPass 'Renamed)]
exports
                in [Name] -> ()
forall a. [a] -> ()
seqList [Name]
ns () -> [Name] -> [Name]
`seq` [Name]
ns
  where
    exportName :: ExportItem (GhcPass 'Renamed) -> [Name]
exportName e :: ExportItem (GhcPass 'Renamed)
e@ExportDecl {} = [Name]
name [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
subs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
patsyns
      where subs :: [Name]
subs    = ((Name, DocForDecl Name) -> Name)
-> [(Name, DocForDecl Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, DocForDecl Name) -> Name
forall a b. (a, b) -> a
fst (ExportItem (GhcPass 'Renamed)
-> [(IdP (GhcPass 'Renamed), DocForDecl (IdP (GhcPass 'Renamed)))]
forall name. ExportItem name -> [(IdP name, DocForDecl (IdP name))]
expItemSubDocs ExportItem (GhcPass 'Renamed)
e)
            patsyns :: [Name]
patsyns = ((HsDecl (GhcPass 'Renamed), DocForDecl Name) -> [Name])
-> [(HsDecl (GhcPass 'Renamed), DocForDecl Name)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HsDecl (GhcPass 'Renamed) -> [Name]
forall (p :: Pass). HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder (HsDecl (GhcPass 'Renamed) -> [Name])
-> ((HsDecl (GhcPass 'Renamed), DocForDecl Name)
    -> HsDecl (GhcPass 'Renamed))
-> (HsDecl (GhcPass 'Renamed), DocForDecl Name)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsDecl (GhcPass 'Renamed), DocForDecl Name)
-> HsDecl (GhcPass 'Renamed)
forall a b. (a, b) -> a
fst) (ExportItem (GhcPass 'Renamed)
-> [(HsDecl (GhcPass 'Renamed),
     DocForDecl (IdP (GhcPass 'Renamed)))]
forall name.
ExportItem name -> [(HsDecl name, DocForDecl (IdP name))]
expItemPats ExportItem (GhcPass 'Renamed)
e)
            name :: [Name]
name = case LHsDecl (GhcPass 'Renamed)
-> SrcSpanLess (LHsDecl (GhcPass 'Renamed))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsDecl (GhcPass 'Renamed)
 -> SrcSpanLess (LHsDecl (GhcPass 'Renamed)))
-> LHsDecl (GhcPass 'Renamed)
-> SrcSpanLess (LHsDecl (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ ExportItem (GhcPass 'Renamed) -> LHsDecl (GhcPass 'Renamed)
forall name. ExportItem name -> LHsDecl name
expItemDecl ExportItem (GhcPass 'Renamed)
e of
              InstD _ d -> Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ SrcSpan -> InstMap -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (InstDecl (GhcPass 'Renamed) -> SrcSpan
forall (p :: Pass). InstDecl (GhcPass p) -> SrcSpan
getInstLoc InstDecl (GhcPass 'Renamed)
d) InstMap
instMap
              SrcSpanLess (LHsDecl (GhcPass 'Renamed))
decl      -> HsDecl (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (p :: Pass). HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder HsDecl (GhcPass 'Renamed)
SrcSpanLess (LHsDecl (GhcPass 'Renamed))
decl
    exportName ExportNoDecl {} = [] -- we don't count these as visible, since
                                    -- we don't want links to go to them.
    exportName ExportItem (GhcPass 'Renamed)
_ = []

seqList :: [a] -> ()
seqList :: [a] -> ()
seqList [] = ()
seqList (a
x : [a]
xs) = a
x a -> () -> ()
`seq` [a] -> ()
forall a. [a] -> ()
seqList [a]
xs

-- | Find a stand-alone documentation comment by its name.
findNamedDoc :: String -> [HsDecl GhcRn] -> ErrMsgM (Maybe HsDocString)
findNamedDoc :: String
-> [HsDecl (GhcPass 'Renamed)] -> ErrMsgM (Maybe HsDocString)
findNamedDoc String
name = [HsDecl (GhcPass 'Renamed)] -> ErrMsgM (Maybe HsDocString)
search
  where
    search :: [HsDecl (GhcPass 'Renamed)] -> ErrMsgM (Maybe HsDocString)
search [] = do
      [String] -> ErrMsgM ()
tell [String
"Cannot find documentation for: $" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name]
      Maybe HsDocString -> ErrMsgM (Maybe HsDocString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe HsDocString
forall a. Maybe a
Nothing
    search (DocD XDocD (GhcPass 'Renamed)
_ (DocCommentNamed String
name' HsDocString
doc) : [HsDecl (GhcPass 'Renamed)]
rest)
      | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name' = Maybe HsDocString -> ErrMsgM (Maybe HsDocString)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsDocString -> Maybe HsDocString
forall a. a -> Maybe a
Just HsDocString
doc)
      | Bool
otherwise = [HsDecl (GhcPass 'Renamed)] -> ErrMsgM (Maybe HsDocString)
search [HsDecl (GhcPass 'Renamed)]
rest
    search (HsDecl (GhcPass 'Renamed)
_other_decl : [HsDecl (GhcPass 'Renamed)]
rest) = [HsDecl (GhcPass 'Renamed)] -> ErrMsgM (Maybe HsDocString)
search [HsDecl (GhcPass 'Renamed)]
rest