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

module ExtractDocs (extractDocs) where

import GhcPrelude
import Bag
import GHC.Hs.Binds
import GHC.Hs.Doc
import GHC.Hs.Decls
import GHC.Hs.Extension
import GHC.Hs.Types
import GHC.Hs.Utils
import Name
import NameSet
import SrcLoc
import TcRnTypes

import Control.Applicative
import Data.Bifunctor (first)
import Data.List
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 a. HasSrcSpan a => a -> SrcSpanLess a
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))
-> ([(LHsDecl GhcRn, [HsDocString])]
    -> (Map Name HsDocString, Map Name (Map Int HsDocString)))
-> Maybe [(LHsDecl 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 [(LHsDecl GhcRn, [HsDocString])]
mb_decls_with_docs
    mb_decls_with_docs :: Maybe [(LHsDecl GhcRn, [HsDocString])]
mb_decls_with_docs = HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
topDecls (HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])])
-> Maybe (HsGroup GhcRn) -> Maybe [(LHsDecl 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 (((LHsDecl GhcRn, [HsDocString])
 -> ([(Name, HsDocString)], [(Name, Map Int HsDocString)]))
-> [(LHsDecl GhcRn, [HsDocString])]
-> [([(Name, HsDocString)], [(Name, Map Int HsDocString)])]
forall a b. (a -> b) -> [a] -> [b]
map (LHsDecl GhcRn, [HsDocString])
-> ([(Name, HsDocString)], [(Name, Map Int HsDocString)])
mappings [(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 SrcSpan
l HsDecl GhcRn
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 SrcSpan Name
-> HsDecl GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
subordinates Map SrcSpan 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 = SrcSpan -> HsDecl GhcRn -> [Name]
names SrcSpan
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

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

    names :: SrcSpan -> HsDecl GhcRn -> [Name]
    names :: SrcSpan -> HsDecl GhcRn -> [Name]
names SrcSpan
l (InstD XInstD GhcRn
_ InstDecl GhcRn
d) = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (SrcSpan -> Map SrcSpan Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SrcSpan
loc Map SrcSpan Name
instanceMap) -- See
                                                                 -- Note [1].
      where loc :: SrcSpan
loc = case InstDecl GhcRn
d of
              TyFamInstD XTyFamInstD GhcRn
_ TyFamInstDecl GhcRn
_ -> SrcSpan
l -- The CoAx's loc is the whole line, but only
                                  -- for TFs
              InstDecl GhcRn
_ -> InstDecl GhcRn -> SrcSpan
forall (p :: Pass). InstDecl (GhcPass p) -> SrcSpan
getInstLoc InstDecl GhcRn
d
    names SrcSpan
l (DerivD {}) = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (SrcSpan -> Map SrcSpan Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SrcSpan
l Map SrcSpan Name
instanceMap) -- See Note [1].
    names SrcSpan
_ HsDecl GhcRn
decl = HsDecl GhcRn -> [IdP GhcRn]
forall (p :: Pass). 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 :: 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.
(SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat 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. Sig pass -> [IdP pass]
sigNameNoLoc Sig (GhcPass p)
d
getMainDeclBinder (ForD XForD (GhcPass p)
_ (ForeignImport XForeignImport (GhcPass p)
_ Located (IdP (GhcPass p))
name LHsSigType (GhcPass p)
_ ForeignImport
_)) = [Located (IdP (GhcPass p))
-> SrcSpanLess (Located (IdP (GhcPass p)))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP (GhcPass p))
name]
getMainDeclBinder (ForD XForD (GhcPass p)
_ (ForeignExport XForeignExport (GhcPass p)
_ Located (IdP (GhcPass p))
_ LHsSigType (GhcPass p)
_ ForeignExport
_)) = []
getMainDeclBinder HsDecl (GhcPass p)
_ = []

sigNameNoLoc :: Sig pass -> [IdP pass]
sigNameNoLoc :: Sig pass -> [IdP pass]
sigNameNoLoc (TypeSig    XTypeSig pass
_   [Located (IdP pass)]
ns LHsSigWcType pass
_)         = (Located (IdP pass) -> IdP pass)
-> [Located (IdP pass)] -> [IdP pass]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP pass) -> IdP pass
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP pass)]
ns
sigNameNoLoc (ClassOpSig XClassOpSig pass
_ Bool
_ [Located (IdP pass)]
ns LHsSigType pass
_)         = (Located (IdP pass) -> IdP pass)
-> [Located (IdP pass)] -> [IdP pass]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP pass) -> IdP pass
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP pass)]
ns
sigNameNoLoc (PatSynSig  XPatSynSig pass
_   [Located (IdP pass)]
ns LHsSigType pass
_)         = (Located (IdP pass) -> IdP pass)
-> [Located (IdP pass)] -> [IdP pass]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP pass) -> IdP pass
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP pass)]
ns
sigNameNoLoc (SpecSig    XSpecSig pass
_   Located (IdP pass)
n [LHsSigType pass]
_ InlinePragma
_)        = [Located (IdP pass) -> SrcSpanLess (Located (IdP pass))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP pass)
n]
sigNameNoLoc (InlineSig  XInlineSig pass
_   Located (IdP pass)
n InlinePragma
_)          = [Located (IdP pass) -> SrcSpanLess (Located (IdP pass))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP pass)
n]
sigNameNoLoc (FixSig XFixSig pass
_ (FixitySig XFixitySig pass
_ [Located (IdP pass)]
ns Fixity
_)) = (Located (IdP pass) -> IdP pass)
-> [Located (IdP pass)] -> [IdP pass]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP pass) -> IdP pass
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP 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 }) -> LHsType (GhcPass p) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LHsSigType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType LHsSigType (GhcPass p)
ty)
  DataFamInstD XDataFamInstD (GhcPass p)
