Skip to content

Commit 46cd8b4

Browse files
eddiemundoeddiemundo
committed
barebones conversion to contravariant logging, doesnt work yet
1 parent b2fc5ab commit 46cd8b4

File tree

31 files changed

+988
-507
lines changed

31 files changed

+988
-507
lines changed

‎exe/Main.hs

Lines changed: 33 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -6,29 +6,51 @@
66
module Main(main) where
77

88
import Control.Exception (SomeException, catch, throwIO)
9-
import Development.IDE.Types.Logger (logException,
10-
withLogMessageRecorder)
9+
import Data.Function ((&))
10+
import Data.Text (Text)
11+
import Development.IDE.Core.Tracing (withTelemetryLogger)
12+
import Development.IDE.Types.Logger (Priority (Debug, Info),
13+
WithPriority (WithPriority, priority),
14+
cfilter, cmap, logWith,
15+
withDefaultTextWithPriorityRecorder)
1116
import Ide.Arguments (Arguments (..),
1217
GhcideArguments (..),
1318
getArguments)
1419
import Ide.Main (defaultMain)
15-
import Plugins
20+
import qualified Ide.Main as IdeMain
21+
import qualified Plugins
1622

23+
data Log
24+
= LogIdeMain IdeMain.Log
25+
| LogException SomeException
26+
| LogPlugins Plugins.Log
27+
deriving Show
28+
29+
-- logToText :: Log -> Text
30+
-- logToText = Text.pack . show
31+
32+
logToTextWithPriority :: Log -> WithPriority Text
33+
logToTextWithPriority = undefined
1734
main :: IO ()
1835
main = do
1936

20-
args <- getArguments "haskell-language-server" (idePlugins False)
37+
args <- getArguments "haskell-language-server" (Plugins.idePlugins undefined False)
2138

22-
let logFilePath = case args of
23-
Ghcide GhcideArguments{ argsLogFile } -> argsLogFile
24-
_ -> Nothing
39+
let (isDebugOn, logFilePath) = case args of
40+
Ghcide GhcideArguments{ argsDebugOn, argsLogFile } -> (argsDebugOn, argsLogFile)
41+
_ -> (False, Nothing)
2542

2643
let withExamples =
2744
case args of
2845
Ghcide GhcideArguments{..} -> argsExamplePlugin
2946
_ -> False
3047

31-
withLogMessageRecorder logFilePath $ \recorder ->
32-
catch
33-
(defaultMain recorder args (idePlugins withExamples))
34-
(\e -> logException recorder (e :: SomeException) *> throwIO e)
48+
let minPriority = if isDebugOn then Debug else Info
49+
withDefaultTextWithPriorityRecorder logFilePath $ \textWithPriorityRecorder -> do
50+
withTelemetryLogger $ \textWithPriorityTelemetryRecorder -> do
51+
let recorder = (textWithPriorityRecorder <> textWithPriorityTelemetryRecorder)
52+
& cfilter (\WithPriority{ priority } -> priority >= minPriority)
53+
& cmap logToTextWithPriority
54+
catch
55+
(defaultMain (cmap LogIdeMain recorder) args (Plugins.idePlugins (cmap LogPlugins recorder) withExamples))
56+
(\e -> logWith recorder (LogException e) *> throwIO e)

‎exe/Plugins.hs

Lines changed: 28 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -7,9 +7,10 @@ import Ide.Types (IdePlugins)
77

88
-- fixed plugins
99
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
10+
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
11+
import qualified Ide.Plugin.Example as Example
12+
import qualified Ide.Plugin.Example2 as Example2
13+
1314

1415
-- haskell-language-server optional plugins
1516
#if qualifyImportedNames
@@ -29,7 +30,7 @@ import Ide.Plugin.HaddockComments as HaddockComments
2930
#endif
3031

3132
#if eval
32-
import Ide.Plugin.Eval as Eval
33+
import qualified Ide.Plugin.Eval as Eval
3334
#endif
3435

3536
#if importLens
@@ -45,7 +46,7 @@ import Ide.Plugin.Rename as Rename
4546
#endif
4647

4748
#if retrie
48-
import Ide.Plugin.Retrie as Retrie
49+
import qualified Ide.Plugin.Retrie as Retrie
4950
#endif
5051

