{-# LANGUAGE ScopedTypeVariables #-}

{- |
Module: Pollock.ProcessModule
Copyright: (c) Trevis Elser 2023
License: MIT

Maintainer: trevis@flipstone.com
Stability: experimental
-}
module Pollock.ProcessModule
  ( processModule
  ) where

import qualified Control.Applicative as Applicative
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Bifunctor as Bifunctor
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as T

import qualified Pollock.CompatGHC as CompatGHC
import qualified Pollock.Documentation as Documentation
import Pollock.ModuleInfo (ModuleInfo, buildModuleInfo)

processModule ::
  (MIO.MonadIO m) =>
  CompatGHC.TcGblEnv
  -> m ModuleInfo
processModule :: forall (m :: * -> *). MonadIO m => TcGblEnv -> m ModuleInfo
processModule TcGblEnv
tcGblEnv = do
  let
    localInstances :: [CompatGHC.Name]
    localInstances :: [Name]
localInstances =
      (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter
        (Module -> Name -> Bool
CompatGHC.nameIsLocalOrFrom (TcGblEnv -> Module
CompatGHC.tcg_semantic_mod TcGblEnv
tcGblEnv))
        ( (ClsInst -> Name) -> [ClsInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClsInst -> Name
forall a. NamedThing a => a -> Name
CompatGHC.getName (TcGblEnv -> [ClsInst]
CompatGHC.tcg_insts TcGblEnv
tcGblEnv)
            [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> (FamInst -> Name) -> [FamInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FamInst -> Name
forall a. NamedThing a => a -> Name
CompatGHC.getName (TcGblEnv -> [FamInst]
CompatGHC.tcg_fam_insts TcGblEnv
tcGblEnv)
        )

    tcgExports :: [AvailInfo]
tcgExports = TcGblEnv -> [AvailInfo]
CompatGHC.tcg_exports TcGblEnv
tcGblEnv
    exportedNames :: [Name]
exportedNames = (AvailInfo -> [Name]) -> [AvailInfo] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
CompatGHC.availNames [AvailInfo]
tcgExports
    -- Warnings on declarations in this module
    decl_warnings :: WarningMap
decl_warnings = Warnings GhcRn -> GlobalRdrEnv -> [Name] -> WarningMap
forall a. Warnings a -> GlobalRdrEnv -> [Name] -> WarningMap
mkWarningMap (TcGblEnv -> Warnings GhcRn
CompatGHC.tcg_warns TcGblEnv
tcGblEnv) (TcGblEnv -> GlobalRdrEnv
CompatGHC.tcg_rdr_env TcGblEnv
tcGblEnv) [Name]
exportedNames

  -- The docs added via Template Haskell's putDoc
  ExtractedTHDocs
thDocs <-
    IO ExtractedTHDocs -> m ExtractedTHDocs
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ExtractedTHDocs -> m ExtractedTHDocs)
-> (TcRef THDocs -> IO ExtractedTHDocs)
-> TcRef THDocs
-> m ExtractedTHDocs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (THDocs -> ExtractedTHDocs) -> IO THDocs -> IO ExtractedTHDocs
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap THDocs -> ExtractedTHDocs
CompatGHC.extractTHDocs (IO THDocs -> IO ExtractedTHDocs)
-> (TcRef THDocs -> IO THDocs)
-> TcRef THDocs
-> IO ExtractedTHDocs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcRef THDocs -> IO THDocs
forall a. IORef a -> IO a
CompatGHC.readIORef (TcRef THDocs -> m ExtractedTHDocs)
-> TcRef THDocs -> m ExtractedTHDocs
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> TcRef THDocs
CompatGHC.tcg_th_docs TcGblEnv
tcGblEnv

  -- Process the top-level module header documentation.
  let mbHeaderStr :: Maybe HsDocString
mbHeaderStr =
        (WithHsDocIdentifiers HsDocString GhcRn -> HsDocString)
-> Maybe (WithHsDocIdentifiers HsDocString GhcRn)
-> Maybe HsDocString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers HsDocString GhcRn -> HsDocString
forall a pass. WithHsDocIdentifiers a pass -> a
CompatGHC.hsDocString (ExtractedTHDocs -> Maybe (WithHsDocIdentifiers HsDocString GhcRn)
CompatGHC.ethd_mod_header ExtractedTHDocs
thDocs)
          Maybe HsDocString -> Maybe HsDocString -> Maybe HsDocString
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> TcGblEnv -> Maybe HsDocString
CompatGHC.getHeaderInfo TcGblEnv
tcGblEnv

      decls :: [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
  [WithHsDocIdentifiers HsDocString GhcRn])]
decls = [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
  [WithHsDocIdentifiers HsDocString GhcRn])]
-> (HsGroup GhcRn
    -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
         [WithHsDocIdentifiers HsDocString GhcRn])])
-> Maybe (HsGroup GhcRn)
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
     [WithHsDocIdentifiers HsDocString GhcRn])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
  [WithHsDocIdentifiers HsDocString GhcRn])]
forall a. Monoid a => a
mempty HsGroup GhcRn
-> [(LHsDecl GhcRn, [WithHsDocIdentifiers HsDocString GhcRn])]
HsGroup GhcRn
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
     [WithHsDocIdentifiers HsDocString GhcRn])]
CompatGHC.topDecls (Maybe (HsGroup GhcRn)
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
      [WithHsDocIdentifiers HsDocString GhcRn])])
-> Maybe (HsGroup GhcRn)
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
     [WithHsDocIdentifiers HsDocString GhcRn])]
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> Maybe (HsGroup GhcRn)
CompatGHC.tcg_rn_decls TcGblEnv
tcGblEnv
      maps :: Maps
maps = [Name]
-> [(LHsDecl GhcRn, [WithHsDocIdentifiers HsDocString GhcRn])]
-> ExtractedTHDocs
-> Maps
mkMaps [Name]
localInstances [(LHsDecl GhcRn, [WithHsDocIdentifiers HsDocString GhcRn])]
[(GenLocated SrcSpanAnnA (HsDecl GhcRn),
  [WithHsDocIdentifiers HsDocString GhcRn])]
decls ExtractedTHDocs
thDocs

      exportItems :: [ExportItem]
exportItems =
        Module
-> WarningMap
-> [LHsDecl GhcRn]
-> Maps
-> Map ModuleName [ModuleName]
-> Maybe [(IE GhcRn, [AvailInfo])]
-> [AvailInfo]
-> [ExportItem]
mkExportItems
          (TcGblEnv -> Module
CompatGHC.tcg_semantic_mod TcGblEnv
tcGblEnv)
          WarningMap
decl_warnings
          (((GenLocated SrcSpanAnnA (HsDecl GhcRn),
  [WithHsDocIdentifiers HsDocString GhcRn])
 -> GenLocated SrcSpanAnnA (HsDecl GhcRn))
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
     [WithHsDocIdentifiers HsDocString GhcRn])]
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnA (HsDecl GhcRn),
 [WithHsDocIdentifiers HsDocString GhcRn])
-> GenLocated SrcSpanAnnA (HsDecl GhcRn)
forall a b. (a, b) -> a
fst [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
  [WithHsDocIdentifiers HsDocString GhcRn])]
decls)
          Maps
maps
          (TcGblEnv -> Map ModuleName [ModuleName]
importedModules TcGblEnv
tcGblEnv)
          (TcGblEnv -> Maybe [(IE GhcRn, [AvailInfo])]
fullExplicitExportList TcGblEnv
tcGblEnv)
          [AvailInfo]
tcgExports

  ModuleInfo -> m ModuleInfo
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleInfo -> m ModuleInfo) -> ModuleInfo -> m ModuleInfo
forall a b. (a -> b) -> a -> b
$ Maybe HsDocString -> [ExportItem] -> ModuleInfo
buildModuleInfo Maybe HsDocString
mbHeaderStr [ExportItem]
exportItems

-- Module imports of the form `import X`. Note that there is
-- a) no qualification and
-- b) no import list
importedModules :: CompatGHC.TcGblEnv -> Map.Map CompatGHC.ModuleName [CompatGHC.ModuleName]
importedModules :: TcGblEnv -> Map ModuleName [ModuleName]
importedModules TcGblEnv
tcGblEnv =
  -- If rn_exports aren't available then we know renamed source overall is not available and can
  -- short circuit here.
  case TcGblEnv -> Maybe [(IE GhcRn, [AvailInfo])]
fullExplicitExportList TcGblEnv
tcGblEnv of
    Just [(IE GhcRn, [AvailInfo])]
