-- | Extract docs from the renamer output so they can be serialized. {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BangPatterns #-} module GHC.HsToCore.Docs where import GHC.Prelude import GHC.Data.Bag import GHC.Hs.Binds import GHC.Hs.Doc import GHC.Hs.Decls import Language.Haskell.Syntax.Extension import GHC.Hs.Extension import GHC.Hs.Type import GHC.Hs.Utils import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.SrcLoc import GHC.Tc.Types import GHC.Parser.Annotation import Control.Applicative import Control.Monad.IO.Class import Data.Bifunctor (first) import Data.Foldable (toList) import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Map.Strict (Map) import qualified Data.Map as M import qualified Data.Set as Set import Data.Maybe import Data.Semigroup import GHC.IORef (readIORef) import GHC.Unit.Types import GHC.Hs import GHC.Types.Avail import GHC.Unit.Module import qualified Data.List.NonEmpty as NonEmpty import Data.List.NonEmpty (NonEmpty ((:|))) import GHC.Unit.Module.Imported import GHC.Driver.Session import GHC.Types.TypeEnv import GHC.Types.Id import GHC.Types.Unique.Map -- | Extract docs from renamer output. -- This is monadic since we need to be able to read documentation added from -- Template Haskell's @putDoc@, which is stored in 'tcg_th_docs'. extractDocs :: MonadIO m => DynFlags -> TcGblEnv -> m (Maybe Docs) -- ^ -- 1. Module header -- 2. Docs on top level declarations -- 3. Docs on arguments extractDocs :: forall (m :: * -> *). MonadIO m => DynFlags -> TcGblEnv -> m (Maybe Docs) extractDocs DynFlags dflags TcGblEnv { tcg_semantic_mod :: TcGblEnv -> Module tcg_semantic_mod = Module semantic_mdl , tcg_mod :: TcGblEnv -> Module tcg_mod = Module mdl , tcg_rn_decls :: TcGblEnv -> Maybe (HsGroup (GhcPass 'Renamed)) tcg_rn_decls = Just HsGroup (GhcPass 'Renamed) rn_decls , tcg_rn_exports :: TcGblEnv -> Maybe [(LIE (GhcPass 'Renamed), Avails)] tcg_rn_exports = Maybe [(LIE (GhcPass 'Renamed), Avails)] mb_rn_exports , tcg_exports :: TcGblEnv -> Avails tcg_exports = Avails all_exports , tcg_imports :: TcGblEnv -> ImportAvails tcg_imports = ImportAvails import_avails , tcg_insts :: TcGblEnv -> [ClsInst] tcg_insts = [ClsInst] insts , tcg_fam_insts :: TcGblEnv -> [FamInst] tcg_fam_insts = [FamInst] fam_insts , tcg_doc_hdr :: TcGblEnv -> Maybe (LHsDoc (GhcPass 'Renamed)) tcg_doc_hdr = Maybe (LHsDoc (GhcPass 'Renamed)) mb_doc_hdr , tcg_th_docs :: TcGblEnv -> TcRef THDocs tcg_th_docs = TcRef THDocs th_docs_var , tcg_type_env :: TcGblEnv -> TypeEnv tcg_type_env = TypeEnv ty_env } = do THDocs th_docs <- IO THDocs -> m THDocs forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO THDocs -> m THDocs) -> IO THDocs -> m THDocs forall a b. (a -> b) -> a -> b $ TcRef THDocs -> IO THDocs forall a. IORef a -> IO a readIORef TcRef THDocs th_docs_var let doc_hdr :: Maybe (HsDoc (GhcPass 'Renamed)) doc_hdr = (LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed)) -> Maybe (LHsDoc (GhcPass 'Renamed)) -> Maybe (HsDoc (GhcPass 'Renamed)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (LHsDoc (GhcPass 'Renamed)) mb_doc_hdr) ExtractedTHDocs Maybe (HsDoc (GhcPass 'Renamed)) th_hdr UniqMap Name (HsDoc (GhcPass 'Renamed)) th_decl_docs UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) th_arg_docs UniqMap Name (HsDoc (GhcPass 'Renamed)) th_inst_docs = THDocs -> ExtractedTHDocs extractTHDocs THDocs th_docs mod_docs :: Docs mod_docs = Docs { docs_mod_hdr :: Maybe (HsDoc (GhcPass 'Renamed)) docs_mod_hdr = Maybe (HsDoc (GhcPass 'Renamed)) th_hdr Maybe (HsDoc (GhcPass 'Renamed)) -> Maybe (HsDoc (GhcPass 'Renamed)) -> Maybe (HsDoc (GhcPass 'Renamed)) forall a. Maybe a -> Maybe a -> Maybe a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Maybe (HsDoc (GhcPass 'Renamed)) doc_hdr -- Left biased union (see #21220) , docs_decls :: UniqMap Name [HsDoc (GhcPass 'Renamed)] docs_decls = ([HsDoc (GhcPass 'Renamed)] -> [HsDoc (GhcPass 'Renamed)] -> [HsDoc (GhcPass 'Renamed)]) -> UniqMap Name [HsDoc (GhcPass 'Renamed)] -> UniqMap Name [HsDoc (GhcPass 'Renamed)] -> UniqMap Name [HsDoc (GhcPass 'Renamed)] forall a k. (a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a plusUniqMap_C (\[HsDoc (GhcPass 'Renamed)] a [HsDoc (GhcPass 'Renamed)] _ -> [HsDoc (GhcPass 'Renamed)] a) ((HsDoc (GhcPass 'Renamed) -> [HsDoc (GhcPass 'Renamed)] -> [HsDoc (GhcPass 'Renamed)] forall a. a -> [a] -> [a] :[]) (HsDoc (GhcPass 'Renamed) -> [HsDoc (GhcPass 'Renamed)]) -> UniqMap Name (HsDoc (GhcPass 'Renamed)) -> UniqMap Name [HsDoc (GhcPass 'Renamed)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> UniqMap Name (HsDoc (GhcPass 'Renamed)) th_decl_docs UniqMap Name (HsDoc (GhcPass 'Renamed)) -> UniqMap Name (HsDoc (GhcPass 'Renamed)) -> UniqMap Name (HsDoc (GhcPass 'Renamed)) forall k a. UniqMap k a -> UniqMap k a -> UniqMap k a `plusUniqMap` UniqMap Name (HsDoc (GhcPass 'Renamed)) th_inst_docs) -- These will not clash so safe to use plusUniqMap UniqMap Name [HsDoc (GhcPass 'Renamed)] doc_map , docs_args :: UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) docs_args = UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) th_arg_docs UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) -> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) -> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) forall b. UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) `unionArgMaps` UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) arg_map , docs_structure :: DocStructure docs_structure = DocStructure doc_structure , docs_named_chunks :: Map String (HsDoc (GhcPass 'Renamed)) docs_named_chunks = Map String (HsDoc (GhcPass 'Renamed)) named_chunks , docs_haddock_opts :: Maybe String docs_haddock_opts = DynFlags -> Maybe String haddockOptions DynFlags dflags , docs_language :: Maybe Language docs_language = Maybe Language language_ , docs_extensions :: EnumSet Extension docs_extensions = EnumSet Extension exts } Maybe Docs -> m (Maybe Docs) forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure (Docs -> Maybe Docs forall a. a -> Maybe a Just Docs mod_docs) where exts :: EnumSet Extension exts = DynFlags -> EnumSet Extension extensionFlags DynFlags dflags language_ :: Maybe Language language_ = DynFlags -> Maybe Language language DynFlags dflags -- We need to lookup the Names for default methods, so we -- can put them in the correct map -- See Note [default method Name] in GHC.Iface.Recomp def_meths_env :: OccEnv Name def_meths_env = [(OccName, Name)] -> OccEnv Name forall a. [(OccName, a)] -> OccEnv a mkOccEnv [(OccName occ, Name nm) | Id id <- TypeEnv -> [Id] typeEnvIds TypeEnv ty_env , let nm :: Name nm = Id -> Name idName Id id occ :: OccName occ = Name -> OccName nameOccName Name nm , OccName -> Bool isDefaultMethodOcc OccName occ ] (UniqMap Name [HsDoc (GhcPass 'Renamed)] doc_map, UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) arg_map) = OccEnv Name -> [Name] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] -> (UniqMap Name [HsDoc (GhcPass 'Renamed)], UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))) mkMaps OccEnv Name def_meths_env [Name] local_insts [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] decls_with_docs decls_with_docs :: [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] decls_with_docs = HsGroup (GhcPass 'Renamed) -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] topDecls HsGroup (GhcPass 'Renamed) rn_decls local_insts :: [Name] local_insts = (Name -> Bool) -> [Name] -> [Name] forall a. (a -> Bool) -> [a] -> [a] filter (Module -> Name -> Bool nameIsLocalOrFrom Module semantic_mdl) ([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 doc_structure :: DocStructure doc_structure = Module -> ImportAvails -> Maybe [(LIE (GhcPass 'Renamed), Avails)] -> HsGroup (GhcPass 'Renamed) -> Avails -> OccEnv Name -> DocStructure mkDocStructure Module mdl ImportAvails import_avails Maybe [(LIE (GhcPass 'Renamed), Avails)] mb_rn_exports HsGroup (GhcPass 'Renamed) rn_decls Avails all_exports OccEnv Name def_meths_env named_chunks :: Map String (HsDoc (GhcPass 'Renamed)) named_chunks = Bool -> HsGroup (GhcPass 'Renamed) -> Map String (HsDoc (GhcPass 'Renamed)) forall (pass :: Pass). Bool -> HsGroup (GhcPass pass) -> Map String (HsDoc (GhcPass pass)) getNamedChunks (Maybe [(GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)), Avails)] -> Bool forall a. Maybe a -> Bool isJust Maybe [(LIE (GhcPass 'Renamed), Avails)] Maybe [(GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)), Avails)] mb_rn_exports) HsGroup (GhcPass 'Renamed) rn_decls extractDocs DynFlags _ TcGblEnv _ = Maybe Docs -> m (Maybe Docs) forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Docs forall a. Maybe a Nothing -- | If we have an explicit export list, we extract the documentation structure -- from that. -- Otherwise we use the renamed exports and declarations. mkDocStructure :: Module -- ^ The current module -> ImportAvails -- ^ Imports -> Maybe [(LIE GhcRn, Avails)] -- ^ Explicit export list -> HsGroup GhcRn -> [AvailInfo] -- ^ All exports -> OccEnv Name -- ^ Default Methods -> DocStructure mkDocStructure :: Module -> ImportAvails -> Maybe [(LIE (GhcPass 'Renamed), Avails)] -> HsGroup (GhcPass 'Renamed) -> Avails -> OccEnv Name -> DocStructure mkDocStructure Module mdl ImportAvails import_avails (Just [(LIE (GhcPass 'Renamed), Avails)] export_list) HsGroup (GhcPass 'Renamed) _ Avails _ OccEnv Name _ = Module -> ImportAvails -> [(LIE (GhcPass 'Renamed), Avails)] -> DocStructure mkDocStructureFromExportList Module mdl ImportAvails import_avails [(LIE (GhcPass 'Renamed), Avails)] export_list mkDocStructure Module _ ImportAvails _ Maybe [(LIE (GhcPass 'Renamed), Avails)] Nothing HsGroup (GhcPass 'Renamed) rn_decls Avails all_exports OccEnv Name def_meths_env = OccEnv Name -> Avails -> HsGroup (GhcPass 'Renamed) -> DocStructure mkDocStructureFromDecls OccEnv Name def_meths_env Avails all_exports HsGroup (GhcPass 'Renamed) rn_decls -- TODO: -- * Maybe remove items that export nothing? -- * Combine sequences of DsiExports? -- * Check the ordering of avails in DsiModExport mkDocStructureFromExportList :: Module -- ^ The current module -> ImportAvails -> [(LIE GhcRn, Avails)] -- ^ Explicit export list -> DocStructure mkDocStructureFromExportList :: Module -> ImportAvails -> [(LIE (GhcPass 'Renamed), Avails)] -> DocStructure mkDocStructureFromExportList Module mdl ImportAvails import_avails [(LIE (GhcPass 'Renamed), Avails)] export_list = (IE (GhcPass 'Renamed), Avails) -> DocStructureItem toDocStructure ((IE (GhcPass 'Renamed), Avails) -> DocStructureItem) -> ((GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)), Avails) -> (IE (GhcPass 'Renamed), Avails)) -> (GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)), Avails) -> DocStructureItem forall b c a. (b -> c) -> (a -> b) -> a -> c . (GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)) -> IE (GhcPass 'Renamed)) -> (GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)), Avails) -> (IE (GhcPass 'Renamed), Avails) forall a b c. (a -> b) -> (a, c) -> (b, c) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)) -> IE (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc ((GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)), Avails) -> DocStructureItem) -> [(GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)), Avails)] -> DocStructure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [(LIE (GhcPass 'Renamed), Avails)] [(GenLocated SrcSpanAnnA (IE (GhcPass 'Renamed)), Avails)] export_list where toDocStructure :: (IE GhcRn, Avails) -> DocStructureItem toDocStructure :: (IE (GhcPass 'Renamed), Avails) -> DocStructureItem toDocStructure = \case (IEModuleContents XIEModuleContents (GhcPass 'Renamed) _ XRec (GhcPass 'Renamed) ModuleName lmn, Avails avails) -> ModuleName -> Avails -> DocStructureItem moduleExport (GenLocated SrcSpanAnnA ModuleName -> ModuleName forall l e. GenLocated l e -> e unLoc XRec (GhcPass 'Renamed) ModuleName GenLocated SrcSpanAnnA ModuleName lmn) Avails avails (IEGroup XIEGroup (GhcPass 'Renamed) _ Key level LHsDoc (GhcPass 'Renamed) doc, Avails _) -> Key -> HsDoc (GhcPass 'Renamed) -> DocStructureItem DsiSectionHeading Key level (LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc LHsDoc (GhcPass 'Renamed) doc) (IEDoc XIEDoc (GhcPass 'Renamed) _ LHsDoc (GhcPass 'Renamed) doc, Avails _) -> HsDoc (GhcPass 'Renamed) -> DocStructureItem DsiDocChunk (LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc LHsDoc (GhcPass 'Renamed) doc) (IEDocNamed XIEDocNamed (GhcPass 'Renamed) _ String name, Avails _) -> String -> DocStructureItem DsiNamedChunkRef String name (IE (GhcPass 'Renamed) _, Avails avails) -> Avails -> DocStructureItem DsiExports (Avails -> Avails nubAvails Avails avails) moduleExport :: ModuleName -- Alias -> Avails -> DocStructureItem moduleExport :: ModuleName -> Avails -> DocStructureItem moduleExport ModuleName alias Avails avails = NonEmpty ModuleName -> Avails -> DocStructureItem DsiModExport (NonEmpty ModuleName -> NonEmpty ModuleName nubSortNE NonEmpty ModuleName orig_names) (Avails -> Avails nubAvails Avails avails) where orig_names :: NonEmpty ModuleName orig_names = NonEmpty ModuleName -> ModuleName -> Map ModuleName (NonEmpty ModuleName) -> NonEmpty ModuleName forall k a. Ord k => a -> k -> Map k a -> a M.findWithDefault NonEmpty ModuleName aliasErr ModuleName alias Map ModuleName (NonEmpty ModuleName) aliasMap aliasErr :: NonEmpty ModuleName aliasErr = String -> NonEmpty ModuleName forall a. HasCallStack => String -> a error (String -> NonEmpty ModuleName) -> String -> NonEmpty ModuleName forall a b. (a -> b) -> a -> b $ String "mkDocStructureFromExportList: " String -> String -> String forall a. [a] -> [a] -> [a] ++ (ModuleName -> String moduleNameString (ModuleName -> String) -> (Module -> ModuleName) -> Module -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Module -> ModuleName forall unit. GenModule unit -> ModuleName moduleName) Module mdl String -> String -> String forall a. [a] -> [a] -> [a] ++ String ": Can't find alias " String -> String -> String forall a. [a] -> [a] -> [a] ++ ModuleName -> String moduleNameString ModuleName alias nubSortNE :: NonEmpty ModuleName -> NonEmpty ModuleName nubSortNE = [ModuleName] -> NonEmpty ModuleName forall a. HasCallStack => [a] -> NonEmpty a NonEmpty.fromList ([ModuleName] -> NonEmpty ModuleName) -> (NonEmpty ModuleName -> [ModuleName]) -> NonEmpty ModuleName -> NonEmpty ModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c . Set ModuleName -> [ModuleName] forall a. Set a -> [a] Set.toList (Set ModuleName -> [ModuleName]) -> (NonEmpty ModuleName -> Set ModuleName) -> NonEmpty ModuleName -> [ModuleName] forall b c a. (b -> c) -> (a -> b) -> a -> c . [ModuleName] -> Set ModuleName forall a. Ord a => [a] -> Set a Set.fromList ([ModuleName] -> Set ModuleName) -> (NonEmpty ModuleName -> [ModuleName]) -> NonEmpty ModuleName -> Set ModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c . NonEmpty ModuleName -> [ModuleName] forall a. NonEmpty a -> [a] NonEmpty.toList -- Map from aliases to true module names. aliasMap :: Map ModuleName (NonEmpty ModuleName) aliasMap :: Map ModuleName (NonEmpty ModuleName) aliasMap = (NonEmpty ModuleName -> NonEmpty ModuleName -> NonEmpty ModuleName) -> [(ModuleName, NonEmpty ModuleName)] -> Map ModuleName (NonEmpty ModuleName) forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a M.fromListWith NonEmpty ModuleName -> NonEmpty ModuleName -> NonEmpty ModuleName forall a. Semigroup a => a -> a -> a (<>) ([(ModuleName, NonEmpty ModuleName)] -> Map ModuleName (NonEmpty ModuleName)) -> [(ModuleName, NonEmpty ModuleName)] -> Map ModuleName (NonEmpty ModuleName) forall a b. (a -> b) -> a -> b $ (ModuleName this_mdl_name, ModuleName this_mdl_name ModuleName -> [ModuleName] -> NonEmpty ModuleName forall a. a -> [a] -> NonEmpty a :| []) (ModuleName, NonEmpty ModuleName) -> [(ModuleName, NonEmpty ModuleName)] -> [(ModuleName, NonEmpty ModuleName)] forall a. a -> [a] -> [a] : ((((Module, [ImportedModsVal]) -> [(ModuleName, NonEmpty ModuleName)]) -> [(Module, [ImportedModsVal])] -> [(ModuleName, NonEmpty ModuleName)]) -> [(Module, [ImportedModsVal])] -> ((Module, [ImportedModsVal]) -> [(ModuleName, NonEmpty ModuleName)]) -> [(ModuleName, NonEmpty ModuleName)] forall a b c. (a -> b -> c) -> b -> a -> c flip ((Module, [ImportedModsVal]) -> [(ModuleName, NonEmpty ModuleName)]) -> [(Module, [ImportedModsVal])] -> [(ModuleName, NonEmpty ModuleName)] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (ModuleEnv [ImportedModsVal] -> [(Module, [ImportedModsVal])] forall a. ModuleEnv a -> [(Module, a)] moduleEnvToList ModuleEnv [ImportedModsVal] imported) (((Module, [ImportedModsVal]) -> [(ModuleName, NonEmpty ModuleName)]) -> [(ModuleName, NonEmpty ModuleName)]) -> ((Module, [ImportedModsVal]) -> [(ModuleName, NonEmpty ModuleName)]) -> [(ModuleName, NonEmpty ModuleName)] forall a b. (a -> b) -> a -> b $ \(Module mdl, [ImportedModsVal] imvs) -> [(ImportedModsVal -> ModuleName imv_name ImportedModsVal imv, Module -> ModuleName forall unit. GenModule unit -> ModuleName moduleName Module mdl ModuleName -> [ModuleName] -> NonEmpty ModuleName forall a. a -> [a] -> NonEmpty a :| []) | ImportedModsVal imv <- [ImportedModsVal] imvs]) where this_mdl_name :: ModuleName this_mdl_name = Module -> ModuleName forall unit. GenModule unit -> ModuleName moduleName Module mdl imported :: ModuleEnv [ImportedModsVal] imported :: ModuleEnv [ImportedModsVal] imported = ([ImportedBy] -> [ImportedModsVal]) -> ModuleEnv [ImportedBy] -> ModuleEnv [ImportedModsVal] forall a b. (a -> b) -> ModuleEnv a -> ModuleEnv b mapModuleEnv [ImportedBy] -> [ImportedModsVal] importedByUser (ImportAvails -> ModuleEnv [ImportedBy] imp_mods ImportAvails import_avails) -- | Figure out the documentation structure by correlating -- the module exports with the located declarations. mkDocStructureFromDecls :: OccEnv Name -- ^ The default method environment -> [AvailInfo] -- ^ All exports, unordered -> HsGroup GhcRn -> DocStructure mkDocStructureFromDecls :: OccEnv Name -> Avails -> HsGroup (GhcPass 'Renamed) -> DocStructure mkDocStructureFromDecls OccEnv Name env Avails all_exports HsGroup (GhcPass 'Renamed) decls = (GenLocated SrcSpan DocStructureItem -> DocStructureItem) -> [GenLocated SrcSpan DocStructureItem] -> DocStructure forall a b. (a -> b) -> [a] -> [b] map GenLocated SrcSpan DocStructureItem -> DocStructureItem forall l e. GenLocated l e -> e unLoc ([GenLocated SrcSpan DocStructureItem] -> [GenLocated SrcSpan DocStructureItem] forall a. [Located a] -> [Located a] sortLocated ([GenLocated SrcSpan DocStructureItem] docs [GenLocated SrcSpan DocStructureItem] -> [GenLocated SrcSpan DocStructureItem] -> [GenLocated SrcSpan DocStructureItem] forall a. [a] -> [a] -> [a] ++ [GenLocated SrcSpan DocStructureItem] avails)) where avails :: [Located DocStructureItem] avails :: [GenLocated SrcSpan DocStructureItem] avails = ((AvailInfo -> GenLocated SrcSpan DocStructureItem) -> Avails -> [GenLocated SrcSpan DocStructureItem]) -> Avails -> (AvailInfo -> GenLocated SrcSpan DocStructureItem) -> [GenLocated SrcSpan DocStructureItem] forall a b c. (a -> b -> c) -> b -> a -> c flip (AvailInfo -> GenLocated SrcSpan DocStructureItem) -> Avails -> [GenLocated SrcSpan DocStructureItem] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Avails all_exports ((AvailInfo -> GenLocated SrcSpan DocStructureItem) -> [GenLocated SrcSpan DocStructureItem]) -> (AvailInfo -> GenLocated SrcSpan DocStructureItem) -> [GenLocated SrcSpan DocStructureItem] forall a b. (a -> b) -> a -> b $ \AvailInfo avail -> case Name -> Map Name SrcSpan -> Maybe SrcSpan forall k a. Ord k => k -> Map k a -> Maybe a M.lookup (AvailInfo -> Name availName AvailInfo avail) Map Name SrcSpan name_locs of Just SrcSpan loc -> SrcSpan -> DocStructureItem -> GenLocated SrcSpan DocStructureItem forall l e. l -> e -> GenLocated l e L SrcSpan loc (Avails -> DocStructureItem DsiExports [AvailInfo avail]) -- FIXME: This is just a workaround that we use when handling e.g. -- associated data families like in the html-test Instances.hs. Maybe SrcSpan Nothing -> DocStructureItem -> GenLocated SrcSpan DocStructureItem forall e. e -> Located e noLoc (Avails -> DocStructureItem DsiExports [AvailInfo avail]) -- Nothing -> panicDoc "mkDocStructureFromDecls: No loc found for" -- (ppr avail) docs :: [GenLocated SrcSpan DocStructureItem] docs = (GenLocated SrcSpanAnnA (DocDecl (GhcPass 'Renamed)) -> Maybe (GenLocated SrcSpan DocStructureItem)) -> [GenLocated SrcSpanAnnA (DocDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpan DocStructureItem] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe LDocDecl (GhcPass 'Renamed) -> Maybe (GenLocated SrcSpan DocStructureItem) GenLocated SrcSpanAnnA (DocDecl (GhcPass 'Renamed)) -> Maybe (GenLocated SrcSpan DocStructureItem) structuralDoc (HsGroup (GhcPass 'Renamed) -> [LDocDecl (GhcPass 'Renamed)] forall p. HsGroup p -> [LDocDecl p] hs_docs HsGroup (GhcPass 'Renamed) decls) structuralDoc :: LDocDecl GhcRn -> Maybe (Located DocStructureItem) structuralDoc :: LDocDecl (GhcPass 'Renamed) -> Maybe (GenLocated SrcSpan DocStructureItem) structuralDoc = \case L SrcSpanAnnA loc (DocCommentNamed String _name LHsDoc (GhcPass 'Renamed) doc) -> -- TODO: Is this correct? -- NB: There is no export list where we could reference the named chunk. GenLocated SrcSpan DocStructureItem -> Maybe (GenLocated SrcSpan DocStructureItem) forall a. a -> Maybe a Just (SrcSpan -> DocStructureItem -> GenLocated SrcSpan DocStructureItem forall l e. l -> e -> GenLocated l e L (SrcSpanAnnA -> SrcSpan forall a. SrcSpanAnn' a -> SrcSpan locA SrcSpanAnnA loc) (HsDoc (GhcPass 'Renamed) -> DocStructureItem DsiDocChunk (LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc LHsDoc (GhcPass 'Renamed) doc))) L SrcSpanAnnA loc (DocGroup Key level LHsDoc (GhcPass 'Renamed) doc) -> GenLocated SrcSpan DocStructureItem -> Maybe (GenLocated SrcSpan DocStructureItem) forall a. a -> Maybe a Just (SrcSpan -> DocStructureItem -> GenLocated SrcSpan DocStructureItem forall l e. l -> e -> GenLocated l e L (SrcSpanAnnA -> SrcSpan forall a. SrcSpanAnn' a -> SrcSpan locA SrcSpanAnnA loc) (Key -> HsDoc (GhcPass 'Renamed) -> DocStructureItem DsiSectionHeading Key level (LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc LHsDoc (GhcPass 'Renamed) doc))) LDocDecl (GhcPass 'Renamed) _ -> Maybe (GenLocated SrcSpan DocStructureItem) forall a. Maybe a Nothing name_locs :: Map Name SrcSpan name_locs = [(Name, SrcSpan)] -> Map Name SrcSpan forall k a. Ord k => [(k, a)] -> Map k a M.fromList ((GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)) -> [(Name, SrcSpan)]) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(Name, SrcSpan)] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)) -> [(Name, SrcSpan)] ldeclNames (HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)] ungroup HsGroup (GhcPass 'Renamed) decls)) ldeclNames :: GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)) -> [(Name, SrcSpan)] ldeclNames (L SrcSpanAnnA loc HsDecl (GhcPass 'Renamed) d) = [Name] -> [SrcSpan] -> [(Name, SrcSpan)] forall a b. [a] -> [b] -> [(a, b)] zip (OccEnv Name -> HsDecl (GhcPass 'Renamed) -> [Name] getMainDeclBinder OccEnv Name env HsDecl (GhcPass 'Renamed) d) (SrcSpan -> [SrcSpan] forall a. a -> [a] repeat (SrcSpanAnnA -> SrcSpan forall a. SrcSpanAnn' a -> SrcSpan locA SrcSpanAnnA loc)) -- | Extract named documentation chunks from the renamed declarations. -- -- If there is no explicit export list, we simply return an empty map -- since there would be no way to link to a named chunk. getNamedChunks :: Bool -- ^ Do we have an explicit export list? -> HsGroup (GhcPass pass) -> Map String (HsDoc (GhcPass pass)) getNamedChunks :: forall (pass :: Pass). Bool -> HsGroup (GhcPass pass) -> Map String (HsDoc (GhcPass pass)) getNamedChunks Bool True HsGroup (GhcPass pass) decls = [(String, HsDoc (GhcPass pass))] -> Map String (HsDoc (GhcPass pass)) forall k a. Ord k => [(k, a)] -> Map k a M.fromList ([(String, HsDoc (GhcPass pass))] -> Map String (HsDoc (GhcPass pass))) -> [(String, HsDoc (GhcPass pass))] -> Map String (HsDoc (GhcPass pass)) forall a b. (a -> b) -> a -> b $ ((DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass))) -> [DocDecl (GhcPass pass)] -> [(String, HsDoc (GhcPass pass))]) -> [DocDecl (GhcPass pass)] -> (DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass))) -> [(String, HsDoc (GhcPass pass))] forall a b c. (a -> b -> c) -> b -> a -> c flip (DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass))) -> [DocDecl (GhcPass pass)] -> [(String, HsDoc (GhcPass pass))] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe (GenLocated SrcSpanAnnA (DocDecl (GhcPass pass)) -> DocDecl (GhcPass pass) forall l e. GenLocated l e -> e unLoc (GenLocated SrcSpanAnnA (DocDecl (GhcPass pass)) -> DocDecl (GhcPass pass)) -> [GenLocated SrcSpanAnnA (DocDecl (GhcPass pass))] -> [DocDecl (GhcPass pass)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> HsGroup (GhcPass pass) -> [LDocDecl (GhcPass pass)] forall p. HsGroup p -> [LDocDecl p] hs_docs HsGroup (GhcPass pass) decls) ((DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass))) -> [(String, HsDoc (GhcPass pass))]) -> (DocDecl (GhcPass pass) -> Maybe (String, HsDoc (GhcPass pass))) -> [(String, HsDoc (GhcPass pass))] forall a b. (a -> b) -> a -> b $ \case DocCommentNamed String name LHsDoc (GhcPass pass) doc -> (String, HsDoc (GhcPass pass)) -> Maybe (String, HsDoc (GhcPass pass)) forall a. a -> Maybe a Just (String name, LHsDoc (GhcPass pass) -> HsDoc (GhcPass pass) forall l e. GenLocated l e -> e unLoc LHsDoc (GhcPass pass) doc) DocDecl (GhcPass pass) _ -> Maybe (String, HsDoc (GhcPass pass)) forall a. Maybe a Nothing getNamedChunks Bool False HsGroup (GhcPass pass) _ = Map String (HsDoc (GhcPass pass)) forall k a. Map k a M.empty -- | Create decl and arg doc-maps by looping through the declarations. -- For each declaration, find its names, its subordinates, and its doc strings. mkMaps :: OccEnv Name -> [Name] -> [(LHsDecl GhcRn, [HsDoc GhcRn])] -> (UniqMap Name [HsDoc GhcRn], UniqMap Name (IntMap (HsDoc GhcRn))) mkMaps :: OccEnv Name -> [Name] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] -> (UniqMap Name [HsDoc (GhcPass 'Renamed)], UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))) mkMaps OccEnv Name env [Name] instances [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] decls = ( ([HsDoc (GhcPass 'Renamed)] -> [HsDoc (GhcPass 'Renamed)] -> [HsDoc (GhcPass 'Renamed)]) -> [[(Name, [HsDoc (GhcPass 'Renamed)])]] -> UniqMap Name [HsDoc (GhcPass 'Renamed)] forall {k} {t :: * -> *} {a}. (Uniquable k, Foldable t) => (a -> a -> a) -> t [(k, a)] -> UniqMap k a listsToMapWith [HsDoc (GhcPass 'Renamed)] -> [HsDoc (GhcPass 'Renamed)] -> [HsDoc (GhcPass 'Renamed)] forall a. [a] -> [a] -> [a] (++) (([(Name, [HsDoc (GhcPass 'Renamed)])] -> [(Name, [HsDoc (GhcPass 'Renamed)])]) -> [[(Name, [HsDoc (GhcPass 'Renamed)])]] -> [[(Name, [HsDoc (GhcPass 'Renamed)])]] forall a b. (a -> b) -> [a] -> [b] map (((Name, [HsDoc (GhcPass 'Renamed)]) -> Name) -> [(Name, [HsDoc (GhcPass 'Renamed)])] -> [(Name, [HsDoc (GhcPass 'Renamed)])] forall a. (a -> Name) -> [a] -> [a] nubByName (Name, [HsDoc (GhcPass 'Renamed)]) -> Name forall a b. (a, b) -> a fst) [[(Name, [HsDoc (GhcPass 'Renamed)])]] decls') , (IntMap (HsDoc (GhcPass 'Renamed)) -> IntMap (HsDoc (GhcPass 'Renamed)) -> IntMap (HsDoc (GhcPass 'Renamed))) -> [[(Name, IntMap (HsDoc (GhcPass 'Renamed)))]] -> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) forall {k} {t :: * -> *} {a}. (Uniquable k, Foldable t) => (a -> a -> a) -> t [(k, a)] -> UniqMap k a listsToMapWith IntMap (HsDoc (GhcPass 'Renamed)) -> IntMap (HsDoc (GhcPass 'Renamed)) -> IntMap (HsDoc (GhcPass 'Renamed)) forall a. Semigroup a => a -> a -> a (<>) ((IntMap (HsDoc (GhcPass 'Renamed)) -> Bool) -> [[(Name, IntMap (HsDoc (GhcPass 'Renamed)))]] -> [[(Name, IntMap (HsDoc (GhcPass 'Renamed)))]] forall b a. (b -> Bool) -> [[(a, b)]] -> [[(a, b)]] filterMapping (Bool -> Bool not (Bool -> Bool) -> (IntMap (HsDoc (GhcPass 'Renamed)) -> Bool) -> IntMap (HsDoc (GhcPass 'Renamed)) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . IntMap (HsDoc (GhcPass 'Renamed)) -> Bool forall a. IntMap a -> Bool IM.null) [[(Name, IntMap (HsDoc (GhcPass 'Renamed)))]] args) ) where ([[(Name, [HsDoc (GhcPass 'Renamed)])]] decls', [[(Name, IntMap (HsDoc (GhcPass 'Renamed)))]] args) = [([(Name, [HsDoc (GhcPass 'Renamed)])], [(Name, IntMap (HsDoc (GhcPass 'Renamed)))])] -> ([[(Name, [HsDoc (GhcPass 'Renamed)])]], [[(Name, IntMap (HsDoc (GhcPass 'Renamed)))]]) forall a b. [(a, b)] -> ([a], [b]) unzip (((GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)]) -> ([(Name, [HsDoc (GhcPass 'Renamed)])], [(Name, IntMap (HsDoc (GhcPass 'Renamed)))])) -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])] -> [([(Name, [HsDoc (GhcPass 'Renamed)])], [(Name, IntMap (HsDoc (GhcPass 'Renamed)))])] forall a b. (a -> b) -> [a] -> [b] map (LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)]) -> ([(Name, [HsDoc (GhcPass 'Renamed)])], [(Name, IntMap (HsDoc (GhcPass 'Renamed)))]) (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)]) -> ([(Name, [HsDoc (GhcPass 'Renamed)])], [(Name, IntMap (HsDoc (GhcPass 'Renamed)))]) mappings [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])] decls) listsToMapWith :: (a -> a -> a) -> t [(k, a)] -> UniqMap k a listsToMapWith a -> a -> a f = (a -> a -> a) -> [(k, a)] -> UniqMap k a forall k a. Uniquable k => (a -> a -> a) -> [(k, a)] -> UniqMap k a listToUniqMap_C a -> a -> a f ([(k, a)] -> UniqMap k a) -> (t [(k, a)] -> [(k, a)]) -> t [(k, a)] -> UniqMap k a forall b c a. (b -> c) -> (a -> b) -> a -> c . t [(k, a)] -> [(k, a)] 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, [HsDoc GhcRn]) -> ( [(Name, [HsDoc GhcRn])] , [(Name, IntMap (HsDoc GhcRn))] ) mappings :: (LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)]) -> ([(Name, [HsDoc (GhcPass 'Renamed)])], [(Name, IntMap (HsDoc (GhcPass 'Renamed)))]) mappings (L (SrcSpanAnn EpAnn AnnListItem _ (RealSrcSpan RealSrcSpan l Maybe BufSpan _)) HsDecl (GhcPass 'Renamed) decl, [HsDoc (GhcPass 'Renamed)] doc) = ([(Name, [HsDoc (GhcPass 'Renamed)])] dm, [(Name, IntMap (HsDoc (GhcPass 'Renamed)))] am) where args :: IntMap (HsDoc (GhcPass 'Renamed)) args = HsDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) declTypeDocs HsDecl (GhcPass 'Renamed) decl subs :: [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))] subs :: [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] subs = OccEnv Name -> Map RealSrcSpan Name -> HsDecl (GhcPass 'Renamed) -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] subordinates OccEnv Name env Map RealSrcSpan Name instanceMap HsDecl (GhcPass 'Renamed) decl ([Name] subNs, [[HsDoc (GhcPass 'Renamed)]] subDocs, [IntMap (HsDoc (GhcPass 'Renamed))] subArgs) = [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] -> ([Name], [[HsDoc (GhcPass 'Renamed)]], [IntMap (HsDoc (GhcPass 'Renamed))]) forall a b c. [(a, b, c)] -> ([a], [b], [c]) unzip3 [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] subs ns :: [Name] ns = RealSrcSpan -> HsDecl (GhcPass 'Renamed) -> [Name] names RealSrcSpan l HsDecl (GhcPass 'Renamed) decl dm :: [(Name, [HsDoc (GhcPass 'Renamed)])] dm = [(Name n, [HsDoc (GhcPass 'Renamed)] d) | (Name n, [HsDoc (GhcPass 'Renamed)] d) <- [Name] -> [[HsDoc (GhcPass 'Renamed)]] -> [(Name, [HsDoc (GhcPass 'Renamed)])] forall a b. [a] -> [b] -> [(a, b)] zip [Name] ns ([HsDoc (GhcPass 'Renamed)] -> [[HsDoc (GhcPass 'Renamed)]] forall a. a -> [a] repeat [HsDoc (GhcPass 'Renamed)] doc) [(Name, [HsDoc (GhcPass 'Renamed)])] -> [(Name, [HsDoc (GhcPass 'Renamed)])] -> [(Name, [HsDoc (GhcPass 'Renamed)])] forall a. [a] -> [a] -> [a] ++ [Name] -> [[HsDoc (GhcPass 'Renamed)]] -> [(Name, [HsDoc (GhcPass 'Renamed)])] forall a b. [a] -> [b] -> [(a, b)] zip [Name] subNs [[HsDoc (GhcPass 'Renamed)]] subDocs, Bool -> Bool not (Bool -> Bool) -> Bool -> Bool forall a b. (a -> b) -> a -> b $ (HsDoc (GhcPass 'Renamed) -> Bool) -> [HsDoc (GhcPass 'Renamed)] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all (HsDocString -> Bool isEmptyDocString (HsDocString -> Bool) -> (HsDoc (GhcPass 'Renamed) -> HsDocString) -> HsDoc (GhcPass 'Renamed) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . HsDoc (GhcPass 'Renamed) -> HsDocString forall a pass. WithHsDocIdentifiers a pass -> a hsDocString) [HsDoc (GhcPass 'Renamed)] d] am :: [(Name, IntMap (HsDoc (GhcPass 'Renamed)))] am = [(Name n, IntMap (HsDoc (GhcPass 'Renamed)) args) | Name n <- [Name] ns] [(Name, IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, IntMap (HsDoc (GhcPass 'Renamed)))] forall a. [a] -> [a] -> [a] ++ [Name] -> [IntMap (HsDoc (GhcPass 'Renamed))] -> [(Name, IntMap (HsDoc (GhcPass 'Renamed)))] forall a b. [a] -> [b] -> [(a, b)] zip [Name] subNs [IntMap (HsDoc (GhcPass 'Renamed))] subArgs mappings (L (SrcSpanAnn EpAnn AnnListItem _ (UnhelpfulSpan UnhelpfulSpanReason _)) HsDecl (GhcPass 'Renamed) _, [HsDoc (GhcPass 'Renamed)] _) = ([], []) 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). (Anno (IdGhcP p) ~ SrcSpanAnnN) => 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 = OccEnv Name -> HsDecl (GhcPass 'Renamed) -> [Name] getMainDeclBinder OccEnv Name env 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 :: OccEnv Name -- ^ Default method environment for this module. See Note [default method Name] in GHC.Iface.Recomp -> HsDecl GhcRn -> [Name] getMainDeclBinder :: OccEnv Name -> HsDecl (GhcPass 'Renamed) -> [Name] getMainDeclBinder OccEnv Name _ (TyClD XTyClD (GhcPass 'Renamed) _ TyClDecl (GhcPass 'Renamed) d) = [TyClDecl (GhcPass 'Renamed) -> IdP (GhcPass 'Renamed) forall (p :: Pass). (Anno (IdGhcP p) ~ SrcSpanAnnN) => TyClDecl (GhcPass p) -> IdP (GhcPass p) tcdName TyClDecl (GhcPass 'Renamed) d] getMainDeclBinder OccEnv Name _ (ValD XValD (GhcPass 'Renamed) _ HsBind (GhcPass 'Renamed) d) = case CollectFlag (GhcPass 'Renamed) -> HsBind (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)] forall p idR. CollectPass p => CollectFlag p -> HsBindLR p idR -> [IdP p] collectHsBindBinders CollectFlag (GhcPass 'Renamed) forall p. CollectFlag p CollNoDictBinders HsBind (GhcPass 'Renamed) d of [] -> [] (IdP (GhcPass 'Renamed) name:[IdP (GhcPass 'Renamed)] _) -> [IdP (GhcPass 'Renamed) Name name] getMainDeclBinder OccEnv Name env (SigD XSigD (GhcPass 'Renamed) _ Sig (GhcPass 'Renamed) d) = OccEnv (IdP (GhcPass 'Renamed)) -> Sig (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)] forall a. (UnXRec a, HasOccName (IdP a)) => OccEnv (IdP a) -> Sig a -> [IdP a] sigNameNoLoc OccEnv (IdP (GhcPass 'Renamed)) OccEnv Name env Sig (GhcPass 'Renamed) d getMainDeclBinder OccEnv Name _ (ForD XForD (GhcPass 'Renamed) _ (ForeignImport XForeignImport (GhcPass 'Renamed) _ LIdP (GhcPass 'Renamed) name LHsSigType (GhcPass 'Renamed) _ ForeignImport (GhcPass 'Renamed) _)) = [GenLocated SrcSpanAnnN Name -> Name forall l e. GenLocated l e -> e unLoc LIdP (GhcPass 'Renamed) GenLocated SrcSpanAnnN Name name] getMainDeclBinder OccEnv Name _ (ForD XForD (GhcPass 'Renamed) _ (ForeignExport XForeignExport (GhcPass 'Renamed) _ LIdP (GhcPass 'Renamed) _ LHsSigType (GhcPass 'Renamed) _ ForeignExport (GhcPass 'Renamed) _)) = [] getMainDeclBinder OccEnv Name _ HsDecl (GhcPass 'Renamed) _ = [] -- | The "OccEnv Name" is the default method environment for this module -- Ultimately, the a special "defaultMethodOcc" name is used for -- the signatures on bindings for default methods. Unfortunately, this -- name isn't generated until typechecking, so it is not in the renamed AST. -- We have to look it up from the 'OccEnv' parameter constructed from the typechecked -- AST. -- See also Note [default method Name] in GHC.Iface.Recomp sigNameNoLoc :: forall a . (UnXRec a, HasOccName (IdP a)) => OccEnv (IdP a) -> Sig a -> [IdP a] sigNameNoLoc :: forall a. (UnXRec a, HasOccName (IdP a)) => OccEnv (IdP a) -> Sig a -> [IdP a] sigNameNoLoc OccEnv (IdP a) _ (TypeSig XTypeSig a _ [LIdP a] ns LHsSigWcType a _) = (LIdP a -> IdP a) -> [LIdP a] -> [IdP a] forall a b. (a -> b) -> [a] -> [b] map (forall p a. UnXRec p => XRec p a -> a unXRec @a) [LIdP a] ns sigNameNoLoc OccEnv (IdP a) _ (ClassOpSig XClassOpSig a _ Bool False [LIdP a] ns LHsSigType a _) = (LIdP a -> IdP a) -> [LIdP a] -> [IdP a] forall a b. (a -> b) -> [a] -> [b] map (forall p a. UnXRec p => XRec p a -> a unXRec @a) [LIdP a] ns sigNameNoLoc OccEnv (IdP a) env (ClassOpSig XClassOpSig a _ Bool True [LIdP a] ns LHsSigType a _) = (IdP a -> Maybe (IdP a)) -> [IdP a] -> [IdP a] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe (OccEnv (IdP a) -> OccName -> Maybe (IdP a) forall a. OccEnv a -> OccName -> Maybe a lookupOccEnv OccEnv (IdP a) env (OccName -> Maybe (IdP a)) -> (IdP a -> OccName) -> IdP a -> Maybe (IdP a) forall b c a. (b -> c) -> (a -> b) -> a -> c . OccName -> OccName mkDefaultMethodOcc (OccName -> OccName) -> (IdP a -> OccName) -> IdP a -> OccName forall b c a. (b -> c) -> (a -> b) -> a -> c . IdP a -> OccName forall name. HasOccName name => name -> OccName occName) ([IdP a] -> [IdP a]) -> [IdP a] -> [IdP a] forall a b. (a -> b) -> a -> b $ (LIdP a -> IdP a) -> [LIdP a] -> [IdP a] forall a b. (a -> b) -> [a] -> [b] map (forall p a. UnXRec p => XRec p a -> a unXRec @a) [LIdP a] ns sigNameNoLoc OccEnv (IdP a) _ (PatSynSig XPatSynSig a _ [LIdP a] ns LHsSigType a _) = (LIdP a -> IdP a) -> [LIdP a] -> [IdP a] forall a b. (a -> b) -> [a] -> [b] map (forall p a. UnXRec p => XRec p a -> a unXRec @a) [LIdP a] ns sigNameNoLoc OccEnv (IdP a) _ (SpecSig XSpecSig a _ LIdP a n [LHsSigType a] _ InlinePragma _) = [forall p a. UnXRec p => XRec p a -> a unXRec @a LIdP a n] sigNameNoLoc OccEnv (IdP a) _ (InlineSig XInlineSig a _ LIdP a n InlinePragma _) = [forall p a. UnXRec p => XRec p a -> a unXRec @a LIdP a n] sigNameNoLoc OccEnv (IdP a) _ (FixSig XFixSig a _ (FixitySig XFixitySig a _ [LIdP a] ns Fixity _)) = (LIdP a -> IdP a) -> [LIdP a] -> [IdP a] forall a b. (a -> b) -> [a] -> [b] map (forall p a. UnXRec p => XRec p a -> a unXRec @a) [LIdP a] ns sigNameNoLoc OccEnv (IdP a) _ Sig a _ = [] -- Extract the source location where an instance is defined. This is used -- to correlate InstDecls with their Instance/CoAxiom Names, via the -- instanceMap. getInstLoc :: Anno (IdGhcP p) ~ SrcSpanAnnN => InstDecl (GhcPass p) -> SrcSpan getInstLoc :: forall (p :: Pass). (Anno (IdGhcP p) ~ SrcSpanAnnN) => InstDecl (GhcPass p) -> SrcSpan getInstLoc = \case ClsInstD XClsInstD (GhcPass p) _ (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass cid_poly_ty = LHsSigType (GhcPass p) ty }) -> GenLocated SrcSpanAnnA (HsSigType (GhcPass p)) -> SrcSpan forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan getLocA LHsSigType (GhcPass p) GenLocated SrcSpanAnnA (HsSigType (GhcPass p)) ty -- The Names of data and type family instances have their SrcSpan's attached -- to the *type constructor*. For example, the Name "D:R:Foo:Int" would have -- its SrcSpan attached here: -- type family Foo a -- type instance Foo Int = Bool -- ^^^ DataFamInstD XDataFamInstD (GhcPass p) _ (DataFamInstDecl { dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass) dfid_eqn = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass feqn_tycon = L SrcSpanAnnN l IdGhcP p _ }}) -> SrcSpanAnnN -> SrcSpan forall a. SrcSpanAnn' a -> SrcSpan locA SrcSpanAnnN l -- Since CoAxioms' Names refer to the whole line for type family instances -- in particular, we need to dig a bit deeper to pull out the entire -- equation. This does not happen for data family instances, for some reason. TyFamInstD XTyFamInstD (GhcPass p) _ (TyFamInstDecl { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass tfid_eqn = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass feqn_tycon = L SrcSpanAnnN l IdGhcP p _ }}) -> SrcSpanAnnN -> SrcSpan forall a. SrcSpanAnn' a -> SrcSpan locA SrcSpanAnnN l -- | Get all subordinate declarations inside a declaration, and their docs. -- A subordinate declaration is something like the associate type or data -- family of a type class. subordinates :: OccEnv Name -- ^ The default method environment -> Map RealSrcSpan Name -> HsDecl GhcRn -> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))] subordinates :: OccEnv Name -> Map RealSrcSpan Name -> HsDecl (GhcPass 'Renamed) -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] subordinates OccEnv Name env 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) -> let data_fams :: [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] data_fams = do DataFamInstDecl { dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass) dfid_eqn = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass feqn_tycon = L SrcSpanAnnN l Name _ , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs feqn_rhs = HsDataDefn (GhcPass 'Renamed) defn }} <- GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Renamed)) -> DataFamInstDecl (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Renamed)) -> DataFamInstDecl (GhcPass 'Renamed)) -> [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Renamed))] -> [DataFamInstDecl (GhcPass 'Renamed)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ClsInstDecl (GhcPass 'Renamed) -> [LDataFamInstDecl (GhcPass 'Renamed)] forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass] cid_datafam_insts ClsInstDecl (GhcPass 'Renamed) d [ (Name n, [], IntMap (HsDoc (GhcPass 'Renamed)) forall a. IntMap a IM.empty) | Just Name n <- [SrcSpan -> Map RealSrcSpan Name -> Maybe Name forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a lookupSrcSpan (SrcSpanAnnN -> SrcSpan forall a. SrcSpanAnn' a -> SrcSpan locA SrcSpanAnnN l) Map RealSrcSpan Name instMap] ] [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] forall a. [a] -> [a] -> [a] ++ HsDataDefn (GhcPass 'Renamed) -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] dataSubs HsDataDefn (GhcPass 'Renamed) defn ty_fams :: [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] ty_fams = do TyFamInstDecl { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass tfid_eqn = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass feqn_tycon = L SrcSpanAnnN l Name _ } } <- GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Renamed)) -> TyFamInstDecl (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Renamed)) -> TyFamInstDecl (GhcPass 'Renamed)) -> [GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Renamed))] -> [TyFamInstDecl (GhcPass 'Renamed)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ClsInstDecl (GhcPass 'Renamed) -> [LTyFamInstDecl (GhcPass 'Renamed)] forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass] cid_tyfam_insts ClsInstDecl (GhcPass 'Renamed) d [ (Name n, [], IntMap (HsDoc (GhcPass 'Renamed)) forall a. IntMap a IM.empty) | Just Name n <- [SrcSpan -> Map RealSrcSpan Name -> Maybe Name forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a lookupSrcSpan (SrcSpanAnnN -> SrcSpan forall a. SrcSpanAnn' a -> SrcSpan locA SrcSpanAnnN l) Map RealSrcSpan Name instMap] ] in [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] data_fams [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] forall a. [a] -> [a] -> [a] ++ [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] ty_fams InstD XInstD (GhcPass 'Renamed) _ (DataFamInstD XDataFamInstD (GhcPass 'Renamed) _ (DataFamInstDecl FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed)) d)) -> HsDataDefn (GhcPass 'Renamed) -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] 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, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] classSubs TyClDecl (GhcPass 'Renamed) d | TyClDecl (GhcPass 'Renamed) -> Bool forall pass. TyClDecl pass -> Bool isDataDecl TyClDecl (GhcPass 'Renamed) d -> HsDataDefn (GhcPass 'Renamed) -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] 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, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] classSubs TyClDecl (GhcPass 'Renamed) dd = [ (Name name, [HsDoc (GhcPass 'Renamed)] doc, HsDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) declTypeDocs HsDecl (GhcPass 'Renamed) d) | (L SrcSpanAnnA _ HsDecl (GhcPass 'Renamed) d, [HsDoc (GhcPass 'Renamed)] doc) <- TyClDecl (GhcPass 'Renamed) -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] classDecls TyClDecl (GhcPass 'Renamed) dd , Name name <- OccEnv Name -> HsDecl (GhcPass 'Renamed) -> [Name] getMainDeclBinder OccEnv Name env 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, [HsDoc GhcRn], IntMap (HsDoc GhcRn))] dataSubs :: HsDataDefn (GhcPass 'Renamed) -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] dataSubs HsDataDefn (GhcPass 'Renamed) dd = [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] constrs [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] forall a. [a] -> [a] -> [a] ++ [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] fields [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] -> [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] forall a. [a] -> [a] -> [a] ++ [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] derivs where cons :: DataDefnCons (ConDecl (GhcPass 'Renamed)) cons = GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Renamed)) -> ConDecl (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Renamed)) -> ConDecl (GhcPass 'Renamed)) -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Renamed))) -> DataDefnCons (ConDecl (GhcPass 'Renamed)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> HsDataDefn (GhcPass 'Renamed) -> DataDefnCons (LConDecl (GhcPass 'Renamed)) forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass) dd_cons HsDataDefn (GhcPass 'Renamed) dd constrs :: [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] constrs = [ ( GenLocated SrcSpanAnnN Name -> Name forall l e. GenLocated l e -> e unLoc GenLocated SrcSpanAnnN Name cname , Maybe (HsDoc (GhcPass 'Renamed)) -> [HsDoc (GhcPass 'Renamed)] forall a. Maybe a -> [a] maybeToList (Maybe (HsDoc (GhcPass 'Renamed)) -> [HsDoc (GhcPass 'Renamed)]) -> Maybe (HsDoc (GhcPass 'Renamed)) -> [HsDoc (GhcPass 'Renamed)] forall a b. (a -> b) -> a -> b $ (LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed)) -> Maybe (LHsDoc (GhcPass 'Renamed)) -> Maybe (HsDoc (GhcPass 'Renamed)) forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (Maybe (LHsDoc (GhcPass 'Renamed)) -> Maybe (HsDoc (GhcPass 'Renamed))) -> Maybe (LHsDoc (GhcPass 'Renamed)) -> Maybe (HsDoc (GhcPass 'Renamed)) forall a b. (a -> b) -> a -> b $ ConDecl (GhcPass 'Renamed) -> Maybe (LHsDoc (GhcPass 'Renamed)) forall pass. ConDecl pass -> Maybe (LHsDoc pass) con_doc ConDecl (GhcPass 'Renamed) c , ConDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) conArgDocs ConDecl (GhcPass 'Renamed) c) | ConDecl (GhcPass 'Renamed) c <- DataDefnCons (ConDecl (GhcPass 'Renamed)) -> [ConDecl (GhcPass 'Renamed)] forall a. DataDefnCons a -> [a] forall (t :: * -> *) a. Foldable t => t a -> [a] toList DataDefnCons (ConDecl (GhcPass 'Renamed)) cons, GenLocated SrcSpanAnnN Name cname <- ConDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnN Name] getConNames ConDecl (GhcPass 'Renamed) c ] fields :: [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] fields = [ (FieldOcc (GhcPass 'Renamed) -> XCFieldOcc (GhcPass 'Renamed) forall pass. FieldOcc pass -> XCFieldOcc pass foExt FieldOcc (GhcPass 'Renamed) n, Maybe (HsDoc (GhcPass 'Renamed)) -> [HsDoc (GhcPass 'Renamed)] forall a. Maybe a -> [a] maybeToList (Maybe (HsDoc (GhcPass 'Renamed)) -> [HsDoc (GhcPass 'Renamed)]) -> Maybe (HsDoc (GhcPass 'Renamed)) -> [HsDoc (GhcPass 'Renamed)] forall a b. (a -> b) -> a -> b $ (LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed)) -> Maybe (LHsDoc (GhcPass 'Renamed)) -> Maybe (HsDoc (GhcPass 'Renamed)) forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc Maybe (LHsDoc (GhcPass 'Renamed)) doc, IntMap (HsDoc (GhcPass 'Renamed)) forall a. IntMap a IM.empty) | Just GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))] flds <- DataDefnCons (Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))])) -> [Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))])] forall a. DataDefnCons a -> [a] forall (t :: * -> *) a. Foldable t => t a -> [a] toList (DataDefnCons (Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))])) -> [Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))])]) -> DataDefnCons (Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))])) -> [Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))])] forall a b. (a -> b) -> a -> b $ (ConDecl (GhcPass 'Renamed) -> Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))])) -> DataDefnCons (ConDecl (GhcPass 'Renamed)) -> DataDefnCons (Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))])) forall a b. (a -> b) -> DataDefnCons a -> DataDefnCons b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ConDecl (GhcPass 'Renamed) -> Maybe (LocatedL [LConDeclField (GhcPass 'Renamed)]) ConDecl (GhcPass 'Renamed) -> Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))]) getRecConArgs_maybe DataDefnCons (ConDecl (GhcPass 'Renamed)) cons , (L SrcSpanAnnA _ (ConDeclField XConDeclField (GhcPass 'Renamed) _ [LFieldOcc (GhcPass 'Renamed)] ns XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)) _ Maybe (LHsDoc (GhcPass 'Renamed)) doc)) <- (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))] forall l e. GenLocated l e -> e unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Renamed))] flds) , (L SrcAnn NoEpAnns _ FieldOcc (GhcPass 'Renamed) n) <- [LFieldOcc (GhcPass 'Renamed)] [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))] ns ] derivs :: [(Name, [HsDoc (GhcPass 'Renamed)], IntMap (HsDoc (GhcPass 'Renamed)))] derivs = [ (Name instName, [LHsDoc (GhcPass 'Renamed) -> HsDoc (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc LHsDoc (GhcPass 'Renamed) doc], IntMap (HsDoc (GhcPass 'Renamed)) forall a. IntMap a IM.empty) | (SrcSpan l, LHsDoc (GhcPass 'Renamed) doc) <- (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Renamed)) -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))]) -> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Renamed))] -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (LDerivClauseTys (GhcPass 'Renamed) -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))] GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Renamed)) -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))] extract_deriv_clause_tys (GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Renamed)) -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))]) -> (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Renamed)) -> GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Renamed))) -> GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Renamed)) -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))] forall b c a. (b -> c) -> (a -> b) -> a -> c . HsDerivingClause (GhcPass 'Renamed) -> LDerivClauseTys (GhcPass 'Renamed) HsDerivingClause (GhcPass 'Renamed) -> GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Renamed)) forall pass. HsDerivingClause pass -> LDerivClauseTys pass deriv_clause_tys (HsDerivingClause (GhcPass 'Renamed) -> GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Renamed))) -> (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Renamed)) -> HsDerivingClause (GhcPass 'Renamed)) -> GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Renamed)) -> GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Renamed)) forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Renamed)) -> HsDerivingClause (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc) ([GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Renamed))] -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))]) -> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Renamed))] -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))] forall a b. (a -> b) -> a -> b $ -- unLoc $ dd_derivs dd HsDataDefn (GhcPass 'Renamed) -> HsDeriving (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_clause_tys :: LDerivClauseTys GhcRn -> [(SrcSpan, LHsDoc GhcRn)] extract_deriv_clause_tys :: LDerivClauseTys (GhcPass 'Renamed) -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))] extract_deriv_clause_tys (L SrcSpanAnnC _ DerivClauseTys (GhcPass 'Renamed) dct) = case DerivClauseTys (GhcPass 'Renamed) dct of DctSingle XDctSingle (GhcPass 'Renamed) _ LHsSigType (GhcPass 'Renamed) ty -> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed)) -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))] forall a. Maybe a -> [a] maybeToList (Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed)) -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))]) -> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed)) -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))] forall a b. (a -> b) -> a -> b $ LHsSigType (GhcPass 'Renamed) -> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed)) extract_deriv_ty LHsSigType (GhcPass 'Renamed) ty DctMulti XDctMulti (GhcPass 'Renamed) _ [LHsSigType (GhcPass 'Renamed)] tys -> (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed))) -> [GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))] -> [(SrcSpan, LHsDoc (GhcPass 'Renamed))] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe LHsSigType (GhcPass 'Renamed) -> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed)) GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed)) extract_deriv_ty [LHsSigType (GhcPass 'Renamed)] [GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))] tys extract_deriv_ty :: LHsSigType GhcRn -> Maybe (SrcSpan, LHsDoc GhcRn) extract_deriv_ty :: LHsSigType (GhcPass 'Renamed) -> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed)) extract_deriv_ty (L SrcSpanAnnA l (HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass sig_body = L SrcSpanAnnA _ HsType (GhcPass 'Renamed) ty})) = case HsType (GhcPass 'Renamed) ty of -- deriving (C a {- ^ Doc comment -}) HsDocTy XDocTy (GhcPass 'Renamed) _ XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)) _ LHsDoc (GhcPass 'Renamed) doc -> (SrcSpan, LHsDoc (GhcPass 'Renamed)) -> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed)) forall a. a -> Maybe a Just (SrcSpanAnnA -> SrcSpan forall a. SrcSpanAnn' a -> SrcSpan locA SrcSpanAnnA l, LHsDoc (GhcPass 'Renamed) doc) HsType (GhcPass 'Renamed) _ -> Maybe (SrcSpan, LHsDoc (GhcPass 'Renamed)) forall a. Maybe a Nothing -- | Extract constructor argument docs from inside constructor decls. conArgDocs :: ConDecl GhcRn -> IntMap (HsDoc GhcRn) conArgDocs :: ConDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) conArgDocs (ConDeclH98{con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass con_args = HsConDeclH98Details (GhcPass 'Renamed) args}) = HsConDeclH98Details (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) h98ConArgDocs HsConDeclH98Details (GhcPass 'Renamed) args conArgDocs (ConDeclGADT{con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass con_g_args = HsConDeclGADTDetails (GhcPass 'Renamed) args, con_res_ty :: forall pass. ConDecl pass -> LHsType pass con_res_ty = XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)) res_ty}) = HsConDeclGADTDetails (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) gadtConArgDocs HsConDeclGADTDetails (GhcPass 'Renamed) args (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> HsType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)) GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) res_ty) h98ConArgDocs :: HsConDeclH98Details GhcRn -> IntMap (HsDoc GhcRn) h98ConArgDocs :: HsConDeclH98Details (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) h98ConArgDocs HsConDeclH98Details (GhcPass 'Renamed) con_args = case HsConDeclH98Details (GhcPass 'Renamed) con_args of PrefixCon [Void] _ [HsScaled (GhcPass 'Renamed) (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))] args -> Key -> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed)) con_arg_docs Key 0 ([HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed))) -> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed)) forall a b. (a -> b) -> a -> b $ (HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> HsType (GhcPass 'Renamed)) -> [HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))] -> [HsType (GhcPass 'Renamed)] forall a b. (a -> b) -> [a] -> [b] map (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> HsType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> HsType (GhcPass 'Renamed)) -> (HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> HsType (GhcPass 'Renamed) forall b c a. (b -> c) -> (a -> b) -> a -> c . HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) forall pass a. HsScaled pass a -> a hsScaledThing) [HsScaled (GhcPass 'Renamed) (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))] [HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))] args InfixCon HsScaled (GhcPass 'Renamed) (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))) arg1 HsScaled (GhcPass 'Renamed) (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))) arg2 -> Key -> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed)) con_arg_docs Key 0 [ GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> HsType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) forall pass a. HsScaled pass a -> a hsScaledThing HsScaled (GhcPass 'Renamed) (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))) HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) arg1) , GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> HsType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) forall pass a. HsScaled pass a -> a hsScaledThing HsScaled (GhcPass 'Renamed) (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed))) HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) arg2) ] RecCon XRec (GhcPass 'Renamed) [LConDeclField (GhcPass 'Renamed)] _ -> IntMap (HsDoc (GhcPass 'Renamed)) forall a. IntMap a IM.empty gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> IntMap (HsDoc GhcRn) gadtConArgDocs :: HsConDeclGADTDetails (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) gadtConArgDocs HsConDeclGADTDetails (GhcPass 'Renamed) con_args HsType (GhcPass 'Renamed) res_ty = case HsConDeclGADTDetails (GhcPass 'Renamed) con_args of PrefixConGADT [HsScaled (GhcPass 'Renamed) (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))] args -> Key -> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed)) con_arg_docs Key 0 ([HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed))) -> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed)) forall a b. (a -> b) -> a -> b $ (HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> HsType (GhcPass 'Renamed)) -> [HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))] -> [HsType (GhcPass 'Renamed)] forall a b. (a -> b) -> [a] -> [b] map (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> HsType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> HsType (GhcPass 'Renamed)) -> (HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> HsType (GhcPass 'Renamed) forall b c a. (b -> c) -> (a -> b) -> a -> c . HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))) -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) forall pass a. HsScaled pass a -> a hsScaledThing) [HsScaled (GhcPass 'Renamed) (XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)))] [HsScaled (GhcPass 'Renamed) (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))] args [HsType (GhcPass 'Renamed)] -> [HsType (GhcPass 'Renamed)] -> [HsType (GhcPass 'Renamed)] forall a. [a] -> [a] -> [a] ++ [HsType (GhcPass 'Renamed) res_ty] RecConGADT XRec (GhcPass 'Renamed) [LConDeclField (GhcPass 'Renamed)] _ LHsUniToken "->" "\8594" (GhcPass 'Renamed) _ -> Key -> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed)) con_arg_docs Key 1 [HsType (GhcPass 'Renamed) res_ty] con_arg_docs :: Int -> [HsType GhcRn] -> IntMap (HsDoc GhcRn) con_arg_docs :: Key -> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed)) con_arg_docs Key n = [(Key, HsDoc (GhcPass 'Renamed))] -> IntMap (HsDoc (GhcPass 'Renamed)) forall a. [(Key, a)] -> IntMap a IM.fromList ([(Key, HsDoc (GhcPass 'Renamed))] -> IntMap (HsDoc (GhcPass 'Renamed))) -> ([HsType (GhcPass 'Renamed)] -> [(Key, HsDoc (GhcPass 'Renamed))]) -> [HsType (GhcPass 'Renamed)] -> IntMap (HsDoc (GhcPass 'Renamed)) forall b c a. (b -> c) -> (a -> b) -> a -> c . [Maybe (Key, HsDoc (GhcPass 'Renamed))] -> [(Key, HsDoc (GhcPass 'Renamed))] forall a. [Maybe a] -> [a] catMaybes ([Maybe (Key, HsDoc (GhcPass 'Renamed))] -> [(Key, HsDoc (GhcPass 'Renamed))]) -> ([HsType (GhcPass 'Renamed)] -> [Maybe (Key, HsDoc (GhcPass 'Renamed))]) -> [HsType (GhcPass 'Renamed)] -> [(Key, HsDoc (GhcPass 'Renamed))] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Key -> HsType (GhcPass 'Renamed) -> Maybe (Key, HsDoc (GhcPass 'Renamed))) -> [Key] -> [HsType (GhcPass 'Renamed)] -> [Maybe (Key, HsDoc (GhcPass 'Renamed))] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith Key -> HsType (GhcPass 'Renamed) -> Maybe (Key, HsDoc (GhcPass 'Renamed)) forall {pass} {l} {a}. (XRec pass (HsType pass) ~ GenLocated l (HsType pass)) => a -> HsType pass -> Maybe (a, HsDoc pass) f [Key n..] where f :: a -> HsType pass -> Maybe (a, HsDoc pass) f a n (HsDocTy XDocTy pass _ XRec pass (HsType pass) _ LHsDoc pass lds) = (a, HsDoc pass) -> Maybe (a, HsDoc pass) forall a. a -> Maybe a Just (a n, LHsDoc pass -> HsDoc pass forall l e. GenLocated l e -> e unLoc LHsDoc pass lds) f a n (HsBangTy XBangTy pass _ HsSrcBang _ (L l _ (HsDocTy XDocTy pass _ XRec pass (HsType pass) _ LHsDoc pass lds))) = (a, HsDoc pass) -> Maybe (a, HsDoc pass) forall a. a -> Maybe a Just (a n, LHsDoc pass -> HsDoc pass forall l e. GenLocated l e -> e unLoc LHsDoc pass lds) f a _ HsType pass _ = Maybe (a, HsDoc pass) forall a. Maybe a Nothing 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, [HsDoc GhcRn])] classDecls :: TyClDecl (GhcPass 'Renamed) -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] classDecls TyClDecl (GhcPass 'Renamed) class_ = [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)] filterDecls ([(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]) -> ([GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] forall b c a. (b -> c) -> (a -> b) -> a -> c . [LHsDecl (GhcPass 'Renamed)] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])] collectDocs ([GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]) -> ([GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] forall b c a. (b -> c) -> (a -> b) -> a -> c . [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a e. [GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e] sortLocatedA ([GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] forall a b. (a -> b) -> a -> b $ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] decls where decls :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] decls = [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] docs [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] defs [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] sigs [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] ats docs :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] docs = (TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (DocDecl (GhcPass 'Renamed))]) -> (DocDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls TyClDecl (GhcPass 'Renamed) -> [LDocDecl (GhcPass 'Renamed)] TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (DocDecl (GhcPass 'Renamed))] forall pass. TyClDecl pass -> [LDocDecl pass] tcdDocs (XDocD (GhcPass 'Renamed) -> DocDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed) forall p. XDocD p -> DocDecl p -> HsDecl p DocD XDocD (GhcPass 'Renamed) NoExtField noExtField) TyClDecl (GhcPass 'Renamed) class_ defs :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] defs = (TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))]) -> (HsBind (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls (Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))) -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))] forall a. Bag a -> [a] bagToList (Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))) -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))]) -> (TyClDecl (GhcPass 'Renamed) -> Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))) -> TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))] forall b c a. (b -> c) -> (a -> b) -> a -> c . TyClDecl (GhcPass 'Renamed) -> LHsBinds (GhcPass 'Renamed) TyClDecl (GhcPass 'Renamed) -> Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))) forall pass. TyClDecl pass -> LHsBinds pass tcdMeths) (XValD (GhcPass 'Renamed) -> HsBind (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed) forall p. XValD p -> HsBind p -> HsDecl p ValD XValD (GhcPass 'Renamed) NoExtField noExtField) TyClDecl (GhcPass 'Renamed) class_ sigs :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] sigs = (TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]) -> (Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls TyClDecl (GhcPass 'Renamed) -> [LSig (GhcPass 'Renamed)] TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (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 XSigD (GhcPass 'Renamed) NoExtField noExtField) TyClDecl (GhcPass 'Renamed) class_ ats :: [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] ats = (TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Renamed))]) -> (FamilyDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls TyClDecl (GhcPass 'Renamed) -> [LFamilyDecl (GhcPass 'Renamed)] TyClDecl (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (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 XTyClD (GhcPass 'Renamed) NoExtField 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 XFamDecl (GhcPass 'Renamed) NoExtField noExtField) TyClDecl (GhcPass 'Renamed) class_ -- | Extract function argument docs from inside top-level decls. declTypeDocs :: HsDecl GhcRn -> IntMap (HsDoc GhcRn) declTypeDocs :: HsDecl (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) declTypeDocs = \case SigD XSigD (GhcPass 'Renamed) _ (TypeSig XTypeSig (GhcPass 'Renamed) _ [LIdP (GhcPass 'Renamed)] _ LHsSigWcType (GhcPass 'Renamed) ty) -> HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) sigTypeDocs (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> HsSigType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc (LHsSigWcType (GhcPass 'Renamed) -> LHsSigType (GhcPass 'Renamed) forall pass. LHsSigWcType pass -> LHsSigType pass dropWildCards LHsSigWcType (GhcPass 'Renamed) ty)) SigD XSigD (GhcPass 'Renamed) _ (ClassOpSig XClassOpSig (GhcPass 'Renamed) _ Bool _ [LIdP (GhcPass 'Renamed)] _ LHsSigType (GhcPass 'Renamed) ty) -> HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) sigTypeDocs (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> HsSigType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc LHsSigType (GhcPass 'Renamed) GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) ty) SigD XSigD (GhcPass 'Renamed) _ (PatSynSig XPatSynSig (GhcPass 'Renamed) _ [LIdP (GhcPass 'Renamed)] _ LHsSigType (GhcPass 'Renamed) ty) -> HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) sigTypeDocs (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> HsSigType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc LHsSigType (GhcPass 'Renamed) GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) ty) ForD XForD (GhcPass 'Renamed) _ (ForeignImport XForeignImport (GhcPass 'Renamed) _ LIdP (GhcPass 'Renamed) _ LHsSigType (GhcPass 'Renamed) ty ForeignImport (GhcPass 'Renamed) _) -> HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) sigTypeDocs (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> HsSigType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc LHsSigType (GhcPass 'Renamed) GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) ty) TyClD XTyClD (GhcPass 'Renamed) _ (SynDecl { tcdRhs :: forall pass. TyClDecl pass -> LHsType pass tcdRhs = XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)) ty }) -> HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) typeDocs (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> HsType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)) GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) ty) HsDecl (GhcPass 'Renamed) _ -> IntMap (HsDoc (GhcPass 'Renamed)) forall a. IntMap a IM.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 -> IntMap (HsDoc GhcRn) typeDocs :: HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) typeDocs = Key -> HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) forall {pass} {l}. (XRec pass (HsType pass) ~ GenLocated l (HsType pass)) => Key -> HsType pass -> IntMap (HsDoc pass) go Key 0 where go :: Key -> HsType pass -> IntMap (HsDoc pass) go Key n = \case HsForAllTy { hst_body :: forall pass. HsType pass -> LHsType pass hst_body = XRec pass (HsType pass) ty } -> Key -> HsType pass -> IntMap (HsDoc pass) go Key n (GenLocated l (HsType pass) -> HsType pass forall l e. GenLocated l e -> e unLoc XRec pass (HsType pass) GenLocated l (HsType pass) ty) HsQualTy { hst_body :: forall pass. HsType pass -> LHsType pass hst_body = XRec pass (HsType pass) ty } -> Key -> HsType pass -> IntMap (HsDoc pass) go Key n (GenLocated l (HsType pass) -> HsType pass forall l e. GenLocated l e -> e unLoc XRec pass (HsType pass) GenLocated l (HsType pass) ty) HsFunTy XFunTy pass _ HsArrow pass _ (XRec pass (HsType pass) -> HsType pass GenLocated l (HsType pass) -> HsType pass forall l e. GenLocated l e -> e unLoc->HsDocTy XDocTy pass _ XRec pass (HsType pass) _ LHsDoc pass x) XRec pass (HsType pass) ty -> Key -> HsDoc pass -> IntMap (HsDoc pass) -> IntMap (HsDoc pass) forall a. Key -> a -> IntMap a -> IntMap a IM.insert Key n (LHsDoc pass -> HsDoc pass forall l e. GenLocated l e -> e unLoc LHsDoc pass x) (IntMap (HsDoc pass) -> IntMap (HsDoc pass)) -> IntMap (HsDoc pass) -> IntMap (HsDoc pass) forall a b. (a -> b) -> a -> b $ Key -> HsType pass -> IntMap (HsDoc pass) go (Key nKey -> Key -> Key forall a. Num a => a -> a -> a +Key 1) (GenLocated l (HsType pass) -> HsType pass forall l e. GenLocated l e -> e unLoc XRec pass (HsType pass) GenLocated l (HsType pass) ty) HsFunTy XFunTy pass _ HsArrow pass _ XRec pass (HsType pass) _ XRec pass (HsType pass) ty -> Key -> HsType pass -> IntMap (HsDoc pass) go (Key nKey -> Key -> Key forall a. Num a => a -> a -> a +Key 1) (GenLocated l (HsType pass) -> HsType pass forall l e. GenLocated l e -> e unLoc XRec pass (HsType pass) GenLocated l (HsType pass) ty) HsDocTy XDocTy pass _ XRec pass (HsType pass) _ LHsDoc pass doc -> Key -> HsDoc pass -> IntMap (HsDoc pass) forall a. Key -> a -> IntMap a IM.singleton Key n (LHsDoc pass -> HsDoc pass forall l e. GenLocated l e -> e unLoc LHsDoc pass doc) HsType pass _ -> IntMap (HsDoc pass) forall a. IntMap a IM.empty -- | Extract function argument docs from inside types. sigTypeDocs :: HsSigType GhcRn -> IntMap (HsDoc GhcRn) sigTypeDocs :: HsSigType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) sigTypeDocs (HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass sig_body = XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)) body}) = HsType (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) typeDocs (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> HsType (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc XRec (GhcPass 'Renamed) (HsType (GhcPass 'Renamed)) GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) body) -- | The top-level declarations of a module that we care about, -- ordered by source location, with documentation attached if it exists. topDecls :: HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])] topDecls :: HsGroup (GhcPass 'Renamed) -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] topDecls = [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])] -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])] forall (p :: Pass) doc. IsPass p => [(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)] filterClasses ([(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])] -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])]) -> (HsGroup (GhcPass 'Renamed) -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])]) -> HsGroup (GhcPass 'Renamed) -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])] forall b c a. (b -> c) -> (a -> b) -> a -> c . [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])] forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)] filterDecls ([(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])]) -> (HsGroup (GhcPass 'Renamed) -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]) -> HsGroup (GhcPass 'Renamed) -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed)), [HsDoc (GhcPass 'Renamed)])] forall b c a. (b -> c) -> (a -> b) -> a -> c . [LHsDecl (GhcPass 'Renamed)] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])] collectDocs ([GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])]) -> (HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]) -> HsGroup (GhcPass 'Renamed) -> [(LHsDecl (GhcPass 'Renamed), [HsDoc (GhcPass 'Renamed)])] forall b c a. (b -> c) -> (a -> b) -> a -> c . [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a e. [GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e] sortLocatedA ([GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]) -> (HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))]) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall b c a. (b -> c) -> (a -> b) -> a -> c . HsGroup (GhcPass 'Renamed) -> [LHsDecl (GhcPass 'Renamed)] HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (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) -> [GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed))]) -> (TyClDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls ([TyClGroup (GhcPass 'Renamed)] -> [LTyClDecl (GhcPass 'Renamed)] [TyClGroup (GhcPass 'Renamed)] -> [GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed))] forall pass. [TyClGroup pass] -> [LTyClDecl pass] tyClGroupTyClDecls ([TyClGroup (GhcPass 'Renamed)] -> [GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed))]) -> (HsGroup (GhcPass 'Renamed) -> [TyClGroup (GhcPass 'Renamed)]) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (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 XTyClD (GhcPass 'Renamed) NoExtField noExtField) HsGroup (GhcPass 'Renamed) group_ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ (HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (DerivDecl (GhcPass 'Renamed))]) -> (DerivDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls HsGroup (GhcPass 'Renamed) -> [LDerivDecl (GhcPass 'Renamed)] HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (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 XDerivD (GhcPass 'Renamed) NoExtField noExtField) HsGroup (GhcPass 'Renamed) group_ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ (HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (DefaultDecl (GhcPass 'Renamed))]) -> (DefaultDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls HsGroup (GhcPass 'Renamed) -> [LDefaultDecl (GhcPass 'Renamed)] HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (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 XDefD (GhcPass 'Renamed) NoExtField noExtField) HsGroup (GhcPass 'Renamed) group_ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ (HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (ForeignDecl (GhcPass 'Renamed))]) -> (ForeignDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls HsGroup (GhcPass 'Renamed) -> [LForeignDecl (GhcPass 'Renamed)] HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (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 XForD (GhcPass 'Renamed) NoExtField noExtField) HsGroup (GhcPass 'Renamed) group_ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ (HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (DocDecl (GhcPass 'Renamed))]) -> (DocDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls HsGroup (GhcPass 'Renamed) -> [LDocDecl (GhcPass 'Renamed)] HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (DocDecl (GhcPass 'Renamed))] forall p. HsGroup p -> [LDocDecl p] hs_docs (XDocD (GhcPass 'Renamed) -> DocDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed) forall p. XDocD p -> DocDecl p -> HsDecl p DocD XDocD (GhcPass 'Renamed) NoExtField noExtField) HsGroup (GhcPass 'Renamed) group_ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ (HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))]) -> (InstDecl (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls ([TyClGroup (GhcPass 'Renamed)] -> [LInstDecl (GhcPass 'Renamed)] [TyClGroup (GhcPass 'Renamed)] -> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))] forall pass. [TyClGroup pass] -> [LInstDecl pass] tyClGroupInstDecls ([TyClGroup (GhcPass 'Renamed)] -> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))]) -> (HsGroup (GhcPass 'Renamed) -> [TyClGroup (GhcPass 'Renamed)]) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (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 XInstD (GhcPass 'Renamed) NoExtField noExtField) HsGroup (GhcPass 'Renamed) group_ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ (HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]) -> (Sig (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls (HsValBinds (GhcPass 'Renamed) -> [LSig (GhcPass 'Renamed)] HsValBinds (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] typesigs (HsValBinds (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]) -> (HsGroup (GhcPass 'Renamed) -> HsValBinds (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (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 XSigD (GhcPass 'Renamed) NoExtField noExtField) HsGroup (GhcPass 'Renamed) group_ [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall a. [a] -> [a] -> [a] ++ (HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))]) -> (HsBind (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Renamed))] forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls (HsValBinds (GhcPass 'Renamed) -> [LHsBind (GhcPass 'Renamed)] HsValBinds (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))] valbinds (HsValBinds (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))]) -> (HsGroup (GhcPass 'Renamed) -> HsValBinds (GhcPass 'Renamed)) -> HsGroup (GhcPass 'Renamed) -> [GenLocated SrcSpanAnnA (HsBind (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) -> HsBind (GhcPass 'Renamed) -> HsDecl (GhcPass 'Renamed) forall p. XValD p -> HsBind p -> HsDecl p ValD XValD (GhcPass 'Renamed) NoExtField noExtField) HsGroup (GhcPass 'Renamed) group_ where typesigs :: HsValBinds GhcRn -> [LSig GhcRn] typesigs :: HsValBinds (GhcPass 'Renamed) -> [LSig (GhcPass 'Renamed)] typesigs (XValBindsLR (NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))] _ [LSig (GhcPass 'Renamed)] sig)) = (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> Bool) -> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] -> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] forall a. (a -> Bool) -> [a] -> [a] filter (Sig (GhcPass 'Renamed) -> Bool forall name. Sig name -> Bool isUserSig (Sig (GhcPass 'Renamed) -> Bool) -> (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> Sig (GhcPass 'Renamed)) -> GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> Sig (GhcPass 'Renamed) forall l e. GenLocated l e -> e unLoc) [LSig (GhcPass 'Renamed)] [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] sig typesigs ValBinds{} = String -> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] forall a. HasCallStack => String -> a error String "expected XValBindsLR" valbinds :: HsValBinds GhcRn -> [LHsBind GhcRn] valbinds :: HsValBinds (GhcPass 'Renamed) -> [LHsBind (GhcPass 'Renamed)] valbinds (XValBindsLR (NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))] binds [LSig (GhcPass 'Renamed)] _)) = (Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))) -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))]) -> [Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))] -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))) -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))] forall a. Bag a -> [a] bagToList ([Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))] -> [LHsBind (GhcPass 'Renamed)]) -> ([(RecFlag, LHsBinds (GhcPass 'Renamed))] -> [Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))]) -> [(RecFlag, LHsBinds (GhcPass 'Renamed))] -> [LHsBind (GhcPass 'Renamed)] forall b c a. (b -> c) -> (a -> b) -> a -> c . ([RecFlag], [Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))]) -> [Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))] forall a b. (a, b) -> b snd (([RecFlag], [Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))]) -> [Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))]) -> ([(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))))] -> ([RecFlag], [Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))])) -> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))))] -> [Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))] forall b c a. (b -> c) -> (a -> b) -> a -> c . [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))))] -> ([RecFlag], [Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))]) forall a b. [(a, b)] -> ([a], [b]) unzip ([(RecFlag, LHsBinds (GhcPass 'Renamed))] -> [LHsBind (GhcPass 'Renamed)]) -> [(RecFlag, LHsBinds (GhcPass 'Renamed))] -> [LHsBind (GhcPass 'Renamed)] forall a b. (a -> b) -> a -> b $ [(RecFlag, LHsBinds (GhcPass 'Renamed))] binds valbinds ValBinds{} = String -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))] forall a. HasCallStack => String -> a error String "expected XValBindsLR" -- | Collect docs and attach them to the right declarations. -- -- A declaration may have multiple doc strings attached to it. collectDocs :: forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])] -- ^ This is an example. collectDocs :: forall p. UnXRec p => [LHsDecl p] -> [(LHsDecl p, [HsDoc p])] collectDocs = [WithHsDocIdentifiers HsDocString p] -> Maybe (XRec p (HsDecl p)) -> [XRec p (HsDecl p)] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] go [] Maybe (XRec p (HsDecl p)) forall a. Maybe a Nothing where go :: [WithHsDocIdentifiers HsDocString p] -> Maybe (XRec p (HsDecl p)) -> [XRec p (HsDecl p)] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] go [WithHsDocIdentifiers HsDocString p] docs Maybe (XRec p (HsDecl p)) mprev [XRec p (HsDecl p)] decls = case ([XRec p (HsDecl p)] decls, Maybe (XRec p (HsDecl p)) mprev) of ((forall p a. UnXRec p => XRec p a -> a unXRec @p -> DocD XDocD p _ (DocCommentNext LHsDoc p s)) : [XRec p (HsDecl p)] ds, Maybe (XRec p (HsDecl p)) Nothing) -> [WithHsDocIdentifiers HsDocString p] -> Maybe (XRec p (HsDecl p)) -> [XRec p (HsDecl p)] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] go (LHsDoc p -> WithHsDocIdentifiers HsDocString p forall l e. GenLocated l e -> e unLoc LHsDoc p sWithHsDocIdentifiers HsDocString p -> [WithHsDocIdentifiers HsDocString p] -> [WithHsDocIdentifiers HsDocString p] forall a. a -> [a] -> [a] :[WithHsDocIdentifiers HsDocString p] docs) Maybe (XRec p (HsDecl p)) forall a. Maybe a Nothing [XRec p (HsDecl p)] ds ((forall p a. UnXRec p => XRec p a -> a unXRec @p -> DocD XDocD p _ (DocCommentNext LHsDoc p s)) : [XRec p (HsDecl p)] ds, Just XRec p (HsDecl p) prev) -> XRec p (HsDecl p) -> [WithHsDocIdentifiers HsDocString p] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] forall {a} {a}. a -> [a] -> [(a, [a])] -> [(a, [a])] finished XRec p (HsDecl p) prev [WithHsDocIdentifiers HsDocString p] docs ([(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])]) -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] forall a b. (a -> b) -> a -> b $ [WithHsDocIdentifiers HsDocString p] -> Maybe (XRec p (HsDecl p)) -> [XRec p (HsDecl p)] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] go [LHsDoc p -> WithHsDocIdentifiers HsDocString p forall l e. GenLocated l e -> e unLoc LHsDoc p s] Maybe (XRec p (HsDecl p)) forall a. Maybe a Nothing [XRec p (HsDecl p)] ds ((forall p a. UnXRec p => XRec p a -> a unXRec @p -> DocD XDocD p _ (DocCommentPrev LHsDoc p s)) : [XRec p (HsDecl p)] ds, Maybe (XRec p (HsDecl p)) mprev) -> [WithHsDocIdentifiers HsDocString p] -> Maybe (XRec p (HsDecl p)) -> [XRec p (HsDecl p)] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] go (LHsDoc p -> WithHsDocIdentifiers HsDocString p forall l e. GenLocated l e -> e unLoc LHsDoc p sWithHsDocIdentifiers HsDocString p -> [WithHsDocIdentifiers HsDocString p] -> [WithHsDocIdentifiers HsDocString p] forall a. a -> [a] -> [a] :[WithHsDocIdentifiers HsDocString p] docs) Maybe (XRec p (HsDecl p)) mprev [XRec p (HsDecl p)] ds (XRec p (HsDecl p) d : [XRec p (HsDecl p)] ds, Maybe (XRec p (HsDecl p)) Nothing) -> [WithHsDocIdentifiers HsDocString p] -> Maybe (XRec p (HsDecl p)) -> [XRec p (HsDecl p)] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] go [WithHsDocIdentifiers HsDocString p] docs (XRec p (HsDecl p) -> Maybe (XRec p (HsDecl p)) forall a. a -> Maybe a Just XRec p (HsDecl p) d) [XRec p (HsDecl p)] ds (XRec p (HsDecl p) d : [XRec p (HsDecl p)] ds, Just XRec p (HsDecl p) prev) -> XRec p (HsDecl p) -> [WithHsDocIdentifiers HsDocString p] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] forall {a} {a}. a -> [a] -> [(a, [a])] -> [(a, [a])] finished XRec p (HsDecl p) prev [WithHsDocIdentifiers HsDocString p] docs ([(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])]) -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] forall a b. (a -> b) -> a -> b $ [WithHsDocIdentifiers HsDocString p] -> Maybe (XRec p (HsDecl p)) -> [XRec p (HsDecl p)] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] go [] (XRec p (HsDecl p) -> Maybe (XRec p (HsDecl p)) forall a. a -> Maybe a Just XRec p (HsDecl p) d) [XRec p (HsDecl p)] ds ([] , Maybe (XRec p (HsDecl p)) Nothing) -> [] ([] , Just XRec p (HsDecl p) prev) -> XRec p (HsDecl p) -> [WithHsDocIdentifiers HsDocString p] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] -> [(XRec p (HsDecl p), [WithHsDocIdentifiers HsDocString p])] forall {a} {a}. a -> [a] -> [(a, [a])] -> [(a, [a])] finished XRec p (HsDecl p) prev [WithHsDocIdentifiers HsDocString p] docs [] finished :: a -> [a] -> [(a, [a])] -> [(a, [a])] finished a decl [a] docs [(a, [a])] rest = (a decl, [a] -> [a] forall a. [a] -> [a] reverse [a] docs) (a, [a]) -> [(a, [a])] -> [(a, [a])] forall a. a -> [a] -> [a] : [(a, [a])] rest -- | Filter out declarations that we don't handle in Haddock filterDecls :: forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)] filterDecls :: forall p doc. UnXRec p => [(LHsDecl p, doc)] -> [(LHsDecl p, doc)] filterDecls = ((XRec p (HsDecl p), doc) -> Bool) -> [(XRec p (HsDecl p), doc)] -> [(XRec p (HsDecl p), doc)] forall a. (a -> Bool) -> [a] -> [a] filter (HsDecl p -> Bool forall a. HsDecl a -> Bool isHandled (HsDecl p -> Bool) -> ((XRec p (HsDecl p), doc) -> HsDecl p) -> (XRec p (HsDecl p), doc) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . forall p a. UnXRec p => XRec p a -> a unXRec @p (XRec p (HsDecl p) -> HsDecl p) -> ((XRec p (HsDecl p), doc) -> XRec p (HsDecl p)) -> (XRec p (HsDecl p), doc) -> HsDecl p forall b c a. (b -> c) -> (a -> b) -> a -> c . (XRec p (HsDecl p), doc) -> XRec p (HsDecl p) forall a b. (a, b) -> a fst) where isHandled :: HsDecl name -> Bool isHandled (ForD XForD name _ (ForeignImport {})) = Bool True isHandled (TyClD {}) = Bool True isHandled (InstD {}) = Bool True isHandled (DerivD {}) = Bool True isHandled (SigD XSigD name _ Sig name d) = Sig name -> Bool forall name. Sig name -> Bool isUserSig Sig name d isHandled (ValD {}) = Bool True -- we keep doc declarations to be able to get at named docs isHandled (DocD {}) = Bool True isHandled HsDecl name _ = Bool False -- | Go through all class declarations and filter their sub-declarations filterClasses :: forall p doc. (IsPass p) => [(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)] filterClasses :: forall (p :: Pass) doc. IsPass p => [(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)] filterClasses = ((GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc) -> (GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc)) -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc)] -> [(GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc)] forall a b. (a -> b) -> [a] -> [b] map ((GenLocated SrcSpanAnnA (HsDecl (GhcPass p)) -> GenLocated SrcSpanAnnA (HsDecl (GhcPass p))) -> (GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc) -> (GenLocated SrcSpanAnnA (HsDecl (GhcPass p)), doc) forall a b c. (a -> b) -> (a, c) -> (b, c) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first ((HsDecl (GhcPass p) -> HsDecl (GhcPass p)) -> GenLocated SrcSpanAnnA (HsDecl (GhcPass p)) -> GenLocated SrcSpanAnnA (HsDecl (GhcPass p)) forall a b. (a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap HsDecl (GhcPass p) -> HsDecl (GhcPass p) forall {p} {l}. (XRec p (Sig p) ~ GenLocated l (Sig p), UnXRec 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 = filter (liftA2 (||) (isUserSig . unLoc) isMinimalLSig) (tcdSigs 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 -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls :: forall struct l decl hsDecl. (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl] mkDecls struct -> [GenLocated l decl] field decl -> hsDecl con = (GenLocated l decl -> GenLocated l hsDecl) -> [GenLocated l decl] -> [GenLocated l hsDecl] forall a b. (a -> b) -> [a] -> [b] map ((decl -> hsDecl) -> GenLocated l decl -> GenLocated l hsDecl forall a b. (a -> b) -> GenLocated l a -> GenLocated l b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap decl -> hsDecl con) ([GenLocated l decl] -> [GenLocated l hsDecl]) -> (struct -> [GenLocated l decl]) -> struct -> [GenLocated l hsDecl] forall b c a. (b -> c) -> (a -> b) -> a -> c . struct -> [GenLocated l decl] field -- | Extracts out individual maps of documentation added via Template Haskell's -- @putDoc@. extractTHDocs :: THDocs -> ExtractedTHDocs extractTHDocs :: THDocs -> ExtractedTHDocs extractTHDocs THDocs docs = -- Split up docs into separate maps for each 'DocLoc' type ExtractedTHDocs { ethd_mod_header :: Maybe (HsDoc (GhcPass 'Renamed)) ethd_mod_header = Maybe (HsDoc (GhcPass 'Renamed)) docHeader , ethd_decl_docs :: UniqMap Name (HsDoc (GhcPass 'Renamed)) ethd_decl_docs = (UniqMap Name (HsDoc (GhcPass 'Renamed)) -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name (HsDoc (GhcPass 'Renamed))) -> UniqMap Name (HsDoc (GhcPass 'Renamed)) forall a. (UniqMap Name a -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a) -> UniqMap Name a searchDocs UniqMap Name (HsDoc (GhcPass 'Renamed)) -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name (HsDoc (GhcPass 'Renamed)) forall {a}. UniqMap Name a -> (DocLoc, a) -> UniqMap Name a decl , ethd_arg_docs :: UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) ethd_arg_docs = (UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed)))) -> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) forall a. (UniqMap Name a -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a) -> UniqMap Name a searchDocs UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) args , ethd_inst_docs :: UniqMap Name (HsDoc (GhcPass 'Renamed)) ethd_inst_docs = (UniqMap Name (HsDoc (GhcPass 'Renamed)) -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name (HsDoc (GhcPass 'Renamed))) -> UniqMap Name (HsDoc (GhcPass 'Renamed)) forall a. (UniqMap Name a -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a) -> UniqMap Name a searchDocs UniqMap Name (HsDoc (GhcPass 'Renamed)) -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name (HsDoc (GhcPass 'Renamed)) forall {a}. UniqMap Name a -> (DocLoc, a) -> UniqMap Name a insts } where docHeader :: Maybe (HsDoc GhcRn) docHeader :: Maybe (HsDoc (GhcPass 'Renamed)) docHeader | ((DocLoc _, HsDoc (GhcPass 'Renamed) s):[(DocLoc, HsDoc (GhcPass 'Renamed))] _) <- ((DocLoc, HsDoc (GhcPass 'Renamed)) -> Bool) -> [(DocLoc, HsDoc (GhcPass 'Renamed))] -> [(DocLoc, HsDoc (GhcPass 'Renamed))] forall a. (a -> Bool) -> [a] -> [a] filter (DocLoc, HsDoc (GhcPass 'Renamed)) -> Bool forall {b}. (DocLoc, b) -> Bool isModDoc (THDocs -> [(DocLoc, HsDoc (GhcPass 'Renamed))] forall k a. Map k a -> [(k, a)] M.toList THDocs docs) = HsDoc (GhcPass 'Renamed) -> Maybe (HsDoc (GhcPass 'Renamed)) forall a. a -> Maybe a Just HsDoc (GhcPass 'Renamed) s | Bool otherwise = Maybe (HsDoc (GhcPass 'Renamed)) forall a. Maybe a Nothing isModDoc :: (DocLoc, b) -> Bool isModDoc (DocLoc ModuleDoc, b _) = Bool True isModDoc (DocLoc, b) _ = Bool False -- Folds over the docs, applying 'f' as the accumulating function. -- We use different accumulating functions to sift out the specific types of -- documentation searchDocs :: (UniqMap Name a -> (DocLoc, HsDoc GhcRn) -> UniqMap Name a) -> UniqMap Name a searchDocs :: forall a. (UniqMap Name a -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a) -> UniqMap Name a searchDocs UniqMap Name a -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a f = (UniqMap Name a -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a) -> UniqMap Name a -> [(DocLoc, HsDoc (GhcPass 'Renamed))] -> UniqMap Name a forall b a. (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' UniqMap Name a -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name a f UniqMap Name a forall k a. UniqMap k a emptyUniqMap ([(DocLoc, HsDoc (GhcPass 'Renamed))] -> UniqMap Name a) -> [(DocLoc, HsDoc (GhcPass 'Renamed))] -> UniqMap Name a forall a b. (a -> b) -> a -> b $ THDocs -> [(DocLoc, HsDoc (GhcPass 'Renamed))] forall k a. Map k a -> [(k, a)] M.toList THDocs docs -- Pick out the declaration docs decl :: UniqMap Name a -> (DocLoc, a) -> UniqMap Name a decl UniqMap Name a acc ((DeclDoc Name name), a s) = UniqMap Name a -> Name -> a -> UniqMap Name a forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a addToUniqMap UniqMap Name a acc Name name a s decl UniqMap Name a acc (DocLoc, a) _ = UniqMap Name a acc -- Pick out the instance docs insts :: UniqMap Name a -> (DocLoc, a) -> UniqMap Name a insts UniqMap Name a acc ((InstDoc Name name), a s) = UniqMap Name a -> Name -> a -> UniqMap Name a forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a addToUniqMap UniqMap Name a acc Name name a s insts UniqMap Name a acc (DocLoc, a) _ = UniqMap Name a acc -- Pick out the argument docs args :: UniqMap Name (IntMap (HsDoc GhcRn)) -> (DocLoc, HsDoc GhcRn) -> UniqMap Name (IntMap (HsDoc GhcRn)) args :: UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) -> (DocLoc, HsDoc (GhcPass 'Renamed)) -> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) args UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) acc ((ArgDoc Name name Key i), HsDoc (GhcPass 'Renamed) s) = -- Insert the doc for the arg into the argument map for the function. This -- means we have to search to see if an map already exists for the -- function, and insert the new argument if it exists, or create a new map (IntMap (HsDoc (GhcPass 'Renamed)) -> IntMap (HsDoc (GhcPass 'Renamed)) -> IntMap (HsDoc (GhcPass 'Renamed))) -> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) -> Name -> IntMap (HsDoc (GhcPass 'Renamed)) -> UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) forall k a. Uniquable k => (a -> a -> a) -> UniqMap k a -> k -> a -> UniqMap k a addToUniqMap_C (\IntMap (HsDoc (GhcPass 'Renamed)) _ IntMap (HsDoc (GhcPass 'Renamed)) m -> Key -> HsDoc (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) -> IntMap (HsDoc (GhcPass 'Renamed)) forall a. Key -> a -> IntMap a -> IntMap a IM.insert Key i HsDoc (GhcPass 'Renamed) s IntMap (HsDoc (GhcPass 'Renamed)) m) UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) acc Name name (Key -> HsDoc (GhcPass 'Renamed) -> IntMap (HsDoc (GhcPass 'Renamed)) forall a. Key -> a -> IntMap a IM.singleton Key i HsDoc (GhcPass 'Renamed) s) args UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) acc (DocLoc, HsDoc (GhcPass 'Renamed)) _ = UniqMap Name (IntMap (HsDoc (GhcPass 'Renamed))) acc -- | Unions together two 'ArgDocMaps' (or ArgMaps in haddock-api), such that two -- maps with values for the same key merge the inner map as well. -- Left biased so @unionArgMaps a b@ prefers @a@ over @b@. unionArgMaps :: forall b . UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) unionArgMaps :: forall b. UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) unionArgMaps UniqMap Name (IntMap b) a UniqMap Name (IntMap b) b = ((Name, IntMap b) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b)) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) forall k a b. ((k, a) -> b -> b) -> b -> UniqMap k a -> b nonDetFoldUniqMap (Name, IntMap b) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) go UniqMap Name (IntMap b) b UniqMap Name (IntMap b) a where go :: (Name, IntMap b) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) go :: (Name, IntMap b) -> UniqMap Name (IntMap b) -> UniqMap Name (IntMap b) go (Name n, IntMap b newArgMap) UniqMap Name (IntMap b) acc | Just IntMap b oldArgMap <- UniqMap Name (IntMap b) -> Name -> Maybe (IntMap b) forall k a. Uniquable k => UniqMap k a -> k -> Maybe a lookupUniqMap UniqMap Name (IntMap b) acc Name n = UniqMap Name (IntMap b) -> Name -> IntMap b -> UniqMap Name (IntMap b) forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a addToUniqMap UniqMap Name (IntMap b) acc Name n (IntMap b newArgMap IntMap b -> IntMap b -> IntMap b forall a. IntMap a -> IntMap a -> IntMap a `IM.union` IntMap b oldArgMap) | Bool otherwise = UniqMap Name (IntMap b) -> Name -> IntMap b -> UniqMap Name (IntMap b) forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a addToUniqMap UniqMap Name (IntMap b) acc Name n IntMap b newArgMap