Skip to content

Commit 3b687a5

Browse files
eddiemundoeddiemundo
authored
Improve logging (#2558)
* convert to contravariant logging style part 1, uses additional hardcoded log file to see it side by side with original logging * convert Session to contravariant logging style * convert Plugin/HLS and FireStore to contravariant logging style * convert Rules (and most of the universe) to contravariant logging style * fix tests, allow old style logging and contravariant logging to write to same log file * fix import inside wrong CPP * add CPP for LogTactic constructor * remove redundant import * fix ghcide tests * remove unused import * fix plugin tests * LSP_TEST_STDERR should apply to contra logger as well * fix tactic plugin test * use CPP for Log datatype plugin constructors, remove unused imports * add a few Pretty instances, add prettyprinter to haskell-language-sever and hls-plugin-api dependencies * add Pretty Log instances for Session, FileStore, Notifications * add remaining Pretty Log instances * add logToPriorities * fix slight interleaving issue with hslogger and logger both logging, have default logger be mutex stderr or file handle, use stderr if failing to open log file * forgot to add .cabal files with hslogger dep * dont use UnliftIO file IO helpers because they are too new * remove log helper comments, use Doc instead of Text as final console/file logger input, renaming, export Log constructors * remove accidentally added useless file, removed prettyprinter dep from hls-plugin-api because stack ghc8.6.5 doesnt have it? * use deprecated prettyprint modules import for the sake of circleci ghc-8.6.5 * use dummy stderr logger for plugin cli commands, use priorityToHsLoggerPriority function instead of manual mapping * remove old plugin detritus that somehow got committed * fix prettyprinter imports for 8.6.5 * try enforcing prettyprinter bounds? * enforcing bound makes no sense * maybe changing stack yamls does trick * filter out warnings when their diags are empty to more closely match original * add ability to select wanted logging columns, match prev ghcide exe logging behaviour * dont log anything when diags are empty in some defineEarlyCutoff versions * use non-deprecated prettyprinter imports * fix ghcide test module * change logWith to accept priority at call site, remove all logToPriority functions, add cmapWithPrio that contramaps through WithPriority * remove useless hiding import list, add comments to default recorder makers * make cradleToOptsAndLibDir take concrete cradle to remove existential type var in Log constructor * Types.Logger now re-exports prettyprinter, remove unused dependencies on prettyprinter and hslogger * existential type var to remove boilerplate in Plugins.hs, remove a few Show instances * add SourceLoc logging column, inline logToDoc functions, add comment explaining hslogger setup existence * qualify a name to match original source * fix -WError
1 parent 847ad94 commit 3b687a5

File tree

46 files changed

+1572
-645
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

46 files changed

+1572
-645
lines changed

‎exe/Main.hs

+40-11
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,50 @@
11
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22
-- SPDX-License-Identifier: Apache-2.0
3+
{-# LANGUAGE NamedFieldPuns #-}
34
{-# LANGUAGE OverloadedStrings #-}
4-
{-# LANGUAGE RecordWildCards #-}
55
module Main(main) where
66

7-
import Ide.Arguments (Arguments (..), GhcideArguments (..),
8-
getArguments)
9-
import Ide.Main (defaultMain)
10-
import Plugins
7+
import Data.Function ((&))
8+
import Development.IDE.Types.Logger (Priority (Debug, Info),
9+
WithPriority (WithPriority, priority),
10+
cfilter, cmapWithPrio,
11+
makeDefaultStderrRecorder,
12+
withDefaultRecorder)
13+
import Ide.Arguments (Arguments (..),
14+
GhcideArguments (..),
15+
getArguments)
16+
import Ide.Main (defaultMain)
17+
import qualified Ide.Main as IdeMain
18+
import qualified Plugins
19+
import Prettyprinter (Pretty (pretty))
20+
21+
data Log
22+
= LogIdeMain IdeMain.Log
23+
| LogPlugins Plugins.Log
24+
25+
instance Pretty Log where
26+
pretty log = case log of
27+
LogIdeMain ideMainLog -> pretty ideMainLog
28+
LogPlugins pluginsLog -> pretty pluginsLog
1129

1230
main :: IO ()
1331
main = do
14-
args <- getArguments "haskell-language-server" (idePlugins False)
32+
-- plugin cli commands use stderr logger for now unless we change the args
33+
-- parser to get logging arguments first or do more complicated things
34+
pluginCliRecorder <- cmapWithPrio pretty <$> makeDefaultStderrRecorder Nothing Info
35+
args <- getArguments "haskell-language-server" (Plugins.idePlugins (cmapWithPrio LogPlugins pluginCliRecorder) False)
36+
37+
let (minPriority, logFilePath, includeExamplePlugins) =
38+
case args of
39+
Ghcide GhcideArguments{ argsTesting, argsDebugOn, argsLogFile, argsExamplePlugin } ->
40+
let minPriority = if argsDebugOn || argsTesting then Debug else Info
41+
in (minPriority, argsLogFile, argsExamplePlugin)
42+
_ -> (Info, Nothing, False)
1543

16-
let withExamples =
17-
case args of
18-
Ghcide GhcideArguments{..} -> argsExamplePlugin
19-
_ -> False
44+
withDefaultRecorder logFilePath Nothing minPriority $ \textWithPriorityRecorder -> do
45+
let recorder =
46+
textWithPriorityRecorder
47+
& cfilter (\WithPriority{ priority } -> priority >= minPriority)
48+
& cmapWithPrio pretty
2049

21-
defaultMain args (idePlugins withExamples)
50+
defaultMain (cmapWithPrio LogIdeMain recorder) args (Plugins.idePlugins (cmapWithPrio LogPlugins recorder) includeExamplePlugins)

‎exe/Plugins.hs

+46-36
Original file line numberDiff line numberDiff line change
@@ -1,75 +1,78 @@
1-
{-# LANGUAGE CPP #-}
2-
{-# LANGUAGE OverloadedStrings #-}
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE ExistentialQuantification #-}
3+
{-# LANGUAGE OverloadedStrings #-}
34
module Plugins where
45

6+
import Development.IDE.Types.Logger (Pretty (pretty), Recorder,
7+
WithPriority, cmapWithPrio)
58
import Ide.PluginUtils (pluginDescToIdePlugins)
69
import Ide.Types (IdePlugins)
710

811
-- fixed plugins
912
import Development.IDE (IdeState)
10-
import Development.IDE.Plugin.HLS.GhcIde as GhcIde
11-
import Ide.Plugin.Example as Example
12-
import Ide.Plugin.Example2 as Example2
13+
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
14+
import qualified Ide.Plugin.Example as Example
15+
import qualified Ide.Plugin.Example2 as Example2
1316

1417
-- haskell-language-server optional plugins
1518
#if qualifyImportedNames
16-
import Ide.Plugin.QualifyImportedNames as QualifyImportedNames
19+
import qualified Ide.Plugin.QualifyImportedNames as QualifyImportedNames
1720
#endif
1821

1922
#if callHierarchy
20-
import Ide.Plugin.CallHierarchy as CallHierarchy
23+
import qualified Ide.Plugin.CallHierarchy as CallHierarchy
2124
#endif
2225

2326
#if class
24-
import Ide.Plugin.Class as Class
27+
import qualified Ide.Plugin.Class as Class
2528
#endif
2629

2730
#if haddockComments
28-
import Ide.Plugin.HaddockComments as HaddockComments
31+
import qualified Ide.Plugin.HaddockComments as HaddockComments
2932
#endif
3033

3134
#if eval
32-
import Ide.Plugin.Eval as Eval
35+
import qualified Ide.Plugin.Eval as Eval
3336
#endif
3437

3538
#if importLens
36-
import Ide.Plugin.ExplicitImports as ExplicitImports
39+
import qualified Ide.Plugin.ExplicitImports as ExplicitImports
3740
#endif
3841

3942
#if refineImports
40-
import Ide.Plugin.RefineImports as RefineImports
43+
import qualified Ide.Plugin.RefineImports as RefineImports
4144
#endif
4245

4346
#if rename
44-
import Ide.Plugin.Rename as Rename
47+
import qualified Ide.Plugin.Rename as Rename
4548
#endif
4649

4750
#if retrie
48-
import Ide.Plugin.Retrie as Retrie
51+
import qualified Ide.Plugin.Retrie as Retrie
4952
#endif
5053

5154
#if tactic
52-
import Ide.Plugin.Tactic as Tactic
55+
import qualified Ide.Plugin.Tactic as Tactic
5356
#endif
5457

5558
#if hlint
56-
import Ide.Plugin.Hlint as Hlint
59+
import qualified Ide.Plugin.Hlint as Hlint
5760
#endif
5861

5962
#if moduleName
60-
import Ide.Plugin.ModuleName as ModuleName
63+
import qualified Ide.Plugin.ModuleName as ModuleName
6164
#endif
6265

6366
#if pragmas
64-
import Ide.Plugin.Pragmas as Pragmas
67+
import qualified Ide.Plugin.Pragmas as Pragmas
6568
#endif
6669

6770
#if splice
68-
import Ide.Plugin.Splice as Splice
71+
import qualified Ide.Plugin.Splice as Splice
6972
#endif
7073

7174
#if alternateNumberFormat
72-
import Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat
75+
import qualified Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat
7376
#endif
7477

7578
#if selectionRange
@@ -79,35 +82,42 @@ import Ide.Plugin.SelectionRange as SelectionRange
7982
-- formatters
8083

8184
#if floskell
82-
import Ide.Plugin.Floskell as Floskell
85+
import qualified Ide.Plugin.Floskell as Floskell
8386
#endif
8487

8588
#if fourmolu
86-
import Ide.Plugin.Fourmolu as Fourmolu
89+
import qualified Ide.Plugin.Fourmolu as Fourmolu
8790
#endif
8891

8992
#if ormolu
90-
import Ide.Plugin.Ormolu as Ormolu
93+
import qualified Ide.Plugin.Ormolu as Ormolu
9194
#endif
9295

9396
#if stylishHaskell
94-
import Ide.Plugin.StylishHaskell as StylishHaskell
97+
import qualified Ide.Plugin.StylishHaskell as StylishHaskell
9598
#endif
9699

97100
#if brittany
98-
import Ide.Plugin.Brittany as Brittany
101+
import qualified Ide.Plugin.Brittany as Brittany
99102
#endif
100103

104+
data Log = forall a. (Pretty a) => Log a
105+
106+
instance Pretty Log where
107+
pretty (Log a) = pretty a
108+
101109
-- ---------------------------------------------------------------------
102110

103111
-- | The plugins configured for use in this instance of the language
104112
-- server.
105113
-- These can be freely added or removed to tailor the available
106114
-- features of the server.
107115

108-
idePlugins :: Bool -> IdePlugins IdeState
109-
idePlugins includeExamples = pluginDescToIdePlugins allPlugins
116+
idePlugins :: Recorder (WithPriority Log) -> Bool -> IdePlugins IdeState
117+
idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
110118
where
119+
pluginRecorder :: forall log. (Pretty log) => Recorder (WithPriority log)
120+
pluginRecorder = cmapWithPrio Log recorder
111121
allPlugins = if includeExamples
112122
then basePlugins ++ examplePlugins
113123
else basePlugins
@@ -122,7 +132,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
122132
Fourmolu.descriptor "fourmolu" :
123133
#endif
124134
#if tactic
125-
Tactic.descriptor "tactics" :
135+
Tactic.descriptor pluginRecorder "tactics" :
126136
#endif
127137
#if ormolu
128138
Ormolu.descriptor "ormolu" :
@@ -149,36 +159,36 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
149159
HaddockComments.descriptor "haddockComments" :
150160
#endif
151161
#if eval
152-
Eval.descriptor "eval" :
162+
Eval.descriptor pluginRecorder "eval" :
153163
#endif
154164
#if importLens
155-
ExplicitImports.descriptor "importLens" :
165+
ExplicitImports.descriptor pluginRecorder "importLens" :
156166
#endif
157167
#if qualifyImportedNames
158168
QualifyImportedNames.descriptor "qualifyImportedNames" :
159169
#endif
160170
#if refineImports
161-
RefineImports.descriptor "refineImports" :
171+
RefineImports.descriptor pluginRecorder "refineImports" :
162172
#endif
163173
#if moduleName
164174
ModuleName.descriptor "moduleName" :
165175
#endif
166176
#if hlint
167-
Hlint.descriptor "hlint" :
177+
Hlint.descriptor pluginRecorder "hlint" :
168178
#endif
169179
#if splice
170180
Splice.descriptor "splice" :
171181
#endif
172182
#if alternateNumberFormat
173-
AlternateNumberFormat.descriptor "alternateNumberFormat" :
183+
AlternateNumberFormat.descriptor pluginRecorder "alternateNumberFormat" :
174184
#endif
175185
#if selectionRange
176186
SelectionRange.descriptor "selectionRange" :
177187
#endif
178188
-- The ghcide descriptors should come last so that the notification handlers
179189
-- (which restart the Shake build) run after everything else
180-
GhcIde.descriptors
190+
GhcIde.descriptors pluginRecorder
181191
examplePlugins =
182-
[Example.descriptor "eg"
183-
,Example2.descriptor "eg2"
192+
[Example.descriptor pluginRecorder "eg"
193+
,Example2.descriptor pluginRecorder "eg2"
184194
]

‎ghcide/exe/Main.hs

+58-15
Original file line numberDiff line numberDiff line change
@@ -9,17 +9,28 @@ import Arguments (Arguments (..),
99
getArguments)
1010
import Control.Monad.Extra (unless)
1111
import Data.Default (def)
12+
import Data.Function ((&))
1213
import Data.Version (showVersion)
1314
import Development.GitRev (gitHash)
14-
import Development.IDE (Priority (Debug, Info),
15-
action)
15+
import Development.IDE (action)
1616
import Development.IDE.Core.OfInterest (kick)
1717
import Development.IDE.Core.Rules (mainRule)
18+
import qualified Development.IDE.Core.Rules as Rules
1819
import Development.IDE.Core.Tracing (withTelemetryLogger)
1920
import Development.IDE.Graph (ShakeOptions (shakeThreads))
20-
import qualified Development.IDE.Main as Main
21+
import qualified Development.IDE.Main as IDEMain
2122
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
23+
import Development.IDE.Types.Logger (Logger (Logger),
24+
LoggingColumn (DataColumn, PriorityColumn),
25+
Pretty (pretty),
26+
Priority (Debug, Info),
27+
Recorder (Recorder),
28+
WithPriority (WithPriority, priority),
29+
cfilter, cmapWithPrio,
30+
makeDefaultStderrRecorder)
31+
import qualified Development.IDE.Types.Logger as Logger
2232
import Development.IDE.Types.Options
33+
import GHC.Stack (emptyCallStack)
2334
import Ide.Plugin.Config (Config (checkParents, checkProject))
2435
import Ide.PluginUtils (pluginDescToIdePlugins)
2536
import Paths_ghcide (version)
@@ -29,6 +40,17 @@ import System.Exit (exitSuccess)
2940
import System.IO (hPutStrLn, stderr)
3041
import System.Info (compilerVersion)
3142

43+
data Log
44+
= LogIDEMain IDEMain.Log
45+
| LogRules Rules.Log
46+
| LogGhcIde GhcIde.Log
47+
48+
instance Pretty Log where
49+
pretty = \case
50+
LogIDEMain log -> pretty log
51+
LogRules log -> pretty log
52+
LogGhcIde log -> pretty log
53+
3254
ghcideVersion :: IO String
3355
ghcideVersion = do
3456
path <- getExecutablePath
@@ -42,7 +64,12 @@ ghcideVersion = do
4264

4365
main :: IO ()
4466
main = withTelemetryLogger $ \telemetryLogger -> do
45-
let hlsPlugins = pluginDescToIdePlugins GhcIde.descriptors
67+
-- stderr recorder just for plugin cli commands
68+
pluginCliRecorder <-
69+
cmapWithPrio pretty
70+
<$> makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) Info
71+
72+
let hlsPlugins = pluginDescToIdePlugins (GhcIde.descriptors (cmapWithPrio LogGhcIde pluginCliRecorder))
4673
-- WARNING: If you write to stdout before runLanguageServer
4774
-- then the language server will not work
4875
Arguments{..} <- getArguments hlsPlugins
@@ -55,26 +82,42 @@ main = withTelemetryLogger $ \telemetryLogger -> do
5582
Nothing -> IO.getCurrentDirectory
5683
Just root -> IO.setCurrentDirectory root >> IO.getCurrentDirectory
5784

58-
let logPriority = if argsVerbose then Debug else Info
59-
arguments = if argsTesting then Main.testing else Main.defaultArguments logPriority
85+
let minPriority = if argsVerbose then Debug else Info
86+
87+
docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) minPriority
88+
89+
let docWithFilteredPriorityRecorder@Recorder{ logger_ } =
90+
docWithPriorityRecorder
91+
& cfilter (\WithPriority{ priority } -> priority >= minPriority)
92+
93+
-- exists so old-style logging works. intended to be phased out
94+
let logger = Logger $ \p m -> logger_ (WithPriority p emptyCallStack (pretty m))
95+
96+
let recorder = docWithFilteredPriorityRecorder
97+
& cmapWithPrio pretty
98+
99+
let arguments =
100+
if argsTesting
101+
then IDEMain.testing (cmapWithPrio LogIDEMain recorder) logger
102+
else IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) logger
60103

61-
Main.defaultMain arguments
62-
{ Main.argsProjectRoot = Just argsCwd
63-
, Main.argCommand = argsCommand
64-
,Main.argsLogger = Main.argsLogger arguments <> pure telemetryLogger
104+
IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) arguments
105+
{ IDEMain.argsProjectRoot = Just argsCwd
106+
, IDEMain.argCommand = argsCommand
107+
, IDEMain.argsLogger = IDEMain.argsLogger arguments <> pure telemetryLogger
65108

66-
,Main.argsRules = do
109+
, IDEMain.argsRules = do
67110
-- install the main and ghcide-plugin rules
68-
mainRule def
111+
mainRule (cmapWithPrio LogRules recorder) def
69112
-- install the kick action, which triggers a typecheck on every
70113
-- Shake database restart, i.e. on every user edit.
71114
unless argsDisableKick $
72115
action kick
73116

74-
,Main.argsThreads = case argsThreads of 0 -> Nothing ; i -> Just (fromIntegral i)
117+
, IDEMain.argsThreads = case argsThreads of 0 -> Nothing ; i -> Just (fromIntegral i)
75118

76-
,Main.argsIdeOptions = \config sessionLoader ->
77-
let defOptions = Main.argsIdeOptions arguments config sessionLoader
119+
, IDEMain.argsIdeOptions = \config sessionLoader ->
120+
let defOptions = IDEMain.argsIdeOptions arguments config sessionLoader
78121
in defOptions
79122
{ optShakeProfiling = argsShakeProfiling
80123
, optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling

0 commit comments

Comments
 (0)