-- | 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 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 Control.Applicative
import Data.Bifunctor (first)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Semigroup

-- | Extract docs from renamer output.
extractDocs :: TcGblEnv
            -> (Maybe HsDocString, DeclDocMap, ArgDocMap)
            -- ^
            -- 1. Module header
            -- 2. Docs on top level declarations
            -- 3. Docs on arguments
extractDocs :: TcGblEnv -> (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
                     } =
    (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, Map Name HsDocString -> DeclDocMap
DeclDocMap Map Name HsDocString
doc_map, Map Name (Map Int HsDocString) -> ArgDocMap
ArgDocMap Map Name (Map Int HsDocString)
arg_map)
  where
    (Map Name HsDocString
doc_map, Map Name (Map Int HsDocString)
arg_map) = (Map Name HsDocString, Map Name (Map Int HsDocString))
-> ([(Located (HsDecl GhcRn), [HsDocString])]
    -> (Map Name HsDocString, Map Name (Map Int HsDocString)))
-> Maybe [(Located (HsDecl GhcRn), [HsDocString])]
-> (Map Name HsDocString, Map Name (Map Int HsDocString))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Map Name HsDocString
forall k a. Map k a
M.empty, Map Name (Map Int HsDocString)
forall k a. Map k a
M.empty)
                               ([Name]
-> [(LHsDecl GhcRn, [HsDocString])]
-> (Map Name HsDocString, Map Name (Map Int HsDocString))
mkMaps [Name]
local_insts)
                               Maybe [(Located (HsDecl GhcRn), [HsDocString])]
mb_decls_with_docs
    mb_decls_with_docs :: Maybe [(Located (HsDecl GhcRn), [HsDocString])]
