From 7dd19b547ba30b760053b5f796c439cba6ac6a07 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 3 Nov 2024 15:51:15 +0800 Subject: [PATCH] add extra files --- exe/Main.hs | 2 +- src/HIE/Bios/Cradle.hs | 46 +++++++++++++++++++--------------- src/HIE/Bios/Internal/Debug.hs | 6 +++-- src/HIE/Bios/Types.hs | 1 + 4 files changed, 32 insertions(+), 23 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 28871682..4b81d892 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -87,7 +87,7 @@ main = do res <- forM files $ \fp -> do res <- getCompilerOptions fp LoadFile cradle case res of - CradleFail (CradleError _deps _ex err) -> + CradleFail (CradleError _deps _ex err _fps) -> return $ "Failed to show flags for \"" ++ fp ++ "\": " ++ show err diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index b9cd3f9b..842e25e2 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -243,7 +243,7 @@ resolvedCradlesToCradle logger buildCustomCradle root cs = mdo case selectCradle (prefix . fst) absfp cradleActions of Just (rc, act) -> do addActionDeps (cradleDeps rc) <$> runCradle act fp prev - Nothing -> return $ CradleFail $ CradleError [] ExitSuccess (err_msg fp) + Nothing -> return $ CradleFail $ CradleError [] ExitSuccess (err_msg fp) [fp] , runGhcCmd = run_ghc_cmd } } @@ -518,7 +518,7 @@ biosAction wdir bios bios_deps l fp loadStyle = do -- delimited by newlines. -- Execute the bios action and add dependencies of the cradle. -- Removes all duplicates. - return $ makeCradleResult (ex, std, wdir, fromMaybe [] res) deps + return $ makeCradleResult (ex, std, wdir, fromMaybe [] res) deps [fp] callableToProcess :: Callable -> Maybe String -> IO CreateProcess callableToProcess (Command shellCommand) file = do @@ -817,9 +817,9 @@ cabalAction (ResolvedCradles root cs vs) workDir mc l projectFile fp loadStyle = pure LoadFile _ -> pure LoadFile - let cabalArgs = case determinedLoadStyle of - LoadFile -> [fromMaybe (fixTargetPath fp) mc] - LoadWithContext fps -> concat + let (cabalArgs, extraFileDeps) = case determinedLoadStyle of + LoadFile -> ([fromMaybe (fixTargetPath fp) mc], [(fp, deps) | Just (ResolvedCradle{cradleDeps = deps}) <- [selectCradle prefix fp cs]]) + LoadWithContext fps -> (concat [ [ "--keep-temp-files" , "--enable-multi-repl" , fromMaybe (fixTargetPath fp) mc @@ -832,8 +832,10 @@ cabalAction (ResolvedCradles root cs vs) workDir mc l projectFile fp loadStyle = , (projectConfigFromMaybe root (cabalProjectFile ct)) == projectFile , let old_mc = cabalComponent ct ] - ] + ], [(file, deps) | file <- fp:fps, Just (ResolvedCradle{cradleDeps = deps}) <- [selectCradle prefix file cs]]) + let extraDeps = concatMap snd extraFileDeps + loadingFiles = map fst extraFileDeps liftIO $ l <& LogComputedCradleLoadStyle "cabal" determinedLoadStyle `WithSeverity` Info let @@ -858,7 +860,7 @@ cabalAction (ResolvedCradles root cs vs) workDir mc l projectFile fp loadStyle = deps <- liftIO $ cabalCradleDependencies projectFile workDir workDir let cmd = show (["cabal", cabalCommand] <> cabalArgs) let errorMsg = "Failed to run " <> cmd <> " in directory \"" <> workDir <> "\". Consult the logs for full command and error." - throwCE (CradleError deps ex ([errorMsg] <> errorDetails)) + throwCE (CradleError deps ex ([errorMsg] <> errorDetails) loadingFiles) case processCabalWrapperArgs args of Nothing -> do @@ -866,10 +868,10 @@ cabalAction (ResolvedCradles root cs vs) workDir mc l projectFile fp loadStyle = -- Best effort. Assume the working directory is the -- root of the component, so we are right in trivial cases at least. deps <- liftIO $ cabalCradleDependencies projectFile workDir workDir - throwCE (CradleError deps ex $ ["Failed to parse result of calling cabal" ] <> errorDetails) + throwCE (CradleError (deps <> extraDeps) ex (["Failed to parse result of calling cabal" ] <> errorDetails) loadingFiles) Just (componentDir, final_args) -> do deps <- liftIO $ cabalCradleDependencies projectFile workDir componentDir - CradleLoadResultT $ pure $ makeCradleResult (ex, stde, componentDir, final_args) deps + CradleLoadResultT $ pure $ makeCradleResult (ex, stde, componentDir, final_args) (deps <> extraDeps) loadingFiles where -- Need to make relative on Windows, due to a Cabal bug with how it -- parses file targets with a C: drive in it @@ -987,7 +989,7 @@ stackAction -> FilePath -> LoadStyle -> IO (CradleLoadResult ComponentOptions) -stackAction workDir mc syaml l _fp loadStyle = do +stackAction workDir mc syaml l fp loadStyle = do logCradleHasNoSupportForLoadWithContext l loadStyle "stack" let ghcProcArgs = ("stack", stackYamlProcessArgs syaml <> ["exec", "ghc", "--"]) -- Same wrapper works as with cabal @@ -1011,10 +1013,11 @@ stackAction workDir mc syaml l _fp loadStyle = do -- the root of the component, so we are right in trivial cases at least. deps <- stackCradleDependencies workDir workDir syaml pure $ CradleFail - (CradleError deps ex1 $ - [ "Failed to parse result of calling stack" ] + (CradleError deps ex1 + ([ "Failed to parse result of calling stack" ] ++ stde - ++ args + ++ args) + [fp] ) Just (componentDir, ghc_args) -> do @@ -1025,6 +1028,7 @@ stackAction workDir mc syaml l _fp loadStyle = do , ghc_args ++ pkg_ghc_args ) deps + [fp] stackProcess :: CradleProjectConfig -> [String] -> CreateProcess stackProcess syaml args = proc "stack" $ stackYamlProcessArgs syaml <> args @@ -1217,10 +1221,10 @@ removeFileIfExists f = do yes <- doesFileExist f when yes (removeFile f) -makeCradleResult :: (ExitCode, [String], FilePath, [String]) -> [FilePath] -> CradleLoadResult ComponentOptions -makeCradleResult (ex, err, componentDir, gopts) deps = +makeCradleResult :: (ExitCode, [String], FilePath, [String]) -> [FilePath] -> [FilePath] -> CradleLoadResult ComponentOptions +makeCradleResult (ex, err, componentDir, gopts) deps loadingFiles = case ex of - ExitFailure _ -> CradleFail (CradleError deps ex err) + ExitFailure _ -> CradleFail (CradleError deps ex err loadingFiles) _ -> let compOpts = ComponentOptions gopts componentDir deps in CradleSuccess compOpts @@ -1252,11 +1256,13 @@ readProcessWithCwd' l createdProcess stdin = do case mResult of Just (ExitSuccess, stdo, _) -> pure stdo Just (exitCode, stdo, stde) -> throwCE $ - CradleError [] exitCode $ - ["Error when calling " <> cmdString, stdo, stde] <> prettyProcessEnv createdProcess + CradleError [] exitCode + (["Error when calling " <> cmdString, stdo, stde] <> prettyProcessEnv createdProcess) + [] Nothing -> throwCE $ - CradleError [] ExitSuccess $ - ["Couldn't execute " <> cmdString] <> prettyProcessEnv createdProcess + CradleError [] ExitSuccess + (["Couldn't execute " <> cmdString] <> prettyProcessEnv createdProcess) + [] -- | Log that the cradle has no supported for loading with context, if and only if -- 'LoadWithContext' was requested. diff --git a/src/HIE/Bios/Internal/Debug.hs b/src/HIE/Bios/Internal/Debug.hs index 85ba048a..f31803e9 100644 --- a/src/HIE/Bios/Internal/Debug.hs +++ b/src/HIE/Bios/Internal/Debug.hs @@ -48,11 +48,13 @@ debugInfo fp cradle = unlines <$> do , "Cradle: " ++ crdl , "Dependencies: " ++ unwords deps ] - CradleFail (CradleError deps ext stderr) -> + CradleFail (CradleError deps ext stderr extraFiles) -> return ["Cradle failed to load" , "Deps: " ++ show deps , "Exit Code: " ++ show ext - , "Stderr: " ++ unlines stderr] + , "Stderr: " ++ unlines stderr + , "ExtraFiles: " ++ unlines extraFiles + ] CradleNone -> return ["No cradle"] where diff --git a/src/HIE/Bios/Types.hs b/src/HIE/Bios/Types.hs index e848b30e..5aec0ccf 100644 --- a/src/HIE/Bios/Types.hs +++ b/src/HIE/Bios/Types.hs @@ -266,6 +266,7 @@ data CradleError = CradleError , cradleErrorStderr :: [String] -- ^ Standard error output that can be shown to users to explain -- the loading error. + , cradleErrorLoadingFiles :: [FilePath] } deriving (Show, Eq)