Add invertVersionRange and invertVersionIntervals to Distribution.Ver…

…sion, with tests
haskell · Jun 4, 2015 · cedd81e · cedd81e
1 parent 4c0d862
commit cedd81e
Show file tree

Hide file tree

Showing 2 changed files with 75 additions and 0 deletions.
diff --git a/Cabal/Distribution/Version.hs b/Cabal/Distribution/Version.hs
@@ -32,6 +32,7 @@ module Distribution.Version (
   laterVersion, earlierVersion,
   orLaterVersion, orEarlierVersion,
   unionVersionRanges, intersectVersionRanges,
+  invertVersionRange,
   withinVersion,
   betweenVersionsInclusive,
 
@@ -68,6 +69,7 @@ module Distribution.Version (
   mkVersionIntervals,
   unionVersionIntervals,
   intersectVersionIntervals,
+  invertVersionIntervals
 
  ) where
 
@@ -205,6 +207,15 @@ unionVersionRanges = UnionVersionRanges
 intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange
 intersectVersionRanges = IntersectVersionRanges
 
+-- | The inverse of a version range
+--
+-- >   withinRange v' (invertVersionRange vr)
+-- > = not (withinRange v' vr)
+--
+invertVersionRange :: VersionRange -> VersionRange
+invertVersionRange =
+    fromVersionIntervals . invertVersionIntervals . VersionIntervals . asVersionIntervals
+
 -- | The version range @== v.*@.
 --
 -- For example, for version @1.2@, the version range @== 1.2.*@ is the same as
@@ -677,6 +688,47 @@ intersectInterval (lower , upper ) (lower', upper')
   where
     lowerBound = max lower lower'
 
+invertVersionIntervals :: VersionIntervals
+                       -> VersionIntervals
+invertVersionIntervals (VersionIntervals xs) =
+    case xs of
+      -- Empty interval set
+      [] -> VersionIntervals [(noLowerBound, NoUpperBound)]
+      -- Interval with no lower bound
+      ((lb, ub) : more) | lb == noLowerBound -> VersionIntervals $ invertVersionIntervals' ub more
+      -- Interval with a lower bound
+      ((lb, ub) : more) ->
+          VersionIntervals $ (noLowerBound, invertLowerBound lb) : invertVersionIntervals' ub more
+    where
+      -- Invert subsequent version intervals given the upper bound of
+      -- the intervals already inverted.
+      invertVersionIntervals' :: UpperBound
+                              -> [(LowerBound, UpperBound)]
+                              -> [(LowerBound, UpperBound)]
+      invertVersionIntervals' NoUpperBound [] = []
+      invertVersionIntervals' ub0 [] = [(invertUpperBound ub0, NoUpperBound)]
+      invertVersionIntervals' ub0 [(lb, NoUpperBound)] =
+          [(invertUpperBound ub0, invertLowerBound lb)]
+      invertVersionIntervals' ub0 ((lb, ub1) : more) =
+          (invertUpperBound ub0, invertLowerBound lb)
+            : invertVersionIntervals' ub1 more
+
+      invertLowerBound :: LowerBound -> UpperBound
+      invertLowerBound (LowerBound v b) = UpperBound v (invertBound b)
+
+      invertUpperBound :: UpperBound -> LowerBound
+      invertUpperBound (UpperBound v b) = LowerBound v (invertBound b)
+      invertUpperBound NoUpperBound = error "NoUpperBound: unexpected"
+
+      invertBound :: Bound -> Bound
+      invertBound ExclusiveBound = InclusiveBound
+      invertBound InclusiveBound = ExclusiveBound
+
+      noLowerBound :: LowerBound
+      noLowerBound =
+          LowerBound (Version {versionBranch = [0], versionTags = []})
+                     InclusiveBound
+
 -------------------------------
 -- Parsing and pretty printing
 --

diff --git a/Cabal/tests/Test/Distribution/Version.hs b/Cabal/tests/Test/Distribution/Version.hs
@@ -37,6 +37,7 @@ versionTests = testGroup "Distribution.Version" $ map (\ (n, p) -> testProperty
   , property prop_orEarlierVersion
   , property prop_unionVersionRanges
   , property prop_intersectVersionRanges
+  , property prop_invertVersionRange
   , property prop_withinVersion
   , property prop_foldVersionRange
   , property prop_foldVersionRange'
@@ -73,6 +74,10 @@ versionTests = testGroup "Distribution.Version" $ map (\ (n, p) -> testProperty
   , property prop_intersectVersionIntervals_associative
   , property prop_union_intersect_distributive
   , property prop_intersect_union_distributive
+
+    -- inversion of version intervals
+  , property prop_invertVersionIntervals
+  , property prop_invertVersionIntervalsTwice
   ]
 
 parseTests :: TestTree
@@ -180,6 +185,11 @@ prop_intersectVersionRanges vr1 vr2 v' =
      withinRange v' (intersectVersionRanges vr1 vr2)
   == (withinRange v' vr1 && withinRange v' vr2)
 
+prop_invertVersionRange :: VersionRange -> Version -> Bool
+prop_invertVersionRange vr v' =
+     withinRange v' (invertVersionRange vr)
+  == not (withinRange v' vr)
+
 prop_withinVersion :: Version -> Version -> Bool
 prop_withinVersion v v' =
      withinRange v' (withinVersion v)
@@ -514,6 +524,19 @@ prop_intersect_union_distributive =
       Laws.distributive_left  intersectVersionIntervals unionVersionIntervals
   .&. Laws.distributive_right intersectVersionIntervals unionVersionIntervals
 
+-- | The semantics of 'invertVersionIntervals' is 'not'.
+--
+prop_invertVersionIntervals :: VersionIntervals
+                               -> Version -> Bool
+prop_invertVersionIntervals vi v =
+     withinIntervals v (invertVersionIntervals vi)
+  == not (withinIntervals v vi)
+
+-- | Double application of 'invertVersionIntervals' is the identity function
+prop_invertVersionIntervalsTwice :: VersionIntervals -> Bool
+prop_invertVersionIntervalsTwice vi =
+    invertVersionIntervals (invertVersionIntervals vi) == vi
+
 
 
 --------------------------------