Skip to content

Commit 0ce2dba

Browse files
phadejphadej
authored
Merge pull request #3973 from phadej/version-show
Show Version returning "mkVersion [...]"
2 parents 34eecf4 + 5a07439 commit 0ce2dba

File tree

3 files changed

+143
-78
lines changed

3 files changed

+143
-78
lines changed

‎Cabal/Distribution/Version.hs

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,8 @@ import qualified Text.PrettyPrint as Disp
9292
import Text.PrettyPrint ((<+>))
9393
import Control.Exception (assert)
9494

95+
import qualified Text.Read as Read
96+
9597
-- -----------------------------------------------------------------------------
9698
-- Versions
9799

@@ -113,7 +115,7 @@ data Version = PV0 {-# UNPACK #-} !Word64
113115
-- which all fall into the [0..0xfffe] range), then PV0
114116
-- MUST be used. This is essential for the 'Eq' instance
115117
-- to work.
116-
deriving (Data,Eq,Generic,Show,Read,Typeable)
118+
deriving (Data,Eq,Generic,Typeable)
117119

118120
instance Ord Version where
119121
compare (PV0 x) (PV0 y) = compare x y
@@ -137,6 +139,17 @@ instance Ord Version where
137139
y3 = fromIntegral ((w `shiftR` 16) .&. 0xffff) - 1
138140
y4 = fromIntegral (w .&. 0xffff) - 1
139141

142+
instance Show Version where
143+
showsPrec d v = showParen (d > 10)
144+
$ showString "mkVersion "
145+
. showsPrec 11 (versionNumbers v)
146+
147+
instance Read Version where
148+
readPrec = Read.parens $ do
149+
Read.Ident "mkVersion" <- Read.lexP
150+
v <- Read.step Read.readPrec
151+
return (mkVersion v)
152+
140153
instance Binary Version
141154

142155
instance NFData Version where

‎Cabal/tests/UnitTests/Distribution/Utils/NubList.hs

Lines changed: 38 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,22 +1,28 @@
1-
{-# LANGUAGE CPP #-}
1+
-- to suppress WARNING in "Distribution.Compat.Prelude.Internal"
2+
{-# OPTIONS_GHC -fno-warn-deprecations #-}
23
module UnitTests.Distribution.Utils.NubList
34
( tests
45
) where
56

6-
#if __GLASGOW_HASKELL__ < 710
7-
import Data.Monoid
8-
#endif
7+
import Prelude ()
8+
import Distribution.Compat.Prelude.Internal
9+
910
import Distribution.Utils.NubList
1011
import Test.Tasty
1112
import Test.Tasty.HUnit
1213
import Test.Tasty.QuickCheck
1314

1415
tests :: [TestTree]
1516
tests =
16-
[ testCase "Numlist retains ordering" testOrdering
17-
, testCase "Numlist removes duplicates" testDeDupe
18-
, testProperty "Monoid Numlist Identity" prop_Identity
19-
, testProperty "Monoid Numlist Associativity" prop_Associativity
17+
[ testCase "NubList retains ordering example" testOrdering
18+
, testCase "NubList removes duplicates example" testDeDupe
19+
, testProperty "NubList retains ordering" prop_Ordering
20+
, testProperty "NubList removes duplicates" prop_DeDupe
21+
, testProperty "fromNubList . toNubList = nub" prop_Nub
22+
, testProperty "Monoid NubList Identity" prop_Identity
23+
, testProperty "Monoid NubList Associativity" prop_Associativity
24+
-- NubListR
25+
, testProperty "NubListR removes duplicates from the right" prop_DeDupeR
2026
]
2127

2228
someIntList :: [Int]
@@ -36,6 +42,30 @@ testDeDupe =
3642
-- ---------------------------------------------------------------------------
3743
-- QuickCheck properties for NubList
3844

45+
prop_Ordering :: [Int] -> Property
46+
prop_Ordering xs =
47+
mempty <> toNubList xs' === toNubList xs' <> mempty
48+
where
49+
xs' = nub xs
50+
51+
prop_DeDupe :: [Int] -> Property
52+
prop_DeDupe xs =
53+
fromNubList (toNubList (xs' ++ xs)) === xs' -- Note, we append primeless xs
54+
where
55+
xs' = nub xs
56+
57+
prop_DeDupeR :: [Int] -> Property
58+
prop_DeDupeR xs =
59+
fromNubListR (toNubListR (xs ++ xs')) === xs' -- Note, we prepend primeless xs
60+
where
61+
xs' = nub xs
62+
63+
prop_Nub :: [Int] -> Property
64+
prop_Nub xs = rhs === lhs
65+
where
66+
rhs = fromNubList (toNubList xs)
67+
lhs = nub xs
68+
3969
prop_Identity :: [Int] -> Bool
4070
prop_Identity xs =
4171
mempty `mappend` toNubList xs == toNubList xs `mappend` mempty

‎Cabal/tests/UnitTests/Distribution/Version.hs

Lines changed: 91 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE CPP #-}
12
{-# OPTIONS_GHC -fno-warn-orphans
23
-fno-warn-incomplete-patterns
34
-fno-warn-deprecations
@@ -21,79 +22,89 @@ import Data.Maybe (isJust, fromJust)
2122
import Data.List (sort, sortBy, nub)
2223
import Data.Ord (comparing)
2324
import Data.Function (on)
25+
#if MIN_VERSION_base(4,6,0)
26+
import Text.Read (readMaybe)
27+
#endif
2428

2529
versionTests :: [TestTree]
2630
versionTests =
27-
zipWith (\n p -> testProperty ("Range Property " ++ show n) p) [1::Int ..]
28-
-- properties to validate the test framework
29-
[ property prop_nonNull
30-
, property prop_gen_intervals1
31-
, property prop_gen_intervals2
32-
--, property prop_equivalentVersionRange --FIXME: runs out of test cases
33-
, property prop_intermediateVersion
34-
3531
-- test 'Version' type
36-
, property prop_VersionId
37-
, property prop_VersionId2
38-
, property prop_VersionEq
39-
, property prop_VersionEq2
40-
, property prop_VersionOrd
41-
, property prop_VersionOrd2
42-
43-
-- the basic syntactic version range functions
44-
, property prop_anyVersion
45-
, property prop_noVersion
46-
, property prop_thisVersion
47-
, property prop_notThisVersion
48-
, property prop_laterVersion
49-
, property prop_orLaterVersion
50-
, property prop_earlierVersion
51-
, property prop_orEarlierVersion
52-
, property prop_unionVersionRanges
53-
, property prop_intersectVersionRanges
54-
, property prop_differenceVersionRanges
55-
, property prop_invertVersionRange
56-
, property prop_withinVersion
57-
, property prop_foldVersionRange
58-
, property prop_foldVersionRange'
59-
60-
-- the semantic query functions
61-
--, property prop_isAnyVersion1 --FIXME: runs out of test cases
62-
--, property prop_isAnyVersion2 --FIXME: runs out of test cases
63-
--, property prop_isNoVersion --FIXME: runs out of test cases
64-
--, property prop_isSpecificVersion1 --FIXME: runs out of test cases
65-
--, property prop_isSpecificVersion2 --FIXME: runs out of test cases
66-
, property prop_simplifyVersionRange1
67-
, property prop_simplifyVersionRange1'
68-
--, property prop_simplifyVersionRange2 --FIXME: runs out of test cases
69-
--, property prop_simplifyVersionRange2' --FIXME: runs out of test cases
70-
--, property prop_simplifyVersionRange2'' --FIXME: actually wrong
71-
72-
-- converting between version ranges and version intervals
73-
, property prop_to_intervals
74-
--, property prop_to_intervals_canonical --FIXME: runs out of test cases
75-
--, property prop_to_intervals_canonical' --FIXME: runs out of test cases
76-
, property prop_from_intervals
77-
, property prop_to_from_intervals
78-
, property prop_from_to_intervals
79-
, property prop_from_to_intervals'
80-
81-
-- union and intersection of version intervals
82-
, property prop_unionVersionIntervals
83-
, property prop_unionVersionIntervals_idempotent
84-
, property prop_unionVersionIntervals_commutative
85-
, property prop_unionVersionIntervals_associative
86-
, property prop_intersectVersionIntervals
87-
, property prop_intersectVersionIntervals_idempotent
88-
, property prop_intersectVersionIntervals_commutative
89-
, property prop_intersectVersionIntervals_associative
90-
, property prop_union_intersect_distributive
91-
, property prop_intersect_union_distributive
92-
93-
-- inversion of version intervals
94-
, property prop_invertVersionIntervals
95-
, property prop_invertVersionIntervalsTwice
96-
]
32+
[ tp "versionNumbers . mkVersion = id @[NonNegative Int]" prop_VersionId
33+
, tp "versionNumbers . mkVersion = id @Base.Version" prop_VersionId2
34+
, tp "(==) = (==) `on` versionNumbers" prop_VersionEq
35+
, tp "(==) = (==) `on` mkVersion" prop_VersionEq2
36+
, tp "compare = compare `on` versionNumbers" prop_VersionOrd
37+
, tp "compare = compare `on` mkVersion" prop_VersionOrd2
38+
39+
, tp "readMaybe . show = Just" prop_ShowRead
40+
, tp "read example" prop_ShowRead_example
41+
]
42+
43+
++
44+
zipWith (\n p -> testProperty ("Range Property " ++ show n) p) [1::Int ..]
45+
-- properties to validate the test framework
46+
[ property prop_nonNull
47+
, property prop_gen_intervals1
48+
, property prop_gen_intervals2
49+
--, property prop_equivalentVersionRange --FIXME: runs out of test cases
50+
, property prop_intermediateVersion
51+
52+
, property prop_anyVersion
53+
, property prop_noVersion
54+
, property prop_thisVersion
55+
, property prop_notThisVersion
56+
, property prop_laterVersion
57+
, property prop_orLaterVersion
58+
, property prop_earlierVersion
59+
, property prop_orEarlierVersion
60+
, property prop_unionVersionRanges
61+
, property prop_intersectVersionRanges
62+
, property prop_differenceVersionRanges
63+
, property prop_invertVersionRange
64+
, property prop_withinVersion
65+
, property prop_foldVersionRange
66+
, property prop_foldVersionRange'
67+
68+
-- the semantic query functions
69+
--, property prop_isAnyVersion1 --FIXME: runs out of test cases
70+
--, property prop_isAnyVersion2 --FIXME: runs out of test cases
71+
--, property prop_isNoVersion --FIXME: runs out of test cases
72+
--, property prop_isSpecificVersion1 --FIXME: runs out of test cases
73+
--, property prop_isSpecificVersion2 --FIXME: runs out of test cases
74+
, property prop_simplifyVersionRange1
75+
, property prop_simplifyVersionRange1'
76+
--, property prop_simplifyVersionRange2 --FIXME: runs out of test cases
77+
--, property prop_simplifyVersionRange2' --FIXME: runs out of test cases
78+
--, property prop_simplifyVersionRange2'' --FIXME: actually wrong
79+
80+
-- converting between version ranges and version intervals
81+
, property prop_to_intervals
82+
--, property prop_to_intervals_canonical --FIXME: runs out of test cases
83+
--, property prop_to_intervals_canonical' --FIXME: runs out of test cases
84+
, property prop_from_intervals
85+
, property prop_to_from_intervals
86+
, property prop_from_to_intervals
87+
, property prop_from_to_intervals'
88+
89+
-- union and intersection of version intervals
90+
, property prop_unionVersionIntervals
91+
, property prop_unionVersionIntervals_idempotent
92+
, property prop_unionVersionIntervals_commutative
93+
, property prop_unionVersionIntervals_associative
94+
, property prop_intersectVersionIntervals
95+
, property prop_intersectVersionIntervals_idempotent
96+
, property prop_intersectVersionIntervals_commutative
97+
, property prop_intersectVersionIntervals_associative
98+
, property prop_union_intersect_distributive
99+
, property prop_intersect_union_distributive
100+
101+
-- inversion of version intervals
102+
, property prop_invertVersionIntervals
103+
, property prop_invertVersionIntervalsTwice
104+
]
105+
where
106+
tp :: Testable p => String -> p -> TestTree
107+
tp = testProperty
97108

98109
-- parseTests :: [TestTree]
99110
-- parseTests =
@@ -204,6 +215,17 @@ prop_VersionOrd2 :: VersionArb -> VersionArb -> Bool
204215
prop_VersionOrd2 (VersionArb v1) (VersionArb v2) =
205216
(==) v1 v2 == ((==) `on` mkVersion) v1 v2
206217

218+
prop_ShowRead :: Version -> Property
219+
#if MIN_VERSION_base(4,6,0)
220+
prop_ShowRead v = Just v === readMaybe (show v)
221+
#else
222+
-- readMaybe is since base-4.6
223+
prop_ShowRead v = v === read (show v)
224+
#endif
225+
226+
prop_ShowRead_example :: Bool
227+
prop_ShowRead_example = show (mkVersion [1,2,3]) == "mkVersion [1,2,3]"
228+
207229
---------------------------
208230
-- VersionRange properties
209231
--

0 commit comments

Comments
 (0)