Improve logging

exe/Main.hs

@@ -1,21 +1,56 @@
 -- Copyright (c) 2019 The DAML Authors. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
+{-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
 module Main(main) where
 
-import           Ide.Arguments (Arguments (..), GhcideArguments (..),
-                                getArguments)
-import           Ide.Main      (defaultMain)
-import           Plugins
+import           Data.Function                ((&))
+import           Development.IDE.Types.Logger (Priority (Debug, Info),
+                                               WithPriority (WithPriority, priority),
+                                               cfilter, cmapWithPrio,
+                                               makeDefaultStderrRecorder,
+                                               priorityToHsLoggerPriority,
+                                               withDefaultRecorder)
+import           Ide.Arguments                (Arguments (..),
+                                               GhcideArguments (..),
+                                               getArguments)
+import           Ide.Main                     (defaultMain)
+import qualified Ide.Main                     as IdeMain
+import qualified Plugins
+import           Prettyprinter                (Doc, Pretty (pretty))
+
+data Log
+  = LogIdeMain IdeMain.Log
+  | LogPlugins Plugins.Log
+  deriving Show
+
+instance Pretty Log where
+  pretty log = case log of
+    LogIdeMain ideMainLog -> pretty ideMainLog
+    LogPlugins pluginsLog -> pretty pluginsLog
+
+logToDoc :: Log -> Doc a
+logToDoc = pretty
 
 main :: IO ()
 main = do
-    args <- getArguments "haskell-language-server" (idePlugins False)
+    -- 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 logToDoc <$> makeDefaultStderrRecorder Nothing (priorityToHsLoggerPriority Info)
+    args <- getArguments "haskell-language-server" (Plugins.idePlugins (cmapWithPrio LogPlugins pluginCliRecorder) False)
+
+    let (minPriority, logFilePath, includeExamplePlugins) =
+          case args of
+            Ghcide GhcideArguments{ argsTesting, argsDebugOn, argsLogFile, argsExamplePlugin } ->
+              let minPriority = if argsDebugOn || argsTesting then Debug else Info
+              in (minPriority, argsLogFile, argsExamplePlugin)
+            _ -> (Info, Nothing, False)
+    let hsLoggerMinPriority = priorityToHsLoggerPriority minPriority
 
-    let withExamples =
-            case args of
-                Ghcide GhcideArguments{..} -> argsExamplePlugin
-                _                          -> False
+    withDefaultRecorder logFilePath Nothing hsLoggerMinPriority $ \textWithPriorityRecorder -> do
+      let recorder =
+            textWithPriorityRecorder
+            & cfilter (\WithPriority{ priority } -> priority >= minPriority)
+            & cmapWithPrio logToDoc
 
-    defaultMain args (idePlugins withExamples)
+      defaultMain (cmapWithPrio LogIdeMain recorder) args (Plugins.idePlugins (cmapWithPrio LogPlugins recorder) includeExamplePlugins)

exe/Plugins.hs

@@ -1,75 +1,79 @@
 {-# LANGUAGE CPP               #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Plugins where
 
+import           Development.IDE.Types.Logger      (Recorder, WithPriority,
+                                                    cmapWithPrio)
 import           Ide.PluginUtils                   (pluginDescToIdePlugins)
 import           Ide.Types                         (IdePlugins)
+import           Prettyprinter                     (Pretty (pretty))
 
 -- 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
-import           Ide.Plugin.QualifyImportedNames   as QualifyImportedNames
+import qualified Ide.Plugin.QualifyImportedNames   as QualifyImportedNames
 #endif
 
 #if callHierarchy
-import           Ide.Plugin.CallHierarchy          as CallHierarchy
+import qualified Ide.Plugin.CallHierarchy          as CallHierarchy
 #endif
 
 #if class
-import           Ide.Plugin.Class                  as Class
+import qualified Ide.Plugin.Class                  as Class
 #endif
 
 #if haddockComments
-import           Ide.Plugin.HaddockComments        as HaddockComments
+import qualified Ide.Plugin.HaddockComments        as HaddockComments
 #endif
 
 #if eval
-import           Ide.Plugin.Eval                   as Eval
+import qualified Ide.Plugin.Eval                   as Eval
 #endif
 
 #if importLens
-import           Ide.Plugin.ExplicitImports        as ExplicitImports
+import qualified Ide.Plugin.ExplicitImports        as ExplicitImports
 #endif
 
 #if refineImports
-import           Ide.Plugin.RefineImports          as RefineImports
+import qualified Ide.Plugin.RefineImports          as RefineImports
 #endif
 
 #if rename
-import           Ide.Plugin.Rename                 as Rename
+import qualified Ide.Plugin.Rename                 as Rename
 #endif
 
 #if retrie
-import           Ide.Plugin.Retrie                 as Retrie
+import qualified Ide.Plugin.Retrie                 as Retrie
 #endif
 
 #if tactic
-import           Ide.Plugin.Tactic                 as Tactic
+import qualified Ide.Plugin.Tactic                 as Tactic
 #endif
 
 #if hlint
-import           Ide.Plugin.Hlint                  as Hlint
+import qualified Ide.Plugin.Hlint                  as Hlint
 #endif
 
 #if moduleName
-import           Ide.Plugin.ModuleName             as ModuleName
+import qualified Ide.Plugin.ModuleName             as ModuleName
 #endif
 
 #if pragmas
-import           Ide.Plugin.Pragmas                as Pragmas
+import qualified Ide.Plugin.Pragmas                as Pragmas
 #endif
 
 #if splice
-import           Ide.Plugin.Splice                 as Splice
+import qualified Ide.Plugin.Splice                 as Splice
 #endif
 
 #if alternateNumberFormat
-import           Ide.Plugin.AlternateNumberFormat  as AlternateNumberFormat
+import qualified Ide.Plugin.AlternateNumberFormat  as AlternateNumberFormat
 #endif
 
 #if selectionRange
@@ -79,23 +83,71 @@ import           Ide.Plugin.SelectionRange         as SelectionRange
 -- formatters
 
 #if floskell
-import           Ide.Plugin.Floskell               as Floskell
+import qualified Ide.Plugin.Floskell               as Floskell
 #endif
 
 #if fourmolu
-import           Ide.Plugin.Fourmolu               as Fourmolu
+import qualified Ide.Plugin.Fourmolu               as Fourmolu
 #endif
 
 #if ormolu
-import           Ide.Plugin.Ormolu                 as Ormolu
+import qualified 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           Ide.Plugin.Brittany               as Brittany
+import qualified Ide.Plugin.Brittany               as Brittany
+#endif
+
+data Log
+  = LogGhcIde GhcIde.Log
+  | LogExample Example.Log
+  | LogExample2 Example2.Log
+#if tactic
+  | LogTactic Tactic.Log
+#endif
+#if eval
+  | LogEval Eval.Log
+#endif
+#if importLens
+  | LogExplicitImports ExplicitImports.Log
+#endif
+#if refineImports
+  | LogRefineImports RefineImports.Log
+#endif
+#if hlint
+  | LogHlint Hlint.Log
+#endif
+#if alternateNumberFormat
+  | LogAlternateNumberFormat AlternateNumberFormat.Log
+#endif
+  deriving Show
+
+instance Pretty Log where
+  pretty = \case
+    LogGhcIde log                -> pretty log
+    LogExample log               -> pretty log
+    LogExample2 log              -> pretty log
+#if tactic
+    LogTactic log                -> pretty log
+#endif
+#if eval
+    LogEval log                  -> pretty log
+#endif
+#if importLens
+    LogExplicitImports log       -> pretty log
+#endif
+#if refineImports
+    LogRefineImports log         -> pretty log
+#endif
+#if hlint
+    LogHlint log                 -> pretty log
+#endif
+#if alternateNumberFormat
+    LogAlternateNumberFormat log -> pretty log
 #endif
 
 -- ---------------------------------------------------------------------
@@ -105,8 +157,8 @@ import           Ide.Plugin.Brittany               as Brittany
 -- 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 (WithPriority Log) -> Bool -> IdePlugins IdeState
+idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
   where
     allPlugins = if includeExamples
                    then basePlugins ++ examplePlugins
@@ -122,7 +174,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
       Fourmolu.descriptor "fourmolu" :
 #endif
 #if tactic
-      Tactic.descriptor "tactics" :
+      Tactic.descriptor (cmapWithPrio LogTactic recorder) "tactics" :
 #endif
 #if ormolu
       Ormolu.descriptor   "ormolu" :
@@ -149,36 +201,36 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
       HaddockComments.descriptor "haddockComments" :
 #endif
 #if eval
-      Eval.descriptor "eval" :
+      Eval.descriptor (cmapWithPrio LogEval recorder) "eval" :
 #endif
 #if importLens
-      ExplicitImports.descriptor "importLens" :
+      ExplicitImports.descriptor (cmapWithPrio LogExplicitImports recorder) "importLens" :
 #endif
 #if qualifyImportedNames
       QualifyImportedNames.descriptor "qualifyImportedNames" :
 #endif
 #if refineImports
-      RefineImports.descriptor "refineImports" :
+      RefineImports.descriptor (cmapWithPrio LogRefineImports recorder) "refineImports" :
 #endif
 #if moduleName
       ModuleName.descriptor "moduleName" :
 #endif
 #if hlint
-      Hlint.descriptor "hlint" :
+      Hlint.descriptor (cmapWithPrio LogHlint recorder) "hlint" :
 #endif
 #if splice
       Splice.descriptor "splice" :
 #endif
 #if alternateNumberFormat
-      AlternateNumberFormat.descriptor "alternateNumberFormat" :
+      AlternateNumberFormat.descriptor (cmapWithPrio LogAlternateNumberFormat recorder) "alternateNumberFormat" :
 #endif
 #if selectionRange
       SelectionRange.descriptor "selectionRange" :
 #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 (cmapWithPrio LogGhcIde recorder)
     examplePlugins =
-      [Example.descriptor  "eg"
-      ,Example2.descriptor "eg2"
+      [Example.descriptor  (cmapWithPrio LogExample recorder) "eg"
+      ,Example2.descriptor (cmapWithPrio LogExample2 recorder) "eg2"
       ]