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

{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

module GHC.HsToCore.Docs where

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

import Control.Applicative
import Control.Monad.IO.Class
import Data.Bifunctor (first)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Semigroup
import GHC.IORef (readIORef)

-- | Extract docs from renamer output.
-- This is monadic since we need to be able to read documentation added from
-- Template Haskell's @putDoc@, which is stored in 'tcg_th_docs'.
extractDocs :: MonadIO m
            => TcGblEnv
            -> m (Maybe HsDocString, DeclDocMap, ArgDocMap)
            -- ^
            -- 1. Module header
            -- 2. Docs on top level declarations
            -- 3. Docs on arguments
extractDocs :: TcGblEnv -> m (Maybe HsDocString, DeclDocMap, ArgDocMap)
extractDocs TcGblEnv { tcg_semantic_mod :: TcGblEnv -> Module
tcg_semantic_mod = Module
mod
                     , tcg_rn_decls :: TcGblEnv -> Maybe (HsGroup GhcRn)
tcg_rn_decls = Maybe (HsGroup GhcRn)
mb_rn_decls
                     , tcg_insts :: TcGblEnv -> [ClsInst]
tcg_insts = [ClsInst]
insts
                     , tcg_fam_insts :: TcGblEnv -> [FamInst]
tcg_fam_insts = [FamInst]
fam_insts
                     , tcg_doc_hdr :: TcGblEnv -> Maybe LHsDocString
tcg_doc_hdr = Maybe LHsDocString
mb_doc_hdr
                     , tcg_th_docs :: TcGblEnv -> TcRef THDocs
tcg_th_docs = TcRef THDocs
th_docs_var
                     } = do
    THDocs
th_docs <- IO THDocs -> m THDocs
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO THDocs -> m THDocs) -> IO THDocs -> m THDocs
forall a b. (a -> b) -> a -> b
$ TcRef THDocs -> IO THDocs
forall a. IORef a -> IO a
readIORef TcRef THDocs
th_docs_var
    let doc_hdr :: Maybe HsDocString
doc_hdr = Maybe HsDocString
th_doc_hdr Maybe HsDocString -> Maybe HsDocString -> Maybe HsDocString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc (LHsDocString -> HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LHsDocString
mb_doc_hdr)
        ExtractedTHDocs
          Maybe HsDocString
th_doc_hdr
          (DeclDocMap Map Name HsDocString
th_doc_map)
          (ArgDocMap Map Name (IntMap HsDocString)
th_arg_map)
          (DeclDocMap Map Name HsDocString
th_inst_map) = THDocs -> ExtractedTHDocs
extractTHDocs THDocs
th_docs
    (Maybe HsDocString, DeclDocMap, ArgDocMap)
-> m (Maybe HsDocString, DeclDocMap, ArgDocMap)
forall (m :: * -> *) a. Monad m => a -> m a
return
      ( Maybe HsDocString
doc_hdr
      , Map Name HsDocString -> DeclDocMap
DeclDocMap (Map Name HsDocString
th_doc_map Map Name HsDocString
-> Map Name HsDocString -> Map Name HsDocString
forall a. Semigroup a => a -> a -> a
<> Map Name HsDocString
th_inst_map Map Name HsDocString
-> Map Name HsDocString -> Map Name HsDocString
forall a. Semigroup a => a -> a -> a
<> Map Name HsDocString
doc_map)
      , Map Name (IntMap HsDocString) -> ArgDocMap
ArgDocMap (Map Name (IntMap HsDocString)
th_arg_map Map Name (IntMap HsDocString)
-> Map Name (IntMap HsDocString) -> Map Name (IntMap HsDocString)
forall b.
Map Name (IntMap b) -> Map Name (IntMap b) -> Map Name (IntMap b)
`unionArgMaps` Map Name (IntMap HsDocString)
arg_map)
      )
  where
    (Map Name HsDocString
doc_map, Map Name (IntMap HsDocString)
arg_map) = (Map Name HsDocString, Map Name (IntMap HsDocString))
-> ([(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])]
    -> (Map Name HsDocString, Map Name (IntMap HsDocString)))