_ -> [ImportDecl GhcRn] -> Map ModuleName [ModuleName]
unrestrictedModuleImports ((GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> ImportDecl GhcRn)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcRn)]
-> [ImportDecl GhcRn]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> ImportDecl GhcRn
forall l e. GenLocated l e -> e
CompatGHC.unLoc (TcGblEnv -> [LImportDecl GhcRn]
CompatGHC.tcg_rn_imports TcGblEnv
tcGblEnv))
    Maybe [(IE GhcRn, [AvailInfo])]
Nothing -> Map ModuleName [ModuleName]
forall k a. Map k a
Map.empty

-- All elements of an explicit export list, if present
fullExplicitExportList ::
  CompatGHC.TcGblEnv -> Maybe [(CompatGHC.IE CompatGHC.GhcRn, CompatGHC.Avails)]
fullExplicitExportList :: TcGblEnv -> Maybe [(IE GhcRn, [AvailInfo])]
fullExplicitExportList =
  (([(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
 -> [(IE GhcRn, [AvailInfo])])
-> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
-> Maybe [(IE GhcRn, [AvailInfo])]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
  -> [(IE GhcRn, [AvailInfo])])
 -> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
 -> Maybe [(IE GhcRn, [AvailInfo])])
-> (((GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])
     -> (IE GhcRn, [AvailInfo]))
    -> [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
    -> [(IE GhcRn, [AvailInfo])])
-> ((GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])
    -> (IE GhcRn, [AvailInfo]))
-> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
-> Maybe [(IE GhcRn, [AvailInfo])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])
 -> (IE GhcRn, [AvailInfo]))
-> [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
-> [(IE GhcRn, [AvailInfo])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])
-> (IE GhcRn, [AvailInfo])
forall (bf :: * -> * -> *) l b c.
Bifunctor bf =>
bf (GenLocated l b) c -> bf b c
unLocFirst (Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
 -> Maybe [(IE GhcRn, [AvailInfo])])
-> (TcGblEnv
    -> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])])
-> TcGblEnv
-> Maybe [(IE GhcRn, [AvailInfo])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcGblEnv -> Maybe [(LIE GhcRn, [AvailInfo])]
TcGblEnv
-> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
CompatGHC.tcg_rn_exports

-- 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 ::
  [CompatGHC.ImportDecl CompatGHC.GhcRn] -> Map.Map CompatGHC.ModuleName [CompatGHC.ModuleName]
unrestrictedModuleImports :: [ImportDecl GhcRn] -> Map ModuleName [ModuleName]
unrestrictedModuleImports [ImportDecl GhcRn]
idecls =
  ([ImportDecl GhcRn] -> [ModuleName])
-> Map ModuleName [ImportDecl GhcRn] -> Map ModuleName [ModuleName]
forall a b. (a -> b) -> Map ModuleName a -> Map ModuleName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ImportDecl GhcRn -> ModuleName)
-> [ImportDecl GhcRn] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
CompatGHC.unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> (ImportDecl GhcRn -> GenLocated SrcSpanAnnA ModuleName)
-> ImportDecl GhcRn
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcRn -> XRec GhcRn ModuleName
ImportDecl GhcRn -> GenLocated SrcSpanAnnA ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
CompatGHC.ideclName)) (Map ModuleName [ImportDecl GhcRn] -> Map ModuleName [ModuleName])
-> Map ModuleName [ImportDecl GhcRn] -> Map ModuleName [ModuleName]
forall a b. (a -> b) -> a -> b
$
    ([ImportDecl GhcRn] -> Bool)
-> Map ModuleName [ImportDecl GhcRn]
-> Map ModuleName [ImportDecl GhcRn]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((ImportDecl GhcRn -> Bool) -> [ImportDecl GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ImportDecl GhcRn -> Bool
isInteresting) Map ModuleName [ImportDecl GhcRn]
impModMap
 where
  impModMap :: Map ModuleName [ImportDecl GhcRn]
impModMap =
    ([ImportDecl GhcRn] -> [ImportDecl GhcRn] -> [ImportDecl GhcRn])
-> [(ModuleName, [ImportDecl GhcRn])]
-> Map ModuleName [ImportDecl GhcRn]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [ImportDecl GhcRn] -> [ImportDecl GhcRn] -> [ImportDecl GhcRn]
forall a. Semigroup a => a -> a -> a
(<>) ((ImportDecl GhcRn -> [(ModuleName, [ImportDecl GhcRn])])
-> [ImportDecl GhcRn] -> [(ModuleName, [ImportDecl GhcRn])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ImportDecl GhcRn -> [(ModuleName, [ImportDecl GhcRn])]
moduleMapping [ImportDecl GhcRn]
idecls)

  moduleMapping ::
    CompatGHC.ImportDecl CompatGHC.GhcRn
    -> [(CompatGHC.ModuleName, [CompatGHC.ImportDecl CompatGHC.GhcRn])]
  moduleMapping :: ImportDecl GhcRn -> [(ModuleName, [ImportDecl GhcRn])]
moduleMapping ImportDecl GhcRn
idecl =
    (ModuleName, [ImportDecl GhcRn])
-> [(ModuleName, [ImportDecl GhcRn])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
CompatGHC.unLoc (ImportDecl GhcRn -> XRec GhcRn ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
CompatGHC.ideclName ImportDecl GhcRn
idecl), ImportDecl GhcRn -> [ImportDecl GhcRn]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportDecl GhcRn
idecl)
      [(ModuleName, [ImportDecl GhcRn])]
-> [(ModuleName, [ImportDecl GhcRn])]
-> [(ModuleName, [ImportDecl GhcRn])]
forall a. Semigroup a => a -> a -> a
<> [(ModuleName, [ImportDecl GhcRn])]
-> (GenLocated SrcSpanAnnA ModuleName
    -> [(ModuleName, [ImportDecl GhcRn])])
-> Maybe (GenLocated SrcSpanAnnA ModuleName)
-> [(ModuleName, [ImportDecl GhcRn])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(ModuleName, [ImportDecl GhcRn])]
forall a. Monoid a => a
mempty (\GenLocated SrcSpanAnnA ModuleName
modName -> (ModuleName, [ImportDecl GhcRn])
-> [(ModuleName, [ImportDecl GhcRn])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
CompatGHC.unLoc GenLocated SrcSpanAnnA ModuleName
modName, ImportDecl GhcRn -> [ImportDecl GhcRn]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportDecl GhcRn
idecl)) (ImportDecl GhcRn -> Maybe (XRec GhcRn ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
CompatGHC.ideclAs ImportDecl GhcRn
idecl)

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

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

mkWarningMap ::
  forall a.
  CompatGHC.Warnings a
  -> CompatGHC.GlobalRdrEnv
  -> [CompatGHC.Name]
  -> WarningMap
mkWarningMap :: forall a. Warnings a -> GlobalRdrEnv -> [Name] -> WarningMap
mkWarningMap Warnings a
warnings GlobalRdrEnv
gre =
  [(Name, Doc)] -> WarningMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, Doc)] -> WarningMap)
-> ([Name] -> [(Name, Doc)]) -> [Name] -> WarningMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Name, WarningTxt a) -> (Name, Doc))
-> [(Name, WarningTxt a)] -> [(Name, Doc)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Name, WarningTxt a) -> (Name, Doc))
 -> [(Name, WarningTxt a)] -> [(Name, Doc)])
