Skip to content

Commit 0e6a81b

Browse files
fendorfendor
authored
Merge pull request #3779 from VeryMilkyJoe/improve-unknown-module-error
Add cradle dependencies to session loading errors
2 parents cc0d4ee + 7004b69 commit 0e6a81b

File tree

13 files changed

+166
-100
lines changed

13 files changed

+166
-100
lines changed

‎ghcide/ghcide.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -192,6 +192,7 @@ library
192192
Development.IDE.LSP.Outline
193193
Development.IDE.LSP.Server
194194
Development.IDE.Session
195+
Development.IDE.Session.Diagnostics
195196
Development.IDE.Spans.Common
196197
Development.IDE.Spans.Documentation
197198
Development.IDE.Spans.AtPoint

‎ghcide/session-loader/Development/IDE/Session.hs‎

Lines changed: 2 additions & 70 deletions
Original file line numberDiff line numberDiff line change
@@ -34,14 +34,12 @@ import Data.Aeson hiding (Error)
3434
import Data.Bifunctor
3535
import qualified Data.ByteString.Base16 as B16
3636
import qualified Data.ByteString.Char8 as B
37-
import Data.Char (isLower)
3837
import Data.Default
3938
import Data.Either.Extra
4039
import Data.Function
4140
import Data.Hashable hiding (hash)
4241
import qualified Data.HashMap.Strict as HM
4342
import Data.List
44-
import Data.List.Extra (dropPrefix, split)
4543
import qualified Data.Map.Strict as Map
4644
import Data.Maybe
4745
import Data.Proxy
@@ -69,7 +67,6 @@ import Development.IDE.Types.Location
6967
import Development.IDE.Types.Options
7068
import GHC.Check
7169
import qualified HIE.Bios as HieBios
72-
import qualified HIE.Bios.Cradle as HieBios
7370
import HIE.Bios.Environment hiding (getCacheDir)
7471
import HIE.Bios.Types hiding (Log)
7572
import qualified HIE.Bios.Types as HieBios
@@ -103,6 +100,7 @@ import Data.HashSet (HashSet)
103100
import qualified Data.HashSet as Set
104101
import Database.SQLite.Simple
105102
import Development.IDE.Core.Tracing (withTrace)
103+
import Development.IDE.Session.Diagnostics (renderCradleError)
106104
import Development.IDE.Types.Shake (WithHieDb)
107105
import HieDb.Create
108106
import HieDb.Types
@@ -685,7 +683,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
685683
Left err -> do
686684
dep_info <- getDependencyInfo (maybeToList hieYaml)
687685
let ncfp = toNormalizedFilePath' cfp
688-
let res = (map (renderCradleError cradle ncfp) err, Nothing)
686+
let res = (map (\err' -> renderCradleError err' cradle ncfp) err, Nothing)
689687
void $ modifyVar' fileToFlags $
690688
Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info))
691689
void $ modifyVar' filesMap $ HM.insert ncfp hieYaml
@@ -924,72 +922,6 @@ setCacheDirs recorder CacheDirs{..} dflags = do
924922
& maybe id setHieDir hieCacheDir
925923
& maybe id setODir oCacheDir
926924