-> Maybe [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])]
-> (Map Name HsDocString, Map Name (IntMap HsDocString))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Map Name HsDocString
forall k a. Map k a
M.empty, Map Name (IntMap HsDocString)
forall k a. Map k a
M.empty)
                               ([Name]
-> [(LHsDecl GhcRn, [HsDocString])]
-> (Map Name HsDocString, Map Name (IntMap HsDocString))
mkMaps [Name]
local_insts)
                               Maybe [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])]
mb_decls_with_docs
    mb_decls_with_docs :: Maybe [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])]
mb_decls_with_docs = HsGroup GhcRn
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])]
HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
topDecls (HsGroup GhcRn
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])])
-> Maybe (HsGroup GhcRn)
-> Maybe [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HsGroup GhcRn)
mb_rn_decls
    local_insts :: [Name]
local_insts = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Module -> Name -> Bool
nameIsLocalOrFrom Module
mod)
                         ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ (ClsInst -> Name) -> [ClsInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> Name
forall a. NamedThing a => a -> Name
getName [ClsInst]
insts [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FamInst -> Name) -> [FamInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FamInst -> Name
forall a. NamedThing a => a -> Name
getName [FamInst]
fam_insts

-- | Create decl and arg doc-maps by looping through the declarations.
-- For each declaration, find its names, its subordinates, and its doc strings.
mkMaps :: [Name]
       -> [(LHsDecl GhcRn, [HsDocString])]
       -> (Map Name (HsDocString), Map Name (IntMap HsDocString))
mkMaps :: [Name]
-> [(LHsDecl GhcRn, [HsDocString])]
-> (Map Name HsDocString, Map Name (IntMap HsDocString))
mkMaps [Name]
instances [(LHsDecl GhcRn, [HsDocString])]
decls =
    ( [[(Name, HsDocString)]] -> Map Name HsDocString
forall a. Ord a => [[(a, HsDocString)]] -> Map a HsDocString
f' (([(Name, HsDocString)] -> [(Name, HsDocString)])
-> [[(Name, HsDocString)]] -> [[(Name, HsDocString)]]
forall a b. (a -> b) -> [a] -> [b]
map (((Name, HsDocString) -> Name)
-> [(Name, HsDocString)] -> [(Name, HsDocString)]
forall a. (a -> Name) -> [a] -> [a]
nubByName (Name, HsDocString) -> Name
forall a b. (a, b) -> a
fst) [[(Name, HsDocString)]]
decls')
    , [[(Name, IntMap HsDocString)]] -> Map Name (IntMap HsDocString)
forall a b. (Ord a, Semigroup b) => [[(a, b)]] -> Map a b
f  ((IntMap HsDocString -> Bool)
-> [[(Name, IntMap HsDocString)]] -> [[(Name, IntMap HsDocString)]]
forall b a. (b -> Bool) -> [[(a, b)]] -> [[(a, b)]]
filterMapping (Bool -> Bool
not (Bool -> Bool)
-> (IntMap HsDocString -> Bool) -> IntMap HsDocString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap HsDocString -> Bool
forall a. IntMap a -> Bool
IM.null) [[(Name, IntMap HsDocString)]]
args)
    )
  where
    ([[(Name, HsDocString)]]
decls', [[(Name, IntMap HsDocString)]]
args) = [([(Name, HsDocString)], [(Name, IntMap HsDocString)])]
-> ([[(Name, HsDocString)]], [[(Name, IntMap HsDocString)]])
forall a b. [(a, b)] -> ([a], [b])
unzip (((GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])
 -> ([(Name, HsDocString)], [(Name, IntMap HsDocString)]))
-> [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])]
-> [([(Name, HsDocString)], [(Name, IntMap HsDocString)])]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])
-> ([(Name, HsDocString)], [(Name, IntMap HsDocString)])
(LHsDecl GhcRn, [HsDocString])
-> ([(Name, HsDocString)], [(Name, IntMap HsDocString)])
mappings [(GenLocated SrcSpanAnnA (HsDecl GhcRn), [HsDocString])]
[(LHsDecl GhcRn, [HsDocString])]
decls)

    f :: (Ord a, Semigroup 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' :: Ord a => [[(a, HsDocString)]] -> Map a HsDocString
    f' :: [[(a, HsDocString)]] -> Map a HsDocString
f' = (HsDocString -> HsDocString -> HsDocString)
-> [(a, HsDocString)] -> Map a HsDocString
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith HsDocString -> HsDocString -> HsDocString
appendDocs ([(a, HsDocString)] -> Map a HsDocString)
-> ([[(a, HsDocString)]] -> [(a, HsDocString)])
-> [[(a, HsDocString)]]
-> Map a HsDocString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(a, HsDocString)]] -> [(a, HsDocString)]
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])
             -> ( [(Name, HsDocString)]
                , [(Name, IntMap HsDocString)]
                )
    mappings :: (LHsDecl GhcRn, [HsDocString])
