barebones conversion to contravariant logging, doesnt work yet

Author: eddiemundo

exe/Main.hs

@@ -6,29 +6,51 @@
 module Main(main) where
 
 import           Control.Exception            (SomeException, catch, throwIO)
-import           Development.IDE.Types.Logger (logException,
-                                               withLogMessageRecorder)
+import           Data.Function                ((&))
+import           Data.Text                    (Text)
+import           Development.IDE.Core.Tracing (withTelemetryLogger)
+import           Development.IDE.Types.Logger (Priority (Debug, Info),
+                                               WithPriority (WithPriority, priority),
+                                               cfilter, cmap, logWith,
+                                               withDefaultTextWithPriorityRecorder)
 import           Ide.Arguments                (Arguments (..),
                                                GhcideArguments (..),
                                                getArguments)
 import           Ide.Main                     (defaultMain)
-import           Plugins
+import qualified Ide.Main                     as IdeMain
+import qualified Plugins
 
+data Log
+  = LogIdeMain IdeMain.Log
+  | LogException SomeException
+  | LogPlugins Plugins.Log
+  deriving Show
+
+-- logToText :: Log -> Text
+-- logToText = Text.pack . show
+
+logToTextWithPriority :: Log -> WithPriority Text
+logToTextWithPriority = undefined
 main :: IO ()
 main = do
 
-    args <- getArguments "haskell-language-server" (idePlugins False)
+    args <- getArguments "haskell-language-server" (Plugins.idePlugins undefined False)
 
-    let logFilePath = case args of
-          Ghcide GhcideArguments{ argsLogFile } -> argsLogFile
-          _                                     -> Nothing
+    let (isDebugOn, logFilePath) = case args of
+          Ghcide GhcideArguments{ argsDebugOn, argsLogFile } -> (argsDebugOn, argsLogFile)
+          _                                                  -> (False, Nothing)
 
     let withExamples =
             case args of
                 Ghcide GhcideArguments{..} -> argsExamplePlugin
                 _                          -> False
 
-    withLogMessageRecorder logFilePath $ \recorder ->
-      catch
-        (defaultMain recorder args (idePlugins withExamples))
-        (\e -> logException recorder (e :: SomeException) *> throwIO e)
+    let minPriority = if isDebugOn then Debug else Info
+    withDefaultTextWithPriorityRecorder logFilePath $ \textWithPriorityRecorder -> do
+      withTelemetryLogger $ \textWithPriorityTelemetryRecorder -> do
+        let recorder = (textWithPriorityRecorder <> textWithPriorityTelemetryRecorder)
+                     & cfilter (\WithPriority{ priority } -> priority >= minPriority)
+                     & cmap logToTextWithPriority
+        catch
+          (defaultMain (cmap LogIdeMain recorder) args (Plugins.idePlugins (cmap LogPlugins recorder) withExamples))
+          (\e -> logWith recorder (LogException e) *> throwIO e)

exe/Plugins.hs

@@ -7,9 +7,10 @@ import           Ide.Types                         (IdePlugins)
 
 -- fixed plugins
 import           Development.IDE                   (IdeState)
-import           Development.IDE.Plugin.HLS.GhcIde as GhcIde
-import           Ide.Plugin.Example                as Example
-import           Ide.Plugin.Example2               as Example2
+import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
+import qualified Ide.Plugin.Example                as Example
+import qualified Ide.Plugin.Example2               as Example2
+
 
 -- haskell-language-server optional plugins
 #if qualifyImportedNames
@@ -29,7 +30,7 @@ import           Ide.Plugin.HaddockComments        as HaddockComments
 #endif
 
 #if eval
-import           Ide.Plugin.Eval                   as Eval
+import qualified Ide.Plugin.Eval                   as Eval
 #endif
 
 #if importLens
@@ -45,7 +46,7 @@ import           Ide.Plugin.Rename                 as Rename
 #endif
 
 #if retrie
-import           Ide.Plugin.Retrie                 as Retrie
+import qualified Ide.Plugin.Retrie                 as Retrie
 #endif
 
 #if tactic
