User friendly errors: only show if cabal, show prefixes

Author: seanhess

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

@@ -42,7 +42,7 @@ import           Data.Hashable
 import qualified Data.HashMap.Strict                  as HM
 import           Data.IORef
 import           Data.List
-import           Data.List.Extra                      (dropPrefix, replace)
+import           Data.List.Extra                      (dropPrefix, split)
 import qualified Data.Map.Strict                      as Map
 import           Data.Maybe
 import           Data.Proxy
@@ -77,6 +77,7 @@ import           Development.IDE.Types.Logger         (Pretty (pretty),
 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
@@ -664,7 +665,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
@@ -907,46 +908,75 @@ setCacheDirs recorder CacheDirs{..} dflags = do
           & maybe id setODir oCacheDir
 
 
-renderCradleError :: NormalizedFilePath -> CradleError -> FileDiagnostic
-renderCradleError nfp (CradleError _ _ec ms) =
-  ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp $ T.unlines $ map T.pack $ fromMaybe ms fileMissingMessage
+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
-  { multiCradlePwd :: FilePath
-  , multiCradleFilePath :: FilePath
-  -- , multiCradlePrefixes :: [Prefix]
+  { mcPwd :: FilePath
+  , mcFilePath :: FilePath
+  , mcPrefixes :: [(FilePath, String)]
   } deriving (Show)
 
 -- | Attempt to parse a multi-cradle message
 parseMultiCradleErr :: [String] -> Maybe MultiCradleErr
 parseMultiCradleErr ms = do
-  _  <- prefix "Multi Cradle"
-  wd <- prefix "pwd"
-  fp <- prefix "filepath"
-  pure $ MultiCradleErr wd fp
+  _  <- lineAfter "Multi Cradle: "
+  wd <- lineAfter "pwd: "
+  fp <- lineAfter "filepath: "
+  ps <- prefixes
+  pure $ MultiCradleErr wd fp ps
 
   where
-    -- Extract the string after any line starting with "prefix: "
-    prefix :: String -> Maybe String
-    prefix pre = listToMaybe $ mapMaybe (stripPrefix (pre ++ ": ")) ms
+    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 seems that it is not listed in your .cabal file!"
     , "Perhaps you need to add `"<> moduleName <> "` to other-modules or exposed-modules" --  named 'example' in example.cabal."
     , "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 (multiCradlePwd e) f
-    moduleFileName = localFilePath $ multiCradleFilePath e
+    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