927-
928-
renderCradleError :: Cradle a -> NormalizedFilePath -> CradleError -> FileDiagnostic
929-
renderCradleError cradle nfp (CradleError _ _ec ms) =
930-
ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp $ T.unlines $ map T.pack userFriendlyMessage
931-
where
932-
933-
userFriendlyMessage :: [String]
934-
userFriendlyMessage
935-
| HieBios.isCabalCradle cradle = fromMaybe ms fileMissingMessage
936-
| otherwise = ms
937-
938-
fileMissingMessage :: Maybe [String]
939-
fileMissingMessage =
940-
multiCradleErrMessage <$> parseMultiCradleErr ms
941-
942-
-- | Information included in Multi Cradle error messages
943-
data MultiCradleErr = MultiCradleErr
944-
{ mcPwd :: FilePath
945-
, mcFilePath :: FilePath
946-
, mcPrefixes :: [(FilePath, String)]
947-
} deriving (Show)
948-
949-
-- | Attempt to parse a multi-cradle message
950-
parseMultiCradleErr :: [String] -> Maybe MultiCradleErr
951-
parseMultiCradleErr ms = do
952-
_ <- lineAfter "Multi Cradle: "
953-
wd <- lineAfter "pwd: "
954-
fp <- lineAfter "filepath: "
955-
ps <- prefixes
956-
pure $ MultiCradleErr wd fp ps
957-
958-
where
959-
lineAfter :: String -> Maybe String
960-
lineAfter pre = listToMaybe $ mapMaybe (stripPrefix pre) ms
961-
962-
prefixes :: Maybe [(FilePath, String)]
963-
prefixes = do
964-
pure $ mapMaybe tuple ms
965-
966-
tuple :: String -> Maybe (String, String)
967-
tuple line = do
968-
line' <- surround '(' line ')'
969-
[f, s] <- pure $ split (==',') line'
970-
pure (f, s)
971-
972-
-- extracts the string surrounded by required characters
973-
surround :: Char -> String -> Char -> Maybe String
974-
surround start s end = do
975-
guard (listToMaybe s == Just start)
976-
guard (listToMaybe (reverse s) == Just end)
977-
pure $ drop 1 $ take (length s - 1) s
978-
979-
multiCradleErrMessage :: MultiCradleErr -> [String]
980-
multiCradleErrMessage e =
981-
[ "Loading the module '" <> moduleFileName <> "' failed. It may not be listed in your .cabal file!"
982-
, "Perhaps you need to add `"<> moduleName <> "` to other-modules or exposed-modules."
983-
, "For more information, visit: https://cabal.readthedocs.io/en/3.4/developing-packages.html#modules-included-in-the-package"
984-
, ""
985-
] <> map prefix (mcPrefixes e)
986-
where
987-
localFilePath f = dropWhile (==pathSeparator) $ dropPrefix (mcPwd e) f
988-
moduleFileName = localFilePath $ mcFilePath e
989-
moduleName = intercalate "." $ map dropExtension $ dropWhile isSourceFolder $ splitDirectories moduleFileName
990-
isSourceFolder p = all isLower $ take 1 p
991-
prefix (f, r) = f <> " - " <> r
992-
993925
-- See Note [Multi Cradle Dependency Info]
994926
type DependencyInfo = Map.Map FilePath (Maybe UTCTime)
995927
type HieMap = Map.Map (Maybe FilePath) (HscEnv, [RawComponentInfo])

‎ghcide/session-loader/Development/IDE/Session/Diagnostics.hs‎

