mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-08-17 04:20:37 +03:00
Remove hslogger from codebase (#3526)
Co-authored-by: Fendor <walross.power@gmail.com> Co-authored-by: Michael Peyton Jones <me@michaelpj.com>
This commit is contained in:
parent
adf6622479
commit
014c8f9024
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -91,7 +91,6 @@ library
|
||||
transformers,
|
||||
unordered-containers >= 0.2.10.0,
|
||||
vector,
|
||||
hslogger,
|
||||
Diff ^>=0.4.0,
|
||||
vector,
|
||||
opentelemetry >=0.6.1,
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -510,7 +510,6 @@ executable haskell-language-server-wrapper
|
||||
, ghcide
|
||||
, gitrev
|
||||
, haskell-language-server
|
||||
, hslogger
|
||||
, hie-bios
|
||||
, hls-plugin-api
|
||||
, lsp
|
||||
|
@ -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
|
||||
|
@ -49,7 +49,6 @@ library
|
||||
, hashable
|
||||
, hlint < 3.6
|
||||
, hls-plugin-api ^>=1.6
|
||||
, hslogger
|
||||
, lens
|
||||
, lsp
|
||||
, refact
|
||||
|
Loading…
Reference in New Issue
Block a user