Skip to content

Commit de5cb26

Browse files
VeryMilkyJoefendor
authored andcommitted
Add cradle dependencies to session loading errors
1 parent 861aba7 commit de5cb26

File tree

3 files changed

+89
-70
lines changed

3 files changed

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

0 commit comments

Comments
 (0)