diff --git a/src/Ide/Plugin/Eval.hs b/src/Ide/Plugin/Eval.hs
index 9b452ece61..fe37b0d576 100644
--- a/src/Ide/Plugin/Eval.hs
+++ b/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
diff --git a/test/functional/Eval.hs b/test/functional/Eval.hs
index 4f4cc91691..6f12cac76d 100644
--- a/test/functional/Eval.hs
+++ b/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
diff --git a/test/testdata/eval/T8.hs b/test/testdata/eval/T8.hs
new file mode 100644
index 0000000000..c71bd73f19
--- /dev/null
+++ b/test/testdata/eval/T8.hs
@@ -0,0 +1,3 @@
+module T8 where
+
+-- >>> noFunctionWithThisName
diff --git a/test/testdata/eval/T8.hs.expected b/test/testdata/eval/T8.hs.expected
new file mode 100644
index 0000000000..5ec1150adf
--- /dev/null
+++ b/test/testdata/eval/T8.hs.expected
@@ -0,0 +1,4 @@
+module T8 where
+
+-- >>> noFunctionWithThisName
+-- Variable not in scope: noFunctionWithThisName