Skip to content

Commit 1515483

Browse files
fendorfendor
committed
Drop Logger from HLS code base.
Move ghcide completely to colog-logging style. Move plugins that were relying on `ideLogger` to colog style logging. Move opentelemetry to colog-logging style. This allows us to drop legacy code and unify the logging experience in HLS. We add a bunch of new Log constructors at various locations that aim to be identical to their previous `Logger` statements.
1 parent 97aac54 commit 1515483

File tree

28 files changed

+457
-404
lines changed

28 files changed

+457
-404
lines changed

‎exe/Wrapper.hs

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -41,11 +41,8 @@ import qualified Data.Text as T
4141
import qualified Data.Text.IO as T
4242
import Development.IDE.LSP.LanguageServer (runLanguageServer)
4343
import qualified Development.IDE.Main as Main
44-
import GHC.Stack.Types (emptyCallStack)
45-
import Ide.Logger (Doc, Logger (Logger),
46-
Pretty (pretty),
47-
Recorder (logger_),
48-
WithPriority (WithPriority),
44+
import Ide.Logger (Doc, Pretty (pretty),
45+
Recorder, WithPriority,
4946
cmapWithPrio,
5047
makeDefaultStderrRecorder)
5148
import Ide.Plugin.Config (Config)
@@ -272,9 +269,7 @@ newtype ErrorLSPM c a = ErrorLSPM { unErrorLSPM :: (LspM c) a }
272269
-- to shut down the LSP.
273270
launchErrorLSP :: Recorder (WithPriority (Doc ())) -> T.Text -> IO ()
274271
launchErrorLSP recorder errorMsg = do
275-
let logger = Logger $ \p m -> logger_ recorder (WithPriority p emptyCallStack (pretty m))
276-
277-
let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) logger (IdePlugins [])
272+
let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) (IdePlugins [])
278273

279274
inH <- Main.argsHandleIn defaultArguments
280275

‎ghcide/exe/Main.hs

Lines changed: 7 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -16,14 +16,12 @@ import Development.IDE (action)
1616
import Development.IDE.Core.OfInterest (kick)
1717
import Development.IDE.Core.Rules (mainRule)
1818
import qualified Development.IDE.Core.Rules as Rules
19-
import Development.IDE.Core.Tracing (withTelemetryLogger)
19+
import Development.IDE.Core.Tracing (withTelemetryRecorder)
2020
import qualified Development.IDE.Main as IDEMain
2121
import qualified Development.IDE.Monitoring.OpenTelemetry as OpenTelemetry
2222
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
2323
import Development.IDE.Types.Options
24-
import GHC.Stack (emptyCallStack)
25-
import Ide.Logger (Logger (Logger),
26-
LoggingColumn (DataColumn, PriorityColumn),
24+
import Ide.Logger (LoggingColumn (DataColumn, PriorityColumn),
2725
Pretty (pretty),
2826
Priority (Debug, Error, Info),
2927
WithPriority (WithPriority, priority),
@@ -71,7 +69,7 @@ ghcideVersion = do
7169
<> gitHashSection
7270

7371
main :: IO ()
74-
main = withTelemetryLogger $ \telemetryLogger -> do
72+
main = withTelemetryRecorder $ \telemetryRecorder -> do
7573
-- stderr recorder just for plugin cli commands
7674
pluginCliRecorder <-
7775
cmapWithPrio pretty
@@ -109,23 +107,20 @@ main = withTelemetryLogger $ \telemetryLogger -> do
109107
(lspLogRecorder & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions)
110108
& cfilter (\WithPriority{ priority } -> priority >= minPriority)) <>
111109
(lspMessageRecorder & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions)
112-
& cfilter (\WithPriority{ priority } -> priority >= Error))
113-
114-
-- exists so old-style logging works. intended to be phased out
115-
let logger = Logger $ \p m -> Logger.logger_ docWithFilteredPriorityRecorder (WithPriority p emptyCallStack (pretty m))
110+
& cfilter (\WithPriority{ priority } -> priority >= Error)) <>
111+
telemetryRecorder
116112

117113
let recorder = docWithFilteredPriorityRecorder
118114
& cmapWithPrio pretty
119115