-> ((WarningTxt a -> Doc) -> (Name, WarningTxt a) -> (Name, Doc))
-> (WarningTxt a -> Doc)
-> [(Name, WarningTxt a)]
-> [(Name, Doc)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WarningTxt a -> Doc) -> (Name, WarningTxt a) -> (Name, Doc)
forall a b. (a -> b) -> (Name, a) -> (Name, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) WarningTxt a -> Doc
forall a. WarningTxt a -> Doc
parseWarning ([(Name, WarningTxt a)] -> [(Name, Doc)])
-> ([Name] -> [(Name, WarningTxt a)]) -> [Name] -> [(Name, Doc)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Warnings a -> GlobalRdrEnv -> [Name] -> [(Name, WarningTxt a)]
forall pass.
Warnings pass
-> GlobalRdrEnv -> [Name] -> [(Name, WarningTxt pass)]
CompatGHC.processWarnSome Warnings a
warnings GlobalRdrEnv
gre

parseWarning :: CompatGHC.WarningTxt a -> Documentation.Doc
parseWarning :: forall a. WarningTxt a -> Doc
parseWarning WarningTxt a
w =
  let
    format :: String -> String -> Documentation.Doc
    format :: String -> String -> Doc
format String
x =
      Doc -> Doc
Documentation.DocWarning
        (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
Documentation.DocParagraph
        (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc
Documentation.DocAppend (String -> Doc
Documentation.DocString String
x)
        (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
Documentation.parseText
        (Text -> Doc) -> (String -> Text) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

    formatDeprecated ::
      [ CompatGHC.GenLocated
          l
          (CompatGHC.WithHsDocIdentifiers CompatGHC.StringLiteral pass)
      ]
      -> Documentation.Doc
    formatDeprecated :: forall l pass.
[GenLocated l (WithHsDocIdentifiers StringLiteral pass)] -> Doc
formatDeprecated =
      String -> String -> Doc
format String
"Deprecated: " (String -> Doc)
-> ([GenLocated l (WithHsDocIdentifiers StringLiteral pass)]
    -> String)
-> [GenLocated l (WithHsDocIdentifiers StringLiteral pass)]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated l (WithHsDocIdentifiers StringLiteral pass) -> String)
-> [GenLocated l (WithHsDocIdentifiers StringLiteral pass)]
-> String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (StringLiteral -> String
CompatGHC.stringLiteralToString (StringLiteral -> String)
-> (GenLocated l (WithHsDocIdentifiers StringLiteral pass)
    -> StringLiteral)
-> GenLocated l (WithHsDocIdentifiers StringLiteral pass)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHsDocIdentifiers StringLiteral pass -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
CompatGHC.hsDocString (WithHsDocIdentifiers StringLiteral pass -> StringLiteral)
-> (GenLocated l (WithHsDocIdentifiers StringLiteral pass)
    -> WithHsDocIdentifiers StringLiteral pass)
-> GenLocated l (WithHsDocIdentifiers StringLiteral pass)
-> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (WithHsDocIdentifiers StringLiteral pass)
-> WithHsDocIdentifiers StringLiteral pass
forall l e. GenLocated l e -> e
CompatGHC.unLoc)

    formatWarning ::
      [ CompatGHC.GenLocated
          l
          (CompatGHC.WithHsDocIdentifiers CompatGHC.StringLiteral pass)
      ]
      -> Documentation.Doc
    formatWarning :: forall l pass.
[GenLocated l (WithHsDocIdentifiers StringLiteral pass)] -> Doc
formatWarning =
      String -> String -> Doc
format String
"Warning: " (String -> Doc)
-> ([GenLocated l (WithHsDocIdentifiers StringLiteral pass)]
    -> String)
-> [GenLocated l (WithHsDocIdentifiers StringLiteral pass)]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated l (WithHsDocIdentifiers StringLiteral pass) -> String)
-> [GenLocated l (WithHsDocIdentifiers StringLiteral pass)]
-> String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (StringLiteral -> String
CompatGHC.stringLiteralToString (StringLiteral -> String)
-> (GenLocated l (WithHsDocIdentifiers StringLiteral pass)
    -> StringLiteral)
-> GenLocated l (WithHsDocIdentifiers StringLiteral pass)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHsDocIdentifiers StringLiteral pass -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
CompatGHC.hsDocString (WithHsDocIdentifiers StringLiteral pass -> StringLiteral)
-> (GenLocated l (WithHsDocIdentifiers StringLiteral pass)
    -> WithHsDocIdentifiers StringLiteral pass)
-> GenLocated l (WithHsDocIdentifiers StringLiteral pass)
-> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (WithHsDocIdentifiers StringLiteral pass)
-> WithHsDocIdentifiers StringLiteral pass
forall l e. GenLocated l e -> e
CompatGHC.unLoc)
   in
    ([Located (WithHsDocIdentifiers StringLiteral a)] -> Doc)
-> ([Located (WithHsDocIdentifiers StringLiteral a)] -> Doc)
-> WarningTxt a
-> Doc
forall pass t.
([Located (WithHsDocIdentifiers StringLiteral pass)] -> t)
-> ([Located (WithHsDocIdentifiers StringLiteral pass)] -> t)
-> WarningTxt pass
-> t
CompatGHC.mapWarningTxtMsg [Located (WithHsDocIdentifiers StringLiteral a)] -> Doc
forall l pass.
[GenLocated l (WithHsDocIdentifiers StringLiteral pass)] -> Doc
formatDeprecated [Located (WithHsDocIdentifiers StringLiteral a)] -> Doc
forall l pass.
[GenLocated l (WithHsDocIdentifiers StringLiteral pass)] -> Doc
formatWarning WarningTxt a
w

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

type Maps =
  ( DocMap
  , ArgMap
  , Map.Map
      CompatGHC.Name
      [CompatGHC.HsDecl CompatGHC.GhcRn]
  )

type DocMap = Map.Map CompatGHC.Name Documentation.MetaAndDoc
type ArgMap = Map.Map CompatGHC.Name Documentation.FnArgsDoc
type WarningMap = Map.Map CompatGHC.Name Documentation.Doc

{- | Create 'Maps' by looping through the declarations. For each declaration,
find its names, its subordinates, and its doc strings. Process doc strings
into 'Documentation.Doc's.
-}
mkMaps ::
  [CompatGHC.Name]
  -> [(CompatGHC.LHsDecl CompatGHC.GhcRn, [CompatGHC.HsDoc CompatGHC.GhcRn])]
  -> CompatGHC.ExtractedTHDocs
  -- ^ Template Haskell putDoc docs
  -> Maps
mkMaps :: [Name]
-> [(LHsDecl GhcRn, [WithHsDocIdentifiers HsDocString GhcRn])]
-> ExtractedTHDocs
-> Maps
mkMaps
  [Name]
instances
  [(LHsDecl GhcRn, [WithHsDocIdentifiers HsDocString GhcRn])]
hsdecls
  (CompatGHC.ExtractedTHDocs Maybe (WithHsDocIdentifiers HsDocString GhcRn)
_ UniqMap Name (WithHsDocIdentifiers HsDocString GhcRn)
declDocs UniqMap Name (IntMap (WithHsDocIdentifiers HsDocString GhcRn))
argDocs UniqMap Name (WithHsDocIdentifiers HsDocString GhcRn)
instDocs) =
    let
      thProcessedArgDocs :: Map Name (IntMap MetaAndDoc)
thProcessedArgDocs = (IntMap (WithHsDocIdentifiers HsDocString GhcRn)
 -> IntMap MetaAndDoc)
-> Map Name (IntMap (WithHsDocIdentifiers HsDocString GhcRn))
-> Map Name (IntMap MetaAndDoc)
forall a b. (a -> b) -> Map Name a -> Map Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc)
-> IntMap (WithHsDocIdentifiers HsDocString GhcRn)
-> IntMap MetaAndDoc
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc
mkMetaAndDoc) (UniqMap Name (IntMap (WithHsDocIdentifiers HsDocString GhcRn))
-> Map Name (IntMap (WithHsDocIdentifiers HsDocString GhcRn))
forall k a. Ord k => UniqMap k a -> Map k a
CompatGHC.nonDetEltUniqMapToMap UniqMap Name (IntMap (WithHsDocIdentifiers HsDocString GhcRn))
argDocs)
      thProcessedDeclDocs :: Map Name MetaAndDoc
thProcessedDeclDocs = (WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc)
-> Map Name (WithHsDocIdentifiers HsDocString GhcRn)
-> Map Name MetaAndDoc
forall a b. (a -> b) -> Map Name a -> Map Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc
mkMetaAndDoc (UniqMap Name (WithHsDocIdentifiers HsDocString GhcRn)
-> Map Name (WithHsDocIdentifiers HsDocString GhcRn)
forall k a. Ord k => UniqMap k a -> Map k a
CompatGHC.nonDetEltUniqMapToMap UniqMap Name (WithHsDocIdentifiers HsDocString GhcRn)
declDocs)
      thProcessedInstDocs :: Map Name MetaAndDoc
thProcessedInstDocs = (WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc)
-> Map Name (WithHsDocIdentifiers HsDocString GhcRn)
-> Map Name MetaAndDoc
forall a b. (a -> b) -> Map Name a -> Map Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc
mkMetaAndDoc (UniqMap Name (WithHsDocIdentifiers HsDocString GhcRn)
-> Map Name (WithHsDocIdentifiers HsDocString GhcRn)
forall k a. Ord k => UniqMap k a -> Map k a
CompatGHC.nonDetEltUniqMapToMap UniqMap Name (WithHsDocIdentifiers HsDocString GhcRn)
instDocs)
      thDeclAndInstDocs :: Map Name MetaAndDoc
