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

Distribution/Version.hs

@@ -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

tests/Test/Distribution/Version.hs

@@ -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