-- | Extract docs from the renamer output so they can be serialized.
{-# LANGUAGE LambdaCase #-}
{-# 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 (GhcPass 'Renamed))
tcg_rn_decls = Maybe (HsGroup (GhcPass 'Renamed))
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))
-> ([(LHsDecl (GhcPass 'Renamed), [HsDocString])]
    -> (Map Name HsDocString, Map Name (Map Int HsDocString)))
-> Maybe [(LHsDecl (GhcPass 'Renamed), [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 (GhcPass 'Renamed), [HsDocString])]
-> (Map Name HsDocString, Map Name (Map Int HsDocString))
mkMaps [Name]
local_insts)
                               Maybe [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
mb_decls_with_docs
    mb_decls_with_docs :: Maybe [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
mb_decls_with_docs = HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
topDecls (HsGroup (GhcPass 'Renamed)
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> Maybe (HsGroup (GhcPass 'Renamed))
-> Maybe [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HsGroup (GhcPass 'Renamed))
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 (GhcPass 'Renamed), [HsDocString])]
-> (Map Name HsDocString, Map Name (Map Int HsDocString))
mkMaps [Name]
instances [(LHsDecl (GhcPass 'Renamed), [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 (GhcPass 'Renamed), [HsDocString])
 -> ([(Name, HsDocString)], [(Name, Map Int HsDocString)]))
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> [([(Name, HsDocString)], [(Name, Map Int HsDocString)])]
forall a b. (a -> b) -> [a] -> [b]
map (LHsDecl (GhcPass 'Renamed), [HsDocString])
-> ([(Name, HsDocString)], [(Name, Map Int HsDocString)])
mappings [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
decls)

    f :: (Ord a, Semigroup b) => [[(a, b)]] -> Map a b
    f :: forall a b. (Ord a, Semigroup b) => [[(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' :: forall a. Ord a => [[(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 :: forall b a. (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 (GhcPass 'Renamed), [HsDocString])
-> ([(Name, HsDocString)], [(Name, Map Int HsDocString)])
mappings (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) HsDecl (GhcPass 'Renamed)
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 (GhcPass 'Renamed) -> Map Int HsDocString
declTypeDocs HsDecl (GhcPass 'Renamed)
decl

        subs :: [(Name, [(HsDocString)], Map Int (HsDocString))]
        subs :: [(Name, [HsDocString], Map Int HsDocString)]
subs = Map RealSrcSpan Name
-> HsDecl (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
subordinates Map RealSrcSpan Name
instanceMap HsDecl (GhcPass 'Renamed)
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 (GhcPass 'Renamed) -> [Name]
names RealSrcSpan
l HsDecl (GhcPass 'Renamed)
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 UnhelpfulSpanReason
_) HsDecl (GhcPass 'Renamed)
_, [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 (GhcPass 'Renamed) -> [Name]
names RealSrcSpan
_ (InstD XInstD (GhcPass 'Renamed)
_ InstDecl (GhcPass 'Renamed)
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 (GhcPass 'Renamed) -> SrcSpan
forall (p :: Pass). InstDecl (GhcPass p) -> SrcSpan
getInstLoc InstDecl (GhcPass 'Renamed)
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 (GhcPass 'Renamed)
decl = HsDecl (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (p :: Pass).
CollectPass (GhcPass p) =>
HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder HsDecl (GhcPass 'Renamed)
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 :: forall (p :: Pass).
CollectPass (GhcPass p) =>
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. 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
_)) = [GenLocated SrcSpan (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (IdGhcP p)
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 :: forall pass. 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 l e. GenLocated l e -> e
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 l e. GenLocated l e -> e
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 l e. GenLocated l e -> e
unLoc [Located (IdP pass)]
ns
sigNameNoLoc (SpecSig    XSpecSig pass
_   Located (IdP pass)
n [LHsSigType pass]
_ InlinePragma
_)        = [Located (IdP pass) -> IdP pass
forall l e. GenLocated l e -> e
unLoc Located (IdP pass)
n]
sigNameNoLoc (InlineSig  XInlineSig pass
_   Located (IdP pass)
n InlinePragma
_)          = [Located (IdP pass) -> IdP pass
forall l e. GenLocated l e -> e
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 l e. GenLocated l e -> e
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 :: forall (p :: Pass). InstDecl (GhcPass p) -> SrcSpan
getInstLoc = \case
  ClsInstD XClsInstD (GhcPass p)
_ (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType (GhcPass p)
ty }) -> GenLocated SrcSpan (HsType (GhcPass p)) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (LHsSigType (GhcPass p) -> GenLocated SrcSpan (HsType (GhcPass p))
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType 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 -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = L SrcSpan
l IdP (GhcPass p)
_ }}}) -> 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 = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = L SrcSpan
l IdP (GhcPass p)
_ }}}) -> 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 (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
subordinates Map RealSrcSpan Name
instMap HsDecl (GhcPass 'Renamed)
decl = case HsDecl (GhcPass 'Renamed)
decl of
  InstD XInstD (GhcPass 'Renamed)
_ (ClsInstD XClsInstD (GhcPass 'Renamed)
_ ClsInstDecl (GhcPass 'Renamed)
d) -> do
    DataFamInstDecl { dfid_eqn :: forall pass.
DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body =
      FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = L SrcSpan
l IdP (GhcPass 'Renamed)
_
             , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs   = HsDataDefn (GhcPass 'Renamed)
defn }}} <- GenLocated SrcSpan (DataFamInstDecl (GhcPass 'Renamed))
-> DataFamInstDecl (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (DataFamInstDecl (GhcPass 'Renamed))
 -> DataFamInstDecl (GhcPass 'Renamed))
-> [GenLocated SrcSpan (DataFamInstDecl (GhcPass 'Renamed))]
-> [DataFamInstDecl (GhcPass 'Renamed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClsInstDecl (GhcPass 'Renamed)
-> [GenLocated SrcSpan (DataFamInstDecl (GhcPass 'Renamed))]
forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts ClsInstDecl (GhcPass 'Renamed)
d
    [ (Name
n, [], Map Int HsDocString
forall k a. Map k a
M.empty) | Just Name
n <- [SrcSpan -> 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 (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs HsDataDefn (GhcPass 'Renamed)
defn

  InstD XInstD (GhcPass 'Renamed)
_ (DataFamInstD XDataFamInstD (GhcPass 'Renamed)
_ (DataFamInstDecl (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
d })))
    -> HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
-> HsDataDefn (GhcPass 'Renamed)
forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
d)
  TyClD XTyClD (GhcPass 'Renamed)
_ TyClDecl (GhcPass 'Renamed)
d | TyClDecl (GhcPass 'Renamed) -> Bool
forall pass. TyClDecl pass -> Bool
isClassDecl TyClDecl (GhcPass 'Renamed)
d -> TyClDecl (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
classSubs TyClDecl (GhcPass 'Renamed)
d
            | TyClDecl (GhcPass 'Renamed) -> Bool
forall pass. TyClDecl pass -> Bool
isDataDecl  TyClDecl (GhcPass 'Renamed)
d -> HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs (TyClDecl (GhcPass 'Renamed) -> HsDataDefn (GhcPass 'Renamed)
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl (GhcPass 'Renamed)
d)
  HsDecl (GhcPass 'Renamed)
_ -> []
  where
    classSubs :: TyClDecl (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
classSubs TyClDecl (GhcPass 'Renamed)
dd = [ (Name
name, [HsDocString]
doc, HsDecl (GhcPass 'Renamed) -> Map Int HsDocString
declTypeDocs HsDecl (GhcPass 'Renamed)
d)
                   | (L SrcSpan
_ HsDecl (GhcPass 'Renamed)
d, [HsDocString]
doc) <- TyClDecl (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
classDecls TyClDecl (GhcPass 'Renamed)
dd
                   , Name
name <- HsDecl (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (p :: Pass).
CollectPass (GhcPass p) =>
HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder HsDecl (GhcPass 'Renamed)
d, Bool -> Bool
not (HsDecl (GhcPass 'Renamed) -> Bool
forall a. HsDecl a -> Bool
isValD HsDecl (GhcPass 'Renamed)
d)
                   ]
    dataSubs :: HsDataDefn GhcRn
             -> [(Name, [HsDocString], Map Int (HsDocString))]
    dataSubs :: HsDataDefn (GhcPass 'Renamed)
-> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs HsDataDefn (GhcPass 'Renamed)
dd = [(Name, [HsDocString], Map Int HsDocString)]
constrs [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], Map Int HsDocString)]
fields [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], Map Int HsDocString)]
derivs
      where
        cons :: [ConDecl (GhcPass 'Renamed)]
cons = (GenLocated SrcSpan (ConDecl (GhcPass 'Renamed))
 -> ConDecl (GhcPass 'Renamed))
-> [GenLocated SrcSpan (ConDecl (GhcPass 'Renamed))]
-> [ConDecl (GhcPass 'Renamed)]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (ConDecl (GhcPass 'Renamed))
-> ConDecl (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc ([GenLocated SrcSpan (ConDecl (GhcPass 'Renamed))]
 -> [ConDecl (GhcPass 'Renamed)])
-> [GenLocated SrcSpan (ConDecl (GhcPass 'Renamed))]
-> [ConDecl (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ (HsDataDefn (GhcPass 'Renamed)
-> [GenLocated SrcSpan (ConDecl (GhcPass 'Renamed))]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn (GhcPass 'Renamed)
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 (GhcPass 'Renamed) -> Maybe LHsDocString
forall pass. ConDecl pass -> Maybe LHsDocString
con_doc ConDecl (GhcPass 'Renamed)
c
                    , ConDecl (GhcPass 'Renamed) -> Map Int HsDocString
conArgDocs ConDecl (GhcPass 'Renamed)
c)
                  | ConDecl (GhcPass 'Renamed)
c <- [ConDecl (GhcPass 'Renamed)]
cons, GenLocated SrcSpan Name
cname <- ConDecl (GhcPass 'Renamed) -> [GenLocated SrcSpan Name]
getConNames ConDecl (GhcPass 'Renamed)
c ]
        fields :: [(Name, [HsDocString], Map Int HsDocString)]
fields  = [ (FieldOcc (GhcPass 'Renamed) -> XCFieldOcc (GhcPass 'Renamed)
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc FieldOcc (GhcPass 'Renamed)
n, Maybe HsDocString -> [HsDocString]
forall a. Maybe a -> [a]
maybeToList (Maybe HsDocString -> [HsDocString])
-> Maybe HsDocString -> [HsDocString]
forall a b. (a -> b) -> a -> b
$ (LHsDocString -> HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc Maybe LHsDocString
doc, Map Int HsDocString
forall k a. Map k a
M.empty)
                  | RecCon Located [LConDeclField (GhcPass 'Renamed)]
flds <- (ConDecl (GhcPass 'Renamed)
 -> HsConDetails
      (HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed)))
      (Located [LConDeclField (GhcPass 'Renamed)]))
-> [ConDecl (GhcPass 'Renamed)]
-> [HsConDetails
      (HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed)))
      (Located [LConDeclField (GhcPass 'Renamed)])]
forall a b. (a -> b) -> [a] -> [b]
map ConDecl (GhcPass 'Renamed)
-> HsConDetails
     (HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed)))
     (Located [LConDeclField (GhcPass 'Renamed)])
getConArgs [ConDecl (GhcPass 'Renamed)]
cons
                  , (L SrcSpan
_ (ConDeclField XConDeclField (GhcPass 'Renamed)
_ [LFieldOcc (GhcPass 'Renamed)]
ns LBangType (GhcPass 'Renamed)
_ Maybe LHsDocString
doc)) <- (Located [LConDeclField (GhcPass 'Renamed)]
-> [LConDeclField (GhcPass 'Renamed)]
forall l e. GenLocated l e -> e
unLoc Located [LConDeclField (GhcPass 'Renamed)]
flds)
                  , (L SrcSpan
_ FieldOcc (GhcPass 'Renamed)
n) <- [LFieldOcc (GhcPass 'Renamed)]
ns ]
        derivs :: [(Name, [HsDocString], Map Int HsDocString)]
derivs  = [ (Name
instName, [LHsDocString -> 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) <- (HsImplicitBndrs (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
 -> Maybe (SrcSpan, LHsDocString))
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
-> [(SrcSpan, LHsDocString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LBangType (GhcPass 'Renamed) -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty (LBangType (GhcPass 'Renamed) -> Maybe (SrcSpan, LHsDocString))
-> (HsImplicitBndrs
      (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
    -> LBangType (GhcPass 'Renamed))
-> HsImplicitBndrs
     (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
-> Maybe (SrcSpan, LHsDocString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsImplicitBndrs (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
-> LBangType (GhcPass 'Renamed)
forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body) ([HsImplicitBndrs
    (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
 -> [(SrcSpan, LHsDocString)])
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
-> [(SrcSpan, LHsDocString)]
forall a b. (a -> b) -> a -> b
$
                                (GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))
 -> [HsImplicitBndrs
       (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))])
-> [GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))]
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GenLocated
  SrcSpan
  [HsImplicitBndrs (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
   SrcSpan
   [HsImplicitBndrs (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
 -> [HsImplicitBndrs
       (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))])
-> (GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))
    -> GenLocated
         SrcSpan
         [HsImplicitBndrs
            (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))])
-> GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDerivingClause (GhcPass 'Renamed)
-> GenLocated
     SrcSpan
     [HsImplicitBndrs (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
forall pass. HsDerivingClause pass -> Located [LHsSigType pass]
deriv_clause_tys (HsDerivingClause (GhcPass 'Renamed)
 -> GenLocated
      SrcSpan
      [HsImplicitBndrs
         (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))])
-> (GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))
    -> HsDerivingClause (GhcPass 'Renamed))
-> GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))
-> GenLocated
     SrcSpan
     [HsImplicitBndrs (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))
-> HsDerivingClause (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc) ([GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))]
 -> [HsImplicitBndrs
       (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))])
-> [GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))]
-> [HsImplicitBndrs
      (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
forall a b. (a -> b) -> a -> b
$
                                GenLocated
  SrcSpan [GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))]
-> [GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
   SrcSpan [GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))]
 -> [GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))])
-> GenLocated
     SrcSpan [GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))]
-> [GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))]
forall a b. (a -> b) -> a -> b
$ HsDataDefn (GhcPass 'Renamed)
-> GenLocated
     SrcSpan [GenLocated SrcSpan (HsDerivingClause (GhcPass 'Renamed))]
forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs HsDataDefn (GhcPass 'Renamed)
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_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString)
        extract_deriv_ty :: LBangType (GhcPass 'Renamed) -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty (L SrcSpan
l HsType (GhcPass 'Renamed)
ty) =
          case HsType (GhcPass 'Renamed)
ty of
            -- deriving (forall a. C a {- ^ Doc comment -})
            HsForAllTy{ hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllInvis{}
                      , hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = L SrcSpan
_ (HsDocTy XDocTy (GhcPass 'Renamed)
_ LBangType (GhcPass 'Renamed)
_ LHsDocString
doc) }
                            -> (SrcSpan, LHsDocString) -> Maybe (SrcSpan, LHsDocString)
forall a. a -> Maybe a
Just (SrcSpan
l, LHsDocString
doc)
            -- deriving (C a {- ^ Doc comment -})
            HsDocTy XDocTy (GhcPass 'Renamed)
_ LBangType (GhcPass 'Renamed)
_ LHsDocString
doc -> (SrcSpan, LHsDocString) -> Maybe (SrcSpan, LHsDocString)
forall a. a -> Maybe a
Just (SrcSpan
l, LHsDocString
doc)
            HsType (GhcPass 'Renamed)
_               -> Maybe (SrcSpan, LHsDocString)
forall a. Maybe a
Nothing

-- | Extract constructor argument docs from inside constructor decls.
conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString)
conArgDocs :: ConDecl (GhcPass 'Renamed) -> Map Int HsDocString
conArgDocs ConDecl (GhcPass 'Renamed)
con = case ConDecl (GhcPass 'Renamed)
-> HsConDetails
     (HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed)))
     (Located [LConDeclField (GhcPass 'Renamed)])
getConArgs ConDecl (GhcPass 'Renamed)
con of
                   PrefixCon [HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
args -> Int -> [HsType (GhcPass 'Renamed)] -> Map Int HsDocString
forall {k} {pass}.
(Ord k, Enum k) =>
k -> [HsType pass] -> Map k HsDocString
go Int
0 ((HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
 -> HsType (GhcPass 'Renamed))
-> [HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
-> [HsType (GhcPass 'Renamed)]
forall a b. (a -> b) -> [a] -> [b]
map (LBangType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc (LBangType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed))
-> (HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
    -> LBangType (GhcPass 'Renamed))
-> HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
-> HsType (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
-> LBangType (GhcPass 'Renamed)
forall pass a. HsScaled pass a -> a
hsScaledThing) [HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))]
args [HsType (GhcPass 'Renamed)]
-> [HsType (GhcPass 'Renamed)] -> [HsType (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++ [HsType (GhcPass 'Renamed)]
ret)
                   InfixCon HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
arg1 HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
arg2 -> Int -> [HsType (GhcPass 'Renamed)] -> Map Int HsDocString
forall {k} {pass}.
(Ord k, Enum k) =>
k -> [HsType pass] -> Map k HsDocString
go Int
0 ([LBangType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc (HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
-> LBangType (GhcPass 'Renamed)
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
arg1),
                                                LBangType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc (HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
-> LBangType (GhcPass 'Renamed)
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled (GhcPass 'Renamed) (LBangType (GhcPass 'Renamed))
arg2)] [HsType (GhcPass 'Renamed)]
-> [HsType (GhcPass 'Renamed)] -> [HsType (GhcPass 'Renamed)]
forall a. [a] -> [a] -> [a]
++ [HsType (GhcPass 'Renamed)]
ret)
                   RecCon Located [LConDeclField (GhcPass 'Renamed)]
_ -> Int -> [HsType (GhcPass 'Renamed)] -> Map Int HsDocString
forall {k} {pass}.
(Ord k, Enum k) =>
k -> [HsType pass] -> Map k HsDocString
go Int
1 [HsType (GhcPass 'Renamed)]
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 -> HsDocString
forall l e. GenLocated l e -> e
unLoc LHsDocString
lds)
        f a
n (HsBangTy XBangTy pass
_ HsSrcBang
_ (L SrcSpan
_ (HsDocTy XDocTy pass
_ LHsType 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
_ HsType pass
_ = Maybe (a, HsDocString)
forall a. Maybe a
Nothing

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

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

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

nubByName :: (a -> Name) -> [a] -> [a]
nubByName :: forall a. (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 (GhcPass 'Renamed) -> Map Int HsDocString
typeDocs = Int -> HsType (GhcPass 'Renamed) -> Map Int HsDocString
forall {k} {pass}.
(Ord k, Num k) =>
k -> HsType pass -> Map k HsDocString
go Int
0
  where
    go :: k -> HsType pass -> Map k HsDocString
go k
n = \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 -> HsType pass
forall l e. GenLocated l e -> e
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 -> HsType pass
forall l e. GenLocated l e -> e
unLoc LHsType pass
ty)
      HsFunTy XFunTy pass
_ HsArrow pass
_ (LHsType pass -> HsType pass
forall l e. GenLocated l e -> e
unLoc->HsDocTy XDocTy pass
_ LHsType pass
_ LHsDocString
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 -> 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) (LHsType pass -> HsType pass
forall l e. GenLocated l e -> e
unLoc LHsType pass
ty)
      HsFunTy XFunTy pass
_ HsArrow 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 -> HsType pass
forall l e. GenLocated l e -> e
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 -> HsDocString
forall l e. GenLocated l e -> e
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 (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
topDecls = [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterClasses ([(LHsDecl (GhcPass 'Renamed), [HsDocString])]
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> (HsGroup (GhcPass 'Renamed)
    -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls ([(LHsDecl (GhcPass 'Renamed), [HsDocString])]
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> (HsGroup (GhcPass 'Renamed)
    -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl (GhcPass 'Renamed)]
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall pass. [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]
collectDocs ([LHsDecl (GhcPass 'Renamed)]
 -> [(LHsDecl (GhcPass 'Renamed), [HsDocString])])
-> (HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)])
-> HsGroup (GhcPass 'Renamed)
-> [(LHsDecl (GhcPass 'Renamed), [HsDocString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)]
forall a. [Located a] -> [Located a]
sortLocated ([LHsDecl (GhcPass 'Renamed)] -> [LHsDecl (GhcPass 'Renamed)])
-> (HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)])
-> HsGroup (GhcPass 'Renamed)
-> [LHsDecl (GhcPass 'Renamed)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)]
ungroup

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

    valbinds :: HsValBinds GhcRn -> [LHsBind GhcRn]
    valbinds :: HsValBinds (GhcPass 'Renamed)
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
valbinds (XValBindsLR (NValBinds [(RecFlag,
  Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
binds [Located (Sig (GhcPass 'Renamed))]
_)) =
      (Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
 -> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
-> [Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall a. Bag a -> [a]
bagToList ([Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
 -> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
-> ([(RecFlag,
      Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
    -> [Bag
          (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))])
-> [(RecFlag,
     Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RecFlag],
 [Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))])
-> [Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
forall a b. (a, b) -> b
snd (([RecFlag],
  [Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))])
 -> [Bag
       (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))])
-> ([(RecFlag,
      Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
    -> ([RecFlag],
        [Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]))
-> [(RecFlag,
     Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
-> [Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RecFlag,
  Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
-> ([RecFlag],
    [Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(RecFlag,
   Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
 -> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
-> [(RecFlag,
     Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall a b. (a -> b) -> a -> b
$ [(RecFlag,
  Bag (Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
binds
    valbinds ValBinds{} = [Char]
-> [Located (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
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 :: [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]
-- ^ This is an example.
collectDocs :: forall pass. [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]
collectDocs = [HsDocString]
-> Maybe (GenLocated SrcSpan (HsDecl pass))
-> [GenLocated SrcSpan (HsDecl pass)]
-> [(GenLocated SrcSpan (HsDecl pass), [HsDocString])]
forall {l} {p}.
[HsDocString]
-> Maybe (GenLocated l (HsDecl p))
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go [] Maybe (GenLocated SrcSpan (HsDecl pass))
forall a. Maybe a
Nothing
  where
    go :: [HsDocString]
-> Maybe (GenLocated l (HsDecl p))
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go [HsDocString]
docs Maybe (GenLocated l (HsDecl p))
mprev [GenLocated l (HsDecl p)]
decls = case ([GenLocated l (HsDecl p)]
decls, Maybe (GenLocated l (HsDecl p))
mprev) of
      ((GenLocated l (HsDecl p) -> HsDecl p
forall l e. GenLocated l e -> e
unLoc->DocD XDocD p
_ (DocCommentNext HsDocString
s)) : [GenLocated l (HsDecl p)]
ds, Maybe (GenLocated l (HsDecl p))
Nothing)   -> [HsDocString]
-> Maybe (GenLocated l (HsDecl p))
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go (HsDocString
sHsDocString -> [HsDocString] -> [HsDocString]
forall a. a -> [a] -> [a]
:[HsDocString]
docs) Maybe (GenLocated l (HsDecl p))
forall a. Maybe a
Nothing [GenLocated l (HsDecl p)]
ds
      ((GenLocated l (HsDecl p) -> HsDecl p
forall l e. GenLocated l e -> e
unLoc->DocD XDocD p
_ (DocCommentNext HsDocString
s)) : [GenLocated l (HsDecl p)]
ds, Just GenLocated l (HsDecl p)
prev) -> GenLocated l (HsDecl p)
-> [HsDocString]
-> [(GenLocated l (HsDecl p), [HsDocString])]
-> [(GenLocated l (HsDecl p), [HsDocString])]
forall {a} {a}. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished GenLocated l (HsDecl p)
prev [HsDocString]
docs ([(GenLocated l (HsDecl p), [HsDocString])]
 -> [(GenLocated l (HsDecl p), [HsDocString])])
-> [(GenLocated l (HsDecl p), [HsDocString])]
-> [(GenLocated l (HsDecl p), [HsDocString])]
forall a b. (a -> b) -> a -> b
$ [HsDocString]
-> Maybe (GenLocated l (HsDecl p))
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go [HsDocString
s] Maybe (GenLocated l (HsDecl p))
forall a. Maybe a
Nothing [GenLocated l (HsDecl p)]
ds
      ((GenLocated l (HsDecl p) -> HsDecl p
forall l e. GenLocated l e -> e
unLoc->DocD XDocD p
_ (DocCommentPrev HsDocString
s)) : [GenLocated l (HsDecl p)]
ds, Maybe (GenLocated l (HsDecl p))
mprev)     -> [HsDocString]
-> Maybe (GenLocated l (HsDecl p))
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go (HsDocString
sHsDocString -> [HsDocString] -> [HsDocString]
forall a. a -> [a] -> [a]
:[HsDocString]
docs) Maybe (GenLocated l (HsDecl p))
mprev [GenLocated l (HsDecl p)]
ds
      (GenLocated l (HsDecl p)
d                                  : [GenLocated l (HsDecl p)]
ds, Maybe (GenLocated l (HsDecl p))
Nothing)   -> [HsDocString]
-> Maybe (GenLocated l (HsDecl p))
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go [HsDocString]
docs (GenLocated l (HsDecl p) -> Maybe (GenLocated l (HsDecl p))
forall a. a -> Maybe a
Just GenLocated l (HsDecl p)
d) [GenLocated l (HsDecl p)]
ds
      (GenLocated l (HsDecl p)
d                                  : [GenLocated l (HsDecl p)]
ds, Just GenLocated l (HsDecl p)
prev) -> GenLocated l (HsDecl p)
-> [HsDocString]
-> [(GenLocated l (HsDecl p), [HsDocString])]
-> [(GenLocated l (HsDecl p), [HsDocString])]
forall {a} {a}. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished GenLocated l (HsDecl p)
prev [HsDocString]
docs ([(GenLocated l (HsDecl p), [HsDocString])]
 -> [(GenLocated l (HsDecl p), [HsDocString])])
-> [(GenLocated l (HsDecl p), [HsDocString])]
-> [(GenLocated l (HsDecl p), [HsDocString])]
forall a b. (a -> b) -> a -> b
$ [HsDocString]
-> Maybe (GenLocated l (HsDecl p))
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go [] (GenLocated l (HsDecl p) -> Maybe (GenLocated l (HsDecl p))
forall a. a -> Maybe a
Just GenLocated l (HsDecl p)
d) [GenLocated l (HsDecl p)]
ds
      ([]                                     , Maybe (GenLocated l (HsDecl p))
Nothing)   -> []
      ([]                                     , Just GenLocated l (HsDecl p)
prev) -> GenLocated l (HsDecl p)
-> [HsDocString]
-> [(GenLocated l (HsDecl p), [HsDocString])]
-> [(GenLocated l (HsDecl p), [HsDocString])]
forall {a} {a}. a -> [a] -> [(a, [a])] -> [(a, [a])]
finished GenLocated l (HsDecl p)
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 :: forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls = ((GenLocated SrcSpan (HsDecl a), doc) -> Bool)
-> [(GenLocated SrcSpan (HsDecl a), doc)]
-> [(GenLocated SrcSpan (HsDecl a), doc)]
forall a. (a -> Bool) -> [a] -> [a]
filter (HsDecl a -> Bool
forall a. HsDecl a -> Bool
isHandled (HsDecl a -> Bool)
-> ((GenLocated SrcSpan (HsDecl a), doc) -> HsDecl a)
-> (GenLocated SrcSpan (HsDecl a), doc)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsDecl a) -> HsDecl a
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsDecl a) -> HsDecl a)
-> ((GenLocated SrcSpan (HsDecl a), doc)
    -> GenLocated SrcSpan (HsDecl a))
-> (GenLocated SrcSpan (HsDecl a), doc)
-> HsDecl a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpan (HsDecl a), doc)
-> GenLocated SrcSpan (HsDecl 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 :: forall a doc. [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterClasses = ((GenLocated SrcSpan (HsDecl a), doc)
 -> (GenLocated SrcSpan (HsDecl a), doc))
-> [(GenLocated SrcSpan (HsDecl a), doc)]
-> [(GenLocated SrcSpan (HsDecl a), doc)]
forall a b. (a -> b) -> [a] -> [b]
map ((GenLocated SrcSpan (HsDecl a) -> GenLocated SrcSpan (HsDecl a))
-> (GenLocated SrcSpan (HsDecl a), doc)
-> (GenLocated SrcSpan (HsDecl a), doc)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((HsDecl a -> HsDecl a)
-> GenLocated SrcSpan (HsDecl a) -> GenLocated SrcSpan (HsDecl a)
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc HsDecl a -> HsDecl a
forall {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 :: [GenLocated SrcSpan (Sig p)]
tcdSigs =
        (GenLocated SrcSpan (Sig p) -> Bool)
-> [GenLocated SrcSpan (Sig p)] -> [GenLocated SrcSpan (Sig p)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool)
-> (GenLocated SrcSpan (Sig p) -> Bool)
-> (GenLocated SrcSpan (Sig p) -> Bool)
-> GenLocated SrcSpan (Sig p)
-> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Sig p -> Bool
forall name. Sig name -> Bool
isUserSig (Sig p -> Bool)
-> (GenLocated SrcSpan (Sig p) -> Sig p)
-> GenLocated SrcSpan (Sig p)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (Sig p) -> Sig p
forall l e. GenLocated l e -> e
unLoc) GenLocated SrcSpan (Sig p) -> Bool
forall name. LSig name -> Bool
isMinimalLSig) (TyClDecl p -> [GenLocated SrcSpan (Sig p)]
forall pass. TyClDecl pass -> [LSig pass]
tcdSigs TyClDecl p
c) }
    filterClass HsDecl p
d = HsDecl p
d

-- | Was this signature given by the user?
isUserSig :: Sig name -> Bool
isUserSig :: forall name. 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 :: forall struct decl hsDecl.
(struct -> [Located decl])
-> (decl -> hsDecl) -> struct -> [Located hsDecl]
mkDecls struct -> [Located decl]
field decl -> hsDecl
con = (Located decl -> GenLocated SrcSpan hsDecl)
-> [Located decl] -> [GenLocated SrcSpan hsDecl]
forall a b. (a -> b) -> [a] -> [b]
map ((decl -> hsDecl) -> Located decl -> GenLocated SrcSpan hsDecl
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc decl -> hsDecl
con) ([Located decl] -> [GenLocated SrcSpan hsDecl])
-> (struct -> [Located decl])
-> struct
-> [GenLocated SrcSpan hsDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. struct -> [Located decl]
field