@@ -13,14 +13,14 @@ import Distribution.Helper (Package, projectPackages, pUnits,
13
13
unChModuleName , Ex (.. ), ProjLoc (.. ),
14
14
QueryEnv , mkQueryEnv , runQuery ,
15
15
Unit , unitInfo , uiComponents ,
16
- ChEntrypoint (.. ), uComponentName )
16
+ ChEntrypoint (.. ), UnitInfo ( .. ) )
17
17
import Distribution.Helper.Discover (findProjects , getDefaultDistDir )
18
18
import Data.Char (toLower )
19
19
import Data.Function ((&) )
20
- import Data.List (isPrefixOf , isInfixOf , sortOn , find , intercalate )
20
+ import Data.List (isPrefixOf , isInfixOf , sortOn , find )
21
21
import qualified Data.List.NonEmpty as NonEmpty
22
22
import Data.List.NonEmpty (NonEmpty )
23
- import qualified Data.Map as M
23
+ import qualified Data.Map as Map
24
24
import Data.Maybe (listToMaybe , mapMaybe , isJust )
25
25
import Data.Ord (Down (.. ))
26
26
import Data.String (IsString (.. ))
@@ -146,7 +146,7 @@ getProjectGhcLibDir :: Cradle -> IO (Maybe FilePath)
146
146
getProjectGhcLibDir crdl =
147
147
execProjectGhc crdl [" --print-libdir" ] >>= \ case
148
148
Nothing -> do
149
- logm " Could not obtain the libdir."
149
+ errorm " Could not obtain the libdir."
150
150
return Nothing
151
151
mlibdir -> return mlibdir
152
152
@@ -548,7 +548,7 @@ getComponent env unitCandidates fp = getComponent' [] [] unitCandidates >>=
548
548
(tried, failed, Nothing ) -> return (Left $ buildErrorMsg tried failed)
549
549
(_, _, Just comp) -> return (Right comp)
550
550
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 )
552
552
getComponent' triedUnits failedUnits [] = return (triedUnits, failedUnits, Nothing )
553
553
getComponent' triedUnits failedUnits (unit : units) =
554
554
try (runQuery (unitInfo unit) env) >>= \ case
@@ -560,15 +560,15 @@ getComponent env unitCandidates fp = getComponent' [] [] unitCandidates >>=
560
560
++ fp
561
561
++ " \" in the unit: "
562
562
++ show unit
563
- getComponent' triedUnits (unit: failedUnits) units
563
+ getComponent' triedUnits (( unit, e) : failedUnits) units
564
564
Right ui -> do
565
- let components = M . elems (uiComponents ui)
565
+ let components = Map . elems (uiComponents ui)
566
566
debugm $ " Unit Info: " ++ show ui
567
567
case find (fp `partOfComponent` ) components of
568
- Nothing -> getComponent' (unit : triedUnits) failedUnits units
568
+ Nothing -> getComponent' (ui : triedUnits) failedUnits units
569
569
comp -> return (triedUnits, failedUnits, comp)
570
570
571
- buildErrorMsg :: [Unit pt ] -> [Unit pt ] -> [String ]
571
+ buildErrorMsg :: [UnitInfo ] -> [( Unit pt , IOException ) ] -> [String ]
572
572
buildErrorMsg triedUnits failedUnits =
573
573
[ " Could not obtain flags for: \" " ++ fp ++ " \" ."
574
574
, " "
@@ -577,20 +577,44 @@ getComponent env unitCandidates fp = getComponent' [] [] unitCandidates >>=
577
577
[
578
578
[ " This Module was not part of any component we are aware of."
579
579
, " "
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
- , " "
583
580
]
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
+ ]
584
588
| not (null triedUnits)
585
589
]
586
590
++ concat
587
591
[
588
592
[ " We could not build all components."
589
593
, " 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:"
590
596
]
597
+ ++ concatMap (ppShowIOException . snd ) failedUnits
591
598
| not (null failedUnits)
592
599
]
593
600
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
+
594
618
-- | Check whether the given FilePath is part of the Component.
595
619
-- A FilePath is part of the Component if and only if:
596
620
--
0 commit comments