1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
module UnitTests.Distribution.Client.Targets (
tests
) where
import Distribution.Client.Targets (UserQualifier(..)
,UserConstraintScope(..)
,UserConstraint(..), readUserConstraint)
import Distribution.Package (mkPackageName)
import Distribution.PackageDescription (mkFlagName, mkFlagAssignment)
import Distribution.Version (anyVersion, thisVersion, mkVersion)
import Distribution.Parsec (explicitEitherParsec, parsec, parsecCommaList)
import Distribution.Solver.Types.PackageConstraint (PackageProperty(..))
import Distribution.Solver.Types.OptionalStanza (OptionalStanza(..))
import Test.Tasty
import Test.Tasty.HUnit
import Data.List (intercalate)
-- Helper function: makes a test group by mapping each element
-- of a list to a test case.
makeGroup :: String -> (a -> Assertion) -> [a] -> TestTree
makeGroup name f xs = testGroup name $
zipWith testCase (map show [0 :: Integer ..]) (map f xs)
tests :: [TestTree]
tests =
[ makeGroup "readUserConstraint" (uncurry readUserConstraintTest)
exampleConstraints
, makeGroup "parseUserConstraint" (uncurry parseUserConstraintTest)
exampleConstraints
, makeGroup "readUserConstraints" (uncurry readUserConstraintsTest)
[-- First example only.
(head exampleStrs, take 1 exampleUcs),
-- All examples separated by commas.
(intercalate ", " exampleStrs, exampleUcs)]
]
where
(exampleStrs, exampleUcs) = unzip exampleConstraints
exampleConstraints :: [(String, UserConstraint)]
exampleConstraints =
[ ("template-haskell installed",
UserConstraint (UserQualified UserQualToplevel (pn "template-haskell"))
PackagePropertyInstalled)
, ("bytestring >= 0",
UserConstraint (UserQualified UserQualToplevel (pn "bytestring"))
(PackagePropertyVersion anyVersion))
, ("any.directory test",
UserConstraint (UserAnyQualifier (pn "directory"))
(PackagePropertyStanzas [TestStanzas]))
, ("setup.Cabal installed",
UserConstraint (UserAnySetupQualifier (pn "Cabal"))
PackagePropertyInstalled)
, ("process:setup.bytestring ==5.2",
UserConstraint (UserQualified (UserQualSetup (pn "process")) (pn "bytestring"))
(PackagePropertyVersion (thisVersion (mkVersion [5, 2]))))
-- flag MUST be prefixed with - or +
, ("network:setup.containers +foo -bar +baz",
UserConstraint (UserQualified (UserQualSetup (pn "network")) (pn "containers"))
(PackagePropertyFlags (mkFlagAssignment
[(fn "foo", True),
(fn "bar", False),
(fn "baz", True)])))
-- -- TODO: Re-enable UserQualExe tests once we decide on a syntax.
--
-- , ("foo:happy:exe.template-haskell test",
-- UserConstraint (UserQualified (UserQualExe (pn "foo") (pn "happy")) (pn "template-haskell"))
-- (PackagePropertyStanzas [TestStanzas]))
]
where
pn = mkPackageName
fn = mkFlagName
readUserConstraintTest :: String -> UserConstraint -> Assertion
readUserConstraintTest str uc =
assertEqual ("Couldn't read constraint: '" ++ str ++ "'") expected actual
where
expected = Right uc
actual = readUserConstraint str
parseUserConstraintTest :: String -> UserConstraint -> Assertion
parseUserConstraintTest str uc =
assertEqual ("Couldn't parse constraint: '" ++ str ++ "'") expected actual
where
expected = Right uc
actual = explicitEitherParsec parsec str
readUserConstraintsTest :: String -> [UserConstraint] -> Assertion
readUserConstraintsTest str ucs =
assertEqual ("Couldn't read constraints: '" ++ str ++ "'") expected actual
where
expected = Right ucs
actual = explicitEitherParsec (parsecCommaList parsec) str
|
