{-# 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
extractDocs :: TcGblEnv
-> (Maybe HsDocString, DeclDocMap, ArgDocMap)
TcGblEnv { tcg_semantic_mod :: TcGblEnv -> Module
tcg_semantic_mod = Module
mod
, tcg_rn_decls :: TcGblEnv -> Maybe (HsGroup GhcRn)
tcg_rn_decls = Maybe (HsGroup GhcRn)
mb_rn_decls
, tcg_insts :: TcGblEnv -> [ClsInst]
tcg_insts = [ClsInst]
insts
, tcg_fam_insts :: TcGblEnv -> [FamInst]
tcg_fam_insts = [FamInst]
fam_insts
, tcg_doc_hdr :: TcGblEnv -> Maybe LHsDocString
tcg_doc_hdr = Maybe LHsDocString
mb_doc_hdr
} =
(LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc (LHsDocString -> HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LHsDocString
mb_doc_hdr, Map Name HsDocString -> DeclDocMap
DeclDocMap Map Name HsDocString
doc_map, Map Name (Map Int HsDocString) -> ArgDocMap
ArgDocMap Map Name (Map Int HsDocString)
arg_map)
where
(Map Name HsDocString
doc_map, Map Name (Map Int HsDocString)
arg_map) = (Map Name HsDocString, Map Name (Map Int HsDocString))
-> ([(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
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 (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) 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 RealSrcSpan Name
-> HsDecl GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
subordinates Map RealSrcSpan Name
instanceMap HsDecl GhcRn
decl
([Maybe HsDocString]
subDocs, [Map Int HsDocString]
subArgs) =
[(Maybe HsDocString, Map Int HsDocString)]
-> ([Maybe HsDocString], [Map Int HsDocString])
forall a b. [(a, b)] -> ([a], [b])
unzip (((Name, [HsDocString], Map Int HsDocString)
-> (Maybe HsDocString, Map Int HsDocString))
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Maybe HsDocString, Map Int HsDocString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
_, [HsDocString]
strs, Map Int HsDocString
m) -> ([HsDocString] -> Maybe HsDocString
concatDocs [HsDocString]
strs, Map Int HsDocString
m)) [(Name, [HsDocString], Map Int HsDocString)]
subs)
ns :: [Name]
ns = RealSrcSpan -> HsDecl GhcRn -> [Name]
names RealSrcSpan
l HsDecl GhcRn
decl
subNs :: [Name]
subNs = [ Name
n | (Name
n, [HsDocString]
_, Map Int HsDocString
_) <- [(Name, [HsDocString], Map Int HsDocString)]
subs ]
dm :: [(Name, HsDocString)]
dm = [(Name
n, HsDocString
d) | (Name
n, Just HsDocString
d) <- [Name] -> [Maybe HsDocString] -> [(Name, Maybe HsDocString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
ns (Maybe HsDocString -> [Maybe HsDocString]
forall a. a -> [a]
repeat Maybe HsDocString
doc) [(Name, Maybe HsDocString)]
-> [(Name, Maybe HsDocString)] -> [(Name, Maybe HsDocString)]
forall a. [a] -> [a] -> [a]
++ [Name] -> [Maybe HsDocString] -> [(Name, Maybe HsDocString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
subNs [Maybe HsDocString]
subDocs]
am :: [(Name, Map Int HsDocString)]
am = [(Name
n, Map Int HsDocString
args) | Name
n <- [Name]
ns] [(Name, Map Int HsDocString)]
-> [(Name, Map Int HsDocString)] -> [(Name, Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [Name] -> [Map Int HsDocString] -> [(Name, Map Int HsDocString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
subNs [Map Int HsDocString]
subArgs
mappings (L (UnhelpfulSpan UnhelpfulSpanReason
_) HsDecl GhcRn
_, [HsDocString]
_) = ([], [])
instanceMap :: Map RealSrcSpan Name
instanceMap :: Map RealSrcSpan Name
instanceMap = [(RealSrcSpan, Name)] -> Map RealSrcSpan Name
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(RealSrcSpan
l, Name
n) | Name
n <- [Name]
instances, RealSrcSpan RealSrcSpan
l Maybe BufSpan
_ <- [Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
n] ]
names :: RealSrcSpan -> HsDecl GhcRn -> [Name]
names :: RealSrcSpan -> HsDecl GhcRn -> [Name]
names RealSrcSpan
_ (InstD XInstD GhcRn
_ InstDecl GhcRn
d) = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan (InstDecl GhcRn -> SrcSpan
forall (p :: Pass). InstDecl (GhcPass p) -> SrcSpan
getInstLoc InstDecl GhcRn
d) Map RealSrcSpan Name
instanceMap
names RealSrcSpan
l (DerivD {}) = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (RealSrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup RealSrcSpan
l Map RealSrcSpan Name
instanceMap)
names RealSrcSpan
_ HsDecl GhcRn
decl = HsDecl GhcRn -> [IdP GhcRn]
forall (p :: Pass).
CollectPass (GhcPass p) =>
HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder HsDecl GhcRn
decl
getMainDeclBinder :: (CollectPass (GhcPass p))
=> HsDecl (GhcPass p)
-> [IdP (GhcPass p)]
getMainDeclBinder :: HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder (TyClD XTyClD (GhcPass p)
_ TyClDecl (GhcPass p)
d) = [TyClDecl (GhcPass p) -> IdP (GhcPass p)
forall (p :: Pass). TyClDecl (GhcPass p) -> IdP (GhcPass p)
tcdName TyClDecl (GhcPass p)
d]
getMainDeclBinder (ValD XValD (GhcPass p)
_ HsBind (GhcPass p)
d) =
case HsBind (GhcPass p) -> [IdP (GhcPass p)]
forall p idR. CollectPass p => HsBindLR p idR -> [IdP p]
collectHsBindBinders HsBind (GhcPass p)
d of
[] -> []
(IdP (GhcPass p)
name:[IdP (GhcPass p)]
_) -> [IdP (GhcPass p)
name]
getMainDeclBinder (SigD XSigD (GhcPass p)
_ Sig (GhcPass p)
d) = Sig (GhcPass p) -> [IdP (GhcPass p)]
forall pass. 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 Located (IdP (GhcPass p))
GenLocated SrcSpan (IdGhcP 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 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
_ = []
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 }) -> 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)
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
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
subordinates :: Map RealSrcSpan Name
-> HsDecl GhcRn
-> [(Name, [(HsDocString)], Map Int (HsDocString))]
subordinates :: Map RealSrcSpan Name
-> HsDecl GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
subordinates Map RealSrcSpan Name
instMap HsDecl GhcRn
decl = case HsDecl GhcRn
decl of
InstD XInstD GhcRn
_ (ClsInstD XClsInstD GhcRn
_ ClsInstDecl GhcRn
d) -> do
DataFamInstDecl { dfid_eqn :: forall pass.
DataFamInstDecl pass -> 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 GhcRn
_
, feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = HsDataDefn GhcRn
defn }}} <- GenLocated SrcSpan (DataFamInstDecl GhcRn) -> DataFamInstDecl GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (DataFamInstDecl GhcRn)
-> DataFamInstDecl GhcRn)
-> [GenLocated SrcSpan (DataFamInstDecl GhcRn)]
-> [DataFamInstDecl GhcRn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClsInstDecl GhcRn -> [GenLocated SrcSpan (DataFamInstDecl GhcRn)]
forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts ClsInstDecl GhcRn
d
[ (Name
n, [], Map Int HsDocString
forall k a. Map k a
M.empty) | Just Name
n <- [SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan SrcSpan
l Map RealSrcSpan Name
instMap] ] [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs HsDataDefn GhcRn
defn
InstD XInstD GhcRn
_ (DataFamInstD XDataFamInstD GhcRn
_ (DataFamInstDecl (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 HsDecl GhcRn
d)
| (L SrcSpan
_ HsDecl GhcRn
d, [HsDocString]
doc) <- TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
classDecls TyClDecl GhcRn
dd
, Name
name <- HsDecl GhcRn -> [IdP GhcRn]
forall (p :: Pass).
CollectPass (GhcPass p) =>
HsDecl (GhcPass p) -> [IdP (GhcPass p)]
getMainDeclBinder HsDecl GhcRn
d, Bool -> Bool
not (HsDecl GhcRn -> Bool
forall a. HsDecl a -> Bool
isValD HsDecl GhcRn
d)
]
dataSubs :: HsDataDefn GhcRn
-> [(Name, [HsDocString], Map Int (HsDocString))]
dataSubs :: HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
dataSubs HsDataDefn GhcRn
dd = [(Name, [HsDocString], Map Int HsDocString)]
constrs [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], Map Int HsDocString)]
fields [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
-> [(Name, [HsDocString], Map Int HsDocString)]
forall a. [a] -> [a] -> [a]
++ [(Name, [HsDocString], Map Int HsDocString)]
derivs
where
cons :: [ConDecl GhcRn]
cons = (GenLocated SrcSpan (ConDecl GhcRn) -> ConDecl GhcRn)
-> [GenLocated SrcSpan (ConDecl GhcRn)] -> [ConDecl GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (ConDecl GhcRn) -> ConDecl GhcRn
forall l e. GenLocated l e -> e
unLoc ([GenLocated SrcSpan (ConDecl GhcRn)] -> [ConDecl GhcRn])
-> [GenLocated SrcSpan (ConDecl GhcRn)] -> [ConDecl GhcRn]
forall a b. (a -> b) -> a -> b
$ (HsDataDefn GhcRn -> [GenLocated SrcSpan (ConDecl GhcRn)]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcRn
dd)
constrs :: [(Name, [HsDocString], Map Int HsDocString)]
constrs = [ ( GenLocated SrcSpan Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan Name
cname
, Maybe HsDocString -> [HsDocString]
forall a. Maybe a -> [a]
maybeToList (Maybe HsDocString -> [HsDocString])
-> Maybe HsDocString -> [HsDocString]
forall a b. (a -> b) -> a -> b
$ (LHsDocString -> HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc (Maybe LHsDocString -> Maybe HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall a b. (a -> b) -> a -> b
$ ConDecl GhcRn -> Maybe LHsDocString
forall pass. ConDecl pass -> Maybe LHsDocString
con_doc ConDecl GhcRn
c
, ConDecl GhcRn -> Map Int HsDocString
conArgDocs ConDecl GhcRn
c)
| ConDecl GhcRn
c <- [ConDecl GhcRn]
cons, GenLocated SrcSpan Name
cname <- ConDecl GhcRn -> [GenLocated SrcSpan Name]
getConNames ConDecl GhcRn
c ]
fields :: [(Name, [HsDocString], Map Int HsDocString)]
fields = [ (FieldOcc GhcRn -> XCFieldOcc GhcRn
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc FieldOcc GhcRn
n, Maybe HsDocString -> [HsDocString]
forall a. Maybe a -> [a]
maybeToList (Maybe HsDocString -> [HsDocString])
-> Maybe HsDocString -> [HsDocString]
forall a b. (a -> b) -> a -> b
$ (LHsDocString -> HsDocString)
-> Maybe LHsDocString -> Maybe HsDocString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc Maybe LHsDocString
doc, Map Int HsDocString
forall k a. Map k a
M.empty)
| RecCon Located [LConDeclField GhcRn]
flds <- (ConDecl GhcRn
-> HsConDetails
(HsScaled GhcRn (LBangType GhcRn)) (Located [LConDeclField GhcRn]))
-> [ConDecl GhcRn]
-> [HsConDetails
(HsScaled GhcRn (LBangType GhcRn)) (Located [LConDeclField GhcRn])]
forall a b. (a -> b) -> [a] -> [b]
map ConDecl GhcRn
-> HsConDetails
(HsScaled GhcRn (LBangType GhcRn)) (Located [LConDeclField GhcRn])
getConArgs [ConDecl GhcRn]
cons
, (L SrcSpan
_ (ConDeclField XConDeclField GhcRn
_ [LFieldOcc GhcRn]
ns LBangType GhcRn
_ Maybe LHsDocString
doc)) <- (Located [LConDeclField GhcRn] -> [LConDeclField GhcRn]
forall l e. GenLocated l e -> e
unLoc Located [LConDeclField GhcRn]
flds)
, (L SrcSpan
_ FieldOcc GhcRn
n) <- [LFieldOcc GhcRn]
ns ]
derivs :: [(Name, [HsDocString], Map Int HsDocString)]
derivs = [ (Name
instName, [LHsDocString -> HsDocString
forall l e. GenLocated l e -> e
unLoc LHsDocString
doc], Map Int HsDocString
forall k a. Map k a
M.empty)
| (SrcSpan
l, LHsDocString
doc) <- (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
$
(GenLocated SrcSpan (HsDerivingClause GhcRn)
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GenLocated SrcSpan [HsImplicitBndrs GhcRn (LBangType GhcRn)]
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan [HsImplicitBndrs GhcRn (LBangType GhcRn)]
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> (GenLocated SrcSpan (HsDerivingClause GhcRn)
-> GenLocated SrcSpan [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> GenLocated SrcSpan (HsDerivingClause GhcRn)
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDerivingClause GhcRn
-> GenLocated SrcSpan [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall pass. HsDerivingClause pass -> Located [LHsSigType pass]
deriv_clause_tys (HsDerivingClause GhcRn
-> GenLocated SrcSpan [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> (GenLocated SrcSpan (HsDerivingClause GhcRn)
-> HsDerivingClause GhcRn)
-> GenLocated SrcSpan (HsDerivingClause GhcRn)
-> GenLocated SrcSpan [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsDerivingClause GhcRn)
-> HsDerivingClause GhcRn
forall l e. GenLocated l e -> e
unLoc) ([GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)])
-> [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [HsImplicitBndrs GhcRn (LBangType GhcRn)]
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpan [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [GenLocated SrcSpan (HsDerivingClause GhcRn)]
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [GenLocated SrcSpan (HsDerivingClause GhcRn)])
-> GenLocated SrcSpan [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> [GenLocated SrcSpan (HsDerivingClause GhcRn)]
forall a b. (a -> b) -> a -> b
$ HsDataDefn GhcRn
-> GenLocated SrcSpan [GenLocated SrcSpan (HsDerivingClause GhcRn)]
forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs HsDataDefn GhcRn
dd
, Just Name
instName <- [SrcSpan -> Map RealSrcSpan Name -> Maybe Name
forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan SrcSpan
l Map RealSrcSpan Name
instMap] ]
extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty :: LBangType GhcRn -> Maybe (SrcSpan, LHsDocString)
extract_deriv_ty (L SrcSpan
l HsType GhcRn
ty) =
case HsType GhcRn
ty of
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 GhcRn
_ LBangType GhcRn
_ LHsDocString
doc) }
-> (SrcSpan, LHsDocString) -> Maybe (SrcSpan, LHsDocString)
forall a. a -> Maybe a
Just (SrcSpan
l, LHsDocString
doc)
HsDocTy XDocTy GhcRn
_ LBangType GhcRn
_ LHsDocString
doc -> (SrcSpan, LHsDocString) -> Maybe (SrcSpan, LHsDocString)
forall a. a -> Maybe a
Just (SrcSpan
l, LHsDocString
doc)
HsType GhcRn
_ -> Maybe (SrcSpan, LHsDocString)
forall a. Maybe a
Nothing
conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString)
conArgDocs :: ConDecl GhcRn -> Map Int HsDocString
conArgDocs ConDecl GhcRn
con = case ConDecl GhcRn
-> HsConDetails
(HsScaled GhcRn (LBangType GhcRn)) (Located [LConDeclField GhcRn])
getConArgs ConDecl GhcRn
con of
PrefixCon [HsScaled GhcRn (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 ((HsScaled GhcRn (LBangType GhcRn) -> HsType GhcRn)
-> [HsScaled GhcRn (LBangType GhcRn)] -> [HsType GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (LBangType GhcRn -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc (LBangType GhcRn -> HsType GhcRn)
-> (HsScaled GhcRn (LBangType GhcRn) -> LBangType GhcRn)
-> HsScaled GhcRn (LBangType GhcRn)
-> HsType GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled GhcRn (LBangType GhcRn) -> LBangType GhcRn
forall pass a. HsScaled pass a -> a
hsScaledThing) [HsScaled GhcRn (LBangType GhcRn)]
args [HsType GhcRn] -> [HsType GhcRn] -> [HsType GhcRn]
forall a. [a] -> [a] -> [a]
++ [HsType GhcRn]
ret)
InfixCon HsScaled GhcRn (LBangType GhcRn)
arg1 HsScaled GhcRn (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 -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc (HsScaled GhcRn (LBangType GhcRn) -> LBangType GhcRn
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled GhcRn (LBangType GhcRn)
arg1),
LBangType GhcRn -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc (HsScaled GhcRn (LBangType GhcRn) -> LBangType GhcRn
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled GhcRn (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 -> 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 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 -> HsType GhcRn
forall l e. GenLocated l e -> e
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
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]
sortLocated ([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 NoExtField
XDocD GhcRn
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 NoExtField
XValD GhcRn
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 NoExtField
XSigD GhcRn
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 NoExtField
XTyClD GhcRn
noExtField (TyClDecl GhcRn -> HsDecl GhcRn)
-> (FamilyDecl GhcRn -> TyClDecl GhcRn)
-> FamilyDecl GhcRn
-> HsDecl GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFamDecl GhcRn -> FamilyDecl GhcRn -> TyClDecl GhcRn
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl NoExtField
XFamDecl GhcRn
noExtField) TyClDecl GhcRn
class_
declTypeDocs :: HsDecl GhcRn -> Map Int (HsDocString)
declTypeDocs :: HsDecl GhcRn -> Map Int HsDocString
declTypeDocs = \case
SigD XSigD GhcRn
_ (TypeSig XTypeSig GhcRn
_ [GenLocated SrcSpan (IdP GhcRn)]
_ LHsSigWcType GhcRn
ty) -> HsType GhcRn -> Map Int HsDocString
typeDocs (LBangType GhcRn -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc (LHsSigWcType GhcRn -> LBangType GhcRn
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType GhcRn
ty))
SigD XSigD GhcRn
_ (ClassOpSig XClassOpSig GhcRn
_ Bool
_ [GenLocated SrcSpan (IdP GhcRn)]
_ HsImplicitBndrs GhcRn (LBangType GhcRn)
ty) -> HsType GhcRn -> Map Int HsDocString
typeDocs (LBangType GhcRn -> HsType GhcRn
forall l e. GenLocated l e -> e
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
_ [GenLocated SrcSpan (IdP GhcRn)]
_ HsImplicitBndrs GhcRn (LBangType GhcRn)
ty) -> HsType GhcRn -> Map Int HsDocString
typeDocs (LBangType GhcRn -> HsType GhcRn
forall l e. GenLocated l e -> e
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
_ GenLocated SrcSpan (IdP GhcRn)
_ HsImplicitBndrs GhcRn (LBangType GhcRn)
ty ForeignImport
_) -> HsType GhcRn -> Map Int HsDocString
typeDocs (LBangType GhcRn -> HsType GhcRn
forall l e. GenLocated l e -> e
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 -> HsType GhcRn
forall l e. GenLocated l e -> e
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
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 -> 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
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]
sortLocated ([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
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 NoExtField
XTyClD GhcRn
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 NoExtField
XDerivD GhcRn
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 NoExtField
XDefD GhcRn
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 NoExtField
XForD GhcRn
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 NoExtField
XDocD GhcRn
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 NoExtField
XInstD GhcRn
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 (HsValBinds GhcRn -> [Located (Sig GhcRn)]
typesigs (HsValBinds GhcRn -> [Located (Sig GhcRn)])
-> (HsGroup GhcRn -> HsValBinds GhcRn)
-> HsGroup GhcRn
-> [Located (Sig GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup GhcRn -> HsValBinds GhcRn
forall p. HsGroup p -> HsValBinds p
hs_valds) (XSigD GhcRn -> Sig GhcRn -> HsDecl GhcRn
forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
XSigD GhcRn
noExtField) HsGroup GhcRn
group_ [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 (HsValBinds GhcRn -> [Located (HsBindLR GhcRn GhcRn)]
valbinds (HsValBinds GhcRn -> [Located (HsBindLR GhcRn GhcRn)])
-> (HsGroup GhcRn -> HsValBinds GhcRn)
-> HsGroup GhcRn
-> [Located (HsBindLR GhcRn GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsGroup GhcRn -> HsValBinds GhcRn
forall p. HsGroup p -> HsValBinds p
hs_valds) (XValD GhcRn -> HsBindLR GhcRn GhcRn -> HsDecl GhcRn
forall p. XValD p -> HsBind p -> HsDecl p
ValD NoExtField
XValD GhcRn
noExtField) HsGroup GhcRn
group_
where
typesigs :: HsValBinds GhcRn -> [LSig GhcRn]
typesigs :: HsValBinds GhcRn -> [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 l e. GenLocated l e -> e
unLoc) [Located (Sig GhcRn)]
sig
typesigs ValBinds{} = [Char] -> [Located (Sig GhcRn)]
forall a. HasCallStack => [Char] -> a
error [Char]
"expected XValBindsLR"
valbinds :: HsValBinds GhcRn -> [LHsBind GhcRn]
valbinds :: HsValBinds GhcRn -> [Located (HsBindLR GhcRn GhcRn)]
valbinds (XValBindsLR (NValBinds binds _)) =
(Bag (Located (HsBindLR GhcRn GhcRn))
-> [Located (HsBindLR GhcRn GhcRn)])
-> [Bag (Located (HsBindLR GhcRn GhcRn))]
-> [Located (HsBindLR GhcRn GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bag (Located (HsBindLR GhcRn GhcRn))
-> [Located (HsBindLR GhcRn GhcRn)]
forall a. Bag a -> [a]
bagToList ([Bag (Located (HsBindLR GhcRn GhcRn))]
-> [Located (HsBindLR GhcRn GhcRn)])
-> ([(RecFlag, Bag (Located (HsBindLR GhcRn GhcRn)))]
-> [Bag (Located (HsBindLR GhcRn GhcRn))])
-> [(RecFlag, Bag (Located (HsBindLR GhcRn GhcRn)))]
-> [Located (HsBindLR GhcRn GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RecFlag], [Bag (Located (HsBindLR GhcRn GhcRn))])
-> [Bag (Located (HsBindLR GhcRn GhcRn))]
forall a b. (a, b) -> b
snd (([RecFlag], [Bag (Located (HsBindLR GhcRn GhcRn))])
-> [Bag (Located (HsBindLR GhcRn GhcRn))])
-> ([(RecFlag, Bag (Located (HsBindLR GhcRn GhcRn)))]
-> ([RecFlag], [Bag (Located (HsBindLR GhcRn GhcRn))]))
-> [(RecFlag, Bag (Located (HsBindLR GhcRn GhcRn)))]
-> [Bag (Located (HsBindLR GhcRn GhcRn))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RecFlag, Bag (Located (HsBindLR GhcRn GhcRn)))]
-> ([RecFlag], [Bag (Located (HsBindLR GhcRn GhcRn))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(RecFlag, Bag (Located (HsBindLR GhcRn GhcRn)))]
-> [Located (HsBindLR GhcRn GhcRn)])
-> [(RecFlag, Bag (Located (HsBindLR GhcRn GhcRn)))]
-> [Located (HsBindLR GhcRn GhcRn)]
forall a b. (a -> b) -> a -> b
$ [(RecFlag, Bag (Located (HsBindLR GhcRn GhcRn)))]
binds
valbinds ValBinds{} = [Char] -> [Located (HsBindLR GhcRn GhcRn)]
forall a. HasCallStack => [Char] -> a
error [Char]
"expected XValBindsLR"
collectDocs :: [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]
collectDocs :: [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]
collectDocs = [HsDocString]
-> Maybe (LHsDecl pass)
-> [LHsDecl pass]
-> [(LHsDecl pass, [HsDocString])]
forall l p.
[HsDocString]
-> Maybe (GenLocated l (HsDecl p))
-> [GenLocated l (HsDecl p)]
-> [(GenLocated l (HsDecl p), [HsDocString])]
go [] Maybe (LHsDecl 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
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 l e. GenLocated l e -> e
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
isHandled (DocD {}) = Bool
True
isHandled HsDecl name
_ = Bool
False
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 pass. HsDecl pass -> HsDecl pass
filterClass))
where
filterClass :: HsDecl pass -> HsDecl pass
filterClass (TyClD XTyClD pass
x c :: TyClDecl pass
c@(ClassDecl {})) =
XTyClD pass -> TyClDecl pass -> HsDecl pass
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD pass
x (TyClDecl pass -> HsDecl pass) -> TyClDecl pass -> HsDecl pass
forall a b. (a -> b) -> a -> b
$ TyClDecl pass
c { tcdSigs :: [LSig pass]
tcdSigs =
(LSig pass -> Bool) -> [LSig pass] -> [LSig pass]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool)
-> (LSig pass -> Bool) -> (LSig pass -> Bool) -> LSig pass -> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Sig pass -> Bool
forall name. Sig name -> Bool
isUserSig (Sig pass -> Bool) -> (LSig pass -> Sig pass) -> LSig pass -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSig pass -> Sig pass
forall l e. GenLocated l e -> e
unLoc) LSig pass -> Bool
forall name. LSig name -> Bool
isMinimalLSig) (TyClDecl pass -> [LSig pass]
forall pass. TyClDecl pass -> [LSig pass]
tcdSigs TyClDecl pass
c) }
filterClass HsDecl pass
d = HsDecl pass
d
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
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