@@ -50,8 +50,10 @@ import Development.IDE.Types.Logger (Logger (Logger),
5050 Priority (Info ),
5151 Recorder (logger_ ),
5252 WithPriority (WithPriority ),
53+ Doc ,
5354 cmapWithPrio ,
54- makeDefaultStderrRecorder )
55+ makeDefaultStderrRecorder ,
56+ toCologActionWithPrio )
5557import GHC.Stack.Types (emptyCallStack )
5658import Ide.Plugin.Config (Config )
5759import Ide.Types (IdePlugins (IdePlugins ))
@@ -74,6 +76,7 @@ main = do
7476 args <- getArguments " haskell-language-server-wrapper" mempty
7577
7678 hlsVer <- haskellLanguageServerVersion
79+ recorder <- makeDefaultStderrRecorder Nothing Info
7780 case args of
7881 ProbeToolsMode -> do
7982 programsOfInterest <- findProgramVersions
@@ -82,7 +85,7 @@ main = do
8285 putStrLn $ showProgramVersionOfInterest programsOfInterest
8386 putStrLn " Tool versions in your project"
8487 cradle <- findProjectCradle' False
85- ghcVersion <- runExceptT $ getRuntimeGhcVersion' cradle
88+ ghcVersion <- runExceptT $ getRuntimeGhcVersion' recorder cradle
8689 putStrLn $ showProgramVersion " ghc" $ mkVersion =<< eitherToMaybe ghcVersion
8790
8891 VersionMode PrintVersion ->
@@ -95,18 +98,18 @@ main = do
9598 print =<< findProjectCradle
9699 PrintLibDir -> do
97100 cradle <- findProjectCradle' False
98- (CradleSuccess libdir) <- HieBios. getRuntimeGhcLibDir cradle
101+ (CradleSuccess libdir) <- HieBios. getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio pretty recorder)) cradle
99102 putStr libdir
100- _ -> launchHaskellLanguageServer args >>= \ case
103+ _ -> launchHaskellLanguageServer recorder args >>= \ case
101104 Right () -> pure ()
102105 Left err -> do
103106 T. hPutStrLn stderr (prettyError err NoShorten )
104107 case args of
105- Ghcide _ -> launchErrorLSP (prettyError err Shorten )
108+ Ghcide _ -> launchErrorLSP recorder (prettyError err Shorten )
106109 _ -> pure ()
107110
108- launchHaskellLanguageServer :: Arguments -> IO (Either WrapperSetupError () )
109- launchHaskellLanguageServer parsedArgs = do
111+ launchHaskellLanguageServer :: Recorder ( WithPriority ( Doc () )) -> Arguments -> IO (Either WrapperSetupError () )
112+ launchHaskellLanguageServer recorder parsedArgs = do
110113 case parsedArgs of
111114 Ghcide GhcideArguments {.. } -> whenJust argsCwd setCurrentDirectory
112115 _ -> pure ()
@@ -122,7 +125,7 @@ launchHaskellLanguageServer parsedArgs = do
122125 case parsedArgs of
123126 Ghcide GhcideArguments {.. } ->
124127 when argsProjectGhcVersion $ do
125- runExceptT (getRuntimeGhcVersion' cradle) >>= \ case
128+ runExceptT (getRuntimeGhcVersion' recorder cradle) >>= \ case
126129 Right ghcVersion -> putStrLn ghcVersion >> exitSuccess
127130 Left err -> T. putStrLn (prettyError err NoShorten ) >> exitFailure
128131 _ -> pure ()
@@ -145,7 +148,7 @@ launchHaskellLanguageServer parsedArgs = do
145148 hPutStrLn stderr " Consulting the cradle to get project GHC version..."
146149
147150 runExceptT $ do
148- ghcVersion <- getRuntimeGhcVersion' cradle
151+ ghcVersion <- getRuntimeGhcVersion' recorder cradle
149152 liftIO $ hPutStrLn stderr $ " Project GHC version: " ++ ghcVersion
150153
151154 let
@@ -170,10 +173,10 @@ launchHaskellLanguageServer parsedArgs = do
170173
171174 let cradleName = actionName (cradleOptsProg cradle)
172175 -- we need to be compatible with NoImplicitPrelude
173- ghcBinary <- liftIO (fmap trim <$> runGhcCmd [" -v0" , " -package-env=-" , " -ignore-dot-ghci" , " -e" , " Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)" ])
176+ 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)" ])
174177 >>= cradleResult cradleName
175178
176- libdir <- liftIO (HieBios. getRuntimeGhcLibDir cradle)
179+ libdir <- liftIO (HieBios. getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio pretty recorder)) cradle)
177180 >>= cradleResult cradleName
178181
179182 env <- Map. fromList <$> liftIO getEnvironment
@@ -190,8 +193,8 @@ cradleResult cradleName CradleNone = throwE $ NoneCradleGhcVersion cradleName
190193
191194-- | Version of 'getRuntimeGhcVersion' that dies if we can't get it, and also
192195-- checks to see if the tool is missing if it is one of
193- getRuntimeGhcVersion' :: Cradle Void -> ExceptT WrapperSetupError IO String
194- getRuntimeGhcVersion' cradle = do
196+ getRuntimeGhcVersion' :: Recorder ( WithPriority ( Doc () )) -> Cradle Void -> ExceptT WrapperSetupError IO String
197+ getRuntimeGhcVersion' recorder cradle = do
195198 let cradleName = actionName (cradleOptsProg cradle)
196199
197200 -- See if the tool is installed
@@ -202,7 +205,7 @@ getRuntimeGhcVersion' cradle = do
202205 Direct -> checkToolExists " ghc"
203206 _ -> pure ()
204207
205- ghcVersionRes <- liftIO $ HieBios. getRuntimeGhcVersion cradle
208+ ghcVersionRes <- liftIO $ HieBios. getRuntimeGhcVersion (toCologActionWithPrio (cmapWithPrio pretty recorder)) cradle
206209 cradleResult cradleName ghcVersionRes
207210
208211 where
@@ -271,10 +274,8 @@ newtype ErrorLSPM c a = ErrorLSPM { unErrorLSPM :: (LspM c) a }
271274
272275-- | Launches a LSP that displays an error and presents the user with a request
273276-- to shut down the LSP.
274- launchErrorLSP :: T. Text -> IO ()
275- launchErrorLSP errorMsg = do
276- recorder <- makeDefaultStderrRecorder Nothing Info
277-
277+ launchErrorLSP :: Recorder (WithPriority (Doc () )) -> T. Text -> IO ()
278+ launchErrorLSP recorder errorMsg = do
278279 let logger = Logger $ \ p m -> logger_ recorder (WithPriority p emptyCallStack (pretty m))
279280
280281 let defaultArguments = Main. defaultArguments (cmapWithPrio pretty recorder) logger (IdePlugins [] )
0 commit comments