From 7f254b0329a8d92ea1d0f9d895049e892f9fa1c1 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 14 Mar 2023 21:19:53 +0530 Subject: [PATCH 1/2] Use hie-bios 0.12 --- cabal.project | 2 +- exe/Wrapper.hs | 37 ++++++++++--------- ghcide/ghcide.cabal | 2 +- .../session-loader/Development/IDE/Session.hs | 4 +- src/Ide/Main.hs | 5 ++- stack-lts19.yaml | 2 +- stack.yaml | 2 +- 7 files changed, 29 insertions(+), 25 deletions(-) diff --git a/cabal.project b/cabal.project index d98d57c6df..a0bd4b5af5 100644 --- a/cabal.project +++ b/cabal.project @@ -50,7 +50,7 @@ package * write-ghc-environment-files: never -index-state: 2023-01-27T00:00:00Z +index-state: 2023-03-15T00:00:00Z constraints: -- For GHC 9.4, older versions of entropy fail to build on Windows diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 06eacf47df..6c4837448b 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -50,8 +50,10 @@ import Development.IDE.Types.Logger (Logger (Logger), Priority (Info), Recorder (logger_), WithPriority (WithPriority), + Doc, cmapWithPrio, - makeDefaultStderrRecorder) + makeDefaultStderrRecorder, + toCologActionWithPrio) import GHC.Stack.Types (emptyCallStack) import Ide.Plugin.Config (Config) import Ide.Types (IdePlugins (IdePlugins)) @@ -74,6 +76,7 @@ main = do args <- getArguments "haskell-language-server-wrapper" mempty hlsVer <- haskellLanguageServerVersion + recorder <- makeDefaultStderrRecorder Nothing Info case args of ProbeToolsMode -> do programsOfInterest <- findProgramVersions @@ -82,7 +85,7 @@ main = do putStrLn $ showProgramVersionOfInterest programsOfInterest putStrLn "Tool versions in your project" cradle <- findProjectCradle' False - ghcVersion <- runExceptT $ getRuntimeGhcVersion' cradle + ghcVersion <- runExceptT $ getRuntimeGhcVersion' recorder cradle putStrLn $ showProgramVersion "ghc" $ mkVersion =<< eitherToMaybe ghcVersion VersionMode PrintVersion -> @@ -95,18 +98,18 @@ main = do print =<< findProjectCradle PrintLibDir -> do cradle <- findProjectCradle' False - (CradleSuccess libdir) <- HieBios.getRuntimeGhcLibDir cradle + (CradleSuccess libdir) <- HieBios.getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio pretty recorder)) cradle putStr libdir - _ -> launchHaskellLanguageServer args >>= \case + _ -> launchHaskellLanguageServer recorder args >>= \case Right () -> pure () Left err -> do T.hPutStrLn stderr (prettyError err NoShorten) case args of - Ghcide _ -> launchErrorLSP (prettyError err Shorten) + Ghcide _ -> launchErrorLSP recorder (prettyError err Shorten) _ -> pure () -launchHaskellLanguageServer :: Arguments -> IO (Either WrapperSetupError ()) -launchHaskellLanguageServer parsedArgs = do +launchHaskellLanguageServer :: Recorder (WithPriority (Doc ())) -> Arguments -> IO (Either WrapperSetupError ()) +launchHaskellLanguageServer recorder parsedArgs = do case parsedArgs of Ghcide GhcideArguments{..} -> whenJust argsCwd setCurrentDirectory _ -> pure () @@ -122,7 +125,7 @@ launchHaskellLanguageServer parsedArgs = do case parsedArgs of Ghcide GhcideArguments{..} -> when argsProjectGhcVersion $ do - runExceptT (getRuntimeGhcVersion' cradle) >>= \case + runExceptT (getRuntimeGhcVersion' recorder cradle) >>= \case Right ghcVersion -> putStrLn ghcVersion >> exitSuccess Left err -> T.putStrLn (prettyError err NoShorten) >> exitFailure _ -> pure () @@ -145,7 +148,7 @@ launchHaskellLanguageServer parsedArgs = do hPutStrLn stderr "Consulting the cradle to get project GHC version..." runExceptT $ do - ghcVersion <- getRuntimeGhcVersion' cradle + ghcVersion <- getRuntimeGhcVersion' recorder cradle liftIO $ hPutStrLn stderr $ "Project GHC version: " ++ ghcVersion let @@ -170,10 +173,10 @@ launchHaskellLanguageServer parsedArgs = do let cradleName = actionName (cradleOptsProg cradle) -- we need to be compatible with NoImplicitPrelude - ghcBinary <- liftIO (fmap trim <$> runGhcCmd ["-v0", "-package-env=-", "-ignore-dot-ghci", "-e", "Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)"]) + ghcBinary <- liftIO (fmap trim <$> runGhcCmd (toCologActionWithPrio (cmapWithPrio pretty recorder)) ["-v0", "-package-env=-", "-ignore-dot-ghci", "-e", "Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)"]) >>= cradleResult cradleName - libdir <- liftIO (HieBios.getRuntimeGhcLibDir cradle) + libdir <- liftIO (HieBios.getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio pretty recorder)) cradle) >>= cradleResult cradleName env <- Map.fromList <$> liftIO getEnvironment @@ -190,8 +193,8 @@ cradleResult cradleName CradleNone = throwE $ NoneCradleGhcVersion cradleName -- | Version of 'getRuntimeGhcVersion' that dies if we can't get it, and also -- checks to see if the tool is missing if it is one of -getRuntimeGhcVersion' :: Cradle Void -> ExceptT WrapperSetupError IO String -getRuntimeGhcVersion' cradle = do +getRuntimeGhcVersion' :: Recorder (WithPriority (Doc ())) -> Cradle Void -> ExceptT WrapperSetupError IO String +getRuntimeGhcVersion' recorder cradle = do let cradleName = actionName (cradleOptsProg cradle) -- See if the tool is installed @@ -202,7 +205,7 @@ getRuntimeGhcVersion' cradle = do Direct -> checkToolExists "ghc" _ -> pure () - ghcVersionRes <- liftIO $ HieBios.getRuntimeGhcVersion cradle + ghcVersionRes <- liftIO $ HieBios.getRuntimeGhcVersion (toCologActionWithPrio (cmapWithPrio pretty recorder)) cradle cradleResult cradleName ghcVersionRes where @@ -271,10 +274,8 @@ newtype ErrorLSPM c a = ErrorLSPM { unErrorLSPM :: (LspM c) a } -- | Launches a LSP that displays an error and presents the user with a request -- to shut down the LSP. -launchErrorLSP :: T.Text -> IO () -launchErrorLSP errorMsg = do - recorder <- makeDefaultStderrRecorder Nothing Info - +launchErrorLSP :: Recorder (WithPriority (Doc ())) -> T.Text -> IO () +launchErrorLSP recorder errorMsg = do let logger = Logger $ \p m -> logger_ recorder (WithPriority p emptyCallStack (pretty m)) let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) logger (IdePlugins []) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 72028b666f..06ca3d4c4b 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -103,7 +103,7 @@ library ghc-check >=0.5.0.8, ghc-paths, cryptohash-sha1 >=0.11.100 && <0.12, - hie-bios ^>= 0.11.0, + hie-bios == 0.12.0, -- implicit-hie 0.1.3.0 introduced an unexpected behavioral change. -- https://github.com/Avi-D-coder/implicit-hie/issues/50 -- to make sure ghcide behaves in a desirable way, we put implicit-hie diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 2f2f9fcf30..89855b5293 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -262,7 +262,7 @@ getInitialGhcLibDirDefault recorder rootDir = do let log = logWith recorder hieYaml <- findCradle def rootDir cradle <- loadCradle def hieYaml rootDir - libDirRes <- getRuntimeGhcLibDir cradle + libDirRes <- getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio LogHieBios recorder)) cradle case libDirRes of CradleSuccess libdir -> pure $ Just $ LibDir libdir CradleFail err -> do @@ -725,7 +725,7 @@ cradleToOptsAndLibDir recorder cradle file = do case cradleRes of CradleSuccess r -> do -- Now get the GHC lib dir - libDirRes <- getRuntimeGhcLibDir cradle + libDirRes <- getRuntimeGhcLibDir logger cradle case libDirRes of -- This is the successful path CradleSuccess libDir -> pure (Right (r, libDir)) diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index bf4e79af98..ecfd944b71 100644 --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -28,6 +28,7 @@ import Development.IDE.Types.Logger as G import qualified Development.IDE.Types.Options as Ghcide import GHC.Stack (emptyCallStack) import qualified HIE.Bios.Environment as HieBios +import qualified HIE.Bios.Types as HieBios import HIE.Bios.Types hiding (Log) import Ide.Arguments import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, @@ -44,6 +45,7 @@ data Log | LogDirectory !FilePath | LogLspStart !GhcideArguments ![PluginId] | LogIDEMain IDEMain.Log + | LogHieBios HieBios.Log | LogOther T.Text deriving Show @@ -58,6 +60,7 @@ instance Pretty Log where , viaShow ghcideArgs , "PluginIds:" <+> pretty (coerce @_ @[Text] pluginIds) ] LogIDEMain iDEMainLog -> pretty iDEMainLog + LogHieBios hieBiosLog -> pretty hieBiosLog LogOther t -> pretty t defaultMain :: Recorder (WithPriority Log) -> Arguments -> IdePlugins IdeState -> IO () @@ -105,7 +108,7 @@ defaultMain recorder args idePlugins = do let initialFp = d "a" hieYaml <- Session.findCradle def initialFp cradle <- Session.loadCradle def hieYaml d - (CradleSuccess libdir) <- HieBios.getRuntimeGhcLibDir cradle + (CradleSuccess libdir) <- HieBios.getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio LogHieBios recorder)) cradle putStr libdir where encodePrettySorted = A.encodePretty' A.defConfig diff --git a/stack-lts19.yaml b/stack-lts19.yaml index d30f96d59b..8b964d8dea 100644 --- a/stack-lts19.yaml +++ b/stack-lts19.yaml @@ -62,7 +62,7 @@ extra-deps: - lsp-1.6.0.0 - lsp-types-1.6.0.0 - lsp-test-0.14.1.0 -- hie-bios-0.11.0 +- hie-bios-0.12.0 configure-options: ghcide: diff --git a/stack.yaml b/stack.yaml index b303ed2450..5ffd76d192 100644 --- a/stack.yaml +++ b/stack.yaml @@ -50,7 +50,7 @@ extra-deps: - lsp-1.6.0.0 - lsp-types-1.6.0.0 - lsp-test-0.14.1.0 -- hie-bios-0.11.0 +- hie-bios-0.12.0 # currently needed for ghcide>extra, etc. allow-newer: true From bf0560510c4fdb1ef8a9edcf3164a9dd6d343eee Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Thu, 16 Mar 2023 18:26:28 +0530 Subject: [PATCH 2/2] Use older version of http2 to avoid breakage with -haddock on 8.10 --- cabal.project | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index a0bd4b5af5..6ce3c45205 100644 --- a/cabal.project +++ b/cabal.project @@ -66,7 +66,9 @@ constraints: ghc-check -ghc-check-use-package-abis, ghc-lib-parser-ex -auto, stylish-haskell +ghc-lib, - fourmolu -fixity-th + fourmolu -fixity-th, + -- http2 doesn't build with -haddock on ghc-8.10 + http2 < 4.0.0 -- This is benign and won't affect our ability to release to Hackage, -- because we only depend on `ekg-json` when a non-default flag