Skip to content

Commit 80bce30

Browse files
pepeiborrapepeiborra
committed
no longer silence stderr
Instead, send all ghcide output through the logger and keep stderr open for fatals
1 parent c19ef73 commit 80bce30

File tree

4 files changed

+56
-72
lines changed

4 files changed

+56
-72
lines changed

‎ghcide/session-loader/Development/IDE/Session.hs

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,7 @@ data SessionLoadingOptions = SessionLoadingOptions
102102
-- or 'Nothing' to respect the cradle setting
103103
, getCacheDirs :: String -> [String] -> IO CacheDirs
104104
-- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags'
105-
, getInitialGhcLibDir :: FilePath -> IO (Maybe LibDir)
105+
, getInitialGhcLibDir :: Logger -> FilePath -> IO (Maybe LibDir)
106106
, fakeUid :: UnitId
107107
-- ^ unit id used to tag the internal component built by ghcide
108108
-- To reuse external interface files the unit ids must match,
@@ -140,11 +140,11 @@ loadWithImplicitCradle mHieYaml rootDir = do
140140
Just yaml -> HieBios.loadCradle yaml
141141
Nothing -> loadImplicitHieCradle $ addTrailingPathSeparator rootDir
142142

143-
getInitialGhcLibDirDefault :: FilePath -> IO (Maybe LibDir)
144-
getInitialGhcLibDirDefault rootDir = do
143+
getInitialGhcLibDirDefault :: Logger -> FilePath -> IO (Maybe LibDir)
144+
getInitialGhcLibDirDefault logger rootDir = do
145145
hieYaml <- findCradle def rootDir
146146
cradle <- loadCradle def hieYaml rootDir
147-
hPutStrLn stderr $ "setInitialDynFlags cradle: " ++ show cradle
147+
logDebug logger $ T.pack $ "setInitialDynFlags cradle: " ++ show cradle
148148
libDirRes <- getRuntimeGhcLibDir cradle
149149
case libDirRes of
150150
CradleSuccess libdir -> pure $ Just $ LibDir libdir
@@ -156,9 +156,9 @@ getInitialGhcLibDirDefault rootDir = do
156156
pure Nothing
157157

158158
-- | Sets `unsafeGlobalDynFlags` on using the hie-bios cradle and returns the GHC libdir
159-
setInitialDynFlags :: FilePath -> SessionLoadingOptions -> IO (Maybe LibDir)
160-
setInitialDynFlags rootDir SessionLoadingOptions{..} = do
161-
libdir <- getInitialGhcLibDir rootDir
159+
setInitialDynFlags :: Logger -> FilePath -> SessionLoadingOptions -> IO (Maybe LibDir)
160+
setInitialDynFlags logger rootDir SessionLoadingOptions{..} = do
161+
libdir <- getInitialGhcLibDir logger rootDir
162162
dynFlags <- mapM dynFlagsForPrinting libdir
163163
mapM_ setUnsafeGlobalDynFlags dynFlags
164164
pure libdir
@@ -167,8 +167,8 @@ setInitialDynFlags rootDir SessionLoadingOptions{..} = do
167167
-- writing. Actions are picked off one by one from the `HieWriterChan` and executed in serial
168168
-- by a worker thread using a dedicated database connection.
169169
-- This is done in order to serialize writes to the database, or else SQLite becomes unhappy
170-
runWithDb :: FilePath -> (HieDb -> IndexQueue -> IO ()) -> IO ()
171-
runWithDb fp k = do
170+
runWithDb :: Logger -> FilePath -> (HieDb -> IndexQueue -> IO ()) -> IO ()
171+
runWithDb logger fp k = do
172172
-- Delete the database if it has an incompatible schema version
173173
withHieDb fp (const $ pure ())
174174
`Safe.catch` \IncompatibleSchemaVersion{} -> removeFile fp
@@ -186,9 +186,9 @@ runWithDb fp k = do
186186
k <- atomically $ readTQueue chan
187187
k db
188188
`Safe.catch` \e@SQLError{} -> do
189-
hPutStrLn stderr $ "SQLite error in worker, ignoring: " ++ show e
189+
logDebug logger $ T.pack $ "SQLite error in worker, ignoring: " ++ show e
190190
`Safe.catchAny` \e -> do
191-
hPutStrLn stderr $ "Uncaught error in database worker, ignoring: " ++ show e
191+
logDebug logger $ T.pack $ "Uncaught error in database worker, ignoring: " ++ show e
192192