thDeclAndInstDocs = Map Name MetaAndDoc
thProcessedDeclDocs Map Name MetaAndDoc -> Map Name MetaAndDoc -> Map Name MetaAndDoc
forall a. Semigroup a => a -> a -> a
<> Map Name MetaAndDoc
thProcessedInstDocs
      ([[(Name, MetaAndDoc)]]
declDocLists, [[(Name, IntMap MetaAndDoc)]]
declArgLists, [[(Name, [HsDecl GhcRn])]]
declLists) = [([(Name, MetaAndDoc)], [(Name, IntMap MetaAndDoc)],
  [(Name, [HsDecl GhcRn])])]
-> ([[(Name, MetaAndDoc)]], [[(Name, IntMap MetaAndDoc)]],
    [[(Name, [HsDecl GhcRn])]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([([(Name, MetaAndDoc)], [(Name, IntMap MetaAndDoc)],
   [(Name, [HsDecl GhcRn])])]
 -> ([[(Name, MetaAndDoc)]], [[(Name, IntMap MetaAndDoc)]],
     [[(Name, [HsDecl GhcRn])]]))
-> [([(Name, MetaAndDoc)], [(Name, IntMap MetaAndDoc)],
     [(Name, [HsDecl GhcRn])])]
-> ([[(Name, MetaAndDoc)]], [[(Name, IntMap MetaAndDoc)]],
    [[(Name, [HsDecl GhcRn])]])
forall a b. (a -> b) -> a -> b
$ ((GenLocated SrcSpanAnnA (HsDecl GhcRn),
  [WithHsDocIdentifiers HsDocString GhcRn])
 -> ([(Name, MetaAndDoc)], [(Name, IntMap MetaAndDoc)],
     [(Name, [HsDecl GhcRn])]))
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn),
     [WithHsDocIdentifiers HsDocString GhcRn])]
-> [([(Name, MetaAndDoc)], [(Name, IntMap MetaAndDoc)],
     [(Name, [HsDecl GhcRn])])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Name]
-> (LHsDecl GhcRn, [WithHsDocIdentifiers HsDocString GhcRn])
-> ([(Name, MetaAndDoc)], [(Name, IntMap MetaAndDoc)],
    [(Name, [HsDecl GhcRn])])
nonTHMappings [Name]
instances) [(LHsDecl GhcRn, [WithHsDocIdentifiers HsDocString GhcRn])]
[(GenLocated SrcSpanAnnA (HsDecl GhcRn),
  [WithHsDocIdentifiers HsDocString GhcRn])]
hsdecls
     in
      ( Map Name MetaAndDoc -> Map Name MetaAndDoc -> Map Name MetaAndDoc
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Name MetaAndDoc
thDeclAndInstDocs (Map Name MetaAndDoc -> Map Name MetaAndDoc)
-> Map Name MetaAndDoc -> Map Name MetaAndDoc
forall a b. (a -> b) -> a -> b
$ [[(Name, MetaAndDoc)]] -> Map Name MetaAndDoc
forall (t :: * -> *).
Foldable t =>
t [(Name, MetaAndDoc)] -> Map Name MetaAndDoc
buildDocMap [[(Name, MetaAndDoc)]]
declDocLists
      , Map Name (IntMap MetaAndDoc)
-> Map Name (IntMap MetaAndDoc) -> Map Name (IntMap MetaAndDoc)
forall b.
Map Name (IntMap b) -> Map Name (IntMap b) -> Map Name (IntMap b)
unionArgMaps Map Name (IntMap MetaAndDoc)
thProcessedArgDocs (Map Name (IntMap MetaAndDoc) -> Map Name (IntMap MetaAndDoc))
-> Map Name (IntMap MetaAndDoc) -> Map Name (IntMap MetaAndDoc)
forall a b. (a -> b) -> a -> b
$ (IntMap MetaAndDoc -> Bool)
-> [[(Name, IntMap MetaAndDoc)]] -> Map Name (IntMap MetaAndDoc)
forall b. Semigroup b => (b -> Bool) -> [[(Name, b)]] -> Map Name b
buildMapWithNotNullValues IntMap MetaAndDoc -> Bool
forall a. IntMap a -> Bool
IM.null [[(Name, IntMap MetaAndDoc)]]
declArgLists
      , ([HsDecl GhcRn] -> Bool)
-> [[(Name, [HsDecl GhcRn])]] -> Map Name [HsDecl GhcRn]
forall b. Semigroup b => (b -> Bool) -> [[(Name, b)]] -> Map Name b
buildMapWithNotNullValues [HsDecl GhcRn] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(Name, [HsDecl GhcRn])]]
declLists
      )

nonTHMappings ::
  [CompatGHC.Name]
  -> (CompatGHC.LHsDecl CompatGHC.GhcRn, [CompatGHC.HsDoc CompatGHC.GhcRn])
  -> ( [(CompatGHC.Name, Documentation.MetaAndDoc)]
     , [(CompatGHC.Name, IM.IntMap Documentation.MetaAndDoc)]
     , [(CompatGHC.Name, [CompatGHC.HsDecl CompatGHC.GhcRn])]
     )
nonTHMappings :: [Name]
-> (LHsDecl GhcRn, [WithHsDocIdentifiers HsDocString GhcRn])
-> ([(Name, MetaAndDoc)], [(Name, IntMap MetaAndDoc)],
    [(Name, [HsDecl GhcRn])])
nonTHMappings [Name]
instances (CompatGHC.L SrcSpanAnnA
_ HsDecl GhcRn
decl, [WithHsDocIdentifiers HsDocString GhcRn]
hs_docStrs) =
  let args :: IM.IntMap Documentation.MetaAndDoc
      args :: IntMap MetaAndDoc
args =
        (WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc)
-> IntMap (WithHsDocIdentifiers HsDocString GhcRn)
-> IntMap MetaAndDoc
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc
mkMetaAndDoc (HsDecl GhcRn -> IntMap (WithHsDocIdentifiers HsDocString GhcRn)
CompatGHC.declTypeDocs HsDecl GhcRn
decl)

      instanceMap :: Map.Map CompatGHC.RealSrcSpan CompatGHC.Name
      instanceMap :: Map RealSrcSpan Name
instanceMap =
        [(RealSrcSpan, Name)] -> Map RealSrcSpan Name
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RealSrcSpan, Name)] -> Map RealSrcSpan Name)
-> [(RealSrcSpan, Name)] -> Map RealSrcSpan Name
forall a b. (a -> b) -> a -> b
$ (Name -> [(RealSrcSpan, Name)] -> [(RealSrcSpan, Name)])
-> [(RealSrcSpan, Name)] -> [Name] -> [(RealSrcSpan, Name)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Name -> [(RealSrcSpan, Name)] -> [(RealSrcSpan, Name)]
instanceFoldFn [(RealSrcSpan, Name)]
forall a. Monoid a => a
mempty [Name]
instances

      ([Name]
subNs, [Maybe (Name, MetaAndDoc)]
subDocs, [(Name, IntMap MetaAndDoc)]
subArgs) =
        [(Name, Maybe (Name, MetaAndDoc), (Name, IntMap MetaAndDoc))]
-> ([Name], [Maybe (Name, MetaAndDoc)],
    [(Name, IntMap MetaAndDoc)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Name, Maybe (Name, MetaAndDoc), (Name, IntMap MetaAndDoc))]
 -> ([Name], [Maybe (Name, MetaAndDoc)],
     [(Name, IntMap MetaAndDoc)]))
-> ([(Name, [WithHsDocIdentifiers HsDocString GhcRn],
      IntMap (WithHsDocIdentifiers HsDocString GhcRn))]
    -> [(Name, Maybe (Name, MetaAndDoc), (Name, IntMap MetaAndDoc))])
-> [(Name, [WithHsDocIdentifiers HsDocString GhcRn],
     IntMap (WithHsDocIdentifiers HsDocString GhcRn))]
-> ([Name], [Maybe (Name, MetaAndDoc)],
    [(Name, IntMap MetaAndDoc)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, [WithHsDocIdentifiers HsDocString GhcRn],
  IntMap (WithHsDocIdentifiers HsDocString GhcRn))
 -> (Name, Maybe (Name, MetaAndDoc), (Name, IntMap MetaAndDoc)))
-> [(Name, [WithHsDocIdentifiers HsDocString GhcRn],
     IntMap (WithHsDocIdentifiers HsDocString GhcRn))]
-> [(Name, Maybe (Name, MetaAndDoc), (Name, IntMap MetaAndDoc))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, [WithHsDocIdentifiers HsDocString GhcRn],
 IntMap (WithHsDocIdentifiers HsDocString GhcRn))