mb_decls_with_docs = HsGroup GhcRn -> [(Located (HsDecl GhcRn), [HsDocString])]
HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
topDecls (HsGroup GhcRn -> [(Located (HsDecl GhcRn), [HsDocString])])
-> Maybe (HsGroup GhcRn)
-> Maybe [(Located (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 (Map Int (HsDocString)))
mkMaps :: [Name]
-> [(LHsDecl GhcRn, [HsDocString])]
-> (Map Name HsDocString, Map Name (Map Int 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, Map Int HsDocString)]] -> Map Name (Map Int HsDocString)
forall a b. (Ord a, Semigroup b) => [[(a, b)]] -> Map a b
f  ((Map Int HsDocString -> Bool)
-> [[(Name, Map Int HsDocString)]]
-> [[(Name, Map Int HsDocString)]]
forall b a. (b -> Bool) -> [[(a, b)]] -> [[(a, b)]]
filterMapping (Bool -> Bool
not (Bool -> Bool)
-> (Map Int HsDocString -> Bool) -> Map Int HsDocString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int HsDocString -> Bool
forall k a. Map k a -> Bool
M.null) [[(Name, Map Int HsDocString)]]
args)
    )
  where
    ([[(Name, HsDocString)]]
decls', [[(Name, Map Int HsDocString)]]
args) = [([(Name, HsDocString)], [(Name, Map Int HsDocString)])]
-> ([[(Name, HsDocString)]], [[(Name, Map Int HsDocString)]])
forall a b. [(a, b)] -> ([a], [b])
unzip (((Located (HsDecl GhcRn), [HsDocString])
 -> ([(Name, HsDocString)], [(Name, Map Int HsDocString)]))
-> [(Located (HsDecl GhcRn), [HsDocString])]
-> [([(Name, HsDocString)], [(Name, Map Int HsDocString)])]
forall a b. (a -> b) -> [a] -> [b]
map (Located (HsDecl GhcRn), [HsDocString])
-> ([(Name, HsDocString)], [(Name, Map Int HsDocString)])
(LHsDecl GhcRn, [HsDocString])
-> ([(Name, HsDocString)], [(Name, Map Int HsDocString)])
mappings [(Located (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, Map Int (HsDocString))]
                )
    mappings :: (LHsDecl GhcRn, [HsDocString])
-> ([(Name, HsDocString)], [(Name, Map Int HsDocString)])
mappings (L (RealSrcSpan l _) decl, [HsDocString]
docStrs) =
           ([(Name, HsDocString)]
dm, [(Name, Map Int HsDocString)]
am)
      where
        doc :: Maybe HsDocString
doc = [HsDocString] -> Maybe HsDocString
concatDocs [HsDocString]
docStrs
        args :: Map Int HsDocString
args = HsDecl GhcRn -> Map Int HsDocString
declTypeDocs HsDecl GhcRn
decl

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

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

        ns :: [Name]
ns = RealSrcSpan -> HsDecl GhcRn -> [Name]
names RealSrcSpan
l HsDecl GhcRn
decl
        subNs :: [Name]
subNs = [ Name
n | (Name
n, [HsDocString]
_, Map Int HsDocString
_) <- [(Name, [HsDocString], Map Int 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, Map Int HsDocString)]
am = [(Name
n, Map Int HsDocString
args) | Name
n <- [Name]
ns] [(Name, Map Int HsDocString)]
-> [(Name, Map Int HsDocString)] -> [(Name, Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [Name] -> [Map Int HsDocString] -> [(Name, Map Int HsDocString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
subNs [Map Int HsDocString]
subArgs
    mappings (L (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). 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).
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 :: 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). TyClDecl (GhcPass p) -> IdP (GhcPass p)
tcdName TyClDecl (GhcPass p)
d]
getMainDeclBinder (ValD XValD (GhcPass p)
_ HsBind (GhcPass p)
d) =
  case HsBind (GhcPass p) -> [IdP (GhcPass p)]
forall p idR. CollectPass p => HsBindLR p idR -> [IdP p]
collectHsBindBinders 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 SrcSpan (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (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 :: 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 }) -> LHsSigType (GhcPass p) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc 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 _ }}) -> SrcSpan
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 _ }}) -> SrcSpan
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)], Map Int (HsDocString))]
subordinates :: Map RealSrcSpan Name
-> HsDecl GhcRn -> [(Name, [HsDocString], Map Int 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 SrcSpan (DataFamInstDecl GhcRn) -> DataFamInstDecl GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (DataFamInstDecl GhcRn)
 -> DataFamInstDecl GhcRn)
-> [GenLocated SrcSpan (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, [], Map Int HsDocString
forall k a. Map k a
M.empty) | Just Name
n <- [SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan SrcSpan
l Map RealSrcSpan Name
instMap] ] [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs HsDataDefn GhcRn
defn

  InstD XInstD GhcRn
_ (DataFamInstD XDataFamInstD GhcRn
_ (DataFamInstDecl FamEqn GhcRn (HsDataDefn GhcRn)
d))
    -> HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int 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], Map Int HsDocString)]
classSubs TyClDecl GhcRn
d
            | TyClDecl GhcRn -> Bool
forall pass. TyClDecl pass -> Bool
isDataDecl  TyClDecl GhcRn
d -> HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs (TyClDecl GhcRn -> HsDataDefn GhcRn
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl GhcRn
d)
  HsDecl GhcRn
_ -> []
  where
    classSubs :: TyClDecl GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
classSubs TyClDecl GhcRn
dd = [ (Name
name, [HsDocString]
doc, HsDecl GhcRn -> Map Int HsDocString
declTypeDocs HsDecl GhcRn
d)
                   | (L SrcSpan
_ HsDecl GhcRn
d, [HsDocString]
doc) <- TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
classDecls TyClDecl GhcRn
dd
                   , Name
name <- HsDecl GhcRn -> [IdP GhcRn]
forall (p :: Pass).
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], Map Int (HsDocString))]
    dataSubs :: HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs HsDataDefn GhcRn
dd = [(Name, [HsDocString], Map Int HsDocString)]
constrs [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], Map Int HsDocString)]
fields [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], Map Int HsDocString)]
derivs
      where
        cons :: [ConDecl GhcRn]