Lines changed: 106 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,106 @@
1+
{-# LANGUAGE DeriveAnyClass #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
4+
module Development.IDE.Session.Diagnostics where
5+
import Control.Applicative
6+
import Control.Monad
7+
import qualified Data.Aeson as Aeson
8+
import Data.List
9+
import Data.List.Extra (split)
10+
import Data.Maybe
11+
import qualified Data.Text as T
12+
import Development.IDE.Types.Diagnostics
13+
import Development.IDE.Types.Location
14+
import GHC.Generics
15+
import qualified HIE.Bios.Cradle as HieBios
16+
import HIE.Bios.Types hiding (Log)
17+
import System.FilePath
18+
19+
data CradleErrorDetails =
20+
CradleErrorDetails
21+
{ cabalProjectFiles :: [FilePath]
22+
-- ^ files related to the cradle error
23+
-- i.e. .cabal, cabal.project, etc.
24+
} deriving (Show, Eq, Ord, Read, Generic, Aeson.ToJSON, Aeson.FromJSON)
25+
26+
{- | Takes a cradle error, the corresponding cradle and the file path where
27+
the cradle error occurred (of the file we attempted to load).
28+
Depicts the cradle error in a user-friendly way.
29+
-}
30+
renderCradleError :: CradleError -> Cradle a -> NormalizedFilePath -> FileDiagnostic
31+
renderCradleError (CradleError deps _ec ms) cradle nfp
32+
| HieBios.isCabalCradle cradle =
33+
let (fp, showDiag, diag) = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp $ T.unlines $ map T.pack userFriendlyMessage in
34+
(fp, showDiag, diag{_data_ = Just $ Aeson.toJSON CradleErrorDetails{cabalProjectFiles=absDeps}})
35+
| otherwise = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp $ T.unlines $ map T.pack userFriendlyMessage
36+
where
37+
absDeps = fmap (cradleRootDir cradle </>) deps
38+
userFriendlyMessage :: [String]
39+
userFriendlyMessage
40+
| HieBios.isCabalCradle cradle = fromMaybe ms $ fileMissingMessage <|> mkUnknownModuleMessage
41+
| otherwise = ms
42+
43+
mkUnknownModuleMessage :: Maybe [String]
44+
mkUnknownModuleMessage
45+
| any (isInfixOf "Failed extracting script block:") ms =
46+
Just $ unknownModuleMessage (fromNormalizedFilePath nfp)
47+
| otherwise = Nothing
48+
49+
fileMissingMessage :: Maybe [String]
50+
fileMissingMessage =
51+
multiCradleErrMessage <$> parseMultiCradleErr ms
52+
53+
-- | Information included in Multi Cradle error messages
54+
data MultiCradleErr = MultiCradleErr
55+
{ mcPwd :: FilePath
56+
, mcFilePath :: FilePath
57+
, mcPrefixes :: [(FilePath, String)]
58+
} deriving (Show)
59+
60+
-- | Attempt to parse a multi-cradle message
61+
parseMultiCradleErr :: [String] -> Maybe MultiCradleErr
62+
parseMultiCradleErr ms = do
63+
_ <- lineAfter "Multi Cradle: "
64+
wd <- lineAfter "pwd: "
65+
fp <- lineAfter "filepath: "
66+
ps <- prefixes
67+
pure $ MultiCradleErr wd fp ps
68+
69+
where
70+
lineAfter :: String -> Maybe String
71+
lineAfter pre = listToMaybe $ mapMaybe (stripPrefix pre) ms
72+
73+
prefixes :: Maybe [(FilePath, String)]
74+
prefixes = do
75+
pure $ mapMaybe tuple ms
76+
77+
tuple :: String -> Maybe (String, String)
78+
tuple line = do
79+
line' <- surround '(' line ')'
80+
[f, s] <- pure $ split (==',') line'
81+
pure (f, s)
82+
83+
-- extracts the string surrounded by required characters
84+
surround :: Char -> String -> Char -> Maybe String
85+
surround start s end = do
86+
guard (listToMaybe s == Just start)
87+
guard (listToMaybe (reverse s) == Just end)
88+
pure $ drop 1 $ take (length s - 1) s
89+
90+
multiCradleErrMessage :: MultiCradleErr -> [String]
91+
multiCradleErrMessage e =
92+
unknownModuleMessage (mcFilePath e)
93+
<> [""]
94+
<> map prefix (mcPrefixes e)
95+
where
96+
prefix (f, r) = f <> " - " <> r
97+
98+
unknownModuleMessage :: String -> [String]
99+
unknownModuleMessage moduleFileName =
100+
[ "Loading the module '" <> moduleFileName <> "' failed."
101+
, ""
102+
, "It may not be listed in your .cabal file!"
103+
, "Perhaps you need to add `"<> dropExtension (takeFileName moduleFileName) <> "` to other-modules or exposed-modules."
104+
, ""
105+
, "For more information, visit: https://cabal.readthedocs.io/en/3.4/developing-packages.html#modules-included-in-the-package"
106+
]

‎test/functional/FunctionalBadProject.hs‎

Lines changed: 20 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -2,37 +2,27 @@
22

33
module FunctionalBadProject (tests) where
44

5-
-- import Control.Lens hiding (List)
6-
-- import Control.Monad.IO.Class
7-
-- import qualified Data.Text as T
8-
-- import Language.LSP.Test hiding (message)
9-
-- import Language.LSP.Types as LSP
10-
-- import Language.LSP.Types.Lens as LSP hiding (contents, error )
5+
import Control.Lens
6+
import qualified Data.Text as T
7+
import qualified Language.LSP.Protocol.Lens as L
118
import Test.Hls
9+
import Test.Hls.Command
10+
1211

13-
-- ---------------------------------------------------------------------
14-
-- TODO: Currently this can not succeed, since such an error is thrown in "runActionWithContext" which
15-
-- can produce diagnostics at the moment. Needs more investigation
16-
-- TODO: @fendor: Add issue link here
17-
--
1812
tests :: TestTree
19-
tests = testGroup "behaviour on malformed projects" [
20-
testCase "no test executed" $ True @?= True
13+
tests = testGroup "behaviour on malformed projects"
14+
[ testCase "Missing module diagnostic" $ do
15+
runSession hlsCommand fullCaps "test/testdata/missingModuleTest/missingModule/" $ do
16+
doc <- openDoc "src/MyLib.hs" "haskell"
17+
[diag] <- waitForDiagnosticsFrom doc
18+
liftIO $ assertBool "missing module name" $ "MyLib" `T.isInfixOf` (diag ^. L.message)
19+
liftIO $ assertBool "module missing context" $ "may not be listed" `T.isInfixOf` (diag ^. L.message)
20+
, testCase "Missing module diagnostic - no matching prefix" $ do
21+
runSession hlsCommand fullCaps "test/testdata/missingModuleTest/noPrefixMatch/" $ do
22+
doc <- openDoc "app/Other.hs" "haskell"
23+
[diag] <- waitForDiagnosticsFrom doc
24+
liftIO $ assertBool "missing module name" $
25+
"Other" `T.isInfixOf` (diag ^. L.message)
26+
liftIO $ assertBool "hie-bios message" $
27+
"Cabal {component = Just \"exe:testExe\"}" `T.isInfixOf` (diag ^. L.message)
2128
]
22-
23-
-- testCase "deals with cabal file with unsatisfiable dependency" $
24-
-- runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata/badProjects/cabal" $ do
25-
-- _doc <- openDoc "Foo.hs" "haskell"
26-
27-
-- diags@(d:_) <- waitForDiagnosticsSource "bios"
28-
-- -- liftIO $ show diags @?= ""
29-
-- -- liftIO $ putStrLn $ show diags
30-
-- -- liftIO $ putStrLn "a"
31-
-- liftIO $ do
32-
-- length diags @?= 1
33-
-- d ^. range @?= Range (Position 0 0) (Position 1 0)
34-
-- d ^. severity @?= (Just DsError)
35-
-- d ^. code @?= Nothing
36-
-- d ^. source @?= Just "bios"
37-
-- d ^. message @?=
38-
-- (T.pack "readCreateProcess: stack \"build\" \"--only-configure\" \".\" (exit 1): failed\n")

‎test/testdata/missingModuleTest/missingModule/cabal.project‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
packages: ./

‎test/testdata/missingModuleTest/missingModule/hie.yaml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
cradle:
2+
cabal:

‎test/testdata/missingModuleTest/missingModule/missingModule.cabal‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
cabal-version: 3.4
2+
name: missingModule
3+
version: 0.1.0.0
4+
build-type: Simple
5+
6+
library
7+
hs-source-dirs: ./src/
8+
exposed-modules:
9+
build-depends: base
10+
default-language: Haskell2010

‎test/testdata/missingModuleTest/missingModule/src/MyLib.hs‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
module MyLib where
2+
3+
someFunc :: IO ()
4+
someFunc = do
5+
putStrLn "someFunc"

‎test/testdata/missingModuleTest/noPrefixMatch/app/Main.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
2+
main :: IO ()
3+
main = do
4+
putStrLn "someFunc"

‎test/testdata/missingModuleTest/noPrefixMatch/app/Other.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
module Other where

0 commit comments

Comments
 (0)