-> (Name, Maybe (Name, MetaAndDoc), (Name, IntMap MetaAndDoc))
forall a.
(a, [WithHsDocIdentifiers HsDocString GhcRn],
 IntMap (WithHsDocIdentifiers HsDocString GhcRn))
-> (a, Maybe (a, MetaAndDoc), (a, IntMap MetaAndDoc))
processSubordinates ([(Name, [WithHsDocIdentifiers HsDocString GhcRn],
   IntMap (WithHsDocIdentifiers HsDocString GhcRn))]
 -> ([Name], [Maybe (Name, MetaAndDoc)],
     [(Name, IntMap MetaAndDoc)]))
-> [(Name, [WithHsDocIdentifiers HsDocString GhcRn],
     IntMap (WithHsDocIdentifiers HsDocString GhcRn))]
-> ([Name], [Maybe (Name, MetaAndDoc)],
    [(Name, IntMap MetaAndDoc)])
forall a b. (a -> b) -> a -> b
$
          OccEnv Name
-> Map RealSrcSpan Name
-> HsDecl GhcRn
-> [(Name, [WithHsDocIdentifiers HsDocString GhcRn],
     IntMap (WithHsDocIdentifiers HsDocString GhcRn))]
CompatGHC.subordinates OccEnv Name
forall a. OccEnv a
CompatGHC.emptyOccEnv Map RealSrcSpan Name
instanceMap HsDecl GhcRn
decl

      names :: [Name]
names = HsDecl GhcRn -> Map RealSrcSpan Name -> [Name]
getAssociatedNames HsDecl GhcRn
decl Map RealSrcSpan Name
instanceMap

      docMapping :: [(Name, MetaAndDoc)]
docMapping =
        [Maybe (Name, MetaAndDoc)] -> [(Name, MetaAndDoc)]
forall a. [Maybe a] -> [a]
Maybe.catMaybes [Maybe (Name, MetaAndDoc)]
subDocs
          [(Name, MetaAndDoc)]
-> [(Name, MetaAndDoc)] -> [(Name, MetaAndDoc)]
forall a. Semigroup a => a -> a -> a
<> case [WithHsDocIdentifiers HsDocString GhcRn] -> Maybe MetaAndDoc
processDocStrings [WithHsDocIdentifiers HsDocString GhcRn]
hs_docStrs of
            Just MetaAndDoc
doc ->
              (Name -> (Name, MetaAndDoc)) -> [Name] -> [(Name, MetaAndDoc)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Name
x -> (Name
x, MetaAndDoc
doc)) [Name]
names
            Maybe MetaAndDoc
Nothing ->
              [(Name, MetaAndDoc)]
forall a. Monoid a => a
mempty
      argMapping :: [(Name, IntMap MetaAndDoc)]
argMapping = (Name -> (Name, IntMap MetaAndDoc))
-> [Name] -> [(Name, IntMap MetaAndDoc)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Name
x -> (Name
x, IntMap MetaAndDoc
args)) [Name]
names [(Name, IntMap MetaAndDoc)]
-> [(Name, IntMap MetaAndDoc)] -> [(Name, IntMap MetaAndDoc)]
forall a. Semigroup a => a -> a -> a
<> [(Name, IntMap MetaAndDoc)]
subArgs

      declMapping :: [(CompatGHC.Name, [CompatGHC.HsDecl CompatGHC.GhcRn])]
      declMapping :: [(Name, [HsDecl GhcRn])]