193193

194194
getHieDbLoc :: FilePath -> IO FilePath
@@ -361,7 +361,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
361361
res <- loadDLL hscEnv "libm.so.6"
362362
case res of
363363
Nothing -> pure ()
364-
Just err -> hPutStrLn stderr $
364+
Just err -> logDebug logger $ T.pack $
365365
"Error dynamically loading libm.so.6:\n" <> err
366366

367367
-- Make a map from unit-id to DynFlags, this is used when trying to
@@ -425,7 +425,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
425425
let progMsg = "Setting up " <> T.pack (takeBaseName (cradleRootDir cradle))
426426
<> " (for " <> T.pack lfp <> ")"
427427
eopts <- mRunLspTCallback lspEnv (withIndefiniteProgress progMsg NotCancellable) $
428-
cradleToOptsAndLibDir cradle cfp
428+
cradleToOptsAndLibDir logger cradle cfp
429429

430430
logDebug logger $ T.pack ("Session loading result: " <> show eopts)
431431
case eopts of
@@ -495,11 +495,11 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
495495
-- This then builds dependencies or whatever based on the cradle, gets the
496496
-- GHC options/dynflags needed for the session and the GHC library directory
497497

498-
cradleToOptsAndLibDir :: Show a => Cradle a -> FilePath
498+
cradleToOptsAndLibDir :: Show a => Logger -> Cradle a -> FilePath
499499
-> IO (Either [CradleError] (ComponentOptions, FilePath))
500-
cradleToOptsAndLibDir cradle file = do
500+
cradleToOptsAndLibDir logger cradle file = do
501501
-- Start off by getting the session options
502-
hPutStrLn stderr $ "Output from setting up the cradle " <> show cradle
502+
logDebug logger $ T.pack $ "Output from setting up the cradle " <> show cradle
503503
cradleRes <- HieBios.getCompilerOptions file cradle
504504
case cradleRes of
505505
CradleSuccess r -> do

‎ghcide/src/Development/IDE/LSP/LanguageServer.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -141,7 +141,8 @@ runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChan
141141
T.pack $ "Fatal error in server thread: " <> show e
142142
exitClientMsg
143143
handleServerException _ = pure ()
144-
_ <- flip forkFinally handleServerException $ runWithDb dbLoc $ \hiedb hieChan -> do
144+
logger = ideLogger ide
145+
_ <- flip forkFinally handleServerException $ runWithDb logger dbLoc $ \hiedb hieChan -> do
145146
putMVar dbMVar (hiedb,hieChan)
146147
forever $ do
147148
msg <- readChan clientMsgChan

