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
betweenVersionsInclusive v1 v2 =
IntersectVersionRanges (orLaterVersion v1) (orEarlierVersion v2)
laterVersion :: Version -> Version -> Bool
v1 `laterVersion` v2 = versionBranch v1 > versionBranch v2
earlierVersion :: Version -> Version -> Bool
v1 `earlierVersion` v2 = versionBranch v1 < versionBranch v2
-- |Does this version fall within the given range?
foldVersionRange :: a -> (Version -> a) -> (Version -> a) -> (Version -> a)
-> (Version -> Version -> a)
-> (a -> a -> a) -> (a -> a -> a)
-> VersionRange -> a
foldVersionRange anyv this later earlier wildcard union intersection = fold
where
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 _ AnyVersion = True
withinRange v1 (ThisVersion v2) = v1 == v2
withinRange v1 (LaterVersion v2) = v1 `laterVersion` v2
withinRange v1 (EarlierVersion v2) = v1 `earlierVersion` v2
withinRange v1 (WildcardVersion v2) = versionBranch v1 >= lowerBound
&& versionBranch v1 < upperBound
withinRange v = foldVersionRange
True
(\v' -> versionBranch v == versionBranch v')
(\v' -> versionBranch v > versionBranch v')
(\v' -> versionBranch v < versionBranch v')
(\l u -> versionBranch v >= versionBranch l
&& versionBranch v < versionBranch u)
(||)
(&&)
----------------------------
-- Wildcard range utilities
--
wildcardUpperBound :: Version -> Version
wildcardUpperBound (Version lowerBound ts) = (Version upperBound ts)
where
lowerBound = versionBranch v2
upperBound = init lowerBound ++ [last lowerBound + 1]
withinRange v1 (UnionVersionRanges v2 v3)
= v1 `withinRange` v2 || v1 `withinRange` v3
withinRange v1 (IntersectVersionRanges v2 v3)
= v1 `withinRange` v2 && v1 `withinRange` v3
-------------------------------
-- Parsing and pretty printing
--
instance Text VersionRange where
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