Skip to content

Commit 1d65815

Browse files
committed
WIP ghcide: Core.Compile: getDocsBatch batching
1 parent 38463da commit 1d65815

File tree

1 file changed

+58
-6
lines changed

1 file changed

+58
-6
lines changed

ghcide/src/Development/IDE/Core/Compile.hs

Lines changed: 58 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -985,25 +985,77 @@ mkDetailsFromIface session iface linkable = do
985985
initIfaceLoad hsc' (typecheckIface iface)
986986
return (HomeModInfo iface details linkable)
987987

988+
988989
-- | Non-interactive, batch version of 'InteractiveEval.getDocs'.
989990
-- The interactive paths create problems in ghc-lib builds
990991
--- and leads to fun errors like "Cannot continue after interface file error".
991992
getDocsBatch
992993
:: HscEnv
993994
-> Module -- ^ a moudle where the names are in scope
994995
-> [Name]
996+
-- 2021-11-19: NOTE: Don't forget these 'Map' currently lazy.
995997
-- 2021-11-18: NOTE: Map Int would become IntMap if next GHCs.
996998
-> IO (Either ErrorMessages (Map.Map Name (Either GetDocsFailure (Maybe HsDocString, Maybe (Map.Map Int HsDocString)))))
997999
-- ^ Return a 'Map' of 'Name's to 'Either' (no docs messages) (general doc body & arg docs)
9981000
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
10001002
pure $ maybeToEither errs res
10011003
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
10071059
ModIface
10081060
{ mi_doc_hdr = mb_doc_hdr
10091061
, mi_decl_docs = DeclDocMap dmap

0 commit comments

Comments
 (0)