Skip to content

Use hie-bios 0.12 #3524

New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

Merged
merged 2 commits into from
Mar 17, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 4 additions & 2 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
37 changes: 19 additions & 18 deletions exe/Wrapper.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand All @@ -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
Expand All @@ -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 ->
Expand All @@ -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 ()
Expand All @@ -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 ()
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 [])
Expand Down
2 changes: 1 addition & 1 deletion ghcide/ghcide.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions ghcide/session-loader/Development/IDE/Session.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand Down
5 changes: 4 additions & 1 deletion src/Ide/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -44,6 +45,7 @@ data Log
| LogDirectory !FilePath
| LogLspStart !GhcideArguments ![PluginId]
| LogIDEMain IDEMain.Log
| LogHieBios HieBios.Log
| LogOther T.Text
deriving Show

Expand All @@ -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 ()
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion stack-lts19.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down
2 changes: 1 addition & 1 deletion stack.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down