-> ([(Name, HsDocString)], [(Name, IntMap HsDocString)])
mappings (L (SrcSpanAnn _ (RealSrcSpan l _)) decl, [HsDocString]
docStrs) =
           ([(Name, HsDocString)]
dm, [(Name, IntMap HsDocString)]
am)
      where
        doc :: Maybe HsDocString
doc = [HsDocString] -> Maybe HsDocString
concatDocs [HsDocString]
docStrs
        args :: IntMap HsDocString
args = HsDecl GhcRn -> IntMap HsDocString
declTypeDocs HsDecl GhcRn
decl

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

        ([Maybe HsDocString]
subDocs, [IntMap HsDocString]
subArgs) =
          [(Maybe HsDocString, IntMap HsDocString)]
-> ([Maybe HsDocString], [IntMap HsDocString])
forall a b. [(a, b)] -> ([a], [b])
unzip (((Name, [HsDocString], IntMap HsDocString)
 -> (Maybe HsDocString, IntMap HsDocString))
-> [(Name, [HsDocString], IntMap HsDocString)]
-> [(Maybe HsDocString, IntMap HsDocString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
_, [HsDocString]
strs, IntMap HsDocString
m) -> ([HsDocString] -> Maybe HsDocString
concatDocs [HsDocString]
strs, IntMap HsDocString
m)) [(Name, [HsDocString], IntMap HsDocString)]
subs)

        ns :: [Name]
ns = RealSrcSpan -> HsDecl GhcRn -> [Name]
names RealSrcSpan
l HsDecl GhcRn
decl
        subNs :: [Name]
subNs = [ Name
n | (Name
n, [HsDocString]
_, IntMap HsDocString
_) <- [(Name, [HsDocString], IntMap HsDocString)]
subs ]
        dm :: [(Name, HsDocString)]
