Skip to content

Commit

Permalink
Use hie-bios 0.12
Browse files Browse the repository at this point in the history
  • Loading branch information
wz1000 committed Mar 15, 2023
1 parent 1ebb619 commit 368d849
Show file tree
Hide file tree
Showing 4 changed files with 23 additions and 22 deletions.
2 changes: 1 addition & 1 deletion 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 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

0 comments on commit 368d849

Please sign in to comment.