cons = (GenLocated SrcSpan (ConDecl GhcRn) -> ConDecl GhcRn)
-> [GenLocated SrcSpan (ConDecl GhcRn)] -> [ConDecl GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (ConDecl GhcRn) -> ConDecl GhcRn
forall l e. GenLocated l e -> e
unLoc ([GenLocated SrcSpan (ConDecl GhcRn)] -> [ConDecl GhcRn])
-> [GenLocated SrcSpan (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], Map Int HsDocString)]
constrs = [ ( GenLocated SrcSpan Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan 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 -> Map Int HsDocString
conArgDocs ConDecl GhcRn
c)
                  | ConDecl GhcRn
c <- [ConDecl GhcRn]
cons, GenLocated SrcSpan Name
cname <- ConDecl GhcRn -> [GenLocated SrcSpan Name]
getConNames ConDecl GhcRn
c ]
        fields :: [(Name, [HsDocString], Map Int 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, Map Int HsDocString
forall k a. Map k a
M.empty)
                  | Just GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcRn)]
flds <- (ConDecl GhcRn
 -> Maybe
      (GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcRn)]))
-> [ConDecl GhcRn]
-> [Maybe
      (GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcRn)])]
forall a b. (a -> b) -> [a] -> [b]
map ConDecl GhcRn
-> Maybe
     (GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcRn)])
ConDecl GhcRn -> Maybe (Located [LConDeclField GhcRn])
getRecConArgs_maybe [ConDecl GhcRn]
cons
                  , (L SrcSpan
_ (ConDeclField XConDeclField GhcRn
_ [LFieldOcc GhcRn]
ns LBangType GhcRn
_ Maybe LHsDocString
doc)) <- (GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcRn)]
-> [GenLocated SrcSpan (ConDeclField GhcRn)]
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcRn)]
flds)
                  , (L SrcSpan
_ FieldOcc GhcRn
n) <- [GenLocated SrcSpan (FieldOcc GhcRn)]
[LFieldOcc GhcRn]
ns ]
        derivs :: [(Name, [HsDocString], Map Int HsDocString)]
