@@ -35,12 +35,14 @@ import Data.Bifunctor
35
35
import qualified Data.ByteString.Base16 as B16
36
36
import qualified Data.ByteString.Char8 as B
37
37
import Data.Default
38
+ import Data.Char (isLower )
38
39
import Data.Either.Extra
39
40
import Data.Function
40
41
import Data.Hashable
41
42
import qualified Data.HashMap.Strict as HM
42
43
import Data.IORef
43
44
import Data.List
45
+ import Data.List.Extra (dropPrefix , split )
44
46
import qualified Data.Map.Strict as Map
45
47
import Data.Maybe
46
48
import Data.Proxy
@@ -75,6 +77,7 @@ import Development.IDE.Types.Logger (Pretty (pretty),
75
77
import Development.IDE.Types.Options
76
78
import GHC.Check
77
79
import qualified HIE.Bios as HieBios
80
+ import qualified HIE.Bios.Cradle as HieBios
78
81
import HIE.Bios.Environment hiding (getCacheDir )
79
82
import HIE.Bios.Types hiding (Log )
80
83
import qualified HIE.Bios.Types as HieBios
@@ -662,7 +665,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
662
665
Left err -> do
663
666
dep_info <- getDependencyInfo (maybeToList hieYaml)
664
667
let ncfp = toNormalizedFilePath' cfp
665
- let res = (map (renderCradleError ncfp) err, Nothing )
668
+ let res = (map (renderCradleError cradle ncfp) err, Nothing )
666
669
void $ modifyVar' fileToFlags $
667
670
Map. insertWith HM. union hieYaml (HM. singleton ncfp (res, dep_info))
668
671
void $ modifyVar' filesMap $ HM. insert ncfp hieYaml
@@ -905,9 +908,80 @@ setCacheDirs recorder CacheDirs{..} dflags = do
905
908
& maybe id setODir oCacheDir
906
909
907
910
908
- renderCradleError :: NormalizedFilePath -> CradleError -> FileDiagnostic
909
- renderCradleError nfp (CradleError _ _ec t) =
910
- ideErrorWithSource (Just " cradle" ) (Just DiagnosticSeverity_Error ) nfp (T. unlines (map T. pack t))
911
+ renderCradleError :: Cradle a -> NormalizedFilePath -> CradleError -> FileDiagnostic
912
+ renderCradleError cradle nfp (CradleError _ _ec ms) =
913
+ ideErrorWithSource (Just " cradle" ) (Just DiagnosticSeverity_Error ) nfp $ T. unlines $ map T. pack userFriendlyMessage
914
+ where
915
+
916
+ userFriendlyMessage :: [String ]
917
+ userFriendlyMessage
918
+ | HieBios. isCabalCradle cradle = fromMaybe ms fileMissingMessage
919
+ | otherwise = ms
920
+
921
+ fileMissingMessage :: Maybe [String ]
922
+ fileMissingMessage =
923
+ multiCradleErrMessage <$> parseMultiCradleErr ms
924
+
925
+ -- | Information included in Multi Cradle error messages
926
+ data MultiCradleErr = MultiCradleErr
927
+ { mcPwd :: FilePath
928
+ , mcFilePath :: FilePath
929
+ , mcPrefixes :: [(FilePath , String )]
930
+ } deriving (Show )
931
+
932
+ -- | Attempt to parse a multi-cradle message
933
+ parseMultiCradleErr :: [String ] -> Maybe MultiCradleErr
934
+ parseMultiCradleErr ms = do
935
+ _ <- lineAfter " Multi Cradle: "
936
+ wd <- lineAfter " pwd: "
937
+ fp <- lineAfter " filepath: "
938
+ ps <- prefixes
939
+ pure $ MultiCradleErr wd fp ps
940
+
941
+ where
942
+ lineAfter :: String -> Maybe String
943
+ lineAfter pre = listToMaybe $ mapMaybe (stripPrefix pre) ms
944
+
945
+ prefixes :: Maybe [(FilePath , String )]
946
+ prefixes = do
947
+ pure $ mapMaybe tuple ms
948
+
949
+ tuple :: String -> Maybe (String , String )
950
+ tuple line = do
951
+ line' <- surround ' (' line ' )'
952
+ [f, s] <- pure $ split (== ' ,' ) line'
953
+ pure (f, s)
954
+
955
+ -- extracts the string surrounded by required characters
956
+ surround :: Char -> String -> Char -> Maybe String
957
+ surround start s end = do
958
+ guard (listToMaybe s == Just start)
959
+ guard (listToMaybe (reverse s) == Just end)
960
+ pure $ drop 1 $ take (length s - 1 ) s
961
+
962
+
963
+
964
+
965
+
966
+
967
+ multiCradleErrMessage :: MultiCradleErr -> [String ]
968
+ multiCradleErrMessage e =
969
+ [ " Loading the module '" <> moduleFileName <> " ' failed. It seems that it is not listed in your .cabal file!"
970
+ , " Perhaps you need to add `" <> moduleName <> " ` to other-modules or exposed-modules" -- named 'example' in example.cabal."
971
+ , " For more information, visit: https://cabal.readthedocs.io/en/3.4/developing-packages.html#modules-included-in-the-package"
972
+ , " "
973
+ ] <> map prefix (mcPrefixes e)
974
+ where
975
+ localFilePath f = dropWhile (== pathSeparator) $ dropPrefix (mcPwd e) f
976
+ moduleFileName = localFilePath $ mcFilePath e
977
+ moduleName = intercalate " ." $ map dropExtension $ dropWhile isSourceFolder $ splitDirectories moduleFileName
978
+ isSourceFolder p = all isLower $ take 1 p
979
+ prefix (f, r) = f <> " - " <> r
980
+
981
+
982
+
983
+
984
+
911
985
912
986
-- See Note [Multi Cradle Dependency Info]
913
987
type DependencyInfo = Map. Map FilePath (Maybe UTCTime )
0 commit comments