120116
let arguments =
121117
if argsTesting
122-
then IDEMain.testing (cmapWithPrio LogIDEMain recorder) logger hlsPlugins
123-
else IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) logger hlsPlugins
118+
then IDEMain.testing (cmapWithPrio LogIDEMain recorder) hlsPlugins
119+
else IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) hlsPlugins
124120

125121
IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) arguments
126122
{ IDEMain.argsProjectRoot = Just argsCwd
127123
, IDEMain.argCommand = argsCommand
128-
, IDEMain.argsLogger = IDEMain.argsLogger arguments <> pure telemetryLogger
129124
, IDEMain.argsHlsPlugins = IDEMain.argsHlsPlugins arguments <> pluginDescToIdePlugins [lspRecorderPlugin]
130125

131126
, IDEMain.argsRules = do

‎ghcide/src/Development/IDE/Core/OfInterest.hs

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -42,10 +42,11 @@ import Development.IDE.Types.Location
4242
import Development.IDE.Types.Options (IdeTesting (..))
4343
import GHC.TypeLits (KnownSymbol)
4444
import Ide.Logger (Pretty (pretty),
45+
Priority (..),
4546
Recorder,
4647
WithPriority,
4748
cmapWithPrio,
48-
logDebug)
49+
logWith)
4950
import qualified Language.LSP.Protocol.Message as LSP
5051
import qualified Language.LSP.Server as LSP
5152

@@ -110,16 +111,16 @@ addFileOfInterest state f v = do
110111
pure (new, (prev, new))
111112
when (prev /= Just v) $ do
112113
join $ atomically $ recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]
113-
logDebug (ideLogger state) $
114-
"Set files of interest to: " <> T.pack (show files)
114+
logWith (ideLogger state) Debug $
115+
LogSetFilesOfInterest (HashMap.toList files)
115116

116117
deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO ()
117118
deleteFileOfInterest state f = do
118119
OfInterestVar var <- getIdeGlobalState state
119120
files <- modifyVar' var $ HashMap.delete f
120121
join $ atomically $ recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]
121-
logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show files)
122-
122+
logWith (ideLogger state) Debug $
123+
LogSetFilesOfInterest (HashMap.toList files)
123124
scheduleGarbageCollection :: IdeState -> IO ()
124125
scheduleGarbageCollection state = do
125126
GarbageCollectVar var <- getIdeGlobalState state

‎ghcide/src/Development/IDE/Core/RuleTypes.hs

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,8 @@ import Development.IDE.Spans.Common
4141
import Development.IDE.Spans.LocalBindings
4242
import Development.IDE.Types.Diagnostics
4343
import GHC.Serialized (Serialized)
44+
import Ide.Logger (Pretty (..),
45+
viaShow)
4446
import Language.LSP.Protocol.Types (Int32,
4547
NormalizedFilePath)
4648

@@ -340,6 +342,9 @@ data FileOfInterestStatus
340342
instance Hashable FileOfInterestStatus
341343
instance NFData FileOfInterestStatus
342344

345+
instance Pretty FileOfInterestStatus where
346+
pretty = viaShow
347+
343348
data IsFileOfInterestResult = NotFOI | IsFOI FileOfInterestStatus
344349
deriving (Eq, Show, Typeable, Generic)
345350
instance Hashable IsFileOfInterestResult