@@ -69,7 +70,7 @@ import           Ide.Plugin.Splice                 as Splice
 #endif
 
 #if alternateNumberFormat
-import           Ide.Plugin.AlternateNumberFormat  as AlternateNumberFormat
+import qualified Ide.Plugin.AlternateNumberFormat  as AlternateNumberFormat
 #endif
 
 -- formatters
@@ -87,22 +88,33 @@ import           Ide.Plugin.Ormolu                 as Ormolu
 #endif
 
 #if stylishHaskell
-import           Ide.Plugin.StylishHaskell         as StylishHaskell
+import qualified Ide.Plugin.StylishHaskell         as StylishHaskell
 #endif
 
 #if brittany
+import           Development.IDE.Types.Logger      (Recorder, cmap)
 import           Ide.Plugin.Brittany               as Brittany
 #endif
 
+data Log
+  = LogExample Example.Log
+  | LogExample2 Example2.Log
+  | LogAlternateNumberFormat AlternateNumberFormat.Log
+  | LogStylishHaskell StylishHaskell.Log
+  | LogRetrie Retrie.Log
+  | LogEval Eval.Log
+  | LogGhcide GhcIde.Log
+  deriving Show
+
 -- ---------------------------------------------------------------------
 
 -- | The plugins configured for use in this instance of the language
 -- server.
 -- These can be freely added or removed to tailor the available
 -- features of the server.
 
-idePlugins :: Bool -> IdePlugins IdeState
-idePlugins includeExamples = pluginDescToIdePlugins allPlugins
+idePlugins :: Recorder Log -> Bool -> IdePlugins IdeState
+idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
   where
     allPlugins = if includeExamples
                    then basePlugins ++ examplePlugins
@@ -124,13 +136,13 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
       Ormolu.descriptor   "ormolu" :
 #endif
 #if stylishHaskell
-      StylishHaskell.descriptor "stylish-haskell" :
+      StylishHaskell.descriptor (cmap LogStylishHaskell recorder) "stylish-haskell" :
 #endif
 #if rename
       Rename.descriptor "rename" :
 #endif
 #if retrie
-      Retrie.descriptor "retrie" :
+      Retrie.descriptor (cmap LogRetrie recorder) "retrie" :
 #endif
 #if brittany
       Brittany.descriptor "brittany" :
@@ -145,7 +157,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
       HaddockComments.descriptor "haddockComments" :
 #endif
 #if eval
-      Eval.descriptor "eval" :
+      Eval.descriptor (cmap LogEval recorder) "eval" :
 #endif
 #if importLens
       ExplicitImports.descriptor "importLens" :
@@ -166,12 +178,12 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
       Splice.descriptor "splice" :
 #endif
 #if alternateNumberFormat
-      AlternateNumberFormat.descriptor "alternateNumberFormat" :
+      AlternateNumberFormat.descriptor (cmap LogAlternateNumberFormat recorder) "alternateNumberFormat" :
 #endif
     -- The ghcide descriptors should come last so that the notification handlers
     -- (which restart the Shake build) run after everything else
-      GhcIde.descriptors
+      GhcIde.descriptors (cmap LogGhcide recorder)
     examplePlugins =
-      [Example.descriptor  "eg"
-      ,Example2.descriptor "eg2"
+      [Example.descriptor (cmap LogExample recorder) "eg"
+      ,Example2.descriptor (cmap LogExample2 recorder) "eg2"
       ]

exe/Wrapper.hs

@@ -56,7 +56,7 @@ data Log
   -- hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ initialFp ++ "\""
   | LogHieYamlNotFound
   -- hPutStrLn stderr "No 'hie.yaml' found. Try to discover the project type!"
-  | LogHieBios !String
+  | LogSession !Session.Log
   deriving Show
 
 data LogGhcVersionMessage
@@ -203,4 +203,4 @@ findProjectCradle recorder = do
     Just yaml -> logWith recorder $ LogHieYamlFound initialFp yaml
     Nothing   -> logWith recorder LogHieYamlNotFound
 
-  Session.loadCradle def (cmap LogHieBios recorder) hieYaml d
+  Session.loadCradle def (cmap LogSession recorder) hieYaml d