diff --git a/exe/Main.hs b/exe/Main.hs index ca8c885f4..c519bdd5e 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -51,7 +51,7 @@ main :: IO () main = do -- plugin cli commands use stderr logger for now unless we change the args -- parser to get logging arguments first or do more complicated things - pluginCliRecorder <- cmapWithPrio pretty <$> makeDefaultStderrRecorder Nothing Info + pluginCliRecorder <- cmapWithPrio pretty <$> makeDefaultStderrRecorder Nothing args <- getArguments "haskell-language-server" (Plugins.idePlugins (cmapWithPrio LogPlugins pluginCliRecorder)) (lspLogRecorder, cb1) <- Logger.withBacklog Logger.lspClientLogRecorder @@ -71,7 +71,7 @@ main = do in (argsTesting, minPriority, argsLogFile) _ -> (False, Info, Nothing) - withDefaultRecorder logFilePath Nothing minPriority $ \textWithPriorityRecorder -> do + withDefaultRecorder logFilePath Nothing $ \textWithPriorityRecorder -> do let recorder = cmapWithPrio (pretty &&& id) $ mconcat [textWithPriorityRecorder @@ -87,7 +87,7 @@ main = do -- ability of lsp-test to detect a stuck server in tests and benchmarks & if argsTesting then cfilter (not . heapStats . snd . payload) else id ] - plugins = (Plugins.idePlugins (cmapWithPrio LogPlugins recorder)) + plugins = Plugins.idePlugins (cmapWithPrio LogPlugins recorder) defaultMain (cmapWithPrio LogIdeMain recorder) diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 6c4837448..80a5a8d1d 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -45,12 +45,10 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Development.IDE.LSP.LanguageServer (runLanguageServer) import qualified Development.IDE.Main as Main -import Development.IDE.Types.Logger (Logger (Logger), +import Development.IDE.Types.Logger (Doc, Logger (Logger), Pretty (pretty), - Priority (Info), Recorder (logger_), WithPriority (WithPriority), - Doc, cmapWithPrio, makeDefaultStderrRecorder, toCologActionWithPrio) @@ -76,7 +74,7 @@ main = do args <- getArguments "haskell-language-server-wrapper" mempty hlsVer <- haskellLanguageServerVersion - recorder <- makeDefaultStderrRecorder Nothing Info + recorder <- makeDefaultStderrRecorder Nothing case args of ProbeToolsMode -> do programsOfInterest <- findProgramVersions diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 2d14c9332..4191f6d9f 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -77,7 +77,7 @@ main = withTelemetryLogger $ \telemetryLogger -> do -- stderr recorder just for plugin cli commands pluginCliRecorder <- cmapWithPrio pretty - <$> makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) Info + <$> makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) let hlsPlugins = pluginDescToIdePlugins (GhcIde.descriptors (cmapWithPrio LogGhcIde pluginCliRecorder)) -- WARNING: If you write to stdout before runLanguageServer @@ -94,7 +94,7 @@ main = withTelemetryLogger $ \telemetryLogger -> do let minPriority = if argsVerbose then Debug else Info - docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) minPriority + docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) (lspLogRecorder, cb1) <- Logger.withBacklog Logger.lspClientLogRecorder (lspMessageRecorder, cb2) <- Logger.withBacklog Logger.lspClientMessageRecorder diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 06ca3d4c4..f3e07d51a 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -91,7 +91,6 @@ library transformers, unordered-containers >= 0.2.10.0, vector, - hslogger, Diff ^>=0.4.0, vector, opentelemetry >=0.6.1, diff --git a/ghcide/src/Development/IDE/Types/Logger.hs b/ghcide/src/Development/IDE/Types/Logger.hs index 221e4d611..416049a5a 100644 --- a/ghcide/src/Development/IDE/Types/Logger.hs +++ b/ghcide/src/Development/IDE/Types/Logger.hs @@ -20,7 +20,6 @@ module Development.IDE.Types.Logger , withDefaultRecorder , makeDefaultStderrRecorder , makeDefaultHandleRecorder - , priorityToHsLoggerPriority , LoggingColumn(..) , cmapWithPrio , withBacklog @@ -40,8 +39,7 @@ import Control.Concurrent.STM (atomically, readTVarIO, writeTBQueue, writeTVar) import Control.Exception (IOException) -import Control.Monad (forM_, unless, when, - (>=>)) +import Control.Monad (unless, when, (>=>)) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Foldable (for_) import Data.Functor.Contravariant (Contravariant (contramap)) @@ -77,12 +75,7 @@ import qualified Colog.Core as Colog import System.IO (Handle, IOMode (AppendMode), hClose, hFlush, - hSetEncoding, openFile, - stderr, utf8) -import qualified System.Log.Formatter as HSL -import qualified System.Log.Handler as HSL -import qualified System.Log.Handler.Simple as HSL -import qualified System.Log.Logger as HsLogger + openFile, stderr) import UnliftIO (MonadUnliftIO, displayException, finally, try) @@ -171,31 +164,24 @@ textHandleRecorder handle = Recorder { logger_ = \text -> liftIO $ Text.hPutStrLn handle text *> hFlush handle } --- | Priority is actually for hslogger compatibility -makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> Priority -> m (Recorder (WithPriority (Doc a))) -makeDefaultStderrRecorder columns minPriority = do +makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> m (Recorder (WithPriority (Doc a))) +makeDefaultStderrRecorder columns = do lock <- liftIO newLock - makeDefaultHandleRecorder columns minPriority lock stderr + makeDefaultHandleRecorder columns lock stderr -- | If no path given then use stderr, otherwise use file. --- Kinda complicated because we also need to setup `hslogger` for --- `hie-bios` log compatibility reasons. If `hie-bios` can be set to use our --- logger instead or if `hie-bios` doesn't use `hslogger` then `hslogger` can --- be removed completely. See `setupHsLogger` comment. withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -- ^ Log file path. `Nothing` uses stderr -> Maybe [LoggingColumn] -- ^ logging columns to display. `Nothing` uses `defaultLoggingColumns` - -> Priority - -- ^ min priority for hslogger compatibility -> (Recorder (WithPriority (Doc d)) -> m a) -- ^ action given a recorder -> m a -withDefaultRecorder path columns minPriority action = do +withDefaultRecorder path columns action = do lock <- liftIO newLock - let makeHandleRecorder = makeDefaultHandleRecorder columns minPriority lock + let makeHandleRecorder = makeDefaultHandleRecorder columns lock case path of Nothing -> do recorder <- makeHandleRecorder stderr @@ -217,65 +203,20 @@ makeDefaultHandleRecorder :: MonadIO m => Maybe [LoggingColumn] -- ^ built-in logging columns to display. Nothing uses the default - -> Priority - -- ^ min priority for hslogger compatibility -> Lock -- ^ lock to take when outputting to handle -> Handle -- ^ handle to output to -> m (Recorder (WithPriority (Doc a))) -makeDefaultHandleRecorder columns minPriority lock handle = do +makeDefaultHandleRecorder columns lock handle = do let Recorder{ logger_ } = textHandleRecorder handle let threadSafeRecorder = Recorder { logger_ = \msg -> liftIO $ withLock lock (logger_ msg) } let loggingColumns = fromMaybe defaultLoggingColumns columns let textWithPriorityRecorder = cmapIO (textWithPriorityToText loggingColumns) threadSafeRecorder - -- see `setupHsLogger` comment - liftIO $ setupHsLogger lock handle ["hls", "hie-bios"] (priorityToHsLoggerPriority minPriority) pure (cmap docToText textWithPriorityRecorder) where docToText = fmap (renderStrict . layoutPretty defaultLayoutOptions) -priorityToHsLoggerPriority :: Priority -> HsLogger.Priority -priorityToHsLoggerPriority = \case - Debug -> HsLogger.DEBUG - Info -> HsLogger.INFO - Warning -> HsLogger.WARNING - Error -> HsLogger.ERROR - --- | The purpose of setting up `hslogger` at all is that `hie-bios` uses --- `hslogger` to output compilation logs. The easiest way to merge these logs --- with our log output is to setup an `hslogger` that uses the same handle --- and same lock as our loggers. That way the output from our loggers and --- `hie-bios` don't interleave strangely. --- It may be possible to have `hie-bios` use our logger by decorating the --- `Cradle.cradleOptsProg.runCradle` we get in the Cradle from --- `HieBios.findCradle`, but I remember trying that and something not good --- happened. I'd have to try it again to remember if that was a real issue. --- Once that is figured out or `hie-bios` doesn't use `hslogger`, then all --- references to `hslogger` can be removed entirely. -setupHsLogger :: Lock -> Handle -> [String] -> HsLogger.Priority -> IO () -setupHsLogger lock handle extraLogNames level = do - hSetEncoding handle utf8 - - logH <- HSL.streamHandler handle level - - let logHandle = logH - { HSL.writeFunc = \a s -> withLock lock $ HSL.writeFunc logH a s } - logFormatter = HSL.tfLogFormatter logDateFormat logFormat - logHandler = HSL.setFormatter logHandle logFormatter - - HsLogger.updateGlobalLogger HsLogger.rootLoggerName $ HsLogger.setHandlers ([] :: [HSL.GenericHandler Handle]) - HsLogger.updateGlobalLogger "haskell-lsp" $ HsLogger.setHandlers [logHandler] - HsLogger.updateGlobalLogger "haskell-lsp" $ HsLogger.setLevel level - - -- Also route the additional log names to the same log - forM_ extraLogNames $ \logName -> do - HsLogger.updateGlobalLogger logName $ HsLogger.setHandlers [logHandler] - HsLogger.updateGlobalLogger logName $ HsLogger.setLevel level - where - logFormat = "$time [$tid] $prio $loggername:\t$msg" - logDateFormat = "%Y-%m-%d %H:%M:%S%Q" - data LoggingColumn = TimeColumn | ThreadIdColumn diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 3034c8d59..7e8ac70c5 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -200,7 +200,7 @@ waitForAllProgressDone = loop main :: IO () main = do - docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) Debug + docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) let docWithFilteredPriorityRecorder@Recorder{ logger_ } = docWithPriorityRecorder diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 1012b86f4..867546f05 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -510,7 +510,6 @@ executable haskell-language-server-wrapper , ghcide , gitrev , haskell-language-server - , hslogger , hie-bios , hls-plugin-api , lsp diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index dc39b765c..82c49f1d4 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -240,7 +240,7 @@ pluginTestRecorder = do -- See 'runSessionWithServer'' for details. initialiseTestRecorder :: Pretty a => [String] -> IO (Recorder (WithPriority a), WithPriority (Doc ann) -> IO ()) initialiseTestRecorder envVars = do - docWithPriorityRecorder <- makeDefaultStderrRecorder Nothing Debug + docWithPriorityRecorder <- makeDefaultStderrRecorder Nothing -- There are potentially multiple environment variables that enable this logger definedEnvVars <- forM envVars (\var -> fromMaybe "0" <$> lookupEnv var) let logStdErr = any (/= "0") definedEnvVars diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index 031b442de..9a009f160 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -49,7 +49,6 @@ library , hashable , hlint < 3.6 , hls-plugin-api ^>=1.6 - , hslogger , lens , lsp , refact