Change the default logger to print to stderr

Author: pepeiborra

ghcide/exe/Main.hs

@@ -84,7 +84,7 @@ main = do
                 Typecheck x | not argLSP -> Just x
                 _ -> Nothing
 
-            ,Main.argsLogger = logger
+            ,Main.argsLogger = pure logger
 
             ,Main.argsRules = do
                 -- install the main and ghcide-plugin rules

ghcide/src/Development/IDE/Main.hs

@@ -1,5 +1,5 @@
 module Development.IDE.Main (Arguments(..), defaultMain) where
-import Control.Concurrent.Extra (readVar)
+import           Control.Concurrent.Extra (newLock, readVar, withLock)
 import Control.Exception.Safe (
     Exception (displayException),
     catchAny,
@@ -16,7 +16,8 @@ import Data.List.Extra (
  )
 import Data.Maybe (catMaybes, fromMaybe, isJust)
 import qualified Data.Text as T
-import Development.IDE (Action, Rules, noLogging)
+import qualified Data.Text.IO as T
+import           Development.IDE (Action, Rules)
 import Development.IDE.Core.Debouncer (newAsyncDebouncer)
 import Development.IDE.Core.FileStore (makeVFSHandle)
 import Development.IDE.Core.OfInterest (
@@ -49,7 +50,6 @@ import Development.IDE.Plugin (
 import Development.IDE.Plugin.HLS (asGhcIdePlugin)
 import Development.IDE.Session (SessionLoadingOptions, loadSessionWithOptions, setInitialDynFlags, getHieDbLoc, runWithDb)
 import Development.IDE.Types.Location (toNormalizedFilePath')
-import Development.IDE.Types.Logger (Logger)
 import Development.IDE.Types.Options (
     IdeGhcSession,
     IdeOptions (optCheckParents, optCheckProject, optReportProgress),
@@ -66,15 +66,16 @@ import qualified Language.LSP.Server as LSP
 import qualified System.Directory.Extra as IO
 import System.Exit (ExitCode (ExitFailure), exitWith)
 import System.FilePath (takeExtension, takeFileName)
-import System.IO (hPutStrLn, hSetEncoding, stderr, stdout, utf8)
+import System.IO (hSetBuffering, hPutStrLn, hSetEncoding, stderr, stdout, utf8, BufferMode (LineBuffering))
 import System.Time.Extra (offsetTime, showDuration)
 import Text.Printf (printf)
 import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
+import Development.IDE.Types.Logger (Logger(Logger))
 
 data Arguments = Arguments
     { argsOTMemoryProfiling :: Bool
     , argFiles :: Maybe [FilePath]   -- ^ Nothing: lsp server ;  Just: typecheck and exit
-    , argsLogger :: Logger
+    , argsLogger :: IO Logger
     , argsRules :: Rules ()
     , argsHlsPlugins :: IdePlugins IdeState
     , argsGhcidePlugin :: Plugin Config  -- ^ Deprecated
@@ -89,7 +90,7 @@ instance Default Arguments where
     def = Arguments
         { argsOTMemoryProfiling = False
         , argFiles = Nothing
-        , argsLogger = noLogging
+        , argsLogger = stderrLogger
         , argsRules = mainRule >> action kick
         , argsGhcidePlugin = mempty
         , argsHlsPlugins = pluginDescToIdePlugins Ghcide.descriptors
@@ -100,9 +101,18 @@ instance Default Arguments where
         , argsGetHieDbLoc = getHieDbLoc
         }
 
+-- | Cheap stderr logger that relies on LineBuffering
+stderrLogger :: IO Logger
+stderrLogger = do
+    lock <- newLock
+    return $ Logger $ \p m -> withLock lock $
+        T.hPutStrLn stderr $ "[" <> T.pack (show p) <> "] " <> m
+
 defaultMain :: Arguments -> IO ()
 defaultMain Arguments{..} = do
     pid <- T.pack . show <$> getProcessID
+    logger <- argsLogger
+    hSetBuffering stderr LineBuffering
 
     let hlsPlugin = asGhcIdePlugin argsDefaultHlsConfig argsHlsPlugins
         hlsCommands = allLspCmdIds' pid argsHlsPlugins
@@ -141,7 +151,7 @@ defaultMain Arguments{..} = do
                     argsDefaultHlsConfig
                     rules
                     (Just env)
-                    argsLogger
+                    logger
                     debouncer
                     options
                     vfs
@@ -178,7 +188,7 @@ defaultMain Arguments{..} = do
                         { optCheckParents = pure NeverCheck
                         , optCheckProject = pure False
                         }
-            ide <- initialise argsDefaultHlsConfig rules Nothing argsLogger debouncer options vfs hiedb hieChan
+            ide <- initialise argsDefaultHlsConfig rules Nothing logger debouncer options vfs hiedb hieChan
 
             putStrLn "\nStep 4/4: Type checking the files"
             setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files
@@ -205,7 +215,7 @@ defaultMain Arguments{..} = do
                             Key GhcSessionDeps :
                             [k | (_, k) <- HashMap.keys values, k /= Key GhcSessionIO]
                             ++ [Key GhcSessionIO]
-                measureMemory argsLogger [keys] consoleObserver valuesRef
+                measureMemory logger [keys] consoleObserver valuesRef
 
             unless (null failed) (exitWith $ ExitFailure (length failed))
 {-# ANN defaultMain ("HLint: ignore Use nubOrd" :: String) #-}

src/Ide/Main.hs

@@ -94,7 +94,7 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do
     Main.defaultMain def
       { Main.argFiles = if argLSP then Nothing else Just []
       , Main.argsHlsPlugins = idePlugins
-      , Main.argsLogger = hlsLogger
+      , Main.argsLogger = pure hlsLogger
       , Main.argsIdeOptions = \_config sessionLoader ->
         let defOptions = Ghcide.defaultIdeOptions sessionLoader
         in defOptions