Merge pull request #244 from tittoassini/master

Fix for Eval plugin: Error from tests not reported

src/Ide/Plugin/Eval.hs

@@ -82,6 +82,10 @@ import           System.FilePath
 import           System.IO                      (hClose)
 import           System.IO.Temp
 import Data.Maybe (catMaybes)
+import qualified Control.Exception             as E
+import           Control.DeepSeq                ( NFData
+                                                , deepseq
+                                                )
 
 descriptor :: PluginId -> PluginDescriptor
 descriptor plId =
@@ -278,7 +282,12 @@ done, we want to switch back to GhcSessionDeps:
             void $ runDecls stmt
             return Nothing
 
-    edits <- liftIO $ evalGhcEnv hscEnv' $ traverse (eval . first T.unpack) statements
+    edits <-
+      liftIO
+      $ (either (\e -> [Just . T.pack . pad $ e]) id <$>)
+      $ strictTry
+      $ evalGhcEnv hscEnv'
+      $ traverse (eval . first T.unpack) statements
 
 
     let workspaceEditsMap = Map.fromList [(_uri, List [evalEdit])]
@@ -287,6 +296,11 @@ done, we want to switch back to GhcSessionDeps:
 
     return (WorkspaceApplyEdit, ApplyWorkspaceEditParams workspaceEdits)
 
+strictTry :: NFData b => IO b -> IO (Either String b)
+strictTry op = E.catch
+  (op >>= \v -> return $! Right $! deepseq v v)
+  (\(err :: E.SomeException) -> return $! Left $ show err)
+
 pad :: String -> String
 pad = unlines . map ("-- " <>) . lines
 

test/functional/Eval.hs

@@ -2,63 +2,73 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Eval (tests) where
+module Eval
+  ( tests
+  )
+where
 
-import           Control.Applicative.Combinators (skipManyTill)
-import           Control.Monad.IO.Class          (MonadIO (liftIO))
-import qualified Data.Text.IO                    as T
+import           Control.Applicative.Combinators
+                                                ( skipManyTill )
+import           Control.Monad.IO.Class         ( MonadIO(liftIO) )
+import qualified Data.Text.IO                  as T
 import           Language.Haskell.LSP.Test
-import           Language.Haskell.LSP.Types      (ApplyWorkspaceEditRequest,
-                                                  CodeLens (CodeLens, _command, _range),
-                                                  Command (_title),
-                                                  Position (..), Range (..))
+import           Language.Haskell.LSP.Types     ( ApplyWorkspaceEditRequest
+                                                , CodeLens
+                                                  ( CodeLens
+                                                  , _command
+                                                  , _range
+                                                  )
+                                                , Command(_title)
+                                                , Position(..)
+                                                , Range(..)
+                                                )
 import           System.FilePath
 import           Test.Hls.Util
 import           Test.Tasty
 import           Test.Tasty.HUnit
 
 tests :: TestTree
