User-friendly error message when modules aren't listed

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

@@ -34,13 +34,15 @@ import           Data.Aeson                           hiding (Error)
 import           Data.Bifunctor
 import qualified Data.ByteString.Base16               as B16
 import qualified Data.ByteString.Char8                as B
+import           Data.Char                            (isLower)
 import           Data.Default
 import           Data.Either.Extra
 import           Data.Function
 import           Data.Hashable
 import qualified Data.HashMap.Strict                  as HM
 import           Data.IORef
 import           Data.List
+import           Data.List.Extra                      (dropPrefix, split)
 import qualified Data.Map.Strict                      as Map
 import           Data.Maybe
 import           Data.Proxy
@@ -68,6 +70,7 @@ import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
 import           GHC.Check
 import qualified HIE.Bios                             as HieBios
+import qualified HIE.Bios.Cradle                      as HieBios
 import           HIE.Bios.Environment                 hiding (getCacheDir)
 import           HIE.Bios.Types                       hiding (Log)
 import qualified HIE.Bios.Types                       as HieBios
@@ -681,7 +684,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
              Left err -> do
                dep_info <- getDependencyInfo (maybeToList hieYaml)
                let ncfp = toNormalizedFilePath' cfp
-               let res = (map (renderCradleError ncfp) err, Nothing)
+               let res = (map (renderCradleError cradle ncfp) err, Nothing)
                void $ modifyVar' fileToFlags $
                     Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info))
                void $ modifyVar' filesMap $ HM.insert ncfp hieYaml
@@ -924,9 +927,70 @@ setCacheDirs recorder CacheDirs{..} dflags = do
           & maybe id setODir oCacheDir
 
 
-renderCradleError :: NormalizedFilePath -> CradleError -> FileDiagnostic
-renderCradleError nfp (CradleError _ _ec t) =
-  ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp (T.unlines (map T.pack t))
+renderCradleError :: Cradle a -> NormalizedFilePath -> CradleError -> FileDiagnostic
+renderCradleError cradle nfp (CradleError _ _ec ms) =
+  ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp $ T.unlines $ map T.pack userFriendlyMessage
+  where
+
+    userFriendlyMessage :: [String]
+    userFriendlyMessage
+      | HieBios.isCabalCradle cradle = fromMaybe ms fileMissingMessage
+      | otherwise = ms
+
+    fileMissingMessage :: Maybe [String]
+    fileMissingMessage =
+      multiCradleErrMessage <$> parseMultiCradleErr ms
+
+-- | Information included in Multi Cradle error messages
+data MultiCradleErr = MultiCradleErr
+  { mcPwd      :: FilePath
+  , mcFilePath :: FilePath
+  , mcPrefixes :: [(FilePath, String)]
+  } deriving (Show)
+
+-- | Attempt to parse a multi-cradle message
+parseMultiCradleErr :: [String] -> Maybe MultiCradleErr
+parseMultiCradleErr ms = do
+  _  <- lineAfter "Multi Cradle: "
+  wd <- lineAfter "pwd: "
+  fp <- lineAfter "filepath: "
+  ps <- prefixes
+  pure $ MultiCradleErr wd fp ps
+
+  where
+    lineAfter :: String -> Maybe String
+    lineAfter pre = listToMaybe $ mapMaybe (stripPrefix pre) ms
+
+    prefixes :: Maybe [(FilePath, String)]
+    prefixes = do
+      pure $ mapMaybe tuple ms
+
+    tuple :: String -> Maybe (String, String)
+    tuple line = do
+      line' <- surround '(' line ')'
+      [f, s] <- pure $ split (==',') line'
+      pure (f, s)
+
+    -- extracts the string surrounded by required characters
+    surround :: Char -> String -> Char -> Maybe String
+    surround start s end = do
+      guard (listToMaybe s == Just start)
+      guard (listToMaybe (reverse s) == Just end)
+      pure $ drop 1 $ take (length s - 1) s
+
+multiCradleErrMessage :: MultiCradleErr -> [String]
+multiCradleErrMessage e =
+    [ "Loading the module '" <> moduleFileName <> "' failed. It may not be listed in your .cabal file!"
+    , "Perhaps you need to add `"<> moduleName <> "` to other-modules or exposed-modules."
+    , "For more information, visit: https://cabal.readthedocs.io/en/3.4/developing-packages.html#modules-included-in-the-package"
+    , ""
+    ] <> map prefix (mcPrefixes e)
+  where
+    localFilePath f = dropWhile (==pathSeparator) $ dropPrefix (mcPwd e) f
+    moduleFileName = localFilePath $ mcFilePath e
+    moduleName = intercalate "." $ map dropExtension $ dropWhile isSourceFolder $ splitDirectories moduleFileName
+    isSourceFolder p = all isLower $ take 1 p
+    prefix (f, r) = f <> " - " <> r
 
 -- See Note [Multi Cradle Dependency Info]
 type DependencyInfo = Map.Map FilePath (Maybe UTCTime)