Return an error diagnostic when no TypeCheckedModule

Author: alanz

haskell-ide-engine.cabal

@@ -289,6 +289,7 @@ test-suite func-test
                      , DefinitionSpec
                      , DiagnosticsSpec
                      , FormatSpec
+                     , FunctionalBadProjectSpec
                      , FunctionalCodeActionsSpec
                      , FunctionalLiquidSpec
                      , FunctionalSpec

src/Haskell/Ide/Engine/Plugin/GhcMod.hs

@@ -193,11 +193,12 @@ setTypecheckedModule uri =
 
     canonUri <- canonicalizeUri uri
     let diags = Map.insertWith Set.union canonUri Set.empty diags'
-    case (mpm,mtm) of
+    diags2 <- case (mpm,mtm) of
       (Just pm, Nothing) -> do
         debugm $ "setTypecheckedModule: Did get parsed module for: " ++ show fp
         cacheModule fp (Left pm)
         debugm "setTypecheckedModule: done"
+        return diags
 
       (_, Just tm) -> do
         debugm $ "setTypecheckedModule: Did get typechecked module for: " ++ show fp
@@ -208,13 +209,21 @@ setTypecheckedModule uri =
         modifyMTS (\s -> s {ghcSession = sess})
         cacheModule fp (Right tm)
         debugm "setTypecheckedModule: done"
+        return diags
 
       _ -> do
         debugm $ "setTypecheckedModule: Didn't get typechecked or parsed module for: " ++ show fp
+        debugm $ "setTypecheckedModule: errs: " ++ show errs
 
         failModule fp
 
-    return $ IdeResultOk (diags,errs)
+        let sev = Just DsError
+            range = Range (Position 0 0) (Position 1 0)
+            msgTxt = T.unlines errs
+        let d = Diagnostic range sev Nothing (Just "ghcmod") msgTxt Nothing
+        return $ Map.insertWith Set.union canonUri (Set.singleton d) diags
+
+    return $ IdeResultOk (diags2,errs)
 
 -- ---------------------------------------------------------------------
 

test/functional/FunctionalBadProjectSpec.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module FunctionalBadProjectSpec where
+
+import           Control.Lens hiding (List)
+import           Control.Monad.IO.Class
+import qualified Data.Text as T
+import           Language.Haskell.LSP.Test hiding (message)
+import           Language.Haskell.LSP.Types as LSP
+import           Language.Haskell.LSP.Types.Lens as LSP hiding (contents, error )
+import           Test.Hspec
+import           TestUtils
+import           Utils
+
+-- ---------------------------------------------------------------------
+
+spec :: Spec
+spec = describe "behaviour on malformed projects" $ do
+    it "deals with cabal file with unsatisfiable dependency" $
+      runSession hieCommandExamplePlugin codeActionSupportCaps "test/testdata/badProjects/cabal" $ do
+      -- runSessionWithConfig logConfig hieCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do
+        _doc <- openDoc "Foo.hs" "haskell"
+
+        diags@(d:_) <- waitForDiagnosticsSource "ghcmod"
+        -- liftIO $ show diags `shouldBe` ""
+        -- liftIO $ putStrLn $ show diags
+        -- liftIO $ putStrLn "a"
+        liftIO $ do
+          length diags `shouldBe` 1
+          d ^. range `shouldBe` Range (Position 0 0) (Position 1 0)
+          d ^. severity `shouldBe` (Just DsError)
+          d ^. code `shouldBe` Nothing
+          d ^. source `shouldBe` Just "ghcmod"
+          d ^. message `shouldBe`
+            (T.pack "readCreateProcess: stack \"build\" \"--only-configure\" \".\" (exit 1): failed\n")
+
+    -- ---------------------------------
+
+-- ---------------------------------------------------------------------

test/functional/FunctionalCodeActionsSpec.hs

@@ -139,7 +139,7 @@ spec = describe "code actions" $ do
     it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do
       doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
       _ <- waitForDiagnosticsSource "ghcmod"
-      
+
       let config = def { formatOnImportOn = False }
       sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
 

test/testdata/badProjects/cabal/Foo.hs

@@ -0,0 +1,4 @@
+module Foo where
+
+foo :: Int
+foo = 3

test/testdata/badProjects/cabal/bad-cabal.cabal

@@ -0,0 +1,16 @@
+name:                bad-cabal
+version:             0.1.0.0
+license:             BSD3
+author:              Alan Zimmerman
+maintainer:          [email protected]
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Foo
+  build-depends:       base >=4.7 && <5
+                     -- missing dependency
+                     , does-not-exist
+  -- hs-source-dirs:
+  default-language:    Haskell2010

test/testdata/badProjects/cabal/stack.yaml

@@ -0,0 +1,7 @@
+# WARNING: THIS FILE IS AUTOGENERATED IN test/Main.hs. IT WILL BE OVERWRITTEN ON EVERY TEST RUN
+resolver: lts-13.0
+packages:
+- '.'
+extra-deps: []
+flags: {}
+extra-package-dbs: []

test/utils/TestUtils.hs

@@ -109,6 +109,7 @@ files =
    , "./test/testdata/addPackageTest/cabal/"
    , "./test/testdata/addPackageTest/hpack/"
    , "./test/testdata/addPragmas/"
+   , "./test/testdata/badProjects/cabal/"
    , "./test/testdata/completion/"
    , "./test/testdata/definition/"
    , "./test/testdata/gototest/"