Use hie-bios 0.12

This commit is contained in:
Zubin Duggal 2023-03-14 21:19:53 +05:30 committed by wz1000
parent 1ebb619d86
commit b9565a1b5a
7 changed files with 29 additions and 25 deletions

View File

@ -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

View File

@ -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 [])

View File

@ -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

View File

@ -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))

View File

@ -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

View File

@ -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:

View File

@ -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