diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # ChangeLog hie-bios +## 2023-03-13 - 0.12.0 + +* 9.6 support [#392](https://github.com/haskell/hie-bios/pull/392) +* Better support for multi component projects [#387](https://github.com/haskell/hie-bios/pull/387) +* Remove unused dependencies from hie-bios [#381](https://github.com/haskell/hie-bios/pull/381) +* Add logs over commands [#375](https://github.com/haskell/hie-bios/pull/375) + ## 2022-09-13 - 0.11.0 * Compatibility with aeson 1.5 [#368](https://github.com/haskell/hie-bios/pull/368) diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -75,7 +75,7 @@ logger = L.cmap printLog L.logStringStderr res <- case cmd of - Check targetFiles -> checkSyntax logger cradle targetFiles + Check targetFiles -> checkSyntax logger logger cradle targetFiles Debug files -> case files of [] -> debugInfo logger (cradleRootDir cradle) cradle fp -> debugInfo logger fp cradle diff --git a/hie-bios.cabal b/hie-bios.cabal --- a/hie-bios.cabal +++ b/hie-bios.cabal @@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: hie-bios -Version: 0.11.0 +Version: 0.12.0 Author: Matthew Pickering Maintainer: Matthew Pickering License: BSD-3-Clause @@ -125,7 +125,7 @@ tests/projects/stack-with-yaml/stack-with-yaml.cabal tests/projects/stack-with-yaml/src/Lib.hs -tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.1 || ==9.2.4 +tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.4 Library Default-Language: Haskell2010 @@ -150,27 +150,25 @@ autogen-modules: Paths_hie_bios Build-Depends: base >= 4.8 && < 5, - aeson >= 1.5 && < 2.2, + aeson >= 1.4.4 && < 2.2, base16-bytestring >= 0.1.1 && < 1.1, bytestring >= 0.10.8 && < 0.12, co-log-core ^>= 0.3.0, deepseq >= 1.4.3 && < 1.5, exceptions ^>= 0.10, - containers >= 0.5.10 && < 0.7, cryptohash-sha1 >= 0.11.100 && < 0.12, directory >= 1.3.0 && < 1.4, filepath >= 1.4.1 && < 1.5, time >= 1.8.0 && < 1.13, extra >= 1.6.14 && < 1.8, - prettyprinter ^>= 1.7.0, - process >= 1.6.1 && < 1.7, - ghc >= 8.6.1 && < 9.5, + prettyprinter ^>= 1.6 || ^>= 1.7.0, + ghc >= 8.6.1 && < 9.7, transformers >= 0.5.2 && < 0.7, temporary >= 1.2 && < 1.4, + template-haskell, text >= 1.2.3 && < 2.1, - unix-compat >= 0.5.1 && < 0.6, + unix-compat >= 0.5.1 && < 0.7, unordered-containers >= 0.2.9 && < 0.3, - vector >= 0.12.0 && < 0.13, yaml >= 0.10.0 && < 0.12, file-embed >= 0.0.11 && < 1, conduit >= 1.3 && < 2, @@ -187,7 +185,6 @@ , co-log-core , directory , filepath - , ghc , hie-bios , optparse-applicative , prettyprinter @@ -202,8 +199,6 @@ hie-bios, tasty, tasty-hunit, - text, - unordered-containers, yaml hs-source-dirs: tests/ @@ -215,6 +210,7 @@ default-language: Haskell2010 build-depends: base, + co-log-core, extra, transformers, tasty, @@ -223,8 +219,8 @@ hie-bios, filepath, directory, + prettyprinter, temporary, - tagged, ghc hs-source-dirs: tests/ diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -283,7 +283,7 @@ { actionName = Types.Default , runCradle = \_ _ -> return (CradleSuccess (ComponentOptions argDynamic cur_dir [])) - , runGhcCmd = runGhcCmdOnPath cur_dir + , runGhcCmd = \l -> runGhcCmdOnPath l cur_dir } } @@ -297,7 +297,7 @@ , cradleOptsProg = CradleAction { actionName = Types.None , runCradle = \_ _ -> return CradleNone - , runGhcCmd = \_ -> return CradleNone + , runGhcCmd = \_ _ -> return CradleNone } } @@ -311,14 +311,17 @@ , cradleOptsProg = CradleAction { actionName = multiActionName , runCradle = \l fp -> makeAbsolute fp >>= multiAction buildCustomCradle cur_dir cs l - , runGhcCmd = \args -> + , runGhcCmd = \l args -> -- We're being lazy here and just returning the ghc path for the -- first non-none cradle. This shouldn't matter in practice: all -- sub cradles should be using the same ghc version! case filter (not . isNoneCradleConfig) $ map snd cs of [] -> return CradleNone - (cfg:_) -> flip runGhcCmd args $ cradleOptsProg $ - getCradle buildCustomCradle (cfg, cur_dir) + (cfg:_) -> + runGhcCmd + (cradleOptsProg $ getCradle buildCustomCradle (cfg, cur_dir)) + l + args } } where @@ -393,7 +396,7 @@ { actionName = Types.Direct , runCradle = \_ _ -> return (CradleSuccess (ComponentOptions (args ++ argDynamic) wdir [])) - , runGhcCmd = runGhcCmdOnPath wdir + , runGhcCmd = \l -> runGhcCmdOnPath l wdir } } @@ -409,7 +412,7 @@ , cradleOptsProg = CradleAction { actionName = Types.Bios , runCradle = biosAction wdir biosCall biosDepsCall - , runGhcCmd = \args -> readProcessWithCwd wdir (fromMaybe "ghc" mbGhc) args "" + , runGhcCmd = \l args -> readProcessWithCwd l wdir (fromMaybe "ghc" mbGhc) args "" } } @@ -464,13 +467,13 @@ , cradleOptsProg = CradleAction { actionName = Types.Cabal , runCradle = \l f -> runCradleResultT . cabalAction wdir mc l $ f - , runGhcCmd = \args -> runCradleResultT $ do + , runGhcCmd = \l args -> runCradleResultT $ do buildDir <- liftIO $ cabalBuildDir wdir -- Workaround for a cabal-install bug on 3.0.0.0: -- ./dist-newstyle/tmp/environment.-24811: createDirectory: does not exist (No such file or directory) liftIO $ createDirectoryIfMissing True (buildDir "tmp") -- Need to pass -v0 otherwise we get "resolving dependencies..." - cabalProc <- cabalProcess wdir "v2-exec" $ ["ghc", "-v0", "--"] ++ args + cabalProc <- cabalProcess l wdir "v2-exec" $ ["ghc", "-v0", "--"] ++ args readProcessWithCwd' cabalProc "" } } @@ -484,9 +487,9 @@ -- to the custom ghc wrapper via 'hie_bios_ghc' environment variable which -- the custom ghc wrapper may use as a fallback if it can not respond to certain -- queries, such as ghc version or location of the libdir. -cabalProcess :: FilePath -> String -> [String] -> CradleLoadResultT IO CreateProcess -cabalProcess workDir command args = do - ghcDirs <- cabalGhcDirs workDir +cabalProcess :: LogAction IO (WithSeverity Log) -> FilePath -> String -> [String] -> CradleLoadResultT IO CreateProcess +cabalProcess l workDir command args = do + ghcDirs <- cabalGhcDirs l workDir newEnvironment <- liftIO $ setupEnvironment ghcDirs cabalProc <- liftIO $ setupCabalCommand ghcDirs pure $ (cabalProc @@ -505,7 +508,7 @@ setupCabalCommand :: (FilePath, FilePath) -> IO CreateProcess setupCabalCommand (ghcBin, libdir) = do - wrapper_fp <- withGhcWrapperTool ("ghc", []) workDir + wrapper_fp <- withGhcWrapperTool l ("ghc", []) workDir buildDir <- cabalBuildDir workDir ghcPkgPath <- withGhcPkgTool ghcBin libdir let extraCabalArgs = @@ -514,7 +517,7 @@ , "--with-compiler", wrapper_fp , "--with-hc-pkg", ghcPkgPath ] - pure $ proc "cabal" (extraCabalArgs ++ args) + loggedProc l "cabal" (extraCabalArgs ++ args) -- | Discovers the location of 'ghc-pkg' given the absolute path to 'ghc' -- and its '$libdir' (obtainable by running @ghc --print-libdir@). @@ -619,8 +622,8 @@ -- | Generate a fake GHC that can be passed to cabal or stack -- when run with --interactive, it will print out its -- command-line arguments and exit -withGhcWrapperTool :: GhcProc -> FilePath -> IO FilePath -withGhcWrapperTool (mbGhc, ghcArgs) wdir = do +withGhcWrapperTool :: LogAction IO (WithSeverity Log) -> GhcProc -> FilePath -> IO FilePath +withGhcWrapperTool l (mbGhc, ghcArgs) wdir = do let wrapperContents = if isWindows then cabalWrapperHs else cabalWrapper withExtension fp = if isWindows then fp <.> "exe" else fp srcHash = show (fingerprintString wrapperContents) @@ -630,10 +633,10 @@ withSystemTempDirectory "hie-bios" $ \ tmpDir -> do let wrapper_hs = wrapper_fp -<.> "hs" writeFile wrapper_hs wrapperContents - let ghc = (proc mbGhc $ - ghcArgs ++ ["-rtsopts=ignore", "-outputdir", tmpDir, "-o", wrapper_fp, wrapper_hs]) - { cwd = Just wdir } - readCreateProcess ghc "" >>= putStr + ghc <- loggedProc l mbGhc $ + ghcArgs ++ ["-rtsopts=ignore", "-outputdir", tmpDir, "-o", wrapper_fp, wrapper_hs] + let ghc' = ghc { cwd = Just wdir } + readCreateProcess ghc' "" >>= putStr else writeFile wrapper_fp wrapperContents -- | Create and cache a file in hie-bios's cache directory. @@ -678,10 +681,10 @@ -- 'withGhcWrapperTool'. -- -- If cabal can not figure it out, a 'CradleError' is returned. -cabalGhcDirs :: FilePath -> CradleLoadResultT IO (FilePath, FilePath) -cabalGhcDirs workDir = do - libdir <- readProcessWithCwd_ workDir "cabal" ["exec", "-v0", "--", "ghc", "--print-libdir"] "" - exe <- readProcessWithCwd_ workDir "cabal" +cabalGhcDirs :: LogAction IO (WithSeverity Log) -> FilePath -> CradleLoadResultT IO (FilePath, FilePath) +cabalGhcDirs l workDir = do + libdir <- readProcessWithCwd_ l workDir "cabal" ["exec", "-v0", "--", "ghc", "--print-libdir"] "" + exe <- readProcessWithCwd_ l workDir "cabal" -- DON'T TOUCH THIS CODE -- This works with 'NoImplicitPrelude', with 'RebindableSyntax' and other shenanigans. -- @-package-env=-@ doesn't work with ghc prior 8.4.x @@ -702,7 +705,7 @@ cabalCommand = "v2-repl" cabalArgs = [fromMaybe (fixTargetPath fp) mc] - cabalProc <- cabalProcess workDir cabalCommand cabalArgs `modCradleError` \err -> do + cabalProc <- cabalProcess l workDir cabalCommand cabalArgs `modCradleError` \err -> do deps <- cabalCradleDependencies workDir workDir pure $ err { cradleErrorDependencies = cradleErrorDependencies err ++ deps } @@ -814,11 +817,11 @@ , cradleOptsProg = CradleAction { actionName = Types.Stack , runCradle = stackAction wdir mc syaml - , runGhcCmd = \args -> runCradleResultT $ do + , runGhcCmd = \l args -> runCradleResultT $ do -- Setup stack silently, since stack might print stuff to stdout in some cases (e.g. on Win) -- Issue 242 from HLS: https://github.com/haskell/haskell-language-server/issues/242 - _ <- readProcessWithCwd_ wdir "stack" (stackYamlProcessArgs syaml <> ["setup", "--silent"]) "" - readProcessWithCwd_ wdir "stack" + _ <- readProcessWithCwd_ l wdir "stack" (stackYamlProcessArgs syaml <> ["setup", "--silent"]) "" + readProcessWithCwd_ l wdir "stack" (stackYamlProcessArgs syaml <> ["exec", "ghc", "--"] <> args) "" } @@ -851,15 +854,15 @@ stackAction workDir mc syaml l _fp = do let ghcProcArgs = ("stack", stackYamlProcessArgs syaml <> ["exec", "ghc", "--"]) -- Same wrapper works as with cabal - wrapper_fp <- withGhcWrapperTool ghcProcArgs workDir + wrapper_fp <- withGhcWrapperTool l ghcProcArgs workDir (ex1, _stdo, stde, [(_, maybeArgs)]) <- - readProcessWithOutputs [hie_bios_output] l workDir $ - stackProcess syaml - $ ["repl", "--no-nix-pure", "--with-ghc", wrapper_fp] - <> [ comp | Just comp <- [mc] ] + stackProcess l syaml + (["repl", "--no-nix-pure", "--with-ghc", wrapper_fp] + <> [ comp | Just comp <- [mc] ]) >>= + readProcessWithOutputs [hie_bios_output] l workDir (ex2, pkg_args, stdr, _) <- - readProcessWithOutputs [hie_bios_output] l workDir $ - stackProcess syaml ["path", "--ghc-package-path"] + stackProcess l syaml ["path", "--ghc-package-path"] >>= + readProcessWithOutputs [hie_bios_output] l workDir let split_pkgs = concatMap splitSearchPath pkg_args pkg_ghc_args = concatMap (\p -> ["-package-db", p] ) split_pkgs args = fromMaybe [] maybeArgs @@ -884,8 +887,8 @@ ) deps -stackProcess :: StackYaml -> [String] -> CreateProcess -stackProcess syaml args = proc "stack" $ stackYamlProcessArgs syaml <> args +stackProcess :: LogAction IO (WithSeverity Log) -> StackYaml -> [String] -> IO CreateProcess +stackProcess l syaml args = loggedProc l "stack" $ stackYamlProcessArgs syaml <> args combineExitCodes :: [ExitCode] -> ExitCode combineExitCodes = foldr go ExitSuccess @@ -1083,21 +1086,22 @@ in CradleSuccess compOpts -- | Calls @ghc --print-libdir@, with just whatever's on the PATH. -runGhcCmdOnPath :: FilePath -> [String] -> IO (CradleLoadResult String) -runGhcCmdOnPath wdir args = readProcessWithCwd wdir "ghc" args "" +runGhcCmdOnPath :: LogAction IO (WithSeverity Log) -> FilePath -> [String] -> IO (CradleLoadResult String) +runGhcCmdOnPath l wdir args = readProcessWithCwd l wdir "ghc" args "" -- case mResult of -- Nothing -- | Wrapper around 'readCreateProcess' that sets the working directory and -- clears the environment, suitable for invoking cabal/stack and raw ghc commands. -readProcessWithCwd :: FilePath -> FilePath -> [String] -> String -> IO (CradleLoadResult String) -readProcessWithCwd dir cmd args stdin = runCradleResultT $ readProcessWithCwd_ dir cmd args stdin +readProcessWithCwd :: LogAction IO (WithSeverity Log) -> FilePath -> FilePath -> [String] -> String -> IO (CradleLoadResult String) +readProcessWithCwd l dir cmd args stdin = runCradleResultT $ readProcessWithCwd_ l dir cmd args stdin -readProcessWithCwd_ :: FilePath -> FilePath -> [String] -> String -> CradleLoadResultT IO String -readProcessWithCwd_ dir cmd args stdin = do +readProcessWithCwd_ :: LogAction IO (WithSeverity Log) -> FilePath -> FilePath -> [String] -> String -> CradleLoadResultT IO String +readProcessWithCwd_ l dir cmd args stdin = do cleanEnv <- liftIO getCleanEnvironment - let createProc = (proc cmd args) { cwd = Just dir, env = Just cleanEnv } - readProcessWithCwd' createProc stdin + createdProc <- liftIO $ loggedProc l cmd args + let createdProc' = createdProc { cwd = Just dir, env = Just cleanEnv } + readProcessWithCwd' createdProc' stdin -- | Wrapper around 'readCreateProcessWithExitCode', wrapping the result in -- a 'CradleLoadResult'. Provides better error messages than raw 'readCreateProcess'. @@ -1131,3 +1135,9 @@ , hie_bios_deps ] ] + +loggedProc :: LogAction IO (WithSeverity Log) -> FilePath -> [String] -> IO CreateProcess +loggedProc l command args = do + l <& LogProcessOutput (unwords $ "executing command:":command:args) `WithSeverity` Debug + pure $ proc command args + diff --git a/src/HIE/Bios/Environment.hs b/src/HIE/Bios/Environment.hs --- a/src/HIE/Bios/Environment.hs +++ b/src/HIE/Bios/Environment.hs @@ -13,6 +13,7 @@ import System.Environment (lookupEnv) import qualified Crypto.Hash.SHA1 as H +import Colog.Core (LogAction, WithSeverity) import qualified Data.ByteString.Char8 as B import Data.ByteString.Base16 import Data.List @@ -67,18 +68,20 @@ -- -- -- Obtains libdir by calling 'runCradleGhc' on the provided cradle. -getRuntimeGhcLibDir :: Cradle a +getRuntimeGhcLibDir :: LogAction IO (WithSeverity Log) + -> Cradle a -> IO (CradleLoadResult FilePath) -getRuntimeGhcLibDir cradle = fmap (fmap trim) $ - runGhcCmd (cradleOptsProg cradle) ["--print-libdir"] +getRuntimeGhcLibDir l cradle = fmap (fmap trim) $ + runGhcCmd (cradleOptsProg cradle) l ["--print-libdir"] -- | Gets the version of ghc used when compiling the cradle. It is based off of -- 'getRuntimeGhcLibDir'. If it can't work out the verison reliably, it will -- return a 'CradleError' -getRuntimeGhcVersion :: Cradle a +getRuntimeGhcVersion :: LogAction IO (WithSeverity Log) + -> Cradle a -> IO (CradleLoadResult String) -getRuntimeGhcVersion cradle = - fmap (fmap trim) $ runGhcCmd (cradleOptsProg cradle) ["--numeric-version"] +getRuntimeGhcVersion l cradle = + fmap (fmap trim) $ runGhcCmd (cradleOptsProg cradle) l ["--numeric-version"] ---------------------------------------------------------------- @@ -156,7 +159,7 @@ -- | Make filepaths in the given 'DynFlags' absolute. -- This makes the 'DynFlags' independent of the current working directory. makeDynFlagsAbsolute :: FilePath -> G.DynFlags -> G.DynFlags -makeDynFlagsAbsolute work_dir df = +makeDynFlagsAbsolute root df = Gap.mapOverIncludePaths makeAbs $ df { G.importPaths = map makeAbs (G.importPaths df) @@ -164,7 +167,13 @@ map (Gap.overPkgDbRef makeAbs) (G.packageDBFlags df) } where - makeAbs = (work_dir ) + makeAbs = +#if __GLASGOW_HASKELL__ >= 903 + case G.workingDirectory df of + Just fp -> ((root fp) ) + Nothing -> +#endif + (root ) -- -------------------------------------------------------- diff --git a/src/HIE/Bios/Flags.hs b/src/HIE/Bios/Flags.hs --- a/src/HIE/Bios/Flags.hs +++ b/src/HIE/Bios/Flags.hs @@ -2,14 +2,15 @@ import HIE.Bios.Types -import qualified Colog.Core as L -import Data.Text.Prettyprint.Doc +import Colog.Core (LogAction (..), WithSeverity (..), Severity (..), (<&)) -- | Initialize the 'DynFlags' relating to the compilation of a single -- file or GHC session according to the provided 'Cradle'. getCompilerOptions - :: L.LogAction IO (L.WithSeverity Log) + :: LogAction IO (WithSeverity Log) -> FilePath -- The file we are loading it because of -> Cradle a -> IO (CradleLoadResult ComponentOptions) -getCompilerOptions l fp cradle = runCradle (cradleOptsProg cradle) l fp +getCompilerOptions l fp cradle = do + l <& LogProcessOutput "invoking build tool to determine build flags (this may take some time depending on the cache)" `WithSeverity` Info + runCradle (cradleOptsProg cradle) l fp diff --git a/src/HIE/Bios/Ghc/Check.hs b/src/HIE/Bios/Ghc/Check.hs --- a/src/HIE/Bios/Ghc/Check.hs +++ b/src/HIE/Bios/Ghc/Check.hs @@ -46,20 +46,21 @@ -- | Checking syntax of a target file using GHC. -- Warnings and errors are returned. checkSyntax :: Show a - => LogAction IO (WithSeverity Log) + => LogAction IO (WithSeverity T.Log) + -> LogAction IO (WithSeverity Log) -> Cradle a -> [FilePath] -- ^ The target files. -> IO String -checkSyntax _ _ [] = return "" -checkSyntax logger cradle files = do - libDirRes <- getRuntimeGhcLibDir cradle +checkSyntax _ _ _ [] = return "" +checkSyntax logger checkLogger cradle files = do + libDirRes <- getRuntimeGhcLibDir logger cradle handleRes libDirRes $ \libDir -> G.runGhcT (Just libDir) $ do - liftIO $ logger <& LogCradle cradle `WithSeverity` Info - res <- initializeFlagsWithCradle (cmap (fmap LogAny) logger) (head files) cradle + liftIO $ checkLogger <& LogCradle cradle `WithSeverity` Info + res <- initializeFlagsWithCradle (cmap (fmap LogAny) checkLogger) (head files) cradle handleRes res $ \(ini, _) -> do _sf <- ini - either id id <$> check logger files + either id id <$> check checkLogger files where handleRes (CradleSuccess x) f = f x handleRes (CradleFail ce) _f = liftIO $ throwIO ce diff --git a/src/HIE/Bios/Ghc/Doc.hs b/src/HIE/Bios/Ghc/Doc.hs --- a/src/HIE/Bios/Ghc/Doc.hs +++ b/src/HIE/Bios/Ghc/Doc.hs @@ -3,7 +3,14 @@ module HIE.Bios.Ghc.Doc where -import GHC (DynFlags, getPrintUnqual, pprCols, GhcMonad) +import GHC (DynFlags +#if __GLASGOW_HASKELL__ < 905 + , getPrintUnqual +#endif + , pprCols, GhcMonad) +#if __GLASGOW_HASKELL__ >= 905 +import GHC.Utils.Outputable +#endif #if __GLASGOW_HASKELL__ >= 900 import GHC.Driver.Session (initSDocContext) @@ -15,6 +22,11 @@ #endif import HIE.Bios.Ghc.Gap (makeUserStyle, pageMode, oneLineMode) + +#if __GLASGOW_HASKELL__ >= 905 +getPrintUnqual :: Monad m => m NamePprCtx +getPrintUnqual = pure neverQualify +#endif showPage :: DynFlags -> PprStyle -> SDoc -> String showPage dflag stl sdoc = showDocWith dflag pageMode $ runSDoc sdoc scontext diff --git a/src/HIE/Bios/Ghc/Gap.hs b/src/HIE/Bios/Ghc/Gap.hs --- a/src/HIE/Bios/Ghc/Gap.hs +++ b/src/HIE/Bios/Ghc/Gap.hs @@ -217,7 +217,9 @@ ---------------------------------------------------------------- setNoCode :: DynFlags -> DynFlags -#if __GLASGOW_HASKELL__ >= 901 +#if __GLASGOW_HASKELL__ >= 905 +setNoCode d = d { G.backend = G.noBackend } +#elif __GLASGOW_HASKELL__ >= 901 setNoCode d = d { G.backend = G.NoBackend } #else setNoCode d = d { G.hscTarget = G.HscNothing } @@ -251,7 +253,11 @@ ---------------------------------------------------------------- +#if __GLASGOW_HASKELL__ >= 905 +makeUserStyle :: DynFlags -> NamePprCtx -> PprStyle +#else makeUserStyle :: DynFlags -> PrintUnqualified -> PprStyle +#endif #if __GLASGOW_HASKELL__ >= 900 makeUserStyle _dflags style = mkUserStyle style AllTheWay #elif __GLASGOW_HASKELL__ >= 804 diff --git a/src/HIE/Bios/Ghc/Logger.hs b/src/HIE/Bios/Ghc/Logger.hs --- a/src/HIE/Bios/Ghc/Logger.hs +++ b/src/HIE/Bios/Ghc/Logger.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP #-} +{-# LANGUAGE BangPatterns, CPP, TypeApplications #-} module HIE.Bios.Ghc.Logger ( withLogger @@ -64,8 +64,10 @@ appendLogRef df style (LogRef ref) #if __GLASGOW_HASKELL__ < 903 _ _ sev src -#else +#elif __GLASGOW_HASKELL__ < 905 _ (MCDiagnostic sev _) src +#else + _ (MCDiagnostic sev _ _) src #endif #if __GLASGOW_HASKELL__ < 900 _style @@ -127,7 +129,11 @@ ppErrMsg dflag style err = ppMsg spn SevError dflag style msg -- ++ ext where spn = errMsgSpan err +#if __GLASGOW_HASKELL__ >= 905 + msg = pprLocMsgEnvelope (defaultDiagnosticOpts @GhcMessage) err +#else msg = pprLocMsgEnvelope err +#endif -- fixme #elif __GLASGOW_HASKELL__ >= 902 errBagToStrList :: DynFlags -> Gap.PprStyle -> Bag (MsgEnvelope DecoratedSDoc) -> [String] diff --git a/src/HIE/Bios/Internal/Debug.hs b/src/HIE/Bios/Internal/Debug.hs --- a/src/HIE/Bios/Internal/Debug.hs +++ b/src/HIE/Bios/Internal/Debug.hs @@ -34,8 +34,8 @@ canonFp <- canonicalizePath fp conf <- findConfig canonFp crdl <- findCradle' canonFp - ghcLibDir <- getRuntimeGhcLibDir cradle - ghcVer <- getRuntimeGhcVersion cradle + ghcLibDir <- getRuntimeGhcLibDir logger cradle + ghcVer <- getRuntimeGhcVersion logger cradle case res of CradleSuccess (ComponentOptions gopts croot deps) -> do return [ diff --git a/src/HIE/Bios/Types.hs b/src/HIE/Bios/Types.hs --- a/src/HIE/Bios/Types.hs +++ b/src/HIE/Bios/Types.hs @@ -62,7 +62,7 @@ -- ^ Name of the action. , runCradle :: L.LogAction IO (L.WithSeverity Log) -> FilePath -> IO (CradleLoadResult ComponentOptions) -- ^ Options to compile the given file with. - , runGhcCmd :: [String] -> IO (CradleLoadResult String) + , runGhcCmd :: L.LogAction IO (L.WithSeverity Log) -> [String] -> IO (CradleLoadResult String) -- ^ Executes the @ghc@ binary that is usually used to -- build the cradle. E.g. for a cabal cradle this should be -- equivalent to @cabal exec ghc -- args@ diff --git a/src/HIE/Bios/Wrappers.hs b/src/HIE/Bios/Wrappers.hs --- a/src/HIE/Bios/Wrappers.hs +++ b/src/HIE/Bios/Wrappers.hs @@ -1,12 +1,17 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE CPP #-} module HIE.Bios.Wrappers (cabalWrapper, cabalWrapperHs) where import Data.FileEmbed +#if __GLASGOW_HASKELL__ >= 903 + hiding (makeRelativeToProject) +#endif +import Language.Haskell.TH.Syntax cabalWrapper :: String -cabalWrapper = $(embedStringFile "wrappers/cabal") +cabalWrapper = $(makeRelativeToProject "wrappers/cabal" >>= embedStringFile) cabalWrapperHs :: String -cabalWrapperHs = $(embedStringFile "wrappers/cabal.hs") +cabalWrapperHs = $(makeRelativeToProject "wrappers/cabal.hs" >>= embedStringFile) diff --git a/tests/BiosTests.hs b/tests/BiosTests.hs --- a/tests/BiosTests.hs +++ b/tests/BiosTests.hs @@ -303,10 +303,14 @@ stackYamlResolver :: String stackYamlResolver = -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,2,1,0))) - "nightly-2022-09-11" -- GHC 9.2.4 +#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,4,4,0))) + "nightly-2023-03-13" -- GHC 9.4.4 +#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,2,7,0))) + "lts-20.14" -- GHC 9.2.7 +#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,2,1,0))) + "lts-20.11" -- GHC 9.2.5 #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,0,1,0))) - "lts-19.22" -- GHC 9.0.2 + "lts-19.33" -- GHC 9.0.2 #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,10,7,0))) "lts-18.28" -- GHC 8.10.7 #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,10,1,0))) @@ -382,9 +386,7 @@ ignoreOnUnsupportedGhc :: TestTree -> TestTree ignoreOnUnsupportedGhc tt = -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)) - ignoreTestBecause "Not supported on GHC >= 9.4" -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,2,1,0) && !MIN_VERSION_GLASGOW_HASKELL(9,2,4,0)) +#if (defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,2,1,0) && !MIN_VERSION_GLASGOW_HASKELL(9,2,4,0)) ignoreTestBecause "Not supported on GHC >= 9.2.1 && < 9.2.4" #endif tt diff --git a/tests/Utils.hs b/tests/Utils.hs --- a/tests/Utils.hs +++ b/tests/Utils.hs @@ -67,6 +67,7 @@ findCradleForModuleM, ) where +import qualified Colog.Core as L import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.State @@ -80,6 +81,7 @@ import qualified HIE.Bios.Ghc.Gap as G import HIE.Bios.Ghc.Load import HIE.Bios.Types +import Prettyprinter import System.Directory import System.FilePath import System.IO.Temp @@ -274,15 +276,19 @@ loadRuntimeGhcLibDir = do crd <- askCradle step "Load run-time ghc libdir" - libdirRes <- liftIO $ getRuntimeGhcLibDir crd + libdirRes <- liftIO $ getRuntimeGhcLibDir testLogger crd setLibDirResult libdirRes loadRuntimeGhcVersion :: TestM () loadRuntimeGhcVersion = do crd <- askCradle step "Load run-time ghc version" - ghcVersionRes <- liftIO $ getRuntimeGhcVersion crd + ghcVersionRes <- liftIO $ getRuntimeGhcVersion testLogger crd setGhcVersionResult ghcVersionRes + +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) inCradleRootDir :: TestM a -> TestM a inCradleRootDir act = do