5152
#if tactic
@@ -69,7 +70,7 @@ import Ide.Plugin.Splice as Splice
6970
#endif
7071

7172
#if alternateNumberFormat
72-
import Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat
73+
import qualified Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat
7374
#endif
7475

7576
-- formatters
@@ -87,22 +88,33 @@ import Ide.Plugin.Ormolu as Ormolu
8788
#endif
8889

8990
#if stylishHaskell
90-
import Ide.Plugin.StylishHaskell as StylishHaskell
91+
import qualified Ide.Plugin.StylishHaskell as StylishHaskell
9192
#endif
9293

9394
#if brittany
95+
import Development.IDE.Types.Logger (Recorder, cmap)
9496
import Ide.Plugin.Brittany as Brittany
9597
#endif
9698

99+
data Log
100+
= LogExample Example.Log
101+
| LogExample2 Example2.Log
102+
| LogAlternateNumberFormat AlternateNumberFormat.Log
103+
| LogStylishHaskell StylishHaskell.Log
104+
| LogRetrie Retrie.Log
105+
| LogEval Eval.Log
106+
| LogGhcide GhcIde.Log
107+
deriving Show
108+
97109
-- ---------------------------------------------------------------------
98110

99111
-- | The plugins configured for use in this instance of the language
100112
-- server.
101113
-- These can be freely added or removed to tailor the available
102114
-- features of the server.
103115

104-
idePlugins :: Bool -> IdePlugins IdeState
105-
idePlugins includeExamples = pluginDescToIdePlugins allPlugins
116+
idePlugins :: Recorder Log -> Bool -> IdePlugins IdeState
117+
idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
106118
where
107119
allPlugins = if includeExamples
108120
then basePlugins ++ examplePlugins
@@ -124,13 +136,13 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
124136
Ormolu.descriptor "ormolu" :
125137
#endif
126138
#if stylishHaskell
127-
StylishHaskell.descriptor "stylish-haskell" :
139+
StylishHaskell.descriptor (cmap LogStylishHaskell recorder) "stylish-haskell" :
128140
#endif
129141
#if rename
130142
Rename.descriptor "rename" :
131143
#endif
132144
#if retrie
133-
Retrie.descriptor "retrie" :
145+
Retrie.descriptor (cmap LogRetrie recorder) "retrie" :
134146
#endif
135147
#if brittany
136148
Brittany.descriptor "brittany" :
@@ -145,7 +157,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
145157
HaddockComments.descriptor "haddockComments" :
146158
#endif
147159
#if eval
148-
Eval.descriptor "eval" :
160+
Eval.descriptor (cmap LogEval recorder) "eval" :
149161
#endif
150162
#if importLens
151163
ExplicitImports.descriptor "importLens" :
@@ -166,12 +178,12 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
166178
Splice.descriptor "splice" :
167179
#endif
168180
#if alternateNumberFormat
169-
AlternateNumberFormat.descriptor "alternateNumberFormat" :
181+
AlternateNumberFormat.descriptor (cmap LogAlternateNumberFormat recorder) "alternateNumberFormat" :
170182
#endif
171183
-- The ghcide descriptors should come last so that the notification handlers
172184
-- (which restart the Shake build) run after everything else
173-
GhcIde.descriptors
185+
GhcIde.descriptors (cmap LogGhcide recorder)
174186
examplePlugins =
175-
[Example.descriptor "eg"
176-
,Example2.descriptor "eg2"
187+
[Example.descriptor (cmap LogExample recorder) "eg"
188+
,Example2.descriptor (cmap LogExample2 recorder) "eg2"
177189
]

‎exe/Wrapper.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ data Log
5656
-- hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ initialFp ++ "\""
5757
| LogHieYamlNotFound
5858
-- hPutStrLn stderr "No 'hie.yaml' found. Try to discover the project type!"
59-
| LogHieBios !String
59+
| LogSession !Session.Log
6060
deriving Show
6161

6262
data LogGhcVersionMessage
@@ -203,4 +203,4 @@ findProjectCradle recorder = do
203203
Just yaml -> logWith recorder $ LogHieYamlFound initialFp yaml
204204
Nothing -> logWith recorder LogHieYamlNotFound
205205

206-
Session.loadCradle def (cmap LogHieBios recorder) hieYaml d
206+
Session.loadCradle def (cmap LogSession recorder) hieYaml d

0 commit comments

Comments
 (0)