diff --git a/exe/Main.hs b/exe/Main.hs index 288716824..4b81d8929 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/hie-bios.cabal b/hie-bios.cabal index 54a5a6df7..dd1f61037 100644 --- a/hie-bios.cabal +++ b/hie-bios.cabal @@ -138,6 +138,11 @@ Extra-Source-Files: README.md tests/projects/stack-with-yaml/hie.yaml tests/projects/stack-with-yaml/stack-with-yaml.cabal tests/projects/stack-with-yaml/src/Lib.hs + tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/app/Main.hs + tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/multi-repl-cabal-fail.cabal + tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Fail.hs + tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Lib.hs + tests/projects/failing-multi-repl-cabal-project/NotInPath.hs tested-with: GHC ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 || ==9.10.1 || ==9.12.1 diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index b9cd3f9b5..30a58372b 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -25,6 +25,11 @@ module HIE.Bios.Cradle ( , makeCradleResult -- | Cradle project configuration types , CradleProjectConfig(..) + + -- expose to tests + , makeVersions + , isCabalMultipleCompSupported + , ProgramVersions ) where import Control.Applicative ((<|>), optional) @@ -47,9 +52,10 @@ import qualified Data.Conduit.Combinators as C import qualified Data.Conduit as C import qualified Data.Conduit.Text as C import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as S import Data.Maybe (fromMaybe, maybeToList) import Data.List -import Data.List.Extra (trimEnd) +import Data.List.Extra (trimEnd, nubOrd) import Data.Ord (Down(..)) import qualified Data.Text as T import System.Environment @@ -73,6 +79,7 @@ import GHC.ResponseFile (escapeArgs) import Data.Version import Data.IORef import Text.ParserCombinators.ReadP (readP_to_S) +import Data.Tuple.Extra (fst3, snd3, thd3) ---------------------------------------------------------------- @@ -129,6 +136,7 @@ data ConcreteCradle a | ConcreteOther a deriving Show + -- | ConcreteCradle augmented with information on which file the -- cradle applies data ResolvedCradle a @@ -243,7 +251,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 +526,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 @@ -788,6 +796,15 @@ cabalGhcDirs l cabalProject workDir = do where projectFileArgs = projectFileProcessArgs cabalProject +isCabalMultipleCompSupported :: MonadIO m => ProgramVersions -> m Bool +isCabalMultipleCompSupported vs = do + cabal_version <- liftIO $ runCachedIO $ cabalVersion vs + ghc_version <- liftIO $ runCachedIO $ ghcVersion vs + -- determine which load style is supported by this cabal cradle. + case (cabal_version, ghc_version) of + (Just cabal, Just ghc) -> pure $ ghc >= makeVersion [9, 4] && cabal >= makeVersion [3, 11] + _ -> pure False + cabalAction :: ResolvedCradles a -> FilePath @@ -798,67 +815,57 @@ cabalAction -> LoadStyle -> CradleLoadResultT IO ComponentOptions cabalAction (ResolvedCradles root cs vs) workDir mc l projectFile fp loadStyle = do - cabal_version <- liftIO $ runCachedIO $ cabalVersion vs - ghc_version <- liftIO $ runCachedIO $ ghcVersion vs + multiCompSupport <- isCabalMultipleCompSupported vs -- determine which load style is supported by this cabal cradle. - determinedLoadStyle <- case (cabal_version, ghc_version) of - (Just cabal, Just ghc) - -- Multi-component supported from cabal-install 3.11 - -- and ghc 9.4 - | LoadWithContext _ <- loadStyle -> - if ghc >= makeVersion [9,4] && cabal >= makeVersion [3,11] - then pure loadStyle - else do - liftIO $ l <& WithSeverity - (LogLoadWithContextUnsupported "cabal" - $ Just "cabal or ghc version is too old. We require `cabal >= 3.11` and `ghc >= 9.4`" - ) - Warning - pure LoadFile - _ -> pure LoadFile - - let cabalArgs = case determinedLoadStyle of - LoadFile -> [fromMaybe (fixTargetPath fp) mc] - LoadWithContext fps -> concat - [ [ "--keep-temp-files" - , "--enable-multi-repl" - , fromMaybe (fixTargetPath fp) mc - ] - , [fromMaybe (fixTargetPath old_fp) old_mc - | old_fp <- fps - -- Lookup the component for the old file - , Just (ResolvedCradle{concreteCradle = ConcreteCabal ct}) <- [selectCradle prefix old_fp cs] - -- Only include this file if the old component is in the same project - , (projectConfigFromMaybe root (cabalProjectFile ct)) == projectFile - , let old_mc = cabalComponent ct - ] - ] + determinedLoadStyle <- case loadStyle of + LoadWithContext _ | not multiCompSupport -> do + liftIO $ + l + <& WithSeverity + ( LogLoadWithContextUnsupported "cabal" $ + Just "cabal or ghc version is too old. We require `cabal >= 3.11` and `ghc >= 9.4`" + ) + Warning + pure LoadFile + _ -> pure loadStyle + + let fpModule = fromMaybe (fixTargetPath fp) mc + let (cabalArgs, loadingFiles, extraDeps) = case determinedLoadStyle of + LoadFile -> ([fpModule], [fp], []) + LoadWithContext fps -> + let allModulesFpsDeps = ((fpModule, fp, []) : moduleFilesFromSameProject fps) + allModules = nubOrd $ fst3 <$> allModulesFpsDeps + allFiles = nubOrd $ snd3 <$> allModulesFpsDeps + allFpsDeps = nubOrd $ concatMap thd3 allModulesFpsDeps + in (["--keep-temp-files", "--enable-multi-repl"] ++ allModules, allFiles, allFpsDeps) liftIO $ l <& LogComputedCradleLoadStyle "cabal" determinedLoadStyle `WithSeverity` Info + liftIO $ l <& LogCabalLoad fp mc (prefix <$> cs) loadingFiles `WithSeverity` Debug - let - cabalCommand = "v2-repl" + let cabalCommand = "v2-repl" - cabalProc <- cabalProcess l projectFile workDir cabalCommand cabalArgs `modCradleError` \err -> do + cabalProc <- + cabalProcess l projectFile workDir cabalCommand cabalArgs `modCradleError` \err -> do deps <- cabalCradleDependencies projectFile workDir workDir - pure $ err { cradleErrorDependencies = cradleErrorDependencies err ++ deps } + pure $ err {cradleErrorDependencies = cradleErrorDependencies err ++ deps} (ex, output, stde, [(_, maybeArgs)]) <- liftIO $ readProcessWithOutputs [hie_bios_output] l workDir cabalProc let args = fromMaybe [] maybeArgs let errorDetails = - ["Failed command: " <> prettyCmdSpec (cmdspec cabalProc) - , unlines output - , unlines stde - , unlines $ args - , "Process Environment:"] - <> prettyProcessEnv cabalProc + [ "Failed command: " <> prettyCmdSpec (cmdspec cabalProc), + unlines output, + unlines stde, + unlines args, + "Process Environment:" + ] + <> prettyProcessEnv cabalProc when (ex /= ExitSuccess) $ do 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,16 +873,26 @@ 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 + -- parses file targets with a C: drive in it. So we decide to make + -- the paths relative to the working directory. fixTargetPath x | isWindows && hasDrive x = makeRelative workDir x | otherwise = x + moduleFilesFromSameProject fps = + [ (fromMaybe (fixTargetPath file) old_mc, file, deps) + | file <- fps, + -- Lookup the component for the old file + Just (ResolvedCradle {concreteCradle = ConcreteCabal ct, cradleDeps = deps}) <- [selectCradle prefix file cs], + -- Only include this file if the old component is in the same project + (projectConfigFromMaybe root (cabalProjectFile ct)) == projectFile, + let old_mc = cabalComponent ct + ] removeInteractive :: [String] -> [String] removeInteractive = filter (/= "--interactive") @@ -928,7 +945,7 @@ cabalWorkDir wdir = data CradleProjectConfig = NoExplicitConfig | ExplicitConfig FilePath - deriving Eq + deriving (Eq, Show) -- | Create an explicit project configuration. Expects a working directory -- followed by an optional name of the project configuration. @@ -987,7 +1004,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 +1028,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 +1043,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 +1236,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 +1271,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 85ba048aa..527eb6b88 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 + , "Failed: " ++ unlines extraFiles + ] CradleNone -> return ["No cradle"] where diff --git a/src/HIE/Bios/Types.hs b/src/HIE/Bios/Types.hs index e848b30e5..2dc248336 100644 --- a/src/HIE/Bios/Types.hs +++ b/src/HIE/Bios/Types.hs @@ -99,6 +99,7 @@ data Log | LogRequestedCradleLoadStyle !T.Text !LoadStyle | LogComputedCradleLoadStyle !T.Text !LoadStyle | LogLoadWithContextUnsupported !T.Text !(Maybe T.Text) + | LogCabalLoad !FilePath !(Maybe String) ![FilePath] ![FilePath] deriving (Show) instance Pretty Log where @@ -135,6 +136,11 @@ instance Pretty Log where Nothing -> "." Just reason -> ", because:" <+> pretty reason <> "." <+> "Falling back loading to single file mode." + pretty (LogCabalLoad file prefixes projectFile crs) = + "Cabal Loading file" <+> pretty file + <> line <> indent 4 "from project: " <+> pretty projectFile + <> line <> indent 4 "with prefixes:" <+> pretty prefixes + <> line <> indent 4 "with actual loading files:" <+> pretty crs -- | The 'LoadStyle' instructs a cradle on how to load a given file target. data LoadStyle @@ -266,6 +272,10 @@ data CradleError = CradleError , cradleErrorStderr :: [String] -- ^ Standard error output that can be shown to users to explain -- the loading error. + , cradleErrorLoadingFiles :: [FilePath] + -- ^ files that were attempted to be loaded by the cradle. + -- This can be useful if we are loading multiple files at once, + -- e.g. in a cabal cradle with the multi-repl feature. } deriving (Show, Eq) diff --git a/tests/BiosTests.hs b/tests/BiosTests.hs index ec17e7a6e..f589e746d 100644 --- a/tests/BiosTests.hs +++ b/tests/BiosTests.hs @@ -19,7 +19,7 @@ import Control.Monad ( forM_ ) import Data.List ( sort, isPrefixOf ) import Data.Typeable import System.Directory -import System.FilePath (()) +import System.FilePath ((), makeRelative) import System.Exit (ExitCode(ExitSuccess, ExitFailure)) import Control.Monad.Extra (unlessM) import qualified HIE.Bios.Ghc.Gap as Gap @@ -138,11 +138,25 @@ biosTestCases = cabalTestCases :: ToolDependency -> [TestTree] cabalTestCases extraGhcDep = - [ testCaseSteps "failing-cabal" $ runTestEnv "./failing-cabal" $ do + [ + testCaseSteps "failing-cabal" $ runTestEnv "./failing-cabal" $ do cabalAttemptLoad "MyLib.hs" assertCradleError (\CradleError {..} -> do cradleErrorExitCode @?= ExitFailure 1 cradleErrorDependencies `shouldMatchList` ["failing-cabal.cabal", "cabal.project", "cabal.project.local"]) + , testCaseSteps "failing-cabal-multi-repl-with-shrink-error-files" $ runTestEnv "./failing-multi-repl-cabal-project" $ do + cabalAttemptLoadFiles "multi-repl-cabal-fail/app/Main.hs" ["multi-repl-cabal-fail/src/Lib.hs", "multi-repl-cabal-fail/src/Fail.hs", "NotInPath.hs"] + root <- askRoot + multiSupported <- isCabalMultipleCompSupported' + if multiSupported + then + assertCradleError (\CradleError {..} -> do + cradleErrorExitCode @?= ExitFailure 1 + cradleErrorDependencies `shouldMatchList` ["cabal.project","cabal.project.local","multi-repl-cabal-fail.cabal"] + -- NotInPath.hs does not match the cradle for `app/Main.hs`, so it should not be tried. + (makeRelative root <$> cradleErrorLoadingFiles) `shouldMatchList` ["multi-repl-cabal-fail/app/Main.hs","multi-repl-cabal-fail/src/Fail.hs","multi-repl-cabal-fail/src/Lib.hs"]) + else assertLoadSuccess >>= \ComponentOptions {} -> do + return () , testCaseSteps "simple-cabal" $ runTestEnv "./simple-cabal" $ do testDirectoryM isCabalCradle "B.hs" , testCaseSteps "nested-cabal" $ runTestEnv "./nested-cabal" $ do @@ -224,6 +238,12 @@ cabalTestCases extraGhcDep = assertCradle isCabalCradle loadComponentOptions fp + cabalAttemptLoadFiles :: FilePath -> [FilePath] -> TestM () + cabalAttemptLoadFiles fp fps = do + initCradle fp + assertCradle isCabalCradle + loadComponentOptionsMultiStyle fp fps + cabalLoadOptions :: FilePath -> TestM ComponentOptions cabalLoadOptions fp = do initCradle fp diff --git a/tests/Utils.hs b/tests/Utils.hs index bbe600ff8..a5b44975f 100644 --- a/tests/Utils.hs +++ b/tests/Utils.hs @@ -42,10 +42,12 @@ module Utils ( initCradle, initImplicitCradle, loadComponentOptions, + loadComponentOptionsMultiStyle, loadRuntimeGhcLibDir, loadRuntimeGhcVersion, inCradleRootDir, loadFileGhc, + isCabalMultipleCompSupported', -- * Assertion helpers assertCradle, @@ -272,6 +274,15 @@ loadComponentOptions fp = do clr <- liftIO $ getCompilerOptions a_fp LoadFile crd setLoadResult clr +loadComponentOptionsMultiStyle :: FilePath -> [FilePath] -> TestM () +loadComponentOptionsMultiStyle fp fps = do + a_fp <- normFile fp + a_fps <- mapM normFile fps + crd <- askCradle + step $ "Initialise flags for: " <> fp <> " and " <> show fps + clr <- liftIO $ getCompilerOptions a_fp (LoadWithContext a_fps) crd + setLoadResult clr + loadRuntimeGhcLibDir :: TestM () loadRuntimeGhcLibDir = do crd <- askCradle @@ -286,6 +297,14 @@ loadRuntimeGhcVersion = do ghcVersionRes <- liftIO $ getRuntimeGhcVersion crd setGhcVersionResult ghcVersionRes +isCabalMultipleCompSupported' :: TestM Bool +isCabalMultipleCompSupported' = do + cr <- askCradle + root <- askRoot + versions <- liftIO $ makeVersions (cradleLogger cr) root ((runGhcCmd . cradleOptsProg) cr) + liftIO $ isCabalMultipleCompSupported versions + + testLogger :: forall a . Pretty a => L.LogAction IO (L.WithSeverity a) testLogger = L.cmap printLog L.logStringStderr where printLog (L.WithSeverity l sev) = "[" ++ show sev ++ "] " ++ show (pretty l) @@ -380,7 +399,7 @@ assertCradleLoadSuccess :: CradleLoadResult a -> TestM a assertCradleLoadSuccess = \case (CradleSuccess x) -> pure x CradleNone -> liftIO $ assertFailure "Unexpected none-Cradle" - (CradleFail (CradleError _deps _ex stde)) -> + (CradleFail (CradleError _deps _ex stde _err_loading_files)) -> liftIO $ assertFailure ("Unexpected cradle fail" <> unlines stde) assertCradleLoadError :: CradleLoadResult a -> TestM CradleError diff --git a/tests/projects/failing-multi-repl-cabal-project/NotInPath.hs b/tests/projects/failing-multi-repl-cabal-project/NotInPath.hs new file mode 100644 index 000000000..658ece422 --- /dev/null +++ b/tests/projects/failing-multi-repl-cabal-project/NotInPath.hs @@ -0,0 +1,5 @@ +module NotInPath where + +import System.FilePath (()) + +foo = "test" "me" diff --git a/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/app/Main.hs b/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/app/Main.hs new file mode 100644 index 000000000..0efdb0b52 --- /dev/null +++ b/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/app/Main.hs @@ -0,0 +1,4 @@ + +import System.Directory (getCurrentDirectory) + +main = return () diff --git a/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/multi-repl-cabal-fail.cabal b/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/multi-repl-cabal-fail.cabal new file mode 100644 index 000000000..e45f5a86f --- /dev/null +++ b/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/multi-repl-cabal-fail.cabal @@ -0,0 +1,21 @@ +cabal-version: >=2.0 +name: multi-cabal +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: Lib + -- other-modules: + -- other-extensions: + build-depends: base >=4.10 && < 5, filepath + hs-source-dirs: src + default-language: Haskell2010 + + +executable multi-cabal + main-is: app/Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.10 && < 5, directory + -- hs-source-dirs: + default-language: Haskell2010 diff --git a/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Fail.hs b/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Fail.hs new file mode 100644 index 000000000..891d38a18 --- /dev/null +++ b/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Fail.hs @@ -0,0 +1,5 @@ +module Fail where + +import System.FilePath (()) + +foo = "test" "me" diff --git a/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Lib.hs b/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Lib.hs new file mode 100644 index 000000000..a709c5ea9 --- /dev/null +++ b/tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Lib.hs @@ -0,0 +1,5 @@ +module Lib where + +import System.FilePath (()) + +foo = "test" "me" diff --git a/tests/projects/multi-cabal/src/Lib.hs b/tests/projects/multi-cabal/src/Lib.hs index 9341bdebe..a709c5ea9 100644 --- a/tests/projects/multi-cabal/src/Lib.hs +++ b/tests/projects/multi-cabal/src/Lib.hs @@ -2,4 +2,4 @@ module Lib where import System.FilePath (()) -foo = "test" "me" \ No newline at end of file +foo = "test" "me" diff --git a/tests/projects/multi-stack/src/Lib.hs b/tests/projects/multi-stack/src/Lib.hs index 9341bdebe..a709c5ea9 100644 --- a/tests/projects/multi-stack/src/Lib.hs +++ b/tests/projects/multi-stack/src/Lib.hs @@ -2,4 +2,4 @@ module Lib where import System.FilePath (()) -foo = "test" "me" \ No newline at end of file +foo = "test" "me"