declMapping = (Name -> (Name, [HsDecl GhcRn]))
-> [Name] -> [(Name, [HsDecl GhcRn])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Name
x -> (Name
x, HsDecl GhcRn -> [HsDecl GhcRn]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsDecl GhcRn
decl)) ([Name] -> [(Name, [HsDecl GhcRn])])
-> [Name] -> [(Name, [HsDecl GhcRn])]
forall a b. (a -> b) -> a -> b
$ [Name]
names [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> [Name]
subNs
   in ([(Name, MetaAndDoc)]
docMapping, [(Name, IntMap MetaAndDoc)]
argMapping, [(Name, [HsDecl GhcRn])]
declMapping)

processSubordinates ::
  (a, [CompatGHC.HsDoc CompatGHC.GhcRn], IM.IntMap (CompatGHC.HsDoc CompatGHC.GhcRn))
  -> (a, Maybe (a, Documentation.MetaAndDoc), (a, IM.IntMap Documentation.MetaAndDoc))
processSubordinates :: forall a.
(a, [WithHsDocIdentifiers HsDocString GhcRn],
 IntMap (WithHsDocIdentifiers HsDocString GhcRn))
-> (a, Maybe (a, MetaAndDoc), (a, IntMap MetaAndDoc))
processSubordinates (a
name, [WithHsDocIdentifiers HsDocString GhcRn]
docStrs', IntMap (WithHsDocIdentifiers HsDocString GhcRn)
docStrMap) =
  (a
name, (a, Maybe MetaAndDoc) -> Maybe (a, MetaAndDoc)
forall a b. (a, Maybe b) -> Maybe (a, b)
maybeSnd (a
name, [WithHsDocIdentifiers HsDocString GhcRn] -> Maybe MetaAndDoc
processDocStrings [WithHsDocIdentifiers HsDocString GhcRn]
docStrs'), (a
name, (WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc)
-> IntMap (WithHsDocIdentifiers HsDocString GhcRn)
-> IntMap MetaAndDoc
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc
mkMetaAndDoc IntMap (WithHsDocIdentifiers HsDocString GhcRn)
docStrMap))

instanceFoldFn ::
  CompatGHC.Name
  -> [(CompatGHC.RealSrcSpan, CompatGHC.Name)]
  -> [(CompatGHC.RealSrcSpan, CompatGHC.Name)]
instanceFoldFn :: Name -> [(RealSrcSpan, Name)] -> [(RealSrcSpan, Name)]
instanceFoldFn Name
n [(RealSrcSpan, Name)]
accum =
  case Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
CompatGHC.getSrcSpan Name
n of
    CompatGHC.RealSrcSpan RealSrcSpan
l Maybe BufSpan
_ ->
      (RealSrcSpan
l, Name
n) (RealSrcSpan, Name)
-> [(RealSrcSpan, Name)] -> [(RealSrcSpan, Name)]
forall a. a -> [a] -> [a]
: [(RealSrcSpan, Name)]
accum
    SrcSpan
_ -> [(RealSrcSpan, Name)]
accum

getAssociatedNames ::
  CompatGHC.HsDecl CompatGHC.GhcRn
  -> Map.Map CompatGHC.RealSrcSpan CompatGHC.Name
  -> [CompatGHC.Name]
getAssociatedNames :: HsDecl GhcRn -> Map RealSrcSpan Name -> [Name]
getAssociatedNames (CompatGHC.InstD XInstD GhcRn
_ InstDecl GhcRn
d) Map RealSrcSpan Name
instanceMap =
  let
    loc :: SrcSpan
loc =
      case InstDecl GhcRn
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.
        CompatGHC.TyFamInstD XTyFamInstD GhcRn
_ (CompatGHC.TyFamInstDecl XCTyFamInstDecl GhcRn
_ TyFamInstEqn GhcRn
d') -> GenLocated SrcSpanAnnN Name -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
CompatGHC.getLocA (FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)) -> LIdP GhcRn
forall pass rhs. FamEqn pass rhs -> LIdP pass
CompatGHC.feqn_tycon TyFamInstEqn GhcRn
FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
d')
        InstDecl GhcRn
_ -> InstDecl GhcRn -> SrcSpan
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
InstDecl (GhcPass p) -> SrcSpan
CompatGHC.getInstLoc InstDecl GhcRn
d
   in
    Maybe Name -> [Name]
forall a. Maybe a -> [a]
Maybe.maybeToList (SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
CompatGHC.lookupSrcSpan SrcSpan
loc Map RealSrcSpan Name
instanceMap) -- See note [2].
getAssociatedNames HsDecl GhcRn
decl Map RealSrcSpan Name
_ =
  OccEnv Name -> HsDecl GhcRn -> [Name]
CompatGHC.getMainDeclBinder OccEnv Name
forall a. OccEnv a
CompatGHC.emptyOccEnv HsDecl GhcRn
decl

{- | Unions together two 'ArgDocMaps' (or ArgMaps in haddock-api), such that two
maps with values for the same key merge the inner map as well.
Left biased so @unionArgMaps a b@ prefers @a@ over @b@.
-}
unionArgMaps ::
  forall b.
  Map.Map CompatGHC.Name (IM.IntMap b)
  -> Map.Map CompatGHC.Name (IM.IntMap b)
  -> Map.Map CompatGHC.Name (IM.IntMap b)
unionArgMaps :: forall b.
Map Name (IntMap b) -> Map Name (IntMap b) -> Map Name (IntMap b)
unionArgMaps Map Name (IntMap b)
a Map Name (IntMap b)
b = (Name -> IntMap b -> Map Name (IntMap b) -> Map Name (IntMap b))
-> Map Name (IntMap b)
-> Map Name (IntMap b)
-> Map Name (IntMap b)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Name -> IntMap b -> Map Name (IntMap b) -> Map Name (IntMap b)
go Map Name (IntMap b)
b Map Name (IntMap b)
a
 where
  go ::
    CompatGHC.Name
    -> IM.IntMap b
    -> Map.Map CompatGHC.Name (IM.IntMap b)
    -> Map.Map CompatGHC.Name (IM.IntMap b)
  go :: Name -> IntMap b -> Map Name (IntMap b) -> Map Name (IntMap b)
go Name
n IntMap b
newArgMap Map Name (IntMap b)
acc =
    case Name -> Map Name (IntMap b) -> Maybe (IntMap b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name (IntMap b)
acc of
      Just IntMap b
oldArgMap ->
        Name -> IntMap b -> Map Name (IntMap b) -> Map Name (IntMap b)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n (IntMap b
newArgMap IntMap b -> IntMap b -> IntMap b
forall a. IntMap a -> IntMap a -> IntMap a
`IM.union` IntMap b
oldArgMap) Map Name (IntMap b)
acc
      Maybe (IntMap b)
Nothing -> Name -> IntMap b -> Map Name (IntMap b) -> Map Name (IntMap b)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n IntMap b
newArgMap Map Name (IntMap b)
acc

-- 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).

buildDocMap ::
  (Foldable t) =>
  t [(CompatGHC.Name, Documentation.MetaAndDoc)]
  -> Map.Map CompatGHC.Name Documentation.MetaAndDoc
buildDocMap :: forall (t :: * -> *).
Foldable t =>
t [(Name, MetaAndDoc)] -> Map Name MetaAndDoc
buildDocMap =
  (MetaAndDoc -> MetaAndDoc -> MetaAndDoc)
-> ([(Name, MetaAndDoc)] -> [(Name, MetaAndDoc)])
-> t [(Name, MetaAndDoc)]
-> Map Name MetaAndDoc
forall k (t :: * -> *) a b.
(Ord k, Foldable t) =>
(a -> a -> a) -> (b -> [(k, a)]) -> t b -> Map k a
fromListWithAndFilter MetaAndDoc -> MetaAndDoc -> MetaAndDoc
Documentation.metaAndDocAppend (((Name, MetaAndDoc) -> Name)
-> [(Name, MetaAndDoc)] -> [(Name, MetaAndDoc)]
forall a. (a -> Name) -> [a] -> [a]
CompatGHC.nubByName (Name, MetaAndDoc) -> Name
forall a b. (a, b) -> a
fst)

fromListWithAndFilter ::
  (Ord k, Foldable t) =>
  (a -> a -> a)
  -> (b -> [(k, a)])
  -> t b
  -> Map.Map k a
fromListWithAndFilter :: forall k (t :: * -> *) a b.
(Ord k, Foldable t) =>
(a -> a -> a) -> (b -> [(k, a)]) -> t b -> Map k a
fromListWithAndFilter a -> a -> a
appendFn b -> [(k, a)]
filterFn =
  (a -> a -> a) -> [(k, a)] -> Map k a
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith a -> a -> a
appendFn ([(k, a)] -> Map k a) -> (t b -> [(k, a)]) -> t b -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> [(k, a)]) -> t b -> [(k, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap b -> [(k, a)]
filterFn

buildMapWithNotNullValues ::
  (Semigroup b) =>
  (b -> Bool)
  -> [[(CompatGHC.Name, b)]]
  -> Map.Map CompatGHC.Name b
buildMapWithNotNullValues :: forall b. Semigroup b => (b -> Bool) -> [[(Name, b)]] -> Map Name b
buildMapWithNotNullValues b -> Bool
nullFn =
  (b -> b -> b)
-> ([(Name, b)] -> [(Name, b)]) -> [[(Name, b)]] -> Map Name b
forall k (t :: * -> *) a b.
(Ord k, Foldable t) =>
(a -> a -> a) -> (b -> [(k, a)]) -> t b -> Map k a
fromListWithAndFilter b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>) (((Name, b) -> Bool) -> [(Name, b)] -> [(Name, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Name, b) -> Bool) -> (Name, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Bool
nullFn (b -> Bool) -> ((Name, b) -> b) -> (Name, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, b) -> b
forall a b. (a, b) -> b
snd))

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

{- | 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 ::
  CompatGHC.Module -- semantic module
  -> WarningMap
  -> [CompatGHC.LHsDecl CompatGHC.GhcRn] -- renamed source declarations
  -> Maps
  -> Map.Map CompatGHC.ModuleName [CompatGHC.ModuleName] -- imported modules
  -> Maybe [(CompatGHC.IE CompatGHC.GhcRn, CompatGHC.Avails)]
  -> CompatGHC.Avails -- exported stuff from this module
  -> [Documentation.ExportItem]
mkExportItems :: Module
-> WarningMap
-> [LHsDecl GhcRn]
-> Maps
-> Map ModuleName [ModuleName]
-> Maybe [(IE GhcRn, [AvailInfo])]
-> [AvailInfo]
-> [ExportItem]
mkExportItems Module
semMod WarningMap
warnings [LHsDecl GhcRn]
hsdecls Maps
maps Map ModuleName [ModuleName]
unrestricted_imp_mods Maybe [(IE GhcRn, [AvailInfo])]
exportList [AvailInfo]
allExports =
  case Maybe [(IE GhcRn, [AvailInfo])]
exportList of
    Maybe [(IE GhcRn, [AvailInfo])]
Nothing ->
      Module
-> WarningMap
-> [LHsDecl GhcRn]
-> Maps
-> [AvailInfo]
-> [ExportItem]
fullModuleContents
        Module
semMod
        WarningMap
warnings
        [LHsDecl GhcRn]
hsdecls
        Maps
maps
        [AvailInfo]
allExports
    Just [(IE GhcRn, [AvailInfo])]
exports -> [[ExportItem]] -> [ExportItem]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ExportItem]] -> [ExportItem]) -> [[ExportItem]] -> [ExportItem]
forall a b. (a -> b) -> a -> b
$ ((IE GhcRn, [AvailInfo]) -> [ExportItem])
-> [(IE GhcRn, [AvailInfo])] -> [[ExportItem]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (IE GhcRn, [AvailInfo]) -> [ExportItem]
lookupExport [(IE GhcRn, [AvailInfo])]
exports
 where
  lookupExport ::
    (CompatGHC.IE CompatGHC.GhcRn, [CompatGHC.AvailInfo])
    -> [Documentation.ExportItem]
  lookupExport :: (IE GhcRn, [AvailInfo]) -> [ExportItem]
lookupExport (CompatGHC.IEGroup{}, [AvailInfo]
_) =
    [ExportItem]
forall a. Monoid a => a
mempty
  lookupExport (CompatGHC.IEDoc XIEDoc GhcRn
_ LHsDoc GhcRn
docStr, [AvailInfo]
_) =
    ExportItem -> [ExportItem]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExportItem -> [ExportItem])