dm = [(Name
n, HsDocString
d) | (Name
n, Just HsDocString
d) <- [Name] -> [Maybe HsDocString] -> [(Name, Maybe HsDocString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
ns (Maybe HsDocString -> [Maybe HsDocString]
forall a. a -> [a]
repeat Maybe HsDocString
doc) [(Name, Maybe HsDocString)]
-> [(Name, Maybe HsDocString)] -> [(Name, Maybe HsDocString)]
forall a. [a] -> [a] -> [a]
++ [Name] -> [Maybe HsDocString] -> [(Name, Maybe HsDocString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
subNs [Maybe HsDocString]
subDocs]
        am :: [(Name, IntMap HsDocString)]
am = [(Name
n, IntMap HsDocString
args) | Name
n <- [Name]
ns] [(Name, IntMap HsDocString)]
-> [(Name, IntMap HsDocString)] -> [(Name, IntMap HsDocString)]
forall a. [a] -> [a] -> [a]
++ [Name] -> [IntMap HsDocString] -> [(Name, IntMap HsDocString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
subNs [IntMap HsDocString]
subArgs
    mappings (L (SrcSpanAnn _ (UnhelpfulSpan _)) _, [HsDocString]
_) = ([], [])

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

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

{-
Note [1]:
---------
We relate ClsInsts to InstDecls and DerivDecls using the SrcSpans buried
inside them. That should work for normal user-written instances (from
looking at GHC sources). We can assume that commented instances are
user-written. This lets us relate Names (from ClsInsts) to comments
(associated with InstDecls and DerivDecls).
-}
getMainDeclBinder :: (Anno (IdGhcP p) ~ SrcSpanAnnN, CollectPass (GhcPass p))
                  => HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder :: HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder (TyClD XTyClD (GhcPass p)
_ TyClDecl (GhcPass p)
d) = [TyClDecl (GhcPass p) -> IdP (GhcPass p)
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
TyClDecl (GhcPass p) -> IdP (GhcPass p)
tcdName TyClDecl (GhcPass p)
d]
getMainDeclBinder (ValD XValD (GhcPass p)
_ HsBind (GhcPass p)
d) =
  case CollectFlag (GhcPass p) -> HsBind (GhcPass p) -> [IdP (GhcPass p)]
forall p idR.
CollectPass p =>
CollectFlag p -> HsBindLR p idR -> [IdP p]
collectHsBindBinders CollectFlag (GhcPass p)
forall p. CollectFlag p
CollNoDictBinders HsBind (GhcPass p)
d of
    []       -> []
    (IdP (GhcPass p)
name:[IdP (GhcPass p)]
_) -> [IdP (GhcPass p)
name]
getMainDeclBinder (SigD XSigD (GhcPass p)
_ Sig (GhcPass p)
d) = Sig (GhcPass p) -> [IdP (GhcPass p)]
forall pass. UnXRec pass => Sig pass -> [IdP pass]
sigNameNoLoc Sig (GhcPass p)
d
getMainDeclBinder (ForD XForD (GhcPass p)
_ (ForeignImport XForeignImport (GhcPass p)
_ LIdP (GhcPass p)
name LHsSigType (GhcPass p)
_ ForeignImport
_)) = [GenLocated SrcSpanAnnN (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN (IdGhcP p)
LIdP (GhcPass p)
name]
getMainDeclBinder (ForD XForD (GhcPass p)
_ (ForeignExport XForeignExport (GhcPass p)
_ LIdP (GhcPass p)
_ LHsSigType (GhcPass p)
_ ForeignExport
_)) = []
getMainDeclBinder HsDecl (GhcPass p)
_ = []


sigNameNoLoc :: forall pass. UnXRec pass => Sig pass -> [IdP pass]
sigNameNoLoc :: Sig pass -> [IdP pass]
sigNameNoLoc (TypeSig    XTypeSig pass
_   [LIdP pass]
ns LHsSigWcType pass
_)         = (LIdP pass -> IdP pass) -> [LIdP pass] -> [IdP pass]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. UnXRec pass => XRec pass a -> a
forall p a. UnXRec p => XRec p a -> a
unXRec @pass) [LIdP pass]
ns
sigNameNoLoc (ClassOpSig XClassOpSig pass
_ Bool
_ [LIdP pass]
ns LHsSigType pass
_)         = (LIdP pass -> IdP pass) -> [LIdP pass] -> [IdP pass]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. UnXRec pass => XRec pass a -> a
forall p a. UnXRec p => XRec p a -> a
unXRec @pass) [LIdP pass]
ns
sigNameNoLoc (PatSynSig  XPatSynSig pass
_   [LIdP pass]
ns LHsSigType pass
_)         = (LIdP pass -> IdP pass) -> [LIdP pass] -> [IdP pass]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. UnXRec pass => XRec pass a -> a
forall p a. UnXRec p => XRec p a -> a
unXRec @pass) [LIdP pass]
ns
sigNameNoLoc (SpecSig    XSpecSig pass
_   LIdP pass
n [LHsSigType pass]
_ InlinePragma
_)        = [LIdP pass -> IdP pass
forall p a. UnXRec p => XRec p a -> a
unXRec @pass LIdP pass
n]
sigNameNoLoc (InlineSig  XInlineSig pass
_   LIdP pass
n InlinePragma
_)          = [LIdP pass -> IdP pass
forall p a. UnXRec p => XRec p a -> a
unXRec @pass LIdP pass
n]
sigNameNoLoc (FixSig XFixSig pass
_ (FixitySig XFixitySig pass
_ [LIdP pass]
ns Fixity
_)) = (LIdP pass -> IdP pass) -> [LIdP pass] -> [IdP pass]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. UnXRec pass => XRec pass a -> a
forall p a. UnXRec p => XRec p a -> a
unXRec @pass) [LIdP pass]
ns
sigNameNoLoc Sig pass
_                             = []

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

-- | Get all subordinate declarations inside a declaration, and their docs.
-- A subordinate declaration is something like the associate type or data
-- family of a type class.
subordinates :: Map RealSrcSpan Name
             -> HsDecl GhcRn
             -> [(Name, [HsDocString], IntMap HsDocString)]
subordinates :: Map RealSrcSpan Name
-> HsDecl GhcRn -> [(Name, [HsDocString], IntMap HsDocString)]
subordinates Map RealSrcSpan Name
instMap HsDecl GhcRn
decl = case HsDecl GhcRn
decl of
  InstD XInstD GhcRn
_ (ClsInstD XClsInstD GhcRn
_ ClsInstDecl GhcRn
d) -> do
    DataFamInstDecl { dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn =
      FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = L l _
             , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs   = HsDataDefn GhcRn
defn }} <- GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)
-> DataFamInstDecl GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)
 -> DataFamInstDecl GhcRn)
