Commit d1d9737c authored by Brendan Hay's avatar Brendan Hay Committed by GitHub
Browse files

Merge pull request #3844 from brendanhay/implicit-vs-explicit-project-errors

Track cabal.project provenance for error reporting
parents e82736cc c2ebd714
......@@ -8,6 +8,7 @@ module Distribution.Client.ProjectConfig (
ProjectConfig(..),
ProjectConfigBuildOnly(..),
ProjectConfigShared(..),
ProjectConfigProvenance(..),
PackageConfig(..),
MapLast(..),
MapMappend(..),
......@@ -100,10 +101,12 @@ import Control.Monad
import Control.Monad.Trans (liftIO)
import Control.Exception
import Data.Typeable
import Data.List (intercalate)
import Data.Maybe
import Data.Either
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Distribution.Compat.Semigroup
import System.FilePath hiding (combine)
......@@ -382,7 +385,7 @@ readProjectLocalConfig verbosity projectRootDir = do
if usesExplicitProjectRoot
then do
monitorFiles [monitorFileHashed projectFile]
liftIO readProjectFile
addProjectFileProvenance <$> liftIO readProjectFile
else do
monitorFiles [monitorNonExistentFile projectFile]
return defaultImplicitProjectConfig
......@@ -394,6 +397,12 @@ readProjectLocalConfig verbosity projectRootDir = do
. parseProjectConfig
=<< readFile projectFile
addProjectFileProvenance config =
config {
projectConfigProvenance =
Set.insert (Explicit projectFile) (projectConfigProvenance config)
}
defaultImplicitProjectConfig :: ProjectConfig
defaultImplicitProjectConfig =
mempty {
......@@ -401,9 +410,10 @@ readProjectLocalConfig verbosity projectRootDir = do
projectPackages = [ "./*.cabal" ],
-- This is to automatically pick up deps that we unpack locally.
projectPackagesOptional = [ "./*/*.cabal" ]
}
projectPackagesOptional = [ "./*/*.cabal" ],
projectConfigProvenance = Set.singleton Implicit
}
-- | Reads a @cabal.project.local@ file in the given project root dir,
-- or returns empty. This file gets written by @cabal configure@, or in
......@@ -534,7 +544,8 @@ data ProjectPackageLocation =
-- | Exception thrown by 'findProjectPackages'.
--
newtype BadPackageLocations = BadPackageLocations [BadPackageLocation]
data BadPackageLocations
= BadPackageLocations (Set ProjectConfigProvenance) [BadPackageLocation]
#if MIN_VERSION_base(4,8,0)
deriving (Show, Typeable)
#else
......@@ -567,15 +578,58 @@ data BadPackageLocationMatch
deriving Show
renderBadPackageLocations :: BadPackageLocations -> String
renderBadPackageLocations (BadPackageLocations bpls) =
unlines (map renderBadPackageLocation bpls)
renderBadPackageLocations (BadPackageLocations provenance bpls)
-- There is no provenance information,
-- render standard bad package error information.
| Set.null provenance = renderErrors renderBadPackageLocation
-- The configuration is implicit, render bad package locations
-- using possibly specialized error messages.
| Set.singleton Implicit == provenance =
renderErrors renderImplicitBadPackageLocation
-- The configuration contains both implicit and explicit provenance.
-- This should not occur, and a message is output to assist debugging.
| Implicit `Set.member` provenance =
"Warning: both implicit and explicit configuration is present."
++ renderExplicit
-- The configuration was read from one or more explicit path(s),
-- list the locations and render the bad package error information.
-- The intent is to supersede this with the relevant location information
-- per package error.
| otherwise = renderExplicit
where
renderErrors f = unlines (map f bpls)
renderExplicit =
"When using configuration(s) from "
++ intercalate ", " (mapMaybe getExplicit (Set.toList provenance))
++ ", the following errors occurred:\n"
++ renderErrors renderBadPackageLocation
getExplicit (Explicit path) = Just path
getExplicit Implicit = Nothing
--TODO: [nice to have] keep track of the config file (and src loc) packages
-- were listed, to use in error messages
--TODO: [nice to have] keep track in the ProjectConfig and BadPackageLocations
-- of whether the project config was explicit or implicit so we can report a
-- better message, either pointing to the file or talking about the issues
-- related to having no project file and no package.
-- | Render bad package location error information for the implicit
-- @cabal.project@ configuration.
--
-- TODO: This is currently not fully realized, with only one of the implicit
-- cases handled. More cases should be added with informative help text
-- about the issues related specifically when having no project configuration
-- is present.
renderImplicitBadPackageLocation :: BadPackageLocation -> String
renderImplicitBadPackageLocation bpl = case bpl of
BadLocGlobEmptyMatch pkglocstr ->
"No cabal.project file or cabal file matching the default glob '"
++ pkglocstr ++ "' was found.\n"
++ "Please create a package description file <pkgname>.cabal "
++ "or a cabal.project file referencing the packages you "
++ "want to build."
_ -> renderBadPackageLocation bpl
renderBadPackageLocation :: BadPackageLocation -> String
renderBadPackageLocation bpl = case bpl of
......@@ -632,7 +686,7 @@ findProjectPackages projectRootDir ProjectConfig{..} = do
(problems, pkglocs) <-
partitionEithers <$> mapM (findPackageLocation required) pkglocstr
unless (null problems) $
liftIO $ throwIO $ BadPackageLocations problems
liftIO $ throwIO $ BadPackageLocations projectConfigProvenance problems
return (concat pkglocs)
......
......@@ -242,6 +242,7 @@ convertLegacyProjectConfig
projectConfigBuildOnly = configBuildOnly,
projectConfigShared = configAllPackages,
projectConfigProvenance = mempty,
projectConfigLocalPackages = configLocalPackages,
projectConfigSpecificPackage = fmap perPackage legacySpecificConfig
}
......
......@@ -8,6 +8,7 @@ module Distribution.Client.ProjectConfig.Types (
ProjectConfig(..),
ProjectConfigBuildOnly(..),
ProjectConfigShared(..),
ProjectConfigProvenance(..),
PackageConfig(..),
-- * Resolving configuration
......@@ -53,6 +54,7 @@ import Distribution.Verbosity
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import Distribution.Compat.Binary (Binary)
import Distribution.Compat.Semigroup
import GHC.Generics (Generic)
......@@ -104,6 +106,7 @@ data ProjectConfig
-- values are about:
projectConfigBuildOnly :: ProjectConfigBuildOnly,
projectConfigShared :: ProjectConfigShared,
projectConfigProvenance :: Set ProjectConfigProvenance,
-- | Configuration to be applied to *local* packages; i.e.,
-- any packages which are explicitly named in `cabal.project`.
......@@ -186,6 +189,21 @@ data ProjectConfigShared
deriving (Eq, Show, Generic)
-- | Specifies the provenance of project configuration, whether defaults were
-- used or if the configuration was read from an explicit file path.
data ProjectConfigProvenance
-- | The configuration is implicit due to no explicit configuration
-- being found. See 'Distribution.Client.ProjectConfig.readProjectConfig'
-- for how implicit configuration is determined.
= Implicit
-- | The path the project configuration was explicitly read from.
-- | The configuration was explicitly read from the specified 'FilePath'.
| Explicit FilePath
deriving (Eq, Ord, Show, Generic)
-- | Project configuration that is specific to each package, that is where we
-- can in principle have different values for different packages in the same
-- project.
......@@ -239,6 +257,7 @@ data PackageConfig
instance Binary ProjectConfig
instance Binary ProjectConfigBuildOnly
instance Binary ProjectConfigShared
instance Binary ProjectConfigProvenance
instance Binary PackageConfig
......
......@@ -69,7 +69,7 @@ tests config =
testExceptionInFindingPackage :: ProjectConfig -> Assertion
testExceptionInFindingPackage config = do
BadPackageLocations locs <- expectException "BadPackageLocations" $
BadPackageLocations _ locs <- expectException "BadPackageLocations" $
void $ planProject testdir config
case locs of
[BadLocGlobEmptyMatch "./*.cabal"] -> return ()
......@@ -81,7 +81,7 @@ testExceptionInFindingPackage config = do
testExceptionInFindingPackage2 :: ProjectConfig -> Assertion
testExceptionInFindingPackage2 config = do
BadPackageLocations locs <- expectException "BadPackageLocations" $
BadPackageLocations _ locs <- expectException "BadPackageLocations" $
void $ planProject testdir config
case locs of
[BadPackageLocationFile (BadLocDirNoCabalFile ".")] -> return ()
......
......@@ -95,8 +95,11 @@ roundtrip_legacytypes =
prop_roundtrip_legacytypes_all :: ProjectConfig -> Bool
prop_roundtrip_legacytypes_all =
prop_roundtrip_legacytypes_all config =
roundtrip_legacytypes
config {
projectConfigProvenance = mempty
}
prop_roundtrip_legacytypes_packages :: ProjectConfig -> Bool
prop_roundtrip_legacytypes_packages config =
......@@ -104,6 +107,7 @@ prop_roundtrip_legacytypes_packages config =
config {
projectConfigBuildOnly = mempty,
projectConfigShared = mempty,
projectConfigProvenance = mempty,
projectConfigLocalPackages = mempty,
projectConfigSpecificPackage = mempty
}
......@@ -140,7 +144,7 @@ roundtrip_printparse config =
. showLegacyProjectConfig
. convertToLegacyProjectConfig)
config of
ParseOk _ x -> x == config
ParseOk _ x -> x == config { projectConfigProvenance = mempty }
_ -> False
......@@ -244,19 +248,21 @@ instance Arbitrary ProjectConfig where
<*> (map getPackageLocationString <$> arbitrary)
<*> shortListOf 3 arbitrary
<*> arbitrary
<*> arbitrary <*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> (MapMappend . fmap getNonMEmpty . Map.fromList
<$> shortListOf 3 arbitrary)
-- package entries with no content are equivalent to
-- the entry not existing at all, so exclude empty
shrink (ProjectConfig x0 x1 x2 x3 x4 x5 x6 x7) =
shrink (ProjectConfig x0 x1 x2 x3 x4 x5 x6 x7 x8) =
[ ProjectConfig x0' x1' x2' x3'
x4' x5' x6' (MapMappend (fmap getNonMEmpty x7'))
| ((x0', x1', x2', x3'), (x4', x5', x6', x7'))
x4' x5' x6' x7' (MapMappend (fmap getNonMEmpty x8'))
| ((x0', x1', x2', x3'), (x4', x5', x6', x7', x8'))
<- shrink ((x0, x1, x2, x3),
(x4, x5, x6, fmap NonMEmpty (getMapMappend x7)))
(x4, x5, x6, x7, fmap NonMEmpty (getMapMappend x8)))
]
newtype PackageLocationString
......@@ -374,6 +380,9 @@ projectConfigConstraintSource :: ConstraintSource
projectConfigConstraintSource =
ConstraintSourceProjectConfig "TODO"
instance Arbitrary ProjectConfigProvenance where
arbitrary = elements [Implicit, Explicit "cabal.project"]
instance Arbitrary PackageConfig where
arbitrary =
PackageConfig
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment