Commit 6dc05349 authored by kristenk's avatar kristenk
Browse files

Run package checks on the GenericPackageDescription created by the solver DSL.

The checks might detect some errors in the DSL. The commit also adds non-default
values to some fields to make the checks pass, such as adding a default-language
to each component.
parent 7d0b6834
......@@ -33,7 +33,7 @@ module UnitTests.Distribution.Solver.Modular.DSL (
-- base
import Data.Either (partitionEithers)
import Data.Maybe (catMaybes, isNothing)
import Data.List (elemIndex, nub)
import Data.List (elemIndex, isPrefixOf, nub)
import Data.Monoid
import Data.Ord (comparing)
import qualified Data.Map as Map
......@@ -41,12 +41,16 @@ import qualified Data.Map as Map
-- Cabal
import qualified Distribution.Compiler as C
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.License (License(..))
import qualified Distribution.ModuleName as Module
import qualified Distribution.Package as C
hiding (HasUnitId(..))
import qualified Distribution.PackageDescription as C
import qualified Distribution.PackageDescription.Check as C
import qualified Distribution.Simple.PackageIndex as C.PackageIndex
import Distribution.Simple.Setup (BooleanFlag(..))
import qualified Distribution.System as C
import Distribution.Text (display)
import qualified Distribution.Version as C
import Language.Haskell.Extension (Extension(..), Language(..))
......@@ -265,7 +269,7 @@ exAvSrcPkg ex =
C.setupDepends = mkSetupDeps deps,
C.defaultSetupDepends = False
}
in SourcePackage {
package = SourcePackage {
packageInfoId = pkgId
, packageSource = LocalTarballPackage "<<path>>"
, packageDescrOverride = Nothing
......@@ -279,6 +283,16 @@ exAvSrcPkg ex =
, C.benchmarks = error "not yet configured: benchmarks"
, C.buildDepends = error "not yet configured: buildDepends"
, C.setupBuildInfo = setup
, C.license = BSD3
, C.buildType = if isNothing setup
then Just C.Simple
else Just C.Custom
, C.category = "category"
, C.maintainer = "maintainer"
, C.description = "description"
, C.synopsis = "synopsis"
, C.licenseFiles = ["LICENSE"]
, C.specVersionRaw = Left $ C.mkVersion [1,12]
}
, C.genPackageFlags = nub $ concatMap extractFlags $
CD.libraryDeps (exAvDeps ex)
......@@ -286,21 +300,43 @@ exAvSrcPkg ex =
++ concatMap snd executables
, C.condLibrary =
let mkLib bi = mempty { C.libBuildInfo = bi }
in Just $ mkCondTree mkLib $ mkBuildInfoTree $
in Just $ mkCondTree defaultLib mkLib $ mkBuildInfoTree $
Buildable (CD.libraryDeps (exAvDeps ex))
, C.condSubLibraries = []
, C.condExecutables =
let mkTree = mkCondTree mkExe . mkBuildInfoTree . Buildable
let mkTree = mkCondTree defaultExe mkExe . mkBuildInfoTree . Buildable
mkExe bi = mempty { C.buildInfo = bi }
in map (\(t, deps) -> (t, mkTree deps)) executables
, C.condTestSuites =
let mkTree = mkCondTree mkTest . mkBuildInfoTree . Buildable
let mkTree = mkCondTree defaultTest mkTest . mkBuildInfoTree . Buildable
mkTest bi = mempty { C.testBuildInfo = bi }
in map (\(t, deps) -> (t, mkTree deps)) testSuites
, C.condBenchmarks = []
}
}
pkgCheckErrors =
let ignore = ["Unknown extensions:", "Unknown languages:"]
in [ err | err <- C.checkPackage (packageDescription package) Nothing
, not $ any (`isPrefixOf` C.explanation err) ignore ]
in if null pkgCheckErrors
then package
else error $ "invalid GenericPackageDescription for package "
++ display pkgId ++ ": " ++ show pkgCheckErrors
where
defaultTopLevelBuildInfo :: C.BuildInfo
defaultTopLevelBuildInfo = mempty { C.defaultLanguage = Just Haskell98 }
defaultLib :: C.Library
defaultLib = mempty { C.exposedModules = [Module.fromString "Module"] }
defaultExe :: C.Executable
defaultExe = mempty { C.modulePath = "Main.hs" }
defaultTest :: C.TestSuite
defaultTest = mempty {
C.testInterface = C.TestSuiteExeV10 (C.mkVersion [1,0]) "Test.hs"
}
-- Split the set of dependencies into the set of dependencies of the library,
-- the dependencies of the test suites and extensions.
splitTopLevel :: [ExampleDependency]
......@@ -354,21 +390,27 @@ exAvSrcPkg ex =
extractFlags (ExPkg _) = []
-- Convert a tree of BuildInfos into a tree of a specific component type.
-- 'defaultTopLevel' contains the default values for the component, and
-- 'mkComponent' creates a component from a 'BuildInfo'.
mkCondTree :: forall a. Monoid a =>
(C.BuildInfo -> a)
a -> (C.BuildInfo -> a)
-> DependencyTree C.BuildInfo
-> DependencyTree a
mkCondTree mkComponent (C.CondNode ctData constraints comps) =
mkCondTree defaultTopLevel mkComponent (C.CondNode topData topConstraints topComps) =
C.CondNode {
C.condTreeData = mkComponent ctData
, C.condTreeConstraints = constraints
, C.condTreeComponents = goComponents comps
C.condTreeData =
defaultTopLevel <> mkComponent (defaultTopLevelBuildInfo <> topData)
, C.condTreeConstraints = topConstraints
, C.condTreeComponents = goComponents topComps
}
where
go :: DependencyTree C.BuildInfo -> DependencyTree a
go (C.CondNode ctData constraints comps) =
C.CondNode (mkComponent ctData) constraints (goComponents comps)
goComponents :: [DependencyComponent C.BuildInfo]
-> [DependencyComponent a]
goComponents cs =
[(cond, mkCondTree mkComponent t, mkCondTree mkComponent <$> me) | (cond, t, me) <- cs]
goComponents comps = [(cond, go t, go <$> me) | (cond, t, me) <- comps]
mkBuildInfoTree :: Dependencies -> DependencyTree C.BuildInfo
mkBuildInfoTree NotBuildable =
......
......@@ -980,7 +980,7 @@ dbLangs1 = [
testBuildable :: String -> ExampleDependency -> TestTree
testBuildable testName unavailableDep =
runTest $
mkTestExtLangPC (Just []) (Just []) [] db testName ["pkg"] expected
mkTestExtLangPC (Just []) (Just [Haskell98]) [] db testName ["pkg"] expected
where
expected = solverSuccess [("false-dep", 1), ("pkg", 1)]
db = [
......
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