-> [GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)]
-> [DataFamInstDecl GhcRn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClsInstDecl GhcRn -> [LDataFamInstDecl GhcRn]
forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts ClsInstDecl GhcRn
d
    [ (Name
n, [], IntMap HsDocString
forall a. IntMap a
IM.empty) | Just Name
n <- [SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l) Map RealSrcSpan Name
instMap] ] [(Name, [HsDocString], IntMap HsDocString)]
-> [(Name, [HsDocString], IntMap HsDocString)]
-> [(Name, [HsDocString], IntMap HsDocString)]
forall a. [a] -> [a] -> [a]
++ HsDataDefn GhcRn -> [(Name, [HsDocString], IntMap HsDocString)]
dataSubs HsDataDefn GhcRn
defn

  InstD XInstD GhcRn
_ (DataFamInstD XDataFamInstD GhcRn
_ (DataFamInstDecl FamEqn GhcRn (HsDataDefn GhcRn)
d))
    -> HsDataDefn GhcRn -> [(Name, [HsDocString], IntMap HsDocString)]
dataSubs (FamEqn GhcRn (HsDataDefn GhcRn) -> HsDataDefn GhcRn
forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs FamEqn GhcRn (HsDataDefn GhcRn)
d)
  TyClD XTyClD GhcRn
_ TyClDecl GhcRn
d | TyClDecl GhcRn -> Bool
forall pass. TyClDecl pass -> Bool
isClassDecl TyClDecl GhcRn
d -> TyClDecl GhcRn -> [(Name, [HsDocString], IntMap HsDocString)]
classSubs TyClDecl GhcRn
d
            | TyClDecl GhcRn -> Bool
forall pass. TyClDecl pass -> Bool
isDataDecl  TyClDecl GhcRn
d -> HsDataDefn GhcRn -> [(Name, [HsDocString], IntMap HsDocString)]
dataSubs (TyClDecl GhcRn -> HsDataDefn GhcRn
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl GhcRn
d)
  HsDecl GhcRn
_ -> []
  where
    classSubs :: TyClDecl GhcRn -> [(Name, [HsDocString], IntMap HsDocString)]
classSubs TyClDecl GhcRn
dd = [ (Name
name, [HsDocString]
doc, HsDecl GhcRn -> IntMap HsDocString
declTypeDocs HsDecl GhcRn
d)
                   | (L SrcSpanAnnA
_ HsDecl GhcRn
d, [HsDocString]
doc) <- TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
classDecls TyClDecl GhcRn
dd
                   , Name
name <- HsDecl GhcRn -> [IdP GhcRn]
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN, CollectPass (GhcPass p)) =>
HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder HsDecl GhcRn
d, Bool -> Bool
not (HsDecl GhcRn -> Bool
forall a. HsDecl a -> Bool
isValD HsDecl GhcRn
d)
                   ]
    dataSubs :: HsDataDefn GhcRn
             -> [(Name, [HsDocString], IntMap HsDocString)]
    dataSubs :: HsDataDefn GhcRn -> [(Name, [HsDocString], IntMap HsDocString)]
