Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 0e6a81b

Browse files
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])
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")
Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
packages: ./
Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
cradle:
2+
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
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"
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"
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)

AltStyle によって変換されたページ (->オリジナル) /