-> (WithHsDocIdentifiers HsDocString GhcRn -> ExportItem)
-> WithHsDocIdentifiers HsDocString GhcRn
-> [ExportItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaAndDoc -> ExportItem
Documentation.mkExportDoc (MetaAndDoc -> ExportItem)
-> (WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc)
-> WithHsDocIdentifiers HsDocString GhcRn
-> ExportItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc
mkMetaAndDoc (WithHsDocIdentifiers HsDocString GhcRn -> [ExportItem])
-> WithHsDocIdentifiers HsDocString GhcRn -> [ExportItem]
forall a b. (a -> b) -> a -> b
$ LHsDoc GhcRn -> WithHsDocIdentifiers HsDocString GhcRn
forall l e. GenLocated l e -> e
CompatGHC.unLoc LHsDoc GhcRn
docStr
  lookupExport (CompatGHC.IEDocNamed XIEDocNamed GhcRn
_ String
_, [AvailInfo]
_) =
    -- FIXME: If we have some named docs then that isn't really an export of some code to keep
    -- track of for coverage or other analysis. Make sure we don't need to restore this for
    -- something though.
    [ExportItem]
forall a. Monoid a => a
mempty
  -- liftErrMsg $
  --   findNamedDoc str (fmap CompatGHC.unLoc hsdecls) >>= \case
  --     Nothing -> pure []
  --     Just docStr ->
  --       pure [pollock_mkExportDoc $ processDocStringParas docStr]
  lookupExport (CompatGHC.IEModuleContents XIEModuleContents GhcRn
_ (CompatGHC.L SrcSpanAnnA
_ 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
Map.lookup ModuleName
mod_name Map ModuleName [ModuleName]
unrestricted_imp_mods
    , Bool -> Bool
not ([ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
mods) =
        [ExportItem]
forall a. Monoid a => a
mempty
  -- FIXME Can we get away with completely ignoring module exports like this?
  -- concat <$> traverse (moduleExport thisMod dflags modMap instIfaceMap) mods

  lookupExport (IE GhcRn
_, [AvailInfo]
avails) =
    (AvailInfo -> [ExportItem]) -> [AvailInfo] -> [ExportItem]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [ExportItem]
availExport ([AvailInfo] -> [AvailInfo]
CompatGHC.nubAvails [AvailInfo]
avails)

  availExport :: AvailInfo -> [ExportItem]
availExport =
    Module -> WarningMap -> Maps -> AvailInfo -> [ExportItem]
availExportItem Module
semMod WarningMap
warnings Maps
maps

availExportItem ::
  CompatGHC.Module -- semantic module
  -> WarningMap
  -> Maps
  -> CompatGHC.AvailInfo
  -> [Documentation.ExportItem]
availExportItem :: Module -> WarningMap -> Maps -> AvailInfo -> [ExportItem]
availExportItem Module
semMod WarningMap
warnings (Map Name MetaAndDoc
docMap, Map Name (IntMap MetaAndDoc)
argMap, Map Name [HsDecl GhcRn]
declMap) AvailInfo
avail =
  let
    n :: Name
n = AvailInfo -> Name
CompatGHC.availName AvailInfo
avail
   in
    if (() :: Constraint) => Name -> Module
Name -> Module
CompatGHC.nameModule Name
n Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
semMod
      then case Name -> Map Name [HsDecl GhcRn] -> Maybe [HsDecl GhcRn]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name [HsDecl GhcRn]
declMap of
        Just [CompatGHC.ValD XValD GhcRn
_ HsBind GhcRn
_] ->
          ExportItem -> [ExportItem]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExportItem -> [ExportItem])
-> ((DocumentationForDecl, [(Name, DocumentationForDecl)])
    -> ExportItem)
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
-> [ExportItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportDecl -> ExportItem
Documentation.ExportItemDecl (ExportDecl -> ExportItem)
-> ((DocumentationForDecl, [(Name, DocumentationForDecl)])
    -> ExportDecl)
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
-> ExportItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentationForDecl -> ExportDecl
Documentation.ExportDecl (DocumentationForDecl -> ExportDecl)
-> ((DocumentationForDecl, [(Name, DocumentationForDecl)])
    -> DocumentationForDecl)
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
-> ExportDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocumentationForDecl, [(Name, DocumentationForDecl)])
-> DocumentationForDecl
forall a b. (a, b) -> a
fst ((DocumentationForDecl, [(Name, DocumentationForDecl)])
 -> [ExportItem])
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
-> [ExportItem]
forall a b. (a -> b) -> a -> b
$
            AvailInfo
-> WarningMap
-> Map Name MetaAndDoc
-> Map Name (IntMap MetaAndDoc)
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
lookupDocs AvailInfo
avail WarningMap
warnings Map Name MetaAndDoc
docMap Map Name (IntMap MetaAndDoc)
argMap
        Just [HsDecl GhcRn]
ds ->
          case (HsDecl GhcRn -> Bool) -> [HsDecl GhcRn] -> [HsDecl GhcRn]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (HsDecl GhcRn -> Bool) -> HsDecl GhcRn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDecl GhcRn -> Bool
forall a. HsDecl a -> Bool
CompatGHC.isValD) [HsDecl GhcRn]
ds of
            [HsDecl GhcRn
_] ->
              AvailInfo
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
-> [ExportItem]
availExportDecl AvailInfo
avail ((DocumentationForDecl, [(Name, DocumentationForDecl)])
 -> [ExportItem])
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
-> [ExportItem]
forall a b. (a -> b) -> a -> b
$ AvailInfo
-> WarningMap
-> Map Name MetaAndDoc
-> Map Name (IntMap MetaAndDoc)
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
lookupDocs AvailInfo
avail WarningMap
warnings Map Name MetaAndDoc
docMap Map Name (IntMap MetaAndDoc)
argMap
            [HsDecl GhcRn]
_ ->
              [ExportItem]
forall a. Monoid a => a
mempty
        Maybe [HsDecl GhcRn]
Nothing ->
          [ExportItem]
forall a. Monoid a => a
mempty
      else [ExportItem]
forall a. Monoid a => a
mempty

availExportDecl ::
  CompatGHC.AvailInfo
  -> (Documentation.DocumentationForDecl, [(CompatGHC.Name, Documentation.DocumentationForDecl)])
  -> [Documentation.ExportItem]
availExportDecl :: AvailInfo
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
-> [ExportItem]
availExportDecl AvailInfo
avail (DocumentationForDecl
doc, [(Name, DocumentationForDecl)]
subs) =
  if AvailInfo -> Bool
CompatGHC.availExportsDecl AvailInfo
avail
    then ExportItem -> [ExportItem]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExportItem -> [ExportItem])
-> (ExportDecl -> ExportItem) -> ExportDecl -> [ExportItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportDecl -> ExportItem
Documentation.ExportItemDecl (ExportDecl -> [ExportItem]) -> ExportDecl -> [ExportItem]
forall a b. (a -> b) -> a -> b
$ DocumentationForDecl -> ExportDecl
Documentation.ExportDecl DocumentationForDecl
doc
    else ((Name, DocumentationForDecl) -> ExportItem)
-> [(Name, DocumentationForDecl)] -> [ExportItem]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExportDecl -> ExportItem
Documentation.ExportItemDecl (ExportDecl -> ExportItem)
-> ((Name, DocumentationForDecl) -> ExportDecl)
-> (Name, DocumentationForDecl)
-> ExportItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentationForDecl -> ExportDecl
Documentation.ExportDecl (DocumentationForDecl -> ExportDecl)
-> ((Name, DocumentationForDecl) -> DocumentationForDecl)
-> (Name, DocumentationForDecl)
-> ExportDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, DocumentationForDecl) -> DocumentationForDecl
forall a b. (a, b) -> b
snd) [(Name, DocumentationForDecl)]
subs

-- | Lookup docs for a declaration from maps.
lookupDocs ::
  CompatGHC.AvailInfo
  -> WarningMap
  -> DocMap
  -> ArgMap
  -> (Documentation.DocumentationForDecl, [(CompatGHC.Name, Documentation.DocumentationForDecl)])
lookupDocs :: AvailInfo
-> WarningMap
-> Map Name MetaAndDoc
-> Map Name (IntMap MetaAndDoc)
-> (DocumentationForDecl, [(Name, DocumentationForDecl)])
lookupDocs AvailInfo
avail' WarningMap
warnings Map Name MetaAndDoc
docMap Map Name (IntMap MetaAndDoc)
argMap =
  let n :: Name
n = AvailInfo -> Name
CompatGHC.availName AvailInfo
avail'
      lookupDoc :: Name -> DocumentationForDecl
lookupDoc Name
name =
        Maybe MetaAndDoc
-> Maybe Doc -> IntMap MetaAndDoc -> DocumentationForDecl
Documentation.DocumentationForDecl
          (Name -> Map Name MetaAndDoc -> Maybe MetaAndDoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name MetaAndDoc
docMap)
          (Name -> WarningMap -> Maybe Doc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name WarningMap
warnings)
          (IntMap MetaAndDoc
-> Name -> Map Name (IntMap MetaAndDoc) -> IntMap MetaAndDoc
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault IntMap MetaAndDoc
forall a. IntMap a
IM.empty Name
name Map Name (IntMap MetaAndDoc)
argMap)
      subDocs :: [(Name, DocumentationForDecl)]
subDocs =
        (Name -> (Name, DocumentationForDecl))