dataSubs HsDataDefn GhcRn
dd = [(Name, [HsDocString], IntMap HsDocString)]
constrs [(Name, [HsDocString], IntMap HsDocString)]
-> [(Name, [HsDocString], IntMap HsDocString)]
-> [(Name, [HsDocString], IntMap HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], IntMap HsDocString)]
fields [(Name, [HsDocString], IntMap HsDocString)]
-> [(Name, [HsDocString], IntMap HsDocString)]
-> [(Name, [HsDocString], IntMap HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], IntMap HsDocString)]
derivs
      where
        cons :: [ConDecl GhcRn]
cons = (GenLocated SrcSpanAnnA (ConDecl GhcRn) -> ConDecl GhcRn)
-> [GenLocated SrcSpanAnnA (ConDecl GhcRn)] -> [ConDecl GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (ConDecl GhcRn) -> ConDecl GhcRn
forall l e. GenLocated l e -> e
unLoc ([GenLocated SrcSpanAnnA (ConDecl GhcRn)] -> [ConDecl GhcRn])
-> [GenLocated SrcSpanAnnA (ConDecl GhcRn)] -> [ConDecl GhcRn]
forall a b. (a -> b) -> a -> b
$ (HsDataDefn GhcRn -> [LConDecl GhcRn]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcRn
dd)
        constrs :: [(Name, [HsDocString], IntMap HsDocString)]
constrs = [ ( GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN 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 l e. GenLocated l e -> e
unLoc (Maybe LHsDocString -> Maybe HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall a b. (a -> b) -> a -> b
$ ConDecl GhcRn -> Maybe LHsDocString
forall pass. ConDecl pass -> Maybe LHsDocString
con_doc ConDecl GhcRn
c
                    , ConDecl GhcRn -> IntMap HsDocString
conArgDocs ConDecl GhcRn
c)
                  | ConDecl GhcRn
c <- [ConDecl GhcRn]
cons, GenLocated SrcSpanAnnN Name
cname <- ConDecl GhcRn -> [GenLocated SrcSpanAnnN Name]
getConNames ConDecl GhcRn
c ]
        fields :: [(Name, [HsDocString], IntMap HsDocString)]
fields  = [ (FieldOcc GhcRn -> XCFieldOcc GhcRn
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc FieldOcc GhcRn
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 l e. GenLocated l e -> e
unLoc Maybe LHsDocString
doc, IntMap HsDocString
forall a. IntMap a
IM.empty)
                  | Just GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
flds <- (ConDecl GhcRn
 -> Maybe
      (GenLocated
         SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]))
-> [ConDecl GhcRn]
-> [Maybe
      (GenLocated
         SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])]
forall a b. (a -> b) -> [a] -> [b]
map ConDecl GhcRn
-> Maybe
     (GenLocated
        SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
ConDecl GhcRn -> Maybe (LocatedL [LConDeclField GhcRn])
getRecConArgs_maybe [ConDecl GhcRn]
cons
                  , (L SrcSpanAnnA
_ (ConDeclField XConDeclField GhcRn
_ [LFieldOcc GhcRn]
ns LBangType GhcRn
_ Maybe LHsDocString
doc)) <- (GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
-> [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
forall l e. GenLocated l e -> e
unLoc GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
flds)
                  , (L SrcSpan
_ FieldOcc GhcRn
n) <- [GenLocated SrcSpan (FieldOcc GhcRn)]
[LFieldOcc GhcRn]
ns ]
        derivs :: [(Name, [HsDocString], IntMap HsDocString)]
derivs  = [ (Name
instName, [LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc LHsDocString
doc], IntMap HsDocString
forall a. IntMap a
IM.empty)
                  | (SrcSpan
l, LHsDocString
doc) <- (GenLocated SrcSpan (HsDerivingClause GhcRn)
 -> [(SrcSpan, LHsDocString)])
-> [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [(SrcSpan, LHsDocString)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GenLocated SrcSpanAnnC (DerivClauseTys GhcRn)
-> [(SrcSpan, LHsDocString)]
LDerivClauseTys GhcRn -> [(SrcSpan, LHsDocString)]
extract_deriv_clause_tys (GenLocated SrcSpanAnnC (DerivClauseTys GhcRn)
 -> [(SrcSpan, LHsDocString)])
-> (GenLocated SrcSpan (HsDerivingClause GhcRn)
    -> GenLocated SrcSpanAnnC (DerivClauseTys GhcRn))
-> GenLocated SrcSpan (HsDerivingClause GhcRn)
-> [(SrcSpan, LHsDocString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                           HsDerivingClause GhcRn
-> GenLocated SrcSpanAnnC (DerivClauseTys GhcRn)
forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_tys (HsDerivingClause GhcRn
 -> GenLocated SrcSpanAnnC (DerivClauseTys GhcRn))
-> (GenLocated SrcSpan (HsDerivingClause GhcRn)
    -> HsDerivingClause GhcRn)
-> GenLocated SrcSpan (HsDerivingClause GhcRn)
-> GenLocated SrcSpanAnnC (DerivClauseTys GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsDerivingClause GhcRn)
-> HsDerivingClause GhcRn
forall l e. GenLocated l e -> e
unLoc) ([GenLocated SrcSpan (HsDerivingClause GhcRn)]
 -> [(SrcSpan, LHsDocString)])
-> [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [(SrcSpan, LHsDocString)]
forall a b. (a -> b) -> a -> b
$
                                -- unLoc $ dd_derivs dd
                                HsDataDefn GhcRn -> HsDeriving GhcRn
forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs HsDataDefn GhcRn
dd
                  , Just Name
instName <- [SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan SrcSpan
l Map RealSrcSpan Name
instMap] ]

        extract_deriv_clause_tys :: LDerivClauseTys GhcRn -> [(SrcSpan, LHsDocString)]
        extract_deriv_clause_tys :: LDerivClauseTys GhcRn -> [(SrcSpan, LHsDocString)]
extract_deriv_clause_tys (L _ dct) =
          case DerivClauseTys GhcRn
dct of
            DctSingle XDctSingle GhcRn
_ LHsSigType GhcRn
ty -> Maybe (SrcSpan, LHsDocString) -> [(SrcSpan, LHsDocString)]
forall a. Maybe a -> [a]
maybeToList (Maybe (SrcSpan, LHsDocString) -> [(SrcSpan, LHsDocString)])
-> Maybe (SrcSpan, LHsDocString) -> [(SrcSpan, LHsDocString)]
forall a b. (a -> b) -> a -> b
$ LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty LHsSigType GhcRn
ty
            DctMulti XDctMulti GhcRn
_ [LHsSigType GhcRn]
tys -> (GenLocated SrcSpanAnnA (HsSigType GhcRn)
 -> Maybe (SrcSpan, LHsDocString))
-> [GenLocated SrcSpanAnnA (HsSigType GhcRn)]
-> [(SrcSpan, LHsDocString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GenLocated SrcSpanAnnA (HsSigType GhcRn)
-> Maybe (SrcSpan, LHsDocString)
LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty [GenLocated SrcSpanAnnA (HsSigType GhcRn)]
[LHsSigType GhcRn]
tys

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

-- | Extracts out individual maps of documentation added via Template Haskell's
-- @putDoc@.
extractTHDocs :: THDocs
              -> ExtractedTHDocs
extractTHDocs :: THDocs -> ExtractedTHDocs
extractTHDocs THDocs
docs =
  -- Split up docs into separate maps for each 'DocLoc' type
  Maybe HsDocString
-> DeclDocMap -> ArgDocMap -> DeclDocMap -> ExtractedTHDocs
ExtractedTHDocs
    Maybe HsDocString
docHeader
    (Map Name HsDocString -> DeclDocMap
DeclDocMap ((Map Name HsDocString -> (DocLoc, [Char]) -> Map Name HsDocString)
-> Map Name HsDocString
forall a. Monoid a => (a -> (DocLoc, [Char]) -> a) -> a
searchDocs Map Name HsDocString -> (DocLoc, [Char]) -> Map Name HsDocString
decl))
    (Map Name (IntMap HsDocString) -> ArgDocMap
ArgDocMap ((Map Name (IntMap HsDocString)
 -> (DocLoc, [Char]) -> Map Name (IntMap HsDocString))
-> Map Name (IntMap HsDocString)
forall a. Monoid a => (a -> (DocLoc, [Char]) -> a) -> a
searchDocs Map Name (IntMap HsDocString)
-> (DocLoc, [Char]) -> Map Name (IntMap HsDocString)
args))
    (Map Name HsDocString -> DeclDocMap
DeclDocMap ((Map Name HsDocString -> (DocLoc, [Char]) -> Map Name HsDocString)
-> Map Name HsDocString
forall a. Monoid a => (a -> (DocLoc, [Char]) -> a) -> a
searchDocs Map Name HsDocString -> (DocLoc, [Char]) -> Map Name HsDocString
insts))
  where
    docHeader :: Maybe HsDocString
    docHeader :: Maybe HsDocString
docHeader
      | ((DocLoc
_, [Char]
s):[(DocLoc, [Char])]
_) <- ((DocLoc, [Char]) -> Bool)
-> [(DocLoc, [Char])] -> [(DocLoc, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocLoc, [Char]) -> Bool
forall b. (DocLoc, b) -> Bool
isModDoc (THDocs -> [(DocLoc, [Char])]
forall k a. Map k a -> [(k, a)]
M.toList THDocs
docs) = HsDocString -> Maybe HsDocString
forall a. a -> Maybe a
Just ([Char] -> HsDocString
mkHsDocString [Char]
s)
      | Bool
otherwise = Maybe HsDocString
forall a. Maybe a
Nothing

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

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

    -- Pick out the declaration docs
    decl :: Map Name HsDocString -> (DocLoc, [Char]) -> Map Name HsDocString
decl Map Name HsDocString
acc ((DeclDoc Name
name), [Char]
s) = Name -> HsDocString -> Map Name HsDocString -> Map Name HsDocString
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name ([Char] -> HsDocString
mkHsDocString [Char]
s) Map Name HsDocString
acc
    decl Map Name HsDocString
acc (DocLoc, [Char])
_ = Map Name HsDocString
acc

    -- Pick out the instance docs
    insts :: Map Name HsDocString -> (DocLoc, [Char]) -> Map Name HsDocString
insts Map Name HsDocString
acc ((InstDoc Name
name), [Char]
s) = Name -> HsDocString -> Map Name HsDocString -> Map Name HsDocString
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name ([Char] -> HsDocString
mkHsDocString [Char]
s) Map Name HsDocString
acc
    insts Map Name HsDocString
acc (DocLoc, [Char])
_ = Map Name HsDocString
acc

    -- Pick out the argument docs
    args :: Map Name (IntMap HsDocString)
         -> (DocLoc, String)
         -> Map Name (IntMap HsDocString)
    args :: Map Name (IntMap HsDocString)
-> (DocLoc, [Char]) -> Map Name (IntMap HsDocString)
args Map Name (IntMap HsDocString)
acc ((ArgDoc Name
name Int
i), [Char]
s) =
      -- Insert the doc for the arg into the argument map for the function. This
      -- means we have to search to see if an map already exists for the
      -- function, and insert the new argument if it exists, or create a new map
      let ds :: HsDocString
ds = [Char] -> HsDocString
mkHsDocString [Char]
s
       in (IntMap HsDocString -> IntMap HsDocString -> IntMap HsDocString)
-> Name
-> IntMap HsDocString
-> Map Name (IntMap HsDocString)
-> Map Name (IntMap HsDocString)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\IntMap HsDocString
_ IntMap HsDocString
m -> Int -> HsDocString -> IntMap HsDocString -> IntMap HsDocString
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
i HsDocString
ds IntMap HsDocString
m) Name
name (Int -> HsDocString -> IntMap HsDocString
forall a. Int -> a -> IntMap a
IM.singleton Int
i HsDocString
ds) Map Name (IntMap HsDocString)
acc
    args Map Name (IntMap HsDocString)
acc (DocLoc, [Char])
_ = Map Name (IntMap HsDocString)
acc

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