haskell/haskell-language-server
1
1
Fork 0
mirror of https://github.com/haskell/haskell-language-server.git synced 2024-08-17 04:20:37 +03:00
Code Issues Projects Releases Wiki Activity

Remove hslogger from codebase (#3526)

Browse Source 
Co-authored-by: Fendor <walross.power@gmail.com>
Co-authored-by: Michael Peyton Jones <me@michaelpj.com>
This commit is contained in:
fendor 2023-03-18 15:46:00 +01:00 committed by GitHub
parent adf6622479
commit 014c8f9024
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
9 changed files with 17 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
exe/Main.hs
View File

@ -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)

6
exe/Wrapper.hs
View File

@ -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

4
ghcide/exe/Main.hs
View File

@ -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

1
ghcide/ghcide.cabal
View File

@ -91,7 +91,6 @@ library
transformers,
unordered-containers >= 0.2.10.0,
vector,
hslogger,
Diff ^>=0.4.0,
vector,
opentelemetry >=0.6.1,

75
ghcide/src/Development/IDE/Types/Logger.hs
View File

@ -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

2
ghcide/test/exe/Main.hs
View File

@ -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

1
haskell-language-server.cabal
View File

@ -510,7 +510,6 @@ executable haskell-language-server-wrapper
, ghcide
, gitrev
, haskell-language-server
, hslogger
, hie-bios
, hls-plugin-api
, lsp

2
hls-test-utils/src/Test/Hls.hs
View File

@ -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

1
plugins/hls-hlint-plugin/hls-hlint-plugin.cabal
View File

@ -49,7 +49,6 @@ library
, hashable
, hlint < 3.6
, hls-plugin-api ^>=1.6
, hslogger
, lens
, lsp
, refact