-> [Name] -> [(Name, DocumentationForDecl)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Name
x -> (Name
x, Name -> DocumentationForDecl
lookupDoc Name
x)) ([Name] -> [(Name, DocumentationForDecl)])
-> [Name] -> [(Name, DocumentationForDecl)]
forall a b. (a -> b) -> a -> b
$ AvailInfo -> [Name]
CompatGHC.availSubordinateNames AvailInfo
avail'
   in (Name -> DocumentationForDecl
lookupDoc Name
n, [(Name, DocumentationForDecl)]
subDocs)

fullModuleContents ::
  CompatGHC.Module -- semantic module
  -> WarningMap
  -> [CompatGHC.LHsDecl CompatGHC.GhcRn] -- renamed source declarations
  -> Maps
  -> CompatGHC.Avails
  -> [Documentation.ExportItem]
fullModuleContents :: Module
-> WarningMap
-> [LHsDecl GhcRn]
-> Maps
-> [AvailInfo]
-> [ExportItem]
fullModuleContents Module
semMod WarningMap
warnings [LHsDecl GhcRn]
hsdecls maps :: Maps
maps@(Map Name MetaAndDoc
_, Map Name (IntMap MetaAndDoc)
_, Map Name [HsDecl GhcRn]
declMap) [AvailInfo]
avails =
  let availEnv :: NameEnv AvailInfo
availEnv = [AvailInfo] -> NameEnv AvailInfo
CompatGHC.availsToNameEnv ([AvailInfo] -> [AvailInfo]
CompatGHC.nubAvails [AvailInfo]
avails)
      fn :: CompatGHC.HsDecl CompatGHC.GhcRn -> [Documentation.ExportItem]
      fn :: HsDecl GhcRn -> [ExportItem]
fn HsDecl GhcRn
decl =
        case HsDecl GhcRn
decl of
          (CompatGHC.DocD XDocD GhcRn
_ (CompatGHC.DocGroup Int
_ LHsDoc GhcRn
_)) ->
            [ExportItem]
forall a. Monoid a => a
mempty
          (CompatGHC.DocD XDocD GhcRn
_ (CompatGHC.DocCommentNamed String
_ LHsDoc GhcRn
docStr)) ->
            let
              doc' :: MetaAndDoc
doc' = WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc
mkMetaAndDoc (WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc)
-> WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc
forall a b. (a -> b) -> a -> b
$ LHsDoc GhcRn -> WithHsDocIdentifiers HsDocString GhcRn
forall l e. GenLocated l e -> e
CompatGHC.unLoc LHsDoc GhcRn
docStr
             in
              ExportItem -> [ExportItem]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExportItem -> [ExportItem]) -> ExportItem -> [ExportItem]
forall a b. (a -> b) -> a -> b
$ MetaAndDoc -> ExportItem
Documentation.mkExportDoc MetaAndDoc
doc'
          (CompatGHC.ValD XValD GhcRn
_ HsBind GhcRn
valDecl)
            | IdP GhcRn
name : [IdP GhcRn]
_ <- CollectFlag GhcRn -> HsBind GhcRn -> [IdP GhcRn]
forall p idR.
CollectPass p =>
CollectFlag p -> HsBindLR p idR -> [IdP p]
CompatGHC.collectHsBindBinders CollectFlag GhcRn
forall p. CollectFlag p
CompatGHC.CollNoDictBinders HsBind GhcRn
valDecl
            , Just (CompatGHC.SigD{} : [HsDecl GhcRn]
_) <- (HsDecl GhcRn -> Bool) -> [HsDecl GhcRn] -> [HsDecl GhcRn]
forall a. (a -> Bool) -> [a] -> [a]
filter HsDecl GhcRn -> Bool
forall a. HsDecl a -> Bool
isSigD ([HsDecl GhcRn] -> [HsDecl GhcRn])
-> Maybe [HsDecl GhcRn] -> Maybe [HsDecl GhcRn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Map Name [HsDecl GhcRn] -> Maybe [HsDecl GhcRn]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup IdP GhcRn
Name
name Map Name [HsDecl GhcRn]
declMap ->
                [ExportItem]
forall a. Monoid a => a
mempty
          HsDecl GhcRn
_ ->
            let
              gn :: Name -> [ExportItem]
gn Name
nm =
                case NameEnv AvailInfo -> Name -> Maybe AvailInfo
forall a. NameEnv a -> Name -> Maybe a
CompatGHC.lookupNameEnv NameEnv AvailInfo
availEnv Name
nm of
                  Just AvailInfo
avail' ->
                    Module -> WarningMap -> Maps -> AvailInfo -> [ExportItem]
availExportItem
                      Module
semMod
                      WarningMap
warnings
                      Maps
maps
                      AvailInfo
avail'
                  Maybe AvailInfo
Nothing -> [ExportItem]
forall a. Monoid a => a
mempty
             in
              (Name -> [ExportItem]) -> [Name] -> [ExportItem]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Name -> [ExportItem]
gn (OccEnv Name -> HsDecl GhcRn -> [Name]
CompatGHC.getMainDeclBinder OccEnv Name
forall a. OccEnv a
CompatGHC.emptyOccEnv HsDecl GhcRn
decl)
   in (GenLocated SrcSpanAnnA (HsDecl GhcRn) -> [ExportItem])
-> [GenLocated SrcSpanAnnA (HsDecl GhcRn)] -> [ExportItem]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HsDecl GhcRn -> [ExportItem]
fn (HsDecl GhcRn -> [ExportItem])
-> (GenLocated SrcSpanAnnA (HsDecl GhcRn) -> HsDecl GhcRn)
-> GenLocated SrcSpanAnnA (HsDecl GhcRn)
-> [ExportItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsDecl GhcRn) -> HsDecl GhcRn
forall l e. GenLocated l e -> e
CompatGHC.unLoc) [LHsDecl GhcRn]
[GenLocated SrcSpanAnnA (HsDecl GhcRn)]
hsdecls

isSigD :: CompatGHC.HsDecl p -> Bool
isSigD :: forall a. HsDecl a -> Bool
isSigD (CompatGHC.SigD{}) = Bool
True
isSigD HsDecl p
_ = Bool
False

mkMetaAndDoc :: CompatGHC.HsDoc CompatGHC.GhcRn -> Documentation.MetaAndDoc
mkMetaAndDoc :: WithHsDocIdentifiers HsDocString GhcRn -> MetaAndDoc
mkMetaAndDoc = HsDocString -> MetaAndDoc
Documentation.processDocStringParas (HsDocString -> MetaAndDoc)
-> (WithHsDocIdentifiers HsDocString GhcRn -> HsDocString)
-> WithHsDocIdentifiers HsDocString GhcRn
-> MetaAndDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHsDocIdentifiers HsDocString GhcRn -> HsDocString
forall a pass. WithHsDocIdentifiers a pass -> a
CompatGHC.hsDocString

processDocStrings :: [CompatGHC.HsDoc CompatGHC.GhcRn] -> Maybe Documentation.MetaAndDoc
processDocStrings :: [WithHsDocIdentifiers HsDocString GhcRn] -> Maybe MetaAndDoc
processDocStrings = [HsDocString] -> Maybe MetaAndDoc
Documentation.processDocStrings ([HsDocString] -> Maybe MetaAndDoc)
-> ([WithHsDocIdentifiers HsDocString GhcRn] -> [HsDocString])
-> [WithHsDocIdentifiers HsDocString GhcRn]
-> Maybe MetaAndDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithHsDocIdentifiers HsDocString GhcRn -> HsDocString)
-> [WithHsDocIdentifiers HsDocString GhcRn] -> [HsDocString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers HsDocString GhcRn -> HsDocString
forall a pass. WithHsDocIdentifiers a pass -> a
CompatGHC.hsDocString

unLocFirst :: (Bifunctor.Bifunctor bf) => bf (CompatGHC.GenLocated l b) c -> bf b c
unLocFirst :: forall (bf :: * -> * -> *) l b c.
Bifunctor bf =>
bf (GenLocated l b) c -> bf b c
unLocFirst =
  (GenLocated l b -> b) -> bf (GenLocated l b) c -> bf b c
forall a b c. (a -> b) -> bf a c -> bf b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first GenLocated l b -> b
forall l e. GenLocated l e -> e
CompatGHC.unLoc

maybeSnd :: (a, Maybe b) -> Maybe (a, b)
maybeSnd :: forall a b. (a, Maybe b) -> Maybe (a, b)
maybeSnd (a
a, Just b
b) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
b)
maybeSnd (a
_, Maybe b
Nothing) = Maybe (a, b)
forall a. Maybe a
Nothing