Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 1ade72c

Browse files
committed
Add more sophisticated error messages
1 parent 50c82af commit 1ade72c

File tree

1 file changed

+36
-12
lines changed

1 file changed

+36
-12
lines changed

hie-plugin-api/Haskell/Ide/Engine/Cradle.hs

Lines changed: 36 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -13,14 +13,14 @@ import Distribution.Helper (Package, projectPackages, pUnits,
1313
unChModuleName, Ex(..), ProjLoc(..),
1414
QueryEnv, mkQueryEnv, runQuery,
1515
Unit, unitInfo, uiComponents,
16-
ChEntrypoint(..), uComponentName)
16+
ChEntrypoint(..), UnitInfo(..))
1717
import Distribution.Helper.Discover (findProjects, getDefaultDistDir)
1818
import Data.Char (toLower)
1919
import Data.Function ((&))
20-
import Data.List (isPrefixOf, isInfixOf, sortOn, find, intercalate)
20+
import Data.List (isPrefixOf, isInfixOf, sortOn, find)
2121
import qualified Data.List.NonEmpty as NonEmpty
2222
import Data.List.NonEmpty (NonEmpty)
23-
import qualified Data.Map as M
23+
import qualified Data.Map as Map
2424
import Data.Maybe (listToMaybe, mapMaybe, isJust)
2525
import Data.Ord (Down(..))
2626
import Data.String (IsString(..))
@@ -146,7 +146,7 @@ getProjectGhcLibDir :: Cradle -> IO (Maybe FilePath)
146146
getProjectGhcLibDir crdl =
147147
execProjectGhc crdl ["--print-libdir"] >>= \case
148148
Nothing -> do
149-
logm "Could not obtain the libdir."
149+
errorm "Could not obtain the libdir."
150150
return Nothing
151151
mlibdir -> return mlibdir
152152

@@ -548,7 +548,7 @@ getComponent env unitCandidates fp = getComponent' [] [] unitCandidates >>=
548548
(tried, failed, Nothing) -> return (Left $ buildErrorMsg tried failed)
549549
(_, _, Just comp) -> return (Right comp)
550550
where
551-
getComponent' :: [Unit pt] -> [Unit pt] -> [Unit pt] -> IO ([Unit pt], [Unit pt], Maybe ChComponentInfo)
551+
getComponent' :: [UnitInfo] -> [(Unit pt, IOException)] -> [Unit pt] -> IO ([UnitInfo], [(Unit pt, IOException)], Maybe ChComponentInfo)
552552
getComponent' triedUnits failedUnits [] = return (triedUnits, failedUnits, Nothing)
553553
getComponent' triedUnits failedUnits (unit : units) =
554554
try (runQuery (unitInfo unit) env) >>= \case
@@ -560,15 +560,15 @@ getComponent env unitCandidates fp = getComponent' [] [] unitCandidates >>=
560560
++ fp
561561
++ "\" in the unit: "
562562
++ show unit
563-
getComponent' triedUnits (unit:failedUnits) units
563+
getComponent' triedUnits ((unit, e):failedUnits) units
564564
Right ui -> do
565-
let components = M.elems (uiComponents ui)
565+
let components = Map.elems (uiComponents ui)
566566
debugm $ "Unit Info: " ++ show ui
567567
case find (fp `partOfComponent`) components of
568-
Nothing -> getComponent' (unit:triedUnits) failedUnits units
568+
Nothing -> getComponent' (ui:triedUnits) failedUnits units
569569
comp -> return (triedUnits, failedUnits, comp)
570570

571-
buildErrorMsg :: [Unit pt] -> [Unit pt] -> [String]
571+
buildErrorMsg :: [UnitInfo] -> [(Unit pt, IOException)] -> [String]
572572
buildErrorMsg triedUnits failedUnits =
573573
[ "Could not obtain flags for: \"" ++ fp ++ "\"."
574574
, ""
@@ -577,20 +577,44 @@ getComponent env unitCandidates fp = getComponent' [] [] unitCandidates >>=
577577
[
578578
[ "This Module was not part of any component we are aware of."
579579
, ""
580-
, "If you dont know how to expose a module, take a look at: "
581-
, "https://www.haskell.org/cabal/users-guide/developing-packages.html"
582-
, ""
583580
]
581+
++ concatMap ppShowUnitInfo triedUnits
582+
++ [ ""
583+
, ""
584+
, "If you dont know how to expose a module, take a look at:"
585+
, "https://www.haskell.org/cabal/users-guide/developing-packages.html"
586+
, ""
587+
]
584588
| not (null triedUnits)
585589
]
586590
++ concat
587591
[
588592
[ "We could not build all components."
589593
, "If one of these components exposes this Module, make sure they compile."
594+
, "You can try to invoke the commands yourself."
595+
, "The following commands failed:"
590596
]
597+
++ concatMap (ppShowIOException . snd) failedUnits
591598
| not (null failedUnits)
592599
]
593600

601+
ppShowUnitInfo :: UnitInfo -> [String]
602+
ppShowUnitInfo u =
603+
u
604+
& uiComponents
605+
& Map.toList
606+
& map
607+
(\(name, info) ->
608+
"Component: " ++ show name ++ " with source directory: " ++ show (ciSourceDirs info)
609+
)
610+
611+
612+
ppShowIOException :: IOException -> [String]
613+
ppShowIOException e =
614+
[ ""
615+
, show e
616+
]
617+
594618
-- | Check whether the given FilePath is part of the Component.
595619
-- A FilePath is part of the Component if and only if:
596620
--

0 commit comments

Comments
 (0)