_ (DataFamInstDecl
    { dfid_eqn :: forall pass.
DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = (Located (IdP (GhcPass p))
-> Located (SrcSpanLess (Located (IdP (GhcPass p))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located (IdP (GhcPass p)))
_) }}}) -> SrcSpan
l
  TyFamInstD XTyFamInstD (GhcPass p)
_ (TyFamInstDecl
    -- 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.
    { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = (LHsType (GhcPass p) -> Located (SrcSpanLess (LHsType (GhcPass p)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (LHsType (GhcPass p))
_) }}}) -> SrcSpan
l
  ClsInstD XClsInstD (GhcPass p)
_ (XClsInstDecl XXClsInstDecl (GhcPass p)
_) -> [Char] -> SrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"getInstLoc"
  DataFamInstD XDataFamInstD (GhcPass p)
_ (DataFamInstDecl (HsIB XHsIB (GhcPass p) (FamEqn (GhcPass p) (HsDataDefn (GhcPass p)))
_ (XFamEqn XXFamEqn (GhcPass p) (HsDataDefn (GhcPass p))
_))) -> [Char] -> SrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"getInstLoc"
  TyFamInstD XTyFamInstD (GhcPass p)
_ (TyFamInstDecl (HsIB XHsIB (GhcPass p) (FamEqn (GhcPass p) (LHsType (GhcPass p)))
_ (XFamEqn XXFamEqn (GhcPass p) (LHsType (GhcPass p))
_))) -> [Char] -> SrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"getInstLoc"
  XInstDecl XXInstDecl (GhcPass p)
_ -> [Char] -> SrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"getInstLoc"
  DataFamInstD XDataFamInstD (GhcPass p)
_ (DataFamInstDecl (XHsImplicitBndrs XXHsImplicitBndrs
  (GhcPass p) (FamEqn (GhcPass p) (HsDataDefn (GhcPass p)))
_)) -> [Char] -> SrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"getInstLoc"
  TyFamInstD XTyFamInstD (GhcPass p)
_ (TyFamInstDecl (XHsImplicitBndrs XXHsImplicitBndrs
  (GhcPass p) (FamEqn (GhcPass p) (LHsType (GhcPass p)))
_)) -> [Char] -> SrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"getInstLoc"

-- | 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 SrcSpan Name
             -> HsDecl GhcRn
             -> [(Name, [(HsDocString)], Map Int (HsDocString))]
subordinates :: Map SrcSpan Name
-> HsDecl GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
subordinates Map SrcSpan 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 -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body =
      FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = (Located (IdP GhcRn) -> Located (SrcSpanLess (Located Name))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located Name)
_)
             , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs   = HsDataDefn GhcRn
