@@ -238,17 +238,20 @@ findCabalHelperEntryPoint fp = do
238
238
supported (Ex ProjLocV1Dir {}) _ cabalInstalled = cabalInstalled
239
239
supported (Ex ProjLocV1CabalFile {}) _ cabalInstalled = cabalInstalled
240
240
241
- isStackProject (Ex ProjLocStackYaml {}) = True
242
- isStackProject _ = False
241
+ isStackProject :: Ex ProjLoc -> Bool
242
+ isStackProject (Ex ProjLocStackYaml {}) = True
243
+ isStackProject _ = False
243
244
244
- isCabalV2FileProject (Ex ProjLocV2File {}) = True
245
- isCabalV2FileProject _ = False
245
+ isCabalV2FileProject :: Ex ProjLoc -> Bool
246
+ isCabalV2FileProject (Ex ProjLocV2File {}) = True
247
+ isCabalV2FileProject _ = False
246
248
247
- isCabalProject (Ex ProjLocV1CabalFile {}) = True
248
- isCabalProject (Ex ProjLocV1Dir {}) = True
249
- isCabalProject (Ex ProjLocV2File {}) = True
250
- isCabalProject (Ex ProjLocV2Dir {}) = True
251
- isCabalProject _ = False
249
+ isCabalProject :: Ex ProjLoc -> Bool
250
+ isCabalProject (Ex ProjLocV1CabalFile {}) = True
251
+ isCabalProject (Ex ProjLocV1Dir {}) = True
252
+ isCabalProject (Ex ProjLocV2File {}) = True
253
+ isCabalProject (Ex ProjLocV2Dir {}) = True
254
+ isCabalProject _ = False
252
255
253
256
{- | Given a FilePath, find the cradle the FilePath belongs to.
254
257
@@ -476,6 +479,7 @@ cabalHelperCradle file = do
476
479
CradleAction { actionName =
477
480
" Cabal-Helper-" ++ actionNameSuffix
478
481
, runCradle = \ _ fp -> cabalHelperAction
482
+ (Ex proj)
479
483
env
480
484
realPackage
481
485
normalisedPackageLocation
@@ -497,24 +501,27 @@ cabalHelperCradle file = do
497
501
else arg
498
502
else arg
499
503
500
- -- | cradle Action to query for the ComponentOptions that are needed
504
+ -- | Cradle Action to query for the ComponentOptions that are needed
501
505
-- to load the given FilePath.
502
506
-- This Function is not supposed to throw any exceptions and use
503
507
-- 'CradleLoadResult' to indicate errors.
504
- cabalHelperAction :: QueryEnv v -- ^ Query Env created by 'mkQueryEnv'
508
+ cabalHelperAction :: Ex ProjLoc -- ^ Project location, can be used
509
+ -- to present error build-tool
510
+ -- agnostic error messages.
511
+ -> QueryEnv v -- ^ Query Env created by 'mkQueryEnv'
505
512
-- with the appropriate 'distdir'
506
513
-> Package v -- ^ Package this cradle is part for.
507
514
-> FilePath -- ^ Root directory of the cradle
508
515
-- this action belongs to.
509
516
-> FilePath -- ^ FilePath to load, expected to be an absolute path.
510
517
-> IO (CradleLoadResult ComponentOptions )
511
- cabalHelperAction env package root fp = do
518
+ cabalHelperAction proj env package root fp = do
512
519
-- Get all unit infos the given FilePath may belong to
513
520
let units = pUnits package
514
521
-- make the FilePath to load relative to the root of the cradle.
515
522
let relativeFp = makeRelative root fp
516
523
debugm $ " Relative Module FilePath: " ++ relativeFp
517
- getComponent env (toList units) relativeFp
524
+ getComponent proj env (toList units) relativeFp
518
525
>>= \ case
519
526
Right comp -> do
520
527
let fs' = getFlags comp
@@ -542,8 +549,8 @@ cabalHelperCradle file = do
542
549
-- The given FilePath must be relative to the Root of the project
543
550
-- the given units belong to.
544
551
getComponent
545
- :: forall pt . QueryEnv pt -> [Unit pt ] -> FilePath -> IO (Either [String ] ChComponentInfo )
546
- getComponent env unitCandidates fp = getComponent' [] [] unitCandidates >>=
552
+ :: forall pt . Ex ProjLoc -> QueryEnv pt -> [Unit pt ] -> FilePath -> IO (Either [String ] ChComponentInfo )
553
+ getComponent proj env unitCandidates fp = getComponent' [] [] unitCandidates >>=
547
554
\ case
548
555
(tried, failed, Nothing ) -> return (Left $ buildErrorMsg tried failed)
549
556
(_, _, Just comp) -> return (Right comp)
@@ -570,33 +577,51 @@ getComponent env unitCandidates fp = getComponent' [] [] unitCandidates >>=
570
577
571
578
buildErrorMsg :: [UnitInfo ] -> [(Unit pt , IOException )] -> [String ]
572
579
buildErrorMsg triedUnits failedUnits =
573
- [ " Could not obtain flags for: \" " ++ fp ++ " \" ."
580
+ concat
581
+ [ [ " Could not obtain flags for: \" " ++ fp ++ " \" ."
574
582
, " "
575
583
]
576
- ++ concat
577
- [
578
- [ " This Module was not part of any component we are aware of."
584
+ , concat
585
+ [ concat
586
+ [ [ " This Module was not part of any component we are aware of."
579
587
, " "
580
588
]
581
- ++ concatMap ppShowUnitInfo triedUnits
582
- ++ [ " "
583
- , " "
584
- , " To expose a module, refer to:"
585
- , " https://www.haskell.org/cabal/users-guide/developing-packages.html"
586
- , " "
587
- ]
588
- | not (null triedUnits)
589
- ]
590
- ++ concat
591
- [
592
- [ " We could not build all components."
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:"
589
+ , concatMap ppShowUnitInfo triedUnits
590
+ , [ " "
591
+ , " "
596
592
]
597
- ++ concatMap (ppShowIOException . snd ) failedUnits
598
- | not (null failedUnits)
593
+ , if isStackProject proj
594
+ then stackSpecificInstructions
595
+ else cabalSpecificInstructions
596
+ ]
597
+ | not (null triedUnits)
598
+ ]
599
+ , concat
600
+ [
601
+ [ " We could not build all components."
602
+ , " If one of these components exposes this Module, make sure they compile."
603
+ , " You can try to invoke the commands yourself."
604
+ , " The following commands failed:"
599
605
]
606
+ ++ concatMap (ppShowIOException . snd ) failedUnits
607
+ | not (null failedUnits)
608
+ ]
609
+ ]
610
+
611
+ stackSpecificInstructions :: [String ]
612
+ stackSpecificInstructions =
613
+ [ " To expose a module, refer to:"
614
+ , " https://docs.haskellstack.org/en/stable/GUIDE/"
615
+ , " If you are using `package.yaml` then you don't have manually expose modules."
616
+ , " Maybe you didn't set the source directories for your project correctly."
617
+ ]
618
+
619
+ cabalSpecificInstructions :: [String ]
620
+ cabalSpecificInstructions =
621
+ [ " To expose a module, refer to:"
622
+ , " https://www.haskell.org/cabal/users-guide/developing-packages.html"
623
+ , " "
624
+ ]
600
625
601
626
ppShowUnitInfo :: UnitInfo -> [String ]
602
627
ppShowUnitInfo u =
0 commit comments