Commit 159e4b76 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add a fold function for the VersionRange

Use it to simplify the eval / withinRange function
parent 9314b473
...@@ -98,27 +98,47 @@ betweenVersionsInclusive :: Version -> Version -> VersionRange ...@@ -98,27 +98,47 @@ betweenVersionsInclusive :: Version -> Version -> VersionRange
betweenVersionsInclusive v1 v2 = betweenVersionsInclusive v1 v2 =
IntersectVersionRanges (orLaterVersion v1) (orEarlierVersion v2) IntersectVersionRanges (orLaterVersion v1) (orEarlierVersion v2)
laterVersion :: Version -> Version -> Bool foldVersionRange :: a -> (Version -> a) -> (Version -> a) -> (Version -> a)
v1 `laterVersion` v2 = versionBranch v1 > versionBranch v2 -> (Version -> Version -> a)
-> (a -> a -> a) -> (a -> a -> a)
earlierVersion :: Version -> Version -> Bool -> VersionRange -> a
v1 `earlierVersion` v2 = versionBranch v1 < versionBranch v2 foldVersionRange anyv this later earlier wildcard union intersection = fold
where
-- |Does this version fall within the given range? fold AnyVersion = anyv
fold (ThisVersion v) = this v
fold (LaterVersion v) = later v
fold (EarlierVersion v) = earlier v
fold (WildcardVersion v) = wildcard v (wildcardUpperBound v)
fold (UnionVersionRanges v1 v2) = union (fold v1) (fold v2)
fold (IntersectVersionRanges v1 v2) = intersection (fold v1) (fold v2)
-- | Does this version fall within the given range?
--
-- This is the evaluation function for the 'VersionRange' type.
--
withinRange :: Version -> VersionRange -> Bool withinRange :: Version -> VersionRange -> Bool
withinRange _ AnyVersion = True withinRange v = foldVersionRange
withinRange v1 (ThisVersion v2) = v1 == v2 True
withinRange v1 (LaterVersion v2) = v1 `laterVersion` v2 (\v' -> versionBranch v == versionBranch v')
withinRange v1 (EarlierVersion v2) = v1 `earlierVersion` v2 (\v' -> versionBranch v > versionBranch v')
withinRange v1 (WildcardVersion v2) = versionBranch v1 >= lowerBound (\v' -> versionBranch v < versionBranch v')
&& versionBranch v1 < upperBound (\l u -> versionBranch v >= versionBranch l
&& versionBranch v < versionBranch u)
(||)
(&&)
----------------------------
-- Wildcard range utilities
--
wildcardUpperBound :: Version -> Version
wildcardUpperBound (Version lowerBound ts) = (Version upperBound ts)
where where
lowerBound = versionBranch v2
upperBound = init lowerBound ++ [last lowerBound + 1] upperBound = init lowerBound ++ [last lowerBound + 1]
withinRange v1 (UnionVersionRanges v2 v3)
= v1 `withinRange` v2 || v1 `withinRange` v3 -------------------------------
withinRange v1 (IntersectVersionRanges v2 v3) -- Parsing and pretty printing
= v1 `withinRange` v2 && v1 `withinRange` v3 --
instance Text VersionRange where instance Text VersionRange where
disp AnyVersion = Disp.text "-any" disp AnyVersion = Disp.text "-any"
......
Supports Markdown
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