-tests =
-  testGroup
-    "eval"
-    [ testCase "Produces Evaluate code lenses" $ do
-        runSession hieCommand fullCaps evalPath $ do
-          doc <- openDoc "T1.hs" "haskell"
-          lenses <- getCodeLenses doc
-          liftIO $ map (fmap _title . _command) lenses @?= [Just "Evaluate..."],
-      testCase "Produces Refresh code lenses" $ do
-        runSession hieCommand fullCaps evalPath $ do
-          doc <- openDoc "T2.hs" "haskell"
-          lenses <- getCodeLenses doc
-          liftIO $ map (fmap _title . _command) lenses @?= [Just "Refresh..."],
-      testCase "Code lenses have ranges" $ do
-        runSession hieCommand fullCaps evalPath $ do
-          doc <- openDoc "T1.hs" "haskell"
-          lenses <- getCodeLenses doc
-          liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)],
-      testCase "Multi-line expressions have a multi-line range" $ do
-        runSession hieCommand fullCaps evalPath $ do
-          doc <- openDoc "T3.hs" "haskell"
-          lenses <- getCodeLenses doc
-          liftIO $ map _range lenses @?= [Range (Position 3 0) (Position 4 15)],
-      testCase "Executed expressions range covers only the expression" $ do
-        runSession hieCommand fullCaps evalPath $ do
-          doc <- openDoc "T2.hs" "haskell"
-          lenses <- getCodeLenses doc
-          liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)],
-      testCase "Evaluation of expressions" $ goldenTest "T1.hs",
-      testCase "Reevaluation of expressions" $ goldenTest "T2.hs",
-      testCase "Evaluation of expressions w/ imports" $ goldenTest "T3.hs",
-      testCase "Evaluation of expressions w/ lets" $ goldenTest "T4.hs",
-      testCase "Refresh an evaluation" $ goldenTest "T5.hs",
-      testCase "Refresh an evaluation w/ lets" $ goldenTest "T6.hs",
-      testCase "Refresh a multiline evaluation" $ goldenTest "T7.hs"
-    ]
+tests = testGroup
+  "eval"
+  [ testCase "Produces Evaluate code lenses" $ do
+    runSession hieCommand fullCaps evalPath $ do
+      doc    <- openDoc "T1.hs" "haskell"
+      lenses <- getCodeLenses doc
+      liftIO $ map (fmap _title . _command) lenses @?= [Just "Evaluate..."]
+  , testCase "Produces Refresh code lenses" $ do
+    runSession hieCommand fullCaps evalPath $ do
+      doc    <- openDoc "T2.hs" "haskell"
+      lenses <- getCodeLenses doc
+      liftIO $ map (fmap _title . _command) lenses @?= [Just "Refresh..."]
+  , testCase "Code lenses have ranges" $ do
+    runSession hieCommand fullCaps evalPath $ do
+      doc    <- openDoc "T1.hs" "haskell"
+      lenses <- getCodeLenses doc
+      liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)]
+  , testCase "Multi-line expressions have a multi-line range" $ do
+    runSession hieCommand fullCaps evalPath $ do
+      doc    <- openDoc "T3.hs" "haskell"
+      lenses <- getCodeLenses doc
+      liftIO $ map _range lenses @?= [Range (Position 3 0) (Position 4 15)]
+  , testCase "Executed expressions range covers only the expression" $ do
+    runSession hieCommand fullCaps evalPath $ do
+      doc    <- openDoc "T2.hs" "haskell"
+      lenses <- getCodeLenses doc
+      liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)]
+  , testCase "Evaluation of expressions" $ goldenTest "T1.hs"
+  , testCase "Reevaluation of expressions" $ goldenTest "T2.hs"
+  , testCase "Evaluation of expressions w/ imports" $ goldenTest "T3.hs"
+  , testCase "Evaluation of expressions w/ lets" $ goldenTest "T4.hs"
+  , testCase "Refresh an evaluation" $ goldenTest "T5.hs"
+  , testCase "Refresh an evaluation w/ lets" $ goldenTest "T6.hs"
+  , testCase "Refresh a multiline evaluation" $ goldenTest "T7.hs"
+  , testCase "Evaluate incorrect expressions" $ goldenTest "T8.hs"
+  ]
 
 goldenTest :: FilePath -> IO ()
 goldenTest input = runSession hieCommand fullCaps evalPath $ do
-  doc <- openDoc input "haskell"
-  [CodeLens {_command = Just c}] <- getCodeLenses doc
+  doc                              <- openDoc input "haskell"
+  [CodeLens { _command = Just c }] <- getCodeLenses doc
   executeCommand c
   _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message
   edited <- documentContents doc

test/testdata/eval/T8.hs

@@ -0,0 +1,3 @@
+module T8 where
+
+-- >>> noFunctionWithThisName

test/testdata/eval/T8.hs.expected

@@ -0,0 +1,4 @@
+module T8 where
+
+-- >>> noFunctionWithThisName
+-- Variable not in scope: noFunctionWithThisName