Commit 1743a4d8 authored by kristenk's avatar kristenk Committed by Mikhail Glushenkov

Solver DSL: Support packages without libraries.

The solver DSL previously always added a default library component.
parent 1bc42a89
......@@ -21,6 +21,7 @@ module UnitTests.Distribution.Solver.Modular.DSL (
, ExampleVar(..)
, EnableAllTests(..)
, exAv
, exAvNoLibrary
, exInst
, exFlagged
, exResolve
......@@ -241,14 +242,21 @@ newtype EnableAllTests = EnableAllTests Bool
--
-- 1. The name 'ExamplePkgName' of the available package,
-- 2. The version 'ExamplePkgVersion' available
-- 3. The list of dependency constraints 'ExampleDependency'
-- that this package has. 'ExampleDependency' provides
-- a number of pre-canned dependency types to look at.
-- 3. The list of dependency constraints ('ExampleDependency')
-- for this package's library component. 'ExampleDependency'
-- provides a number of pre-canned dependency types to look at.
--
exAv :: ExamplePkgName -> ExamplePkgVersion -> [ExampleDependency]
-> ExampleAvailable
exAv n v ds = ExAv { exAvName = n, exAvVersion = v
, exAvDeps = CD.fromLibraryDeps ds, exAvFlags = [] }
exAv n v ds = (exAvNoLibrary n v) { exAvDeps = CD.fromLibraryDeps ds }
-- | Constructs an 'ExampleAvailable' package without a default library
-- component.
exAvNoLibrary :: ExamplePkgName -> ExamplePkgVersion -> ExampleAvailable
exAvNoLibrary n v = ExAv { exAvName = n
, exAvVersion = v
, exAvDeps = CD.empty
, exAvFlags = [] }
-- | Override the default settings (e.g., manual vs. automatic) for a subset of
-- a package's flags.
......@@ -367,9 +375,11 @@ exAvSrcPkg ex =
, C.genPackageFlags = flags
, C.condLibrary =
let mkLib bi = mempty { C.libBuildInfo = bi }
in Just $ mkCondTree defaultLib mkLib $ mkBuildInfoTree $
Buildable $ fromMaybe [] $
lookup CD.ComponentLib (CD.toList (exAvDeps ex))
-- Avoid using the Monoid instance for [a] when getting
-- the library dependencies, to allow for the possibility
-- that the package doesn't have a library:
libDeps = lookup CD.ComponentLib (CD.toList (exAvDeps ex))
in mkCondTree defaultLib mkLib . mkBuildInfoTree . Buildable <$> libDeps
, C.condSubLibraries =
let mkTree = mkCondTree defaultLib mkLib . mkBuildInfoTree . Buildable
mkLib bi = mempty { C.libBuildInfo = bi }
......
......@@ -277,13 +277,17 @@ arbitraryExInst pn v pkgs = do
return $ ExInst (unPN pn) (unPV v) pkgHash (map exInstHash deps)
arbitraryComponentDeps :: PN -> TestDb -> Gen (ComponentDeps [ExampleDependency])
arbitraryComponentDeps _ (TestDb []) = return $ CD.fromList []
arbitraryComponentDeps pn db =
arbitraryComponentDeps _ (TestDb []) = return $ CD.fromLibraryDeps []
arbitraryComponentDeps pn db = do
-- dedupComponentNames removes components with duplicate names, for example,
-- 'ComponentExe x' and 'ComponentTest x', and then CD.fromList combines
-- duplicate unnamed components.
CD.fromList . dedupComponentNames . filter (isValid . fst)
<$> boundedListOf 5 (arbitraryComponentDep db)
cds <- CD.fromList . dedupComponentNames . filter (isValid . fst)
<$> boundedListOf 5 (arbitraryComponentDep db)
return $ if isCompleteComponentDeps cds
then cds
else -- Add a library if the ComponentDeps isn't complete.
CD.fromLibraryDeps [] <> cds
where
isValid :: Component -> Bool
isValid (ComponentSubLib name) = name /= mkUnqualComponentName (unPN pn)
......@@ -301,6 +305,19 @@ arbitraryComponentDeps pn db =
componentName (ComponentTest n) = Just n
componentName (ComponentBench n) = Just n
-- | Returns true if the ComponentDeps forms a complete package, i.e., it
-- contains a library, exe, test, or benchmark.
isCompleteComponentDeps :: ComponentDeps a -> Bool
isCompleteComponentDeps = any (completesPkg . fst) . CD.toList
where
completesPkg ComponentLib = True
completesPkg (ComponentExe _) = True
completesPkg (ComponentTest _) = True
completesPkg (ComponentBench _) = True
completesPkg (ComponentSubLib _) = False
completesPkg (ComponentFLib _) = False
completesPkg ComponentSetup = False
arbitraryComponentDep :: TestDb -> Gen (ComponentDep [ExampleDependency])
arbitraryComponentDep db = do
comp <- arbitrary
......@@ -416,7 +433,7 @@ instance Arbitrary ExampleAvailable where
instance (Arbitrary a, Monoid a) => Arbitrary (ComponentDeps a) where
arbitrary = error "arbitrary not implemented: ComponentDeps"
shrink = map CD.fromList . shrink . CD.toList
shrink = filter isCompleteComponentDeps . map CD.fromList . shrink . CD.toList
instance Arbitrary ExampleDependency where
arbitrary = error "arbitrary not implemented: ExampleDependency"
......
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