Commit 3bcc7ad3 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Fix pretty printing of version ranges to use parens in the right places

parent 40cdcdb2
......@@ -653,26 +653,23 @@ intersectInterval (lower , upper ) (lower', upper')
--
instance Text VersionRange where
disp AnyVersion = Disp.text "-any"
disp (ThisVersion v) = Disp.text "==" <> disp v
disp (LaterVersion v) = Disp.char '>' <> disp v
disp (EarlierVersion v) = Disp.char '<' <> disp v
disp (WildcardVersion v) = Disp.text "==" <> dispWild v
disp = fst
. foldVersionRange' -- precedence:
( Disp.text "-any" , 0)
(\v -> (Disp.text "==" <> disp v , 0))
(\v -> (Disp.char '>' <> disp v , 0))
(\v -> (Disp.char '<' <> disp v , 0))
(\v -> (Disp.text ">=" <> disp v , 0))
(\v -> (Disp.text "<=" <> disp v , 0))
(\v _ -> (Disp.text "==" <> dispWild v , 0))
(\(r1, p1) (r2, p2) -> (punct 2 p1 r1 <+> Disp.text "||" <+> punct 2 p2 r2 , 2))
(\(r1, p1) (r2, p2) -> (punct 1 p1 r1 <+> Disp.text "&&" <+> punct 1 p2 r2 , 1))
where dispWild (Version b _) =
Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int b))
<> Disp.text ".*"
disp (UnionVersionRanges (ThisVersion v1) (LaterVersion v2))
| v1 == v2 = Disp.text ">=" <> disp v1
disp (UnionVersionRanges (LaterVersion v2) (ThisVersion v1))
| v1 == v2 = Disp.text ">=" <> disp v1
disp (UnionVersionRanges (ThisVersion v1) (EarlierVersion v2))
| v1 == v2 = Disp.text "<=" <> disp v1
disp (UnionVersionRanges (EarlierVersion v2) (ThisVersion v1))
| v1 == v2 = Disp.text "<=" <> disp v1
disp (UnionVersionRanges r1 r2)
= disp r1 <+> Disp.text "||" <+> disp r2
disp (IntersectVersionRanges r1 r2)
= disp r1 <+> Disp.text "&&" <+> disp r2
punct p p' | p < p' = Disp.parens
| otherwise = id
parse = expr
where
......
......@@ -2,6 +2,7 @@
module Test.Distribution.Version (properties) where
import Distribution.Version
import Distribution.Text
import Test.QuickCheck
import Test.QuickCheck.Utils
......@@ -68,6 +69,9 @@ properties =
, property prop_intersectVersionIntervals_associative
, property prop_union_intersect_distributive
, property prop_intersect_union_distributive
-- parsing an pretty printing
, property prop_parse_disp
]
instance Arbitrary Version where
......@@ -545,3 +549,40 @@ prop_intermediateVersion v1 v2 =
adjacentVersions :: Version -> Version -> Bool
adjacentVersions (Version v1 _) (Version v2 _) = v1 ++ [0] == v2
|| v2 ++ [0] == v1
--------------------------------
-- Parsing and pretty printing
--
prop_parse_disp :: VersionRange -> Bool
prop_parse_disp vr =
simpleParse (display vr) == Just (canonicalise vr)
where
canonicalise = swizzle . swap
swizzle (UnionVersionRanges (UnionVersionRanges v1 v2) v3)
| not (isOrLaterVersion v1 v2) && not (isOrEarlierVersion v1 v2)
= swizzle (UnionVersionRanges v1 (UnionVersionRanges v2 v3))
swizzle (IntersectVersionRanges (IntersectVersionRanges v1 v2) v3)
= swizzle (IntersectVersionRanges v1 (IntersectVersionRanges v2 v3))
swizzle (UnionVersionRanges v1 v2) =
UnionVersionRanges (swizzle v1) (swizzle v2)
swizzle (IntersectVersionRanges v1 v2) =
IntersectVersionRanges (swizzle v1) (swizzle v2)
swizzle v = v
isOrLaterVersion (ThisVersion v) (LaterVersion v') = v == v'
isOrLaterVersion _ _ = False
isOrEarlierVersion (ThisVersion v) (EarlierVersion v') = v == v'
isOrEarlierVersion _ _ = False
swap =
foldVersionRange' anyVersion thisVersion
laterVersion earlierVersion
orLaterVersion orEarlierVersion
(\v _ -> withinVersion v)
unionVersionRanges intersectVersionRanges
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