defn }}} <- LDataFamInstDecl GhcRn -> DataFamInstDecl GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LDataFamInstDecl GhcRn -> DataFamInstDecl GhcRn)
-> [LDataFamInstDecl 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 SrcSpan Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SrcSpan
l Map SrcSpan 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 (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = 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 SrcSpanLess (LHsDecl GhcRn)
HsDecl GhcRn
d)
                   | (LHsDecl GhcRn -> Located (SrcSpanLess (LHsDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LHsDecl GhcRn)
d, [HsDocString]
doc) <- TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
classDecls TyClDecl GhcRn
dd
                   , Name
name <- HsDecl GhcRn -> [IdP GhcRn]
forall (p :: Pass). HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder SrcSpanLess (LHsDecl GhcRn)
HsDecl GhcRn
d, Bool -> Bool
not (HsDecl GhcRn -> Bool
forall a. HsDecl a -> Bool
isValD SrcSpanLess (LHsDecl GhcRn)
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 = (LConDecl GhcRn -> ConDecl GhcRn)
-> [LConDecl GhcRn] -> [ConDecl GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map LConDecl GhcRn -> ConDecl GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([LConDecl GhcRn] -> [ConDecl GhcRn])
-> [LConDecl 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 = [ ( Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
cname
                    , Maybe HsDocString -> [HsDocString]
forall a. Maybe a -> [a]
maybeToList (Maybe HsDocString -> [HsDocString])
-> Maybe HsDocString -> [HsDocString]
forall a b. (a -> b) -> a -> b
$ (LHsDocString -> HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsDocString -> HsDocString
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Maybe LHsDocString -> Maybe HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall a b. (a -> b) -> a -> b
$ ConDecl 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, Located Name
cname <- ConDecl GhcRn -> [Located (IdP GhcRn)]
forall (p :: Pass).
ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames ConDecl GhcRn
c ]
        fields :: [(Name, [HsDocString], Map Int HsDocString)]
fields  = [ (FieldOcc GhcRn -> XCFieldOcc GhcRn
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc SrcSpanLess (LFieldOcc GhcRn)
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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Maybe LHsDocString
doc, Map Int HsDocString
forall k a. Map k a
M.empty)
                  | RecCon Located [LConDeclField GhcRn]
flds <- (ConDecl GhcRn
 -> HsConDetails (LBangType GhcRn) (Located [LConDeclField GhcRn]))
-> [ConDecl GhcRn]
-> [HsConDetails (LBangType GhcRn) (Located [LConDeclField GhcRn])]
forall a b. (a -> b) -> [a] -> [b]
map ConDecl GhcRn
-> HsConDetails (LBangType GhcRn) (Located [LConDeclField GhcRn])
forall pass. ConDecl pass -> HsConDeclDetails pass
getConArgs [ConDecl GhcRn]
cons
                  , (LConDeclField GhcRn -> Located (SrcSpanLess (LConDeclField GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (ConDeclField _ ns _ doc)) <- (Located [LConDeclField GhcRn]
-> SrcSpanLess (Located [LConDeclField GhcRn])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LConDeclField GhcRn]
flds)
                  , (LFieldOcc GhcRn -> Located (SrcSpanLess (LFieldOcc GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LFieldOcc GhcRn)
n) <- [LFieldOcc GhcRn]
ns ]
        derivs :: [(Name, [HsDocString], Map Int HsDocString)]
derivs  = [ (Name
instName, [LHsDocString -> SrcSpanLess LHsDocString
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDocString
doc], Map Int HsDocString
forall k a. Map k a
M.empty)
                  | (SrcSpan
l, LHsDocString
doc) <- (HsImplicitBndrs GhcRn (LBangType GhcRn)
 -> Maybe (SrcSpan, LHsDocString))
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
-> [(SrcSpan, LHsDocString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LBangType GhcRn -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty (LBangType GhcRn -> Maybe (SrcSpan, LHsDocString))
-> (HsImplicitBndrs GhcRn (LBangType GhcRn) -> LBangType GhcRn)
-> HsImplicitBndrs GhcRn (LBangType GhcRn)
-> Maybe (SrcSpan, LHsDocString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsImplicitBndrs GhcRn (LBangType GhcRn) -> LBangType GhcRn
forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body) ([HsImplicitBndrs GhcRn (LBangType GhcRn)]
 -> [(SrcSpan, LHsDocString)])
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
-> [(SrcSpan, LHsDocString)]
forall a b. (a -> b) -> a -> b
$
                                (LHsDerivingClause GhcRn
 -> [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> [LHsDerivingClause GhcRn]
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Located [HsImplicitBndrs GhcRn (LBangType GhcRn)]
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located [HsImplicitBndrs GhcRn (LBangType GhcRn)]
 -> [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> (LHsDerivingClause GhcRn
    -> Located [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> LHsDerivingClause GhcRn
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDerivingClause GhcRn
-> Located [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall pass. HsDerivingClause pass -> Located [LHsSigType pass]
deriv_clause_tys (HsDerivingClause GhcRn
 -> Located [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> (LHsDerivingClause GhcRn -> HsDerivingClause GhcRn)
-> LHsDerivingClause GhcRn
-> Located [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDerivingClause GhcRn -> HsDerivingClause GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([LHsDerivingClause GhcRn]
 -> [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> [LHsDerivingClause GhcRn]
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall a b. (a -> b) -> a -> b
$
                                HsDeriving GhcRn -> SrcSpanLess (HsDeriving GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsDeriving GhcRn -> SrcSpanLess (HsDeriving GhcRn))
-> HsDeriving GhcRn -> SrcSpanLess (HsDeriving 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 SrcSpan Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SrcSpan
l Map SrcSpan Name
instMap] ]

        extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString)
        extract_deriv_ty :: LBangType GhcRn -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty LBangType GhcRn
ty =
          case LBangType GhcRn -> Located (SrcSpanLess (LBangType GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL LBangType GhcRn
ty of
            -- deriving (forall a. C a {- ^ Doc comment -})
            L SrcSpan
l (HsForAllTy{ hst_fvf = ForallInvis
                           , hst_body = dL->L _ (HsDocTy _ _ doc) })
                                  -> (SrcSpan, LHsDocString) -> Maybe (SrcSpan, LHsDocString)
forall a. a -> Maybe a
Just (SrcSpan
l, LHsDocString
doc)
            -- deriving (C a {- ^ Doc comment -})
            L SrcSpan
l (HsDocTy _ _ doc) -> (SrcSpan, LHsDocString) -> Maybe (SrcSpan, LHsDocString)
forall a. a -> Maybe a
Just (SrcSpan
l, LHsDocString
doc)
            Located (SrcSpanLess (LBangType 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 ConDecl GhcRn
con = case ConDecl GhcRn
-> HsConDetails (LBangType GhcRn) (Located [LConDeclField GhcRn])
forall pass. ConDecl pass -> HsConDeclDetails pass
getConArgs ConDecl GhcRn
con of
                   PrefixCon [LBangType GhcRn]
args -> Int -> [HsType GhcRn] -> Map Int HsDocString
forall k pass.
(Ord k, Enum k) =>
k -> [HsType pass] -> Map k HsDocString
go Int
0 ((LBangType GhcRn -> HsType GhcRn)
-> [LBangType GhcRn] -> [HsType GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map LBangType GhcRn -> HsType GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LBangType GhcRn]
args [HsType GhcRn] -> [HsType GhcRn] -> [HsType GhcRn]
forall a. [a] -> [a] -> [a]
++ [HsType GhcRn]
ret)
                   InfixCon LBangType GhcRn
arg1 LBangType GhcRn
arg2 -> Int -> [HsType GhcRn] -> Map Int HsDocString
forall k pass.
(Ord k, Enum k) =>
k -> [HsType pass] -> Map k HsDocString
go Int
0 ([LBangType GhcRn -> SrcSpanLess (LBangType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LBangType GhcRn
arg1, LBangType GhcRn -> SrcSpanLess (LBangType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LBangType GhcRn
arg2] [HsType GhcRn] -> [HsType GhcRn] -> [HsType GhcRn]
forall a. [a] -> [a] -> [a]
++ [HsType GhcRn]
ret)
                   RecCon Located [LConDeclField GhcRn]
_ -> Int -> [HsType GhcRn] -> Map Int HsDocString
forall k pass.
(Ord k, Enum k) =>
k -> [HsType pass] -> Map k HsDocString
go Int
1 [HsType GhcRn]
ret
  where
    go :: k -> [HsType pass] -> Map k HsDocString
go k
n = [(k, HsDocString)] -> Map k HsDocString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, HsDocString)] -> Map k HsDocString)
-> ([HsType pass] -> [(k, HsDocString)])
-> [HsType pass]
-> Map k HsDocString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (k, HsDocString)] -> [(k, HsDocString)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (k, HsDocString)] -> [(k, HsDocString)])
-> ([HsType pass] -> [Maybe (k, HsDocString)])
-> [HsType pass]
-> [(k, HsDocString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> HsType pass -> Maybe (k, HsDocString))
-> [k] -> [HsType pass] -> [Maybe (k, HsDocString)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith k -> HsType pass -> Maybe (k, HsDocString)
forall a pass. a -> HsType pass -> Maybe (a, HsDocString)
f [k
n..]
      where
        f :: a -> HsType pass -> Maybe (a, HsDocString)
f a
n (HsDocTy XDocTy pass
_ LHsType pass
_ LHsDocString
lds) = (a, HsDocString) -> Maybe (a, HsDocString)
forall a. a -> Maybe a
Just (a
n, LHsDocString -> SrcSpanLess LHsDocString
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDocString
lds)
        f a
_ HsType pass
_ = Maybe (a, HsDocString)
forall a. Maybe a
Nothing

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

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_ = [(LHsDecl GhcRn, [HsDocString])]
-> [(LHsDecl GhcRn, [HsDocString])]
forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls ([(LHsDecl GhcRn, [HsDocString])]
 -> [(LHsDecl GhcRn, [HsDocString])])
-> ([LHsDecl GhcRn] -> [(LHsDecl GhcRn, [HsDocString])])
-> [LHsDecl GhcRn]
-> [(LHsDecl GhcRn, [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcRn] -> [(LHsDecl GhcRn, [HsDocString])]
forall pass. [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]
collectDocs ([LHsDecl GhcRn] -> [(LHsDecl GhcRn, [HsDocString])])
-> ([LHsDecl GhcRn] -> [LHsDecl GhcRn])
-> [LHsDecl GhcRn]
-> [(LHsDecl GhcRn, [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [Located a] -> [Located a]
sortByLoc ([LHsDecl GhcRn] -> [(LHsDecl GhcRn, [HsDocString])])
-> [LHsDecl GhcRn] -> [(LHsDecl GhcRn, [HsDocString])]
forall a b. (a -> b) -> a -> b
$ [LHsDecl GhcRn]
decls
  where
    decls :: [LHsDecl GhcRn]
decls = [LHsDecl GhcRn]
docs [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++ [LHsDecl GhcRn]
defs [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++ [LHsDecl GhcRn]
sigs [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++ [LHsDecl GhcRn]
ats
    docs :: [LHsDecl GhcRn]
docs  = (TyClDecl GhcRn -> [Located DocDecl])
-> (DocDecl -> HsDecl GhcRn) -> TyClDecl GhcRn -> [LHsDecl 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 XDocD GhcRn
NoExtField
noExtField) TyClDecl GhcRn
class_
    defs :: [LHsDecl GhcRn]
defs  = (TyClDecl GhcRn -> [Located (HsBindLR GhcRn GhcRn)])
-> (HsBindLR GhcRn GhcRn -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [LHsDecl GhcRn]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls (Bag (Located (HsBindLR GhcRn GhcRn))
-> [Located (HsBindLR GhcRn GhcRn)]
forall a. Bag a -> [a]
bagToList (Bag (Located (HsBindLR GhcRn GhcRn))
 -> [Located (HsBindLR GhcRn GhcRn)])
-> (TyClDecl GhcRn -> Bag (Located (HsBindLR GhcRn GhcRn)))
-> TyClDecl GhcRn
-> [Located (HsBindLR GhcRn GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyClDecl GhcRn -> Bag (Located (HsBindLR GhcRn GhcRn))
forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths) (XValD GhcRn -> HsBindLR GhcRn GhcRn -> HsDecl GhcRn
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcRn
NoExtField
noExtField) TyClDecl GhcRn
class_
    sigs :: [LHsDecl GhcRn]
sigs  = (TyClDecl GhcRn -> [Located (Sig GhcRn)])
-> (Sig GhcRn -> HsDecl GhcRn) -> TyClDecl GhcRn -> [LHsDecl 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 XSigD GhcRn
NoExtField
noExtField) TyClDecl GhcRn
class_
    ats :: [LHsDecl GhcRn]
ats   = (TyClDecl GhcRn -> [Located (FamilyDecl GhcRn)])
-> (FamilyDecl GhcRn -> HsDecl GhcRn)
-> TyClDecl GhcRn
-> [LHsDecl 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 XTyClD GhcRn
NoExtField
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 XFamDecl GhcRn
NoExtField
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
_ [Located (IdP GhcRn)]
_ LHsSigWcType GhcRn
ty)          -> HsType GhcRn -> Map Int HsDocString
typeDocs (LBangType GhcRn -> SrcSpanLess (LBangType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsSigWcType GhcRn -> LBangType GhcRn
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType GhcRn
ty))
  SigD  XSigD GhcRn
_ (ClassOpSig XClassOpSig GhcRn
_ Bool
_ [Located (IdP GhcRn)]
_ HsImplicitBndrs GhcRn (LBangType GhcRn)
ty)     -> HsType GhcRn -> Map Int HsDocString
typeDocs (LBangType GhcRn -> SrcSpanLess (LBangType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsImplicitBndrs GhcRn (LBangType GhcRn) -> LBangType GhcRn
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType HsImplicitBndrs GhcRn (LBangType GhcRn)
ty))
  SigD  XSigD GhcRn
_ (PatSynSig XPatSynSig GhcRn
_ [Located (IdP GhcRn)]
_ HsImplicitBndrs GhcRn (LBangType GhcRn)
ty)        -> HsType GhcRn -> Map Int HsDocString
typeDocs (LBangType GhcRn -> SrcSpanLess (LBangType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsImplicitBndrs GhcRn (LBangType GhcRn) -> LBangType GhcRn
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType HsImplicitBndrs GhcRn (LBangType GhcRn)
ty))
  ForD  XForD GhcRn
_ (ForeignImport XForeignImport GhcRn
_ Located (IdP GhcRn)
_ HsImplicitBndrs GhcRn (LBangType GhcRn)
ty ForeignImport
_)  -> HsType GhcRn -> Map Int HsDocString
typeDocs (LBangType GhcRn -> SrcSpanLess (LBangType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsImplicitBndrs GhcRn (LBangType GhcRn) -> LBangType GhcRn
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType HsImplicitBndrs GhcRn (LBangType GhcRn)
ty))
  TyClD XTyClD GhcRn
_ (SynDecl { tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LBangType GhcRn
ty }) -> HsType GhcRn -> Map Int HsDocString
typeDocs (LBangType GhcRn -> SrcSpanLess (LBangType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc 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.
(Ord k, Num k) =>
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 = LHsType pass
ty }        -> k -> HsType pass -> Map k HsDocString
go k
n (LHsType pass -> SrcSpanLess (LHsType pass)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType pass
ty)
      HsQualTy   { hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType pass
ty }        -> k -> HsType pass -> Map k HsDocString
go k
n (LHsType pass -> SrcSpanLess (LHsType pass)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType pass
ty)
      HsFunTy XFunTy pass
_ (LHsType pass -> SrcSpanLess (LHsType pass)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc->HsDocTy _ _ x) LHsType 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 -> SrcSpanLess LHsDocString
forall a. HasSrcSpan a => a -> SrcSpanLess a
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) (LHsType pass -> SrcSpanLess (LHsType pass)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType pass
ty)
      HsFunTy XFunTy pass
_ LHsType pass
_ LHsType pass
ty                      -> k -> HsType pass -> Map k HsDocString
go (k
nk -> k -> k
forall a. Num a => a -> a -> a
+k
1) (LHsType pass -> SrcSpanLess (LHsType pass)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType pass
ty)
      HsDocTy XDocTy pass
_ LHsType pass
_ LHsDocString
doc                     -> k -> HsDocString -> Map k HsDocString
forall k a. k -> a -> Map k a
M.singleton k
n (LHsDocString -> SrcSpanLess LHsDocString
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDocString
doc)
      HsType pass
_                                   -> Map k HsDocString
forall k a. Map k a
M.empty

-- | 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 = [(LHsDecl GhcRn, [HsDocString])]
-> [(LHsDecl GhcRn, [HsDocString])]
forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterClasses ([(LHsDecl GhcRn, [HsDocString])]
 -> [(LHsDecl GhcRn, [HsDocString])])
-> (HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])])
-> HsGroup GhcRn
-> [(LHsDecl GhcRn, [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(LHsDecl GhcRn, [HsDocString])]
-> [(LHsDecl GhcRn, [HsDocString])]
forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls ([(LHsDecl GhcRn, [HsDocString])]
 -> [(LHsDecl GhcRn, [HsDocString])])
-> (HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])])
-> HsGroup GhcRn
-> [(LHsDecl GhcRn, [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcRn] -> [(LHsDecl GhcRn, [HsDocString])]
forall pass. [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]
collectDocs ([LHsDecl GhcRn] -> [(LHsDecl GhcRn, [HsDocString])])
-> (HsGroup GhcRn -> [LHsDecl GhcRn])
-> HsGroup GhcRn
-> [(LHsDecl GhcRn, [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [Located a] -> [Located a]
sortByLoc ([LHsDecl GhcRn] -> [LHsDecl GhcRn])
-> (HsGroup GhcRn -> [LHsDecl GhcRn])
-> HsGroup GhcRn
-> [LHsDecl GhcRn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
-> [LHsDecl 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 XTyClD GhcRn
NoExtField
noExtField)  HsGroup GhcRn
group_ [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (DerivDecl GhcRn)])
-> (DerivDecl GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [LHsDecl 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 XDerivD GhcRn
NoExtField
noExtField) HsGroup GhcRn
group_ [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (DefaultDecl GhcRn)])
-> (DefaultDecl GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [LHsDecl 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 XDefD GhcRn
NoExtField
noExtField)   HsGroup GhcRn
group_ [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (ForeignDecl GhcRn)])
-> (ForeignDecl GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [LHsDecl 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 XForD GhcRn
NoExtField
noExtField)   HsGroup GhcRn
group_ [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located DocDecl])
-> (DocDecl -> HsDecl GhcRn) -> HsGroup GhcRn -> [LHsDecl 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 XDocD GhcRn
NoExtField
noExtField)   HsGroup GhcRn
group_ [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (InstDecl GhcRn)])
-> (InstDecl GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [LHsDecl 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 XInstD GhcRn
NoExtField
noExtField)  HsGroup GhcRn
group_ [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (Sig GhcRn)])
-> (Sig GhcRn -> HsDecl GhcRn) -> HsGroup GhcRn -> [LHsDecl GhcRn]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls (HsValBindsLR GhcRn GhcRn -> [Located (Sig GhcRn)]
forall idL idR idL.
(XXValBindsLR idL idR ~ NHsValBindsLR idL) =>
HsValBindsLR idL idR -> [Located (Sig GhcRn)]
typesigs (HsValBindsLR GhcRn GhcRn -> [Located (Sig GhcRn)])
-> (HsGroup GhcRn -> HsValBindsLR GhcRn GhcRn)
-> HsGroup GhcRn
-> [Located (Sig GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup GhcRn -> HsValBindsLR GhcRn GhcRn
forall p. HsGroup p -> HsValBinds p
hs_valds)  (XSigD GhcRn -> Sig GhcRn -> HsDecl GhcRn
forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcRn
NoExtField
noExtField)   HsGroup GhcRn
group_ [LHsDecl GhcRn] -> [LHsDecl GhcRn] -> [LHsDecl GhcRn]
forall a. [a] -> [a] -> [a]
++
  (HsGroup GhcRn -> [Located (HsBindLR GhcRn GhcRn)])
-> (HsBindLR GhcRn GhcRn -> HsDecl GhcRn)
-> HsGroup GhcRn
-> [LHsDecl GhcRn]
forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls (HsValBindsLR GhcRn GhcRn -> [Located (HsBindLR GhcRn GhcRn)]
forall idL idR idL.
(XXValBindsLR idL idR ~ NHsValBindsLR idL) =>
HsValBindsLR idL idR -> [LHsBindLR idL idL]
valbinds (HsValBindsLR GhcRn GhcRn -> [Located (HsBindLR GhcRn GhcRn)])
-> (HsGroup GhcRn -> HsValBindsLR GhcRn GhcRn)
-> HsGroup GhcRn
-> [Located (HsBindLR GhcRn GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup GhcRn -> HsValBindsLR GhcRn GhcRn
forall p. HsGroup p -> HsValBinds p
hs_valds)  (XValD GhcRn -> HsBindLR GhcRn GhcRn -> HsDecl GhcRn
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcRn
NoExtField
noExtField)   HsGroup GhcRn
group_
  where
    typesigs :: HsValBindsLR idL idR -> [Located (Sig 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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located (Sig GhcRn)]
sig
    typesigs ValBinds{} = [Char] -> [Located (Sig GhcRn)]
forall a. HasCallStack => [Char] -> a
error [Char]
"expected XValBindsLR"

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

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

-- | Collect docs and attach them to the right declarations.
--
-- A declaration may have multiple doc strings attached to it.
collectDocs :: [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]
-- ^ This is an example.
collectDocs :: [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]
collectDocs = [HsDocString]
-> Maybe (LHsDecl pass)
-> [LHsDecl pass]
-> [(LHsDecl pass, [HsDocString])]
forall a p.
(HasSrcSpan a, SrcSpanLess a ~ HsDecl p) =>
[HsDocString] -> Maybe a -> [a] -> [(a, [HsDocString])]
go [] Maybe (LHsDecl pass)
forall a. Maybe a
Nothing
  where
    go :: [HsDocString] -> Maybe a -> [a] -> [(a, [HsDocString])]
go [HsDocString]
docs Maybe a
mprev [a]
decls = case ([a]
decls, Maybe a
mprev) of
      ((a -> SrcSpanLess a
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc->DocD _ (DocCommentNext s)) : [a]
ds, Maybe a
Nothing)   -> [HsDocString] -> Maybe a -> [a] -> [(a, [HsDocString])]
go (HsDocString
sHsDocString -> [HsDocString] -> [HsDocString]
forall a. a -> [a] -> [a]
:[HsDocString]
docs) Maybe a
forall a. Maybe a
Nothing [a]
ds
      ((a -> SrcSpanLess a
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc->DocD _ (DocCommentNext s)) : [a]
ds, Just a
prev) -> a -> [HsDocString] -> [(a, [HsDocString])] -> [(a, [HsDocString])]
forall a a. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished a
prev [HsDocString]
docs ([(a, [HsDocString])] -> [(a, [HsDocString])])
-> [(a, [HsDocString])] -> [(a, [HsDocString])]
forall a b. (a -> b) -> a -> b
$ [HsDocString] -> Maybe a -> [a] -> [(a, [HsDocString])]
go [HsDocString
s] Maybe a
forall a. Maybe a
Nothing [a]
ds
      ((a -> SrcSpanLess a
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc->DocD _ (DocCommentPrev s)) : [a]
ds, Maybe a
mprev)     -> [HsDocString] -> Maybe a -> [a] -> [(a, [HsDocString])]
go (HsDocString
sHsDocString -> [HsDocString] -> [HsDocString]
forall a. a -> [a] -> [a]
:[HsDocString]
docs) Maybe a
mprev [a]
ds
      (a
d                                  : [a]
ds, Maybe a
Nothing)   -> [HsDocString] -> Maybe a -> [a] -> [(a, [HsDocString])]
go [HsDocString]
docs (a -> Maybe a
forall a. a -> Maybe a
Just a
d) [a]
ds
      (a
d                                  : [a]
ds, Just a
prev) -> a -> [HsDocString] -> [(a, [HsDocString])] -> [(a, [HsDocString])]
forall a a. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished a
prev [HsDocString]
docs ([(a, [HsDocString])] -> [(a, [HsDocString])])
-> [(a, [HsDocString])] -> [(a, [HsDocString])]
forall a b. (a -> b) -> a -> b
$ [HsDocString] -> Maybe a -> [a] -> [(a, [HsDocString])]
go [] (a -> Maybe a
forall a. a -> Maybe a
Just a
d) [a]
ds
      ([]                                     , Maybe a
Nothing)   -> []
      ([]                                     , Just a
prev) -> a -> [HsDocString] -> [(a, [HsDocString])] -> [(a, [HsDocString])]
forall a a. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished a
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 :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls = ((LHsDecl a, doc) -> Bool)
-> [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
forall a. (a -> Bool) -> [a] -> [a]
filter (HsDecl a -> Bool
forall a. HsDecl a -> Bool
isHandled (HsDecl a -> Bool)
-> ((LHsDecl a, doc) -> HsDecl a) -> (LHsDecl a, doc) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl a -> HsDecl a
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsDecl a -> HsDecl a)
-> ((LHsDecl a, doc) -> LHsDecl a) -> (LHsDecl a, doc) -> HsDecl a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsDecl a, doc) -> LHsDecl a
forall a b. (a, b) -> a
fst)
  where
    isHandled :: HsDecl name -> Bool
isHandled (ForD XForD name
_ (ForeignImport {})) = Bool
True
    isHandled (TyClD {})  = Bool
True
    isHandled (InstD {})  = Bool
True
    isHandled (DerivD {}) = Bool
True
    isHandled (SigD XSigD name
_ Sig name
d)  = 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 :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterClasses = ((LHsDecl a, doc) -> (LHsDecl a, doc))
-> [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
forall a b. (a -> b) -> [a] -> [b]
map ((LHsDecl a -> LHsDecl a) -> (LHsDecl a, doc) -> (LHsDecl a, doc)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((HsDecl a -> HsDecl a) -> LHsDecl a -> LHsDecl a
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc HsDecl a -> HsDecl a
forall name. HsDecl name -> HsDecl name
filterClass))
  where
    filterClass :: HsDecl name -> HsDecl name
filterClass (TyClD XTyClD name
x c :: TyClDecl name
c@(ClassDecl {})) =
      XTyClD name -> TyClDecl name -> HsDecl name
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD name
x (TyClDecl name -> HsDecl name) -> TyClDecl name -> HsDecl name
forall a b. (a -> b) -> a -> b
$ TyClDecl name
c { tcdSigs :: [LSig name]
tcdSigs =
        (LSig name -> Bool) -> [LSig name] -> [LSig name]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool)
-> (LSig name -> Bool) -> (LSig name -> Bool) -> LSig name -> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Sig name -> Bool
forall name. Sig name -> Bool
isUserSig (Sig name -> Bool) -> (LSig name -> Sig name) -> LSig name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSig name -> Sig name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) LSig name -> Bool
forall name. LSig name -> Bool
isMinimalLSig) (TyClDecl name -> [LSig name]
forall pass. TyClDecl pass -> [LSig pass]
tcdSigs TyClDecl name
c) }
    filterClass HsDecl name
d = HsDecl name
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