derivs  = [ (Name
instName, [LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc LHsDocString
doc], Map Int HsDocString
forall k a. Map k a
M.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 (Located (DerivClauseTys GhcRn) -> [(SrcSpan, LHsDocString)]
LDerivClauseTys GhcRn -> [(SrcSpan, LHsDocString)]
extract_deriv_clause_tys (Located (DerivClauseTys GhcRn) -> [(SrcSpan, LHsDocString)])
-> (GenLocated SrcSpan (HsDerivingClause GhcRn)
    -> Located (DerivClauseTys GhcRn))
-> GenLocated SrcSpan (HsDerivingClause GhcRn)
-> [(SrcSpan, LHsDocString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                           HsDerivingClause GhcRn -> Located (DerivClauseTys GhcRn)
forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_tys (HsDerivingClause GhcRn -> Located (DerivClauseTys GhcRn))
-> (GenLocated SrcSpan (HsDerivingClause GhcRn)
    -> HsDerivingClause GhcRn)
-> GenLocated SrcSpan (HsDerivingClause GhcRn)
-> Located (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
$
                                GenLocated SrcSpan [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [GenLocated SrcSpan (HsDerivingClause GhcRn)]
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan [GenLocated SrcSpan (HsDerivingClause GhcRn)]
 -> [GenLocated SrcSpan (HsDerivingClause GhcRn)])
-> GenLocated SrcSpan [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [GenLocated SrcSpan (HsDerivingClause GhcRn)]
forall a b. (a -> b) -> a -> b
$ 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 -> (LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString))
-> [LHsSigType GhcRn] -> [(SrcSpan, LHsDocString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty [LHsSigType GhcRn]
tys

        extract_deriv_ty :: LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString)
        extract_deriv_ty :: LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty (L SrcSpan
l (HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass
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 (SrcSpan
l, LHsDocString
doc)
            HsType GhcRn
_               -> Maybe (SrcSpan, LHsDocString)
forall a. Maybe a
Nothing

-- | Extract constructor argument docs from inside constructor decls.
conArgDocs :: ConDecl GhcRn -> Map Int HsDocString
conArgDocs :: ConDecl GhcRn -> Map Int HsDocString
conArgDocs (ConDeclH98{con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details GhcRn
args}) =
  HsConDeclH98Details GhcRn -> Map Int 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 -> Map Int HsDocString
gadtConArgDocs HsConDeclGADTDetails GhcRn
args (GenLocated SrcSpan (HsType GhcRn) -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (HsType GhcRn)
LBangType GhcRn
res_ty)

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

gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> Map Int HsDocString
gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> Map Int 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] -> Map Int HsDocString
con_arg_docs Int
0 ([HsType GhcRn] -> Map Int HsDocString)
-> [HsType GhcRn] -> Map Int HsDocString
forall a b. (a -> b) -> a -> b
$ (HsScaled GhcRn (GenLocated SrcSpan (HsType GhcRn))
 -> HsType GhcRn)
-> [HsScaled GhcRn (GenLocated SrcSpan (HsType GhcRn))]
-> [HsType GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpan (HsType GhcRn) -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsType GhcRn) -> HsType GhcRn)
-> (HsScaled GhcRn (GenLocated SrcSpan (HsType GhcRn))
    -> GenLocated SrcSpan (HsType GhcRn))
-> HsScaled GhcRn (GenLocated SrcSpan (HsType GhcRn))
-> HsType GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled GhcRn (GenLocated SrcSpan (HsType GhcRn))
-> GenLocated SrcSpan (HsType GhcRn)
forall pass a. HsScaled pass a -> a
hsScaledThing) [HsScaled GhcRn (GenLocated SrcSpan (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] -> Map Int HsDocString
con_arg_docs Int
1 [HsType GhcRn
res_ty]

con_arg_docs :: Int -> [HsType GhcRn] -> Map Int HsDocString
con_arg_docs :: Int -> [HsType GhcRn] -> Map Int HsDocString
con_arg_docs Int
n = [(Int, HsDocString)] -> Map Int HsDocString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, HsDocString)] -> Map Int HsDocString)
-> ([HsType GhcRn] -> [(Int, HsDocString)])
-> [HsType GhcRn]
-> Map Int 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 pass 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_ = [(Located (HsDecl GhcRn), [HsDocString])]
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterDecls ([(Located (HsDecl GhcRn), [HsDocString])]
 -> [(Located (HsDecl GhcRn), [HsDocString])])
-> ([Located (HsDecl GhcRn)]
    -> [(Located (HsDecl GhcRn), [HsDocString])])
-> [Located (HsDecl GhcRn)]
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located (HsDecl GhcRn)]
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDocString])]
collectDocs ([Located (HsDecl GhcRn)]
 -> [(Located (HsDecl GhcRn), [HsDocString])])
-> ([Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)])
-> [Located (HsDecl GhcRn)]
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [Located a] -> [Located a]
sortLocated ([Located (HsDecl GhcRn)]
 -> [(Located (HsDecl GhcRn), [HsDocString])])
-> [Located (HsDecl GhcRn)]
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall a b. (a -> b) -> a -> b
$ [Located (HsDecl GhcRn)]
decls
  where
    decls :: [Located (HsDecl GhcRn)]
decls = [Located (HsDecl GhcRn)]
docs [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++ [Located (HsDecl GhcRn)]
defs [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++ [Located (HsDecl GhcRn)]
sigs [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++ [Located (HsDecl GhcRn)]
ats
    docs :: [Located (HsDecl GhcRn)]
docs  = (TyClDecl GhcRn -> [Located DocDecl])
-> (DocDecl -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls TyClDecl GhcRn -> [Located DocDecl]
forall pass. TyClDecl pass -> [Located DocDecl]
tcdDocs (XDocD GhcRn -> DocDecl -> HsDecl GhcRn
forall p. XDocD p -> DocDecl -> HsDecl p
DocD NoExtField
XDocD GhcRn
noExtField) TyClDecl GhcRn
class_
    defs :: [Located (HsDecl GhcRn)]
defs  = (TyClDecl GhcRn -> [Located (HsBind GhcRn)])
-> (HsBind GhcRn -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls (Bag (Located (HsBind GhcRn)) -> [Located (HsBind GhcRn)]
forall a. Bag a -> [a]
bagToList (Bag (Located (HsBind GhcRn)) -> [Located (HsBind GhcRn)])
-> (TyClDecl GhcRn -> Bag (Located (HsBind GhcRn)))
-> TyClDecl GhcRn
-> [Located (HsBind GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyClDecl GhcRn -> Bag (Located (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 :: [Located (HsDecl GhcRn)]
sigs  = (TyClDecl GhcRn -> [Located (Sig GhcRn)])
-> (Sig GhcRn -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls TyClDecl GhcRn -> [Located (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 :: [Located (HsDecl GhcRn)]
ats   = (TyClDecl GhcRn -> [Located (FamilyDecl GhcRn)])
-> (FamilyDecl GhcRn -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls TyClDecl GhcRn -> [Located (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 -> Map Int (HsDocString)
declTypeDocs :: HsDecl GhcRn -> Map Int HsDocString
declTypeDocs = \case
  SigD  XSigD GhcRn
_ (TypeSig XTypeSig GhcRn
_ [LIdP GhcRn]
_ LHsSigWcType GhcRn
ty)          -> HsSigType GhcRn -> Map Int HsDocString
sigTypeDocs (LHsSigType 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 -> Map Int HsDocString
sigTypeDocs (LHsSigType GhcRn -> HsSigType GhcRn
forall l e. GenLocated l e -> e
unLoc LHsSigType GhcRn
ty)
  SigD  XSigD GhcRn
_ (PatSynSig XPatSynSig GhcRn
_ [LIdP GhcRn]
_ LHsSigType GhcRn
ty)        -> HsSigType GhcRn -> Map Int HsDocString
sigTypeDocs (LHsSigType GhcRn -> HsSigType GhcRn
forall l e. GenLocated l e -> e
unLoc LHsSigType GhcRn
ty)
  ForD  XForD GhcRn
_ (ForeignImport XForeignImport GhcRn
_ LIdP GhcRn
_ LHsSigType GhcRn
ty ForeignImport
_)  -> HsSigType GhcRn -> Map Int HsDocString
sigTypeDocs (LHsSigType GhcRn -> HsSigType GhcRn
forall l e. GenLocated l e -> e
unLoc LHsSigType GhcRn
ty)
  TyClD XTyClD GhcRn
_ (SynDecl { tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LBangType GhcRn
ty }) -> HsType GhcRn -> Map Int HsDocString
typeDocs (GenLocated SrcSpan (HsType GhcRn) -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (HsType GhcRn)
LBangType GhcRn
ty)
  HsDecl GhcRn
_                                 -> Map Int HsDocString
forall k a. Map k a
M.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 -> Map Int (HsDocString)
typeDocs :: HsType GhcRn -> Map Int HsDocString
typeDocs = Int -> HsType GhcRn -> Map Int HsDocString
forall k pass l.
(Ord k, Num k,
 XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
k -> HsType pass -> Map k HsDocString
go Int
0
  where
    go :: k -> HsType pass -> Map k HsDocString
go k
n = \case
      HsForAllTy { hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = XRec pass (HsType pass)
ty }          -> k -> HsType pass -> Map k HsDocString
go k
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 }          -> k -> HsType pass -> Map k HsDocString
go k
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 -> k -> HsDocString -> Map k HsDocString -> Map k HsDocString
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
n (LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc LHsDocString
x) (Map k HsDocString -> Map k HsDocString)
-> Map k HsDocString -> Map k HsDocString
forall a b. (a -> b) -> a -> b
$ k -> HsType pass -> Map k HsDocString
go (k
nk -> k -> k
forall a. Num a => a -> a -> a
+k
1) (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                      -> k -> HsType pass -> Map k HsDocString
go (k
nk -> k -> k
forall a. Num a => a -> a -> a
+k
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                       -> k -> HsDocString -> Map k HsDocString
forall k a. k -> a -> Map k a
M.singleton k
n (LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc LHsDocString
doc)
      HsType pass
_                                     -> Map k HsDocString
forall k a. Map k a
M.empty

-- | Extract function argument docs from inside types.
sigTypeDocs :: HsSigType GhcRn -> Map Int HsDocString
sigTypeDocs :: HsSigType GhcRn -> Map Int HsDocString
sigTypeDocs (HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LBangType GhcRn
body}) = HsType GhcRn -> Map Int HsDocString
typeDocs (GenLocated SrcSpan (HsType GhcRn) -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (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 = [(Located (HsDecl GhcRn), [HsDocString])]
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall p doc.
(UnXRec p, MapXRec p) =>
[(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterClasses ([(Located (HsDecl GhcRn), [HsDocString])]
 -> [(Located (HsDecl GhcRn), [HsDocString])])
-> (HsGroup GhcRn -> [(Located (HsDecl GhcRn), [HsDocString])])
-> HsGroup GhcRn
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Located (HsDecl GhcRn), [HsDocString])]
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterDecls ([(Located (HsDecl GhcRn), [HsDocString])]
 -> [(Located (HsDecl GhcRn), [HsDocString])])
-> (HsGroup GhcRn -> [(Located (HsDecl GhcRn), [HsDocString])])
-> HsGroup GhcRn
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located (HsDecl GhcRn)]
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDocString])]
collectDocs ([Located (HsDecl GhcRn)]
 -> [(Located (HsDecl GhcRn), [HsDocString])])
-> (HsGroup GhcRn -> [Located (HsDecl GhcRn)])
-> HsGroup GhcRn
-> [(Located (HsDecl GhcRn), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [Located a] -> [Located a]
sortLocated ([Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)])
-> (HsGroup GhcRn -> [Located (HsDecl GhcRn)])
-> HsGroup GhcRn
-> [Located (HsDecl GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup GhcRn -> [Located (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 -> [Located (TyClDecl GhcRn)])
-> (TyClDecl GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls ([TyClGroup GhcRn] -> [Located (TyClDecl GhcRn)]
forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls ([TyClGroup GhcRn] -> [Located (TyClDecl GhcRn)])
-> (HsGroup GhcRn -> [TyClGroup GhcRn])
-> HsGroup GhcRn
-> [Located (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_ [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (DerivDecl GhcRn)])
-> (DerivDecl GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls HsGroup GhcRn -> [Located (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_ [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (DefaultDecl GhcRn)])
-> (DefaultDecl GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls HsGroup GhcRn -> [Located (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_ [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (ForeignDecl GhcRn)])
-> (ForeignDecl GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls HsGroup GhcRn -> [Located (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_ [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located DocDecl])
-> (DocDecl -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls HsGroup GhcRn -> [Located DocDecl]
forall p. HsGroup p -> [Located DocDecl]
hs_docs                (XDocD GhcRn -> DocDecl -> HsDecl GhcRn
forall p. XDocD p -> DocDecl -> HsDecl p
DocD NoExtField
XDocD GhcRn
noExtField)   HsGroup GhcRn
group_ [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (InstDecl GhcRn)])
-> (InstDecl GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls ([TyClGroup GhcRn] -> [Located (InstDecl GhcRn)]
forall pass. [TyClGroup pass] -> [LInstDecl pass]
tyClGroupInstDecls ([TyClGroup GhcRn] -> [Located (InstDecl GhcRn)])
-> (HsGroup GhcRn -> [TyClGroup GhcRn])
-> HsGroup GhcRn
-> [Located (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_ [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (Sig GhcRn)])
-> (Sig GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls (HsValBinds GhcRn -> [Located (Sig GhcRn)]
HsValBinds GhcRn -> [LSig GhcRn]
typesigs (HsValBinds GhcRn -> [Located (Sig GhcRn)])
-> (HsGroup GhcRn -> HsValBinds GhcRn)
-> HsGroup GhcRn
-> [Located (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_ [Located (HsDecl GhcRn)]
-> [Located (HsDecl GhcRn)] -> [Located (HsDecl GhcRn)]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (HsBind GhcRn)])
-> (HsBind GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [Located (HsDecl GhcRn)]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls (HsValBinds GhcRn -> [Located (HsBind GhcRn)]
HsValBinds GhcRn -> [LHsBind GhcRn]
valbinds (HsValBinds GhcRn -> [Located (HsBind GhcRn)])
-> (HsGroup GhcRn -> HsValBinds GhcRn)
-> HsGroup GhcRn
-> [Located (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)) = (Located (Sig GhcRn) -> Bool)
-> [Located (Sig GhcRn)] -> [Located (Sig GhcRn)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Sig GhcRn -> Bool
forall name. Sig name -> Bool
isUserSig (Sig GhcRn -> Bool)
-> (Located (Sig GhcRn) -> Sig GhcRn)
-> Located (Sig GhcRn)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Sig GhcRn) -> Sig GhcRn
forall l e. GenLocated l e -> e
unLoc) [Located (Sig GhcRn)]
[LSig GhcRn]
sig
    typesigs ValBinds{} = [Char] -> [Located (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 (Located (HsBind GhcRn)) -> [Located (HsBind GhcRn)])
-> [Bag (Located (HsBind GhcRn))] -> [Located (HsBind GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bag (Located (HsBind GhcRn)) -> [Located (HsBind GhcRn)]
forall a. Bag a -> [a]
bagToList ([Bag (Located (HsBind GhcRn))] -> [Located (HsBind GhcRn)])
-> ([(RecFlag, Bag (Located (HsBind GhcRn)))]
    -> [Bag (Located (HsBind GhcRn))])
-> [(RecFlag, Bag (Located (HsBind GhcRn)))]
-> [Located (HsBind GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RecFlag], [Bag (Located (HsBind GhcRn))])
-> [Bag (Located (HsBind GhcRn))]
forall a b. (a, b) -> b
snd (([RecFlag], [Bag (Located (HsBind GhcRn))])
 -> [Bag (Located (HsBind GhcRn))])
-> ([(RecFlag, Bag (Located (HsBind GhcRn)))]
    -> ([RecFlag], [Bag (Located (HsBind GhcRn))]))
-> [(RecFlag, Bag (Located (HsBind GhcRn)))]
-> [Bag (Located (HsBind GhcRn))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RecFlag, Bag (Located (HsBind GhcRn)))]
-> ([RecFlag], [Bag (Located (HsBind GhcRn))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(RecFlag, Bag (Located (HsBind GhcRn)))]
 -> [Located (HsBind GhcRn)])
-> [(RecFlag, Bag (Located (HsBind GhcRn)))]
-> [Located (HsBind GhcRn)]
forall a b. (a -> b) -> a -> b
$ [(RecFlag, Bag (Located (HsBind GhcRn)))]
[(RecFlag, LHsBinds GhcRn)]
binds
    valbinds ValBinds{} = [Char] -> [Located (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. (UnXRec p, MapXRec p) => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterClasses :: [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
filterClasses = ((LHsDecl p, doc) -> (LHsDecl p, doc))
-> [(LHsDecl p, doc)] -> [(LHsDecl p, doc)]
forall a b. (a -> b) -> [a] -> [b]
map ((LHsDecl p -> LHsDecl p) -> (LHsDecl p, doc) -> (LHsDecl p, doc)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((HsDecl p -> HsDecl p) -> LHsDecl p -> LHsDecl p
forall p a b. MapXRec p => (a -> b) -> XRec p a -> XRec p b
mapXRec @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 :: [LSig p]
tcdSigs =
        (LSig p -> Bool) -> [LSig p] -> [LSig p]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool)
-> (LSig p -> Bool) -> (LSig p -> Bool) -> LSig 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) -> (LSig p -> Sig p) -> LSig p -> 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) LSig p -> Bool
forall p. UnXRec p => LSig p -> Bool
isMinimalLSig) (TyClDecl p -> [LSig 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 -> [Located decl])
        -> (decl -> hsDecl)
        -> struct
        -> [Located hsDecl]
mkDecls :: (struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls struct -> [Located decl]
field decl -> hsDecl
con = (Located decl -> Located hsDecl)
-> [Located decl] -> [Located hsDecl]
forall a b. (a -> b) -> [a] -> [b]
map ((decl -> hsDecl) -> Located decl -> Located hsDecl
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc decl -> hsDecl
con) ([Located decl] -> [Located hsDecl])
-> (struct -> [Located decl]) -> struct -> [Located hsDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. struct -> [Located decl]
field