‎ghcide/src/Development/IDE/Core/Service.hs

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,7 @@ import Development.IDE.Core.FileExists (fileExistsRules)
2222
import Development.IDE.Core.OfInterest hiding (Log, LogShake)
2323
import Development.IDE.Graph
2424
import Development.IDE.Types.Options (IdeOptions (..))
25-
import Ide.Logger as Logger (Logger,
26-
Pretty (pretty),
25+
import Ide.Logger as Logger (Pretty (pretty),
2726
Priority (Debug),
2827
Recorder,
2928
WithPriority,
@@ -63,14 +62,13 @@ initialise :: Recorder (WithPriority Log)
6362
-> IdePlugins IdeState
6463
-> Rules ()
6564
-> Maybe (LSP.LanguageContextEnv Config)
66-
-> Logger
6765
-> Debouncer LSP.NormalizedUri
6866
-> IdeOptions
6967
-> WithHieDb
7068
-> IndexQueue
7169
-> Monitoring
7270
-> IO IdeState
73-
initialise recorder defaultConfig plugins mainRule lspEnv logger debouncer options withHieDb hiedbChan metrics = do
71+
initialise recorder defaultConfig plugins mainRule lspEnv debouncer options withHieDb hiedbChan metrics = do
7472
shakeProfiling <- do
7573
let fromConf = optShakeProfiling options
7674
fromEnv <- lookupEnv "GHCIDE_BUILD_PROFILING"
@@ -80,7 +78,6 @@ initialise recorder defaultConfig plugins mainRule lspEnv logger debouncer optio
8078
lspEnv
8179
defaultConfig
8280
plugins
83-
logger
8481
debouncer
8582
shakeProfiling
8683
(optReportProgress options)

‎ghcide/src/Development/IDE/Core/Shake.hs

Lines changed: 30 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -168,11 +168,11 @@ import qualified Language.LSP.Server as LSP
168168
import Language.LSP.VFS hiding (start)
169169
import qualified "list-t" ListT
170170
import OpenTelemetry.Eventlog hiding (addEvent)
171+
import qualified Prettyprinter as Pretty
171172
import qualified StmContainers.Map as STM
172173
import System.FilePath hiding (makeRelative)
173174
import System.IO.Unsafe (unsafePerformIO)
174175
import System.Time.Extra
175-
176176
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
177177

178178
#if !MIN_VERSION_ghc(9,3,0)
@@ -191,6 +191,12 @@ data Log
191191
| LogDiagsDiffButNoLspEnv ![FileDiagnostic]
192192
| LogDefineEarlyCutoffRuleNoDiagHasDiag !FileDiagnostic
193193
| LogDefineEarlyCutoffRuleCustomNewnessHasDiag !FileDiagnostic
194+
| LogCancelledAction !T.Text
195+
| LogSessionInitialised
196+
| LogLookupPersistentKey !T.Text
197+
| LogShakeGarbageCollection !T.Text !Int !Seconds
198+
-- * OfInterest Log messages
199+
| LogSetFilesOfInterest ![(NormalizedFilePath, FileOfInterestStatus)]
194200
deriving Show
195201

196202
instance Pretty Log where
@@ -224,6 +230,16 @@ instance Pretty Log where
224230
LogDefineEarlyCutoffRuleCustomNewnessHasDiag fileDiagnostic ->
225231
"defineEarlyCutoff RuleWithCustomNewnessCheck - file diagnostic:"
226232
<+> pretty (showDiagnosticsColored [fileDiagnostic])
233+
LogCancelledAction action ->
234+
pretty action <+> "was cancelled"
235+
LogSessionInitialised -> "Shake session initialized"
236+
LogLookupPersistentKey key ->
237+
"LOOKUP PERSISTENT FOR:" <+> pretty key
238+
LogShakeGarbageCollection label number duration ->
239+
pretty label <+> "of" <+> pretty number <+> "keys (took " <+> pretty (showDuration duration) <> ")"
240+
LogSetFilesOfInterest ofInterest ->
241+
"Set files of interst to" <> Pretty.line
242+
<> indent 4 (pretty $ fmap (first fromNormalizedFilePath) ofInterest)
227243

228244
-- | We need to serialize writes to the database, so we send any function that
229245
-- needs to write to the database over the channel, where it will be picked up by
@@ -254,7 +270,7 @@ data ShakeExtras = ShakeExtras
254270
{ --eventer :: LSP.FromServerMessage -> IO ()
255271
lspEnv :: Maybe (LSP.LanguageContextEnv Config)
256272
,debouncer :: Debouncer NormalizedUri
257-
,logger :: Logger
273+
,shakeRecorder :: Recorder (WithPriority Log)
258274
,idePlugins :: IdePlugins IdeState
259275
,globals :: TVar (HMap.HashMap TypeRep Dynamic)
260276
-- ^ Registry of global state used by rules.
@@ -439,7 +455,7 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do
439455
| otherwise = do
440456
pmap <- readTVarIO persistentKeys
441457
mv <- runMaybeT $ do
442-
liftIO $ Logger.logDebug (logger s) $ T.pack $ "LOOKUP PERSISTENT FOR: " ++ show k
458+
liftIO $ logWith (shakeRecorder s) Debug $ LogLookupPersistentKey (T.pack $ show k)
443459
f <- MaybeT $ pure $ lookupKeyMap (newKey k) pmap
444460
(dv,del,ver) <- MaybeT $ runIdeAction "lastValueIO" s $ f file
445461
MaybeT $ pure $ (,del,ver) <$> fromDynamic dv
@@ -602,7 +618,6 @@ shakeOpen :: Recorder (WithPriority Log)
602618
-> Maybe (LSP.LanguageContextEnv Config)
603619
-> Config
604620
-> IdePlugins IdeState
605-
-> Logger
606621
-> Debouncer NormalizedUri
607622
-> Maybe FilePath
608623
-> IdeReportProgress
@@ -613,7 +628,7 @@ shakeOpen :: Recorder (WithPriority Log)
613628
-> Monitoring
614629
-> Rules ()
615630
-> IO IdeState
616-
shakeOpen recorder lspEnv defaultConfig idePlugins logger debouncer
631+
shakeOpen recorder lspEnv defaultConfig idePlugins debouncer
617632
shakeProfileDir (IdeReportProgress reportProgress)
618633
ideTesting@(IdeTesting testing)
619634
withHieDb indexQueue opts monitoring rules = mdo
@@ -660,7 +675,7 @@ shakeOpen recorder lspEnv defaultConfig idePlugins logger debouncer
660675
dirtyKeys <- newTVarIO mempty
661676
-- Take one VFS snapshot at the start
662677
vfsVar <- newTVarIO =<< vfsSnapshot lspEnv
663-
pure ShakeExtras{..}
678+
pure ShakeExtras{shakeRecorder = recorder, ..}
664679
shakeDb <-
665680
shakeNewDatabase
666681
opts { shakeExtra = newShakeExtra shakeExtras }
@@ -707,7 +722,7 @@ shakeSessionInit recorder ide@IdeState{..} = do
707722
vfs <- vfsSnapshot (lspEnv shakeExtras)
708723
initSession <- newSession recorder shakeExtras (VFSModified vfs) shakeDb [] "shakeSessionInit"
709724
putMVar shakeSession initSession
710-
logDebug (ideLogger ide) "Shake session initialized"
725+
logWith recorder Debug LogSessionInitialised
711726

712727
shakeShut :: IdeState -> IO ()
713728
shakeShut IdeState{..} = do
@@ -775,7 +790,7 @@ shakeRestart recorder IdeState{..} vfs reason acts =
775790
--
776791
-- Appropriate for user actions other than edits.
777792
shakeEnqueue :: ShakeExtras -> DelayedAction a -> IO (IO a)
778-
shakeEnqueue ShakeExtras{actionQueue, logger} act = do
793+
shakeEnqueue ShakeExtras{actionQueue, shakeRecorder} act = do
779794
(b, dai) <- instantiateDelayedAction act
780795
atomicallyNamed "actionQueue - push" $ pushQueue dai actionQueue
781796
let wait' barrier =
@@ -784,7 +799,7 @@ shakeEnqueue ShakeExtras{actionQueue, logger} act = do
784799
fail $ "internal bug: forever blocked on MVar for " <>
785800
actionName act)
786801
, Handler (\e@AsyncCancelled -> do
787-
logPriority logger Debug $ T.pack $ actionName act <> " was cancelled"
802+
logWith shakeRecorder Debug $ LogCancelledAction (T.pack $ actionName act)
788803

789804
atomicallyNamed "actionQueue - abort" $ abortQueue dai actionQueue
790805
throw e)
@@ -908,13 +923,12 @@ garbageCollectDirtyKeysOlderThan maxAge checkParents = otTracedGarbageCollection
908923
garbageCollectKeys :: String -> Int -> CheckParents -> [(Key, Int)] -> Action [Key]
909924
garbageCollectKeys label maxAge checkParents agedKeys = do
910925
start <- liftIO offsetTime
911-
ShakeExtras{state, dirtyKeys, lspEnv, logger, ideTesting} <- getShakeExtras
926+
ShakeExtras{state, dirtyKeys, lspEnv, shakeRecorder, ideTesting} <- getShakeExtras
912927
(n::Int, garbage) <- liftIO $
913928
foldM (removeDirtyKey dirtyKeys state) (0,[]) agedKeys
914929
t <- liftIO start
915930
when (n>0) $ liftIO $ do
916-
logDebug logger $ T.pack $
917-
label <> " of " <> show n <> " keys (took " <> showDuration t <> ")"
931+
logWith shakeRecorder Debug $ LogShakeGarbageCollection (T.pack label) n t
918932
when (coerce ideTesting) $ liftIO $ mRunLspT lspEnv $
919933
LSP.sendNotification (SMethod_CustomMethod (Proxy @"ghcide/GC"))
920934
(toJSON $ mapMaybe (fmap showKey . fromKeyType) garbage)
@@ -1305,13 +1319,11 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
13051319
| otherwise = c
13061320

13071321

1308-
ideLogger :: IdeState -> Logger
1309-
ideLogger IdeState{shakeExtras=ShakeExtras{logger}} = logger
1322+
ideLogger :: IdeState -> Recorder (WithPriority Log)
1323+
ideLogger IdeState{shakeExtras=ShakeExtras{shakeRecorder}} = shakeRecorder
13101324

1311-
actionLogger :: Action Logger
1312-
actionLogger = do
1313-
ShakeExtras{logger} <- getShakeExtras
1314-
return logger
1325+
actionLogger :: Action (Recorder (WithPriority Log))
1326+
actionLogger = shakeRecorder <$> getShakeExtras
13151327

13161328
--------------------------------------------------------------------------------
13171329
type STMDiagnosticStore = STM.Map NormalizedUri StoreItem

‎ghcide/src/Development/IDE/Core/Tracing.hs

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ module Development.IDE.Core.Tracing
77
, otTracedGarbageCollection
88
, withTrace
99
, withEventTrace
10-
, withTelemetryLogger
10+
, withTelemetryRecorder
1111
)
1212
where
1313

@@ -26,7 +26,7 @@ import Development.IDE.Graph.Rule
2626
import Development.IDE.Types.Diagnostics (FileDiagnostic,
2727
showDiagnostics)
2828
import Development.IDE.Types.Location (Uri (..))
29-
import Ide.Logger (Logger (Logger))
29+
import Ide.Logger
3030
import Ide.Types (PluginId (..))
3131
import Language.LSP.Protocol.Types (NormalizedFilePath,
3232
fromNormalizedFilePath)
@@ -51,16 +51,20 @@ withEventTrace name act
5151
| otherwise = act (\_ -> pure ())
5252

5353
-- | Returns a logger that produces telemetry events in a single span
54-
withTelemetryLogger :: (MonadIO m, MonadMask m) => (Logger -> m a) -> m a
55-
withTelemetryLogger k = withSpan "Logger" $ \sp ->
54+
withTelemetryRecorder :: (MonadIO m, MonadMask m) => (Recorder (WithPriority (Doc a)) -> m c) -> m c
55+
withTelemetryRecorder k = withSpan "Logger" $ \sp ->
5656
-- Tracy doesn't like when we create a new span for every log line.
5757
-- To workaround that, we create a single span for all log events.
5858
-- This is fine since we don't care about the span itself, only about the events
59-
k $ Logger $ \p m ->
60-
addEvent sp (fromString $ show p) (encodeUtf8 $ trim m)
61-
where
62-
-- eventlog message size is limited by EVENT_PAYLOAD_SIZE_MAX = STG_WORD16_MAX
63-
trim = T.take (fromIntegral(maxBound :: Word16) - 10)
59+
k $ telemetryLogRecorder sp
60+
61+
-- | Returns a logger that produces telemetry events in a single span.
62+
telemetryLogRecorder :: SpanInFlight -> Recorder (WithPriority (Doc a))
63+
telemetryLogRecorder sp = Recorder $ \WithPriority {..} ->
64+
liftIO $ addEvent sp (fromString $ show priority) (encodeUtf8 $ trim $ renderStrict $ layoutCompact $ payload)
65+
where
66+
-- eventlog message size is limited by EVENT_PAYLOAD_SIZE_MAX = STG_WORD16_MAX
67+
trim = T.take (fromIntegral(maxBound :: Word16) - 10)
6468

6569
-- | Trace a handler using OpenTelemetry. Adds various useful info into tags in the OpenTelemetry span.
6670
otTracedHandler

0 commit comments

Comments
 (0)