‎ghcide/src/Development/IDE/Main.hs

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -63,7 +63,8 @@ import Development.IDE.Session (SessionLoadingOptions,
6363
setInitialDynFlags)
6464
import Development.IDE.Types.Location (NormalizedUri,
6565
toNormalizedFilePath')
66-
import Development.IDE.Types.Logger (Logger (Logger))
66+
import Development.IDE.Types.Logger (Logger (Logger),
67+
logDebug, logInfo)
6768
import Development.IDE.Types.Options (IdeGhcSession,
6869
IdeOptions (optCheckParents, optCheckProject, optReportProgress, optRunSubset),
6970
IdeTesting (IdeTesting),
@@ -251,20 +252,20 @@ defaultMain Arguments{..} = do
251252
LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToDefaultConfig argsHlsPlugins
252253
LSP -> withNumCapabilities (maybe (numProcessors `div` 2) fromIntegral argsThreads) $ do
253254
t <- offsetTime
254-
hPutStrLn stderr "Starting LSP server..."
255-
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run WITHOUT the --lsp option!"
255+
logInfo logger "Starting LSP server..."
256+
logInfo logger "If you are seeing this in a terminal, you probably should have run WITHOUT the --lsp option!"
256257
runLanguageServer options inH outH argsGetHieDbLoc argsDefaultHlsConfig argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath hiedb hieChan -> do
257258
traverse_ IO.setCurrentDirectory rootPath
258259
t <- t
259-
hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
260+
logInfo logger $ T.pack $ "Started LSP server in " ++ showDuration t
260261

261262
dir <- maybe IO.getCurrentDirectory return rootPath
262263

263264
-- We want to set the global DynFlags right now, so that we can use
264265
-- `unsafeGlobalDynFlags` even before the project is configured
265266
_mlibdir <-
266-
setInitialDynFlags dir argsSessionLoadingOptions
267-
`catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing)
267+
setInitialDynFlags logger dir argsSessionLoadingOptions
268+
`catchAny` (\e -> (logDebug logger $ T.pack $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing)
268269

269270

270271
sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir
@@ -273,7 +274,7 @@ defaultMain Arguments{..} = do
273274

274275
-- disable runSubset if the client doesn't support watched files
275276
runSubset <- (optRunSubset def_options &&) <$> LSP.runLspT env isWatchSupported
276-
hPutStrLn stderr $ "runSubset: " <> show runSubset
277+
logDebug logger $ T.pack $ "runSubset: " <> show runSubset
277278

278279
let options = def_options
279280
{ optReportProgress = clientSupportsProgress caps
@@ -299,7 +300,7 @@ defaultMain Arguments{..} = do
299300
Check argFiles -> do
300301
dir <- IO.getCurrentDirectory
301302
dbLoc <- getHieDbLoc dir
302-
runWithDb dbLoc $ \hiedb hieChan -> do
303+
runWithDb logger dbLoc $ \hiedb hieChan -> do
303304
-- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error
304305
hSetEncoding stdout utf8
305306
hSetEncoding stderr utf8
@@ -363,14 +364,14 @@ defaultMain Arguments{..} = do
363364
Db dir opts cmd -> do
364365
dbLoc <- getHieDbLoc dir
365366
hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc
366-
mlibdir <- setInitialDynFlags dir def
367+
mlibdir <- setInitialDynFlags logger dir def
367368
case mlibdir of
368369
Nothing -> exitWith $ ExitFailure 1
369370
Just libdir -> HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd
370371

371372
Custom projectRoot (IdeCommand c) -> do
372373
dbLoc <- getHieDbLoc projectRoot
373-
runWithDb dbLoc $ \hiedb hieChan -> do
374+
runWithDb logger dbLoc $ \hiedb hieChan -> do
374375
vfs <- makeVFSHandle
375376
sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions "."
376377
let def_options = argsIdeOptions argsDefaultHlsConfig sessionLoader

‎hls-test-utils/src/Test/Hls.hs

Lines changed: 27 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -27,46 +27,44 @@ module Test.Hls
2727
where
2828

2929
import Control.Applicative.Combinators
30-
import Control.Concurrent.Async (async, cancel, wait)
30+
import Control.Concurrent.Async (async, cancel, wait)
3131
import Control.Concurrent.Extra
3232
import Control.Exception.Base
33-
import Control.Monad (unless, void)
33+
import Control.Monad (unless, void)
3434
import Control.Monad.IO.Class
35-
import Data.Aeson (Value (Null), toJSON)
36-
import Data.ByteString.Lazy (ByteString)
37-
import Data.Default (def)
38-
import qualified Data.Text as T
39-
import qualified Data.Text.Lazy as TL
40-
import qualified Data.Text.Lazy.Encoding as TL
41-
import Development.IDE (IdeState, hDuplicateTo',
42-
noLogging)
43-
import Development.IDE.Graph (ShakeOptions (shakeThreads))
35+
import Data.Aeson (Value (Null), toJSON)
36+
import Data.ByteString.Lazy (ByteString)
37+
import Data.Default (def)
38+
import qualified Data.Text as T
39+
import qualified Data.Text.Lazy as TL
40+
import qualified Data.Text.Lazy.Encoding as TL
41+
import Development.IDE (IdeState, noLogging)
42+
import Development.IDE.Graph (ShakeOptions (shakeThreads))
4443
import Development.IDE.Main
45-
import qualified Development.IDE.Main as Ghcide
46-
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
47-
import Development.IDE.Plugin.Test (TestRequest (WaitForShakeQueue))
44+
import qualified Development.IDE.Main as Ghcide
45+
import Development.IDE.Plugin.Test (TestRequest (WaitForShakeQueue))
4846
import Development.IDE.Types.Options
4947
import GHC.IO.Handle
50-
import Ide.Plugin.Config (Config, formattingProvider)
51-
import Ide.PluginUtils (idePluginsToPluginDesc,
52-
pluginDescToIdePlugins)
48+
import Ide.Plugin.Config (Config, formattingProvider)
49+
import Ide.PluginUtils (idePluginsToPluginDesc,
50+
pluginDescToIdePlugins)
5351
import Ide.Types
5452
import Language.LSP.Test
55-
import Language.LSP.Types hiding
56-
(SemanticTokenAbsolute (length, line),
57-
SemanticTokenRelative (length),
58-
SemanticTokensEdit (_start))
59-
import Language.LSP.Types.Capabilities (ClientCapabilities)
60-
import System.Directory (getCurrentDirectory,
61-
setCurrentDirectory)
62-
import System.Environment.Blank (getEnvDefault)
53+
import Language.LSP.Types hiding
54+
(SemanticTokenAbsolute (length, line),
55+
SemanticTokenRelative (length),
56+
SemanticTokensEdit (_start))
57+
import Language.LSP.Types.Capabilities (ClientCapabilities)
58+
import System.Directory (getCurrentDirectory,
59+
setCurrentDirectory)
60+
import System.Environment.Blank (getEnvDefault)
6361
import System.FilePath
6462
import System.IO.Extra
65-
import System.IO.Unsafe (unsafePerformIO)
66-
import System.Process.Extra (createPipe)
63+
import System.IO.Unsafe (unsafePerformIO)
64+
import System.Process.Extra (createPipe)
6765
import System.Time.Extra
6866
import Test.Hls.Util
69-
import Test.Tasty hiding (Timeout)
67+
import Test.Tasty hiding (Timeout)
7068
import Test.Tasty.ExpectedFailure
7169
import Test.Tasty.Golden
7270
import Test.Tasty.HUnit
@@ -132,22 +130,6 @@ runSessionWithServerFormatter plugin formatter =
132130
def
133131
fullCaps
134132

135-
-- | Run an action, with stderr silenced
136-
silenceStderr :: IO a -> IO a
137-
silenceStderr action = do
138-
showStderr <- getEnvDefault "LSP_TEST_LOG_STDERR" "0"
139-
case showStderr of
140-
"0" -> withTempFile $ \temp ->
141-
bracket (openFile temp ReadWriteMode) hClose $ \h -> do
142-
old <- hDuplicate stderr
143-
buf <- hGetBuffering stderr
144-
h `hDuplicateTo'` stderr
145-
action `finally` do
146-
old `hDuplicateTo'` stderr
147-
hSetBuffering stderr buf
148-
hClose old
149-
_ -> action
150-
151133
-- | Restore cwd after running an action
152134
keepCurrentDirectory :: IO a -> IO a
153135
keepCurrentDirectory = bracket getCurrentDirectory setCurrentDirectory . const
@@ -170,7 +152,7 @@ runSessionWithServer' ::
170152
FilePath ->
171153
Session a ->
172154
IO a
173-
runSessionWithServer' plugin conf sconf caps root s = withLock lock $ keepCurrentDirectory $ silenceStderr $ do
155+
runSessionWithServer' plugin conf sconf caps root s = withLock lock $ keepCurrentDirectory $ do
174156
(inR, inW) <- createPipe
175157
(outR, outW) <- createPipe
176158
server <-

0 commit comments

Comments
 (0)