Add diff option for eval plugin

Author: Ailrun

plugins/hls-eval-plugin/hls-eval-plugin.cabal

@@ -45,6 +45,7 @@ library
   other-modules:
     Ide.Plugin.Eval.Code
     Ide.Plugin.Eval.CodeLens
+    Ide.Plugin.Eval.Config
     Ide.Plugin.Eval.GHC
     Ide.Plugin.Eval.Parse.Comments
     Ide.Plugin.Eval.Parse.Option

plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs

@@ -11,17 +11,23 @@ module Ide.Plugin.Eval (
 
 import           Development.IDE          (IdeState)
 import qualified Ide.Plugin.Eval.CodeLens as CL
+import           Ide.Plugin.Eval.Config
 import           Ide.Plugin.Eval.Rules    (rules)
-import           Ide.Types                (PluginDescriptor (..), PluginId,
+import           Ide.Types                (ConfigDescriptor (..),
+                                           PluginDescriptor (..), PluginId,
+                                           defaultConfigDescriptor,
                                            defaultPluginDescriptor,
-                                           mkPluginHandler)
+                                           mkCustomConfig, mkPluginHandler)
 import           Language.LSP.Types
 
 -- |Plugin descriptor
 descriptor :: PluginId -> PluginDescriptor IdeState
 descriptor plId =
     (defaultPluginDescriptor plId)
         { pluginHandlers = mkPluginHandler STextDocumentCodeLens CL.codeLens
-        , pluginCommands = [CL.evalCommand]
+        , pluginCommands = [CL.evalCommand plId]
         , pluginRules = rules
+        , pluginConfigDescriptor = defaultConfigDescriptor
+                                   { configCustomConfig = mkCustomConfig properties
+                                   }
         }

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE ViewPatterns        #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns      #-}
 {-# OPTIONS_GHC -Wwarn -fno-warn-orphans #-}
 
 -- | Expression execution
@@ -59,9 +59,9 @@ showDiff (First w)  = "WAS " <> w
 showDiff (Second w) = "NOW " <> w
 showDiff (Both w _) = w
 
-testCheck :: (Section, Test) -> [T.Text] -> [T.Text]
-testCheck (section, test) out
-    | null (testOutput test) || sectionLanguage section == Plain = out
+testCheck :: Bool -> (Section, Test) -> [T.Text] -> [T.Text]
+testCheck diff (section, test) out
+    | not diff || null (testOutput test) || sectionLanguage section == Plain = out
     | otherwise = showDiffs $ getDiff (map T.pack $ testOutput test) out
 
 testLengths :: Test -> (Int, Int)

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

@@ -30,6 +30,7 @@ import qualified Control.Exception               as E
 import           Control.Lens                    (_1, _3, (%~), (<&>), (^.))
 import           Control.Monad                   (guard, join, void, when)
 import           Control.Monad.IO.Class          (MonadIO (liftIO))
+import           Control.Monad.Trans             (lift)
 import           Control.Monad.Trans.Except      (ExceptT (..))
 import           Data.Aeson                      (toJSON)
 import           Data.Char                       (isSpace)
@@ -108,6 +109,8 @@ import           GHC.Driver.Session              (unitDatabases, unitState)
 import           GHC.Types.SrcLoc                (UnhelpfulSpanReason (UnhelpfulInteractive))
 #else
 import           DynFlags
+import           Ide.Plugin.Config               (Config)
+import           Ide.Plugin.Eval.Config          (getDiffProperty)
 #endif
 
 
@@ -176,16 +179,16 @@ codeLens st plId CodeLensParams{_textDocument} =
 evalCommandName :: CommandId
 evalCommandName = "evalCommand"
 
-evalCommand :: PluginCommand IdeState
-evalCommand = PluginCommand evalCommandName "evaluate" runEvalCmd
+evalCommand :: PluginId -> PluginCommand IdeState
+evalCommand plId = PluginCommand evalCommandName "evaluate" (runEvalCmd plId)
 
 type EvalId = Int
 
-runEvalCmd :: CommandFunction IdeState EvalParams
-runEvalCmd st EvalParams{..} =
+runEvalCmd :: PluginId -> CommandFunction IdeState EvalParams
+runEvalCmd plId st EvalParams{..} =
     let dbg = logWith st
         perf = timed dbg
-        cmd :: ExceptT String (LspM c) WorkspaceEdit
+        cmd :: ExceptT String (LspM Config) WorkspaceEdit
         cmd = do
             let tests = map (\(a,_,b) -> (a,b)) $ testsBySection sections
 
@@ -300,12 +303,13 @@ runEvalCmd st EvalParams{..} =
                         -- Evaluation takes place 'inside' the module
                         setContext [Compat.IIModule modName]
                         Right <$> getSession
-
+            diff <- lift $ getDiffProperty plId
             edits <-
                 perf "edits" $
                     liftIO $
                         evalGhcEnv hscEnv' $
                             runTests
+                                diff
                                 (st, fp)
                                 tests
 
@@ -347,8 +351,8 @@ testsBySection sections =
 
 type TEnv = (IdeState, String)
 
-runTests :: TEnv -> [(Section, Test)] -> Ghc [TextEdit]
-runTests e@(_st, _) tests = do
+runTests :: Bool -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]
+runTests diff e@(_st, _) tests = do
     df <- getInteractiveDynFlags
     evalSetup
     when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals e df propSetup
@@ -363,7 +367,7 @@ runTests e@(_st, _) tests = do
         rs <- runTest e df test
         dbg "TEST RESULTS" rs
 
-        let checkedResult = testCheck (section, test) rs
+        let checkedResult = testCheck diff (section, test) rs
 
         let edit = asEdit (sectionFormat section) test (map pad checkedResult)
         dbg "TEST EDIT" edit

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Config.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedLabels  #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Ide.Plugin.Eval.Config
+  ( properties
+  , getDiffProperty
+  ) where
+
+import           Ide.Plugin.Config     (Config)
+import           Ide.Plugin.Properties
+import           Ide.PluginUtils       (usePropertyLsp)
+import           Ide.Types             (PluginId)
+import           Language.LSP.Server   (MonadLsp)
+
+properties :: Properties '[ 'PropertyKey "diff" 'TBoolean]
+properties = emptyProperties
+  & defineBooleanProperty #diff
+    "Enable the diff output (WAS/NOW) of eval lenses" True
+
+getDiffProperty :: (MonadLsp Config m) => PluginId -> m Bool
+getDiffProperty plId = usePropertyLsp #diff plId properties