@@ -985,25 +985,77 @@ mkDetailsFromIface session iface linkable = do
985
985
initIfaceLoad hsc' (typecheckIface iface)
986
986
return (HomeModInfo iface details linkable)
987
987
988
+
988
989
-- | Non-interactive, batch version of 'InteractiveEval.getDocs'.
989
990
-- The interactive paths create problems in ghc-lib builds
990
991
--- and leads to fun errors like "Cannot continue after interface file error".
991
992
getDocsBatch
992
993
:: HscEnv
993
994
-> Module -- ^ a moudle where the names are in scope
994
995
-> [Name ]
996
+ -- 2021-11-19: NOTE: Don't forget these 'Map' currently lazy.
995
997
-- 2021-11-18: NOTE: Map Int would become IntMap if next GHCs.
996
998
-> IO (Either ErrorMessages (Map. Map Name (Either GetDocsFailure (Maybe HsDocString , Maybe (Map. Map Int HsDocString )))))
997
999
-- ^ Return a 'Map' of 'Name's to 'Either' (no docs messages) (general doc body & arg docs)
998
1000
getDocsBatch hsc_env _mod _names = do
999
- ((_warns,errs), res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ Map. fromList <$> traverse findNameInfo _names
1001
+ ((_warns,errs), res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ Map. fromList <$> traverse undefined undefined
1000
1002
pure $ maybeToEither errs res
1001
1003
where
1002
- findNameInfo :: Name -> IOEnv (Env TcGblEnv TcLclEnv ) (Name , Either GetDocsFailure (Maybe HsDocString , Maybe (Map. Map Int HsDocString )))
1003
- findNameInfo name =
1004
- case nameModule_maybe name of
1005
- Nothing -> return (name, Left $ NameHasNoModule name)
1006
- Just mod -> do
1004
+ mapOfRequestedDocs :: IOEnv (Env TcGblEnv TcLclEnv ) (Map Name (Maybe HsDocString , Maybe (Map Int HsDocString )))
1005
+ mapOfRequestedDocs = Map. fromList . foldMap getAskedIfaceDocs <$> loadIfaces
1006
+
1007
+ getAskedIfaceDocs :: ((Map Name HsDocString , Map Name (Map Int HsDocString )), [Name ]) -> [(Name , (Maybe HsDocString , Maybe (Map Int HsDocString )))]
1008
+ getAskedIfaceDocs a = lookupDocs <$> snd a
1009
+ where
1010
+ lookupDocs :: Name -> (Name , (Maybe HsDocString , Maybe (Map Int HsDocString )))
1011
+ lookupDocs n = (n, bimap (Map. lookup n) (Map. lookup n) $ fst a)
1012
+
1013
+ loadIfaces :: IOEnv (Env TcGblEnv TcLclEnv ) [((Map Name HsDocString , Map Name (Map Int HsDocString )), [Name ])]
1014
+ loadIfaces = mkOneEnv (fmap (first getIfaceGenNArgDocMaps) loadModules)
1015
+ where
1016
+ mkOneEnv :: Applicative env => [(env ms , ns )] -> env [(ms , ns )]
1017
+ mkOneEnv a = traverse (fmap swap . sequenceA . swap) a
1018
+
1019
+ getIfaceGenNArgDocMaps :: TcRn ModIface -> IOEnv (Env TcGblEnv TcLclEnv ) (Map Name HsDocString , Map Name (Map Int HsDocString ))
1020
+ getIfaceGenNArgDocMaps mi = do
1021
+ ModIface
1022
+ { mi_doc_hdr = mb_doc_hdr
1023
+ , mi_decl_docs = DeclDocMap dmap
1024
+ , mi_arg_docs = ArgDocMap amap
1025
+ }
1026
+ <- mi
1027
+ pure $
1028
+ if isNothing mb_doc_hdr && Map. null dmap && Map. null amap
1029
+ then error " Instead of 'error' here handle 'NoDocsInIface mod $ isCompiled name' case"
1030
+ else (dmap, amap)
1031
+
1032
+ loadModules :: [(TcRn ModIface , [Name ])]
1033
+ loadModules = fmap loadAvailableModules namesGroupedByModule
1034
+ where
1035
+ loadAvailableModules :: (Module , [Name ]) -> (TcRn ModIface , [Name ])
1036
+ loadAvailableModules = first loadModuleInterfaceOnce
1037
+
1038
+
1039
+ loadModuleInterfaceOnce :: Module -> TcRn ModIface
1040
+ loadModuleInterfaceOnce =
1041
+ loadModuleInterface " getModuleInterface"
1042
+
1043
+ namesGroupedByModule :: [(Module , [Name ])]
1044
+ namesGroupedByModule =
1045
+ groupSort $ fmap (first (fromMaybe (error " Instead of 'error' handle here 'NameHasNoModule' case" ) . nameModule_maybe) . dupe) _names
1046
+
1047
+ -- modulesPartitionedOnAvalability :: [(Either (Name -> GetDocsFailure) Module, [Name])]
1048
+ -- modulesPartitionedOnAvalability = fmap partitionOnModuleAvalibility namesGroupedByModule
1049
+
1050
+ -- partitionOnModuleAvalibility :: (Maybe Module, [Name]) -> (Either (Name -> GetDocsFailure) Module, [Name])
1051
+ -- partitionOnModuleAvalibility =
1052
+ -- first (maybeToEither NameHasNoModule)
1053
+
1054
+
1055
+ -- 2021-11-18: NOTE: This code initially was taken from: https://hackage.haskell.org/package/ghc-9.2.1/docs/src/GHC.Runtime.Eval.html#getDocs
1056
+ findNameInfo :: Maybe Module -> Name -> IOEnv (Env TcGblEnv TcLclEnv ) (Name , Either GetDocsFailure (Maybe HsDocString , Maybe (Map. Map Int HsDocString )))
1057
+ findNameInfo Nothing name = return (name, Left $ NameHasNoModule name)
1058
+ findNameInfo (Just mod ) name = do
1007
1059
ModIface
1008
1060
{ mi_doc_hdr = mb_doc_hdr
1009
1061
, mi_decl_docs = DeclDocMap dmap
0 commit comments