content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  Distribution.Version
  -- Copyright   :  Isaac Jones, Simon Marlow 2003-2004
  --                Duncan Coutts 2008
  --
  -- Maintainer  :  cabal-devel@haskell.org
  -- Portability :  portable
  --
  -- Exports the 'Version' type along with a parser and pretty printer. A version
  -- is something like @\"1.3.3\"@. It also defines the 'VersionRange' data
  -- types. Version ranges are like @\">= 1.2 && < 2\"@.
  
  {- Copyright (c) 2003-2004, Isaac Jones
  All rights reserved.
  
  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions are
  met:
  
      * Redistributions of source code must retain the above copyright
        notice, this list of conditions and the following disclaimer.
  
      * Redistributions in binary form must reproduce the above
        copyright notice, this list of conditions and the following
        disclaimer in the documentation and/or other materials provided
        with the distribution.
  
      * Neither the name of Isaac Jones nor the names of other
        contributors may be used to endorse or promote products derived
        from this software without specific prior written permission.
  
  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
  
  module Distribution.Version (
    -- * Package versions
    Version(..),
  
    -- * Version ranges
    VersionRange(..),
  
    -- ** Constructing
    anyVersion, noVersion,
    thisVersion, notThisVersion,
    laterVersion, earlierVersion,
    orLaterVersion, orEarlierVersion,
    unionVersionRanges, intersectVersionRanges,
    withinVersion,
    betweenVersionsInclusive,
  
    -- ** Inspection
    withinRange,
    isAnyVersion,
    isNoVersion,
    isSpecificVersion,
    simplifyVersionRange,
    foldVersionRange,
    foldVersionRange',
  
    -- * Version intervals view
    asVersionIntervals,
    VersionInterval,
    LowerBound(..),
    UpperBound(..),
    Bound(..),
  
    -- ** 'VersionIntervals' abstract type
    -- | The 'VersionIntervals' type and the accompanying functions are exposed
    -- primarily for completeness and testing purposes. In practice
    -- 'asVersionIntervals' is the main function to use to
    -- view a 'VersionRange' as a bunch of 'VersionInterval's.
    --
    VersionIntervals,
    toVersionIntervals,
    fromVersionIntervals,
    withinIntervals,
    versionIntervals,
    mkVersionIntervals,
    unionVersionIntervals,
    intersectVersionIntervals,
  
   ) where
  
  import Data.Version     ( Version(..) )
  
  import Distribution.Text ( Text(..) )
  import qualified Distribution.Compat.ReadP as Parse
  import Distribution.Compat.ReadP ((+++))
  import qualified Text.PrettyPrint as Disp
  import Text.PrettyPrint ((<>), (<+>))
  import qualified Data.Char as Char (isDigit)
  import Control.Exception (assert)
  
  -- -----------------------------------------------------------------------------
  -- Version ranges
  
  -- Todo: maybe move this to Distribution.Package.Version?
  -- (package-specific versioning scheme).
  
  data VersionRange
    = AnyVersion
    | ThisVersion            Version -- = version
    | LaterVersion           Version -- > version  (NB. not >=)
    | EarlierVersion         Version -- < version
    | WildcardVersion        Version -- == ver.*   (same as >= ver && < ver+1)
    | UnionVersionRanges     VersionRange VersionRange
    | IntersectVersionRanges VersionRange VersionRange
    | VersionRangeParens     VersionRange -- just '(exp)' parentheses syntax
    deriving (Show,Read,Eq)
  
  {-# DEPRECATED AnyVersion "Use 'anyVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
  {-# DEPRECATED ThisVersion "use 'thisVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
  {-# DEPRECATED LaterVersion "use 'laterVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
  {-# DEPRECATED EarlierVersion "use 'earlierVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
  {-# DEPRECATED WildcardVersion "use 'anyVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
  {-# DEPRECATED UnionVersionRanges "use 'unionVersionRanges', 'foldVersionRange' or 'asVersionIntervals'" #-}
  {-# DEPRECATED IntersectVersionRanges "use 'intersectVersionRanges', 'foldVersionRange' or 'asVersionIntervals'" #-}
  
  -- | The version range @-any@. That is, a version range containing all
  -- versions.
  --
  -- > withinRange v anyVersion = True
  --
  anyVersion :: VersionRange
  anyVersion = AnyVersion
  
  -- | The empty version range, that is a version range containing no versions.
  --
  -- This can be constructed using any unsatisfiable version range expression,
  -- for example @> 1 && < 1@.
  --
  -- > withinRange v anyVersion = False
  --
  noVersion :: VersionRange
  noVersion = IntersectVersionRanges (LaterVersion v) (EarlierVersion v)
    where v = Version [1] []
  
  -- | The version range @== v@
  --
  -- > withinRange v' (thisVersion v) = v' == v
  --
  thisVersion :: Version -> VersionRange
  thisVersion = ThisVersion
  
  -- | The version range @< v || > v@
  --
  -- > withinRange v' (notThisVersion v) = v' /= v
  --
  notThisVersion :: Version -> VersionRange
  notThisVersion v = UnionVersionRanges (EarlierVersion v) (LaterVersion v)
  
  -- | The version range @> v@
  --
  -- > withinRange v' (laterVersion v) = v' > v
  --
  laterVersion :: Version -> VersionRange
  laterVersion = LaterVersion
  
  -- | The version range @>= v@
  --
  -- > withinRange v' (orLaterVersion v) = v' >= v
  --
  orLaterVersion :: Version -> VersionRange
  orLaterVersion   v = UnionVersionRanges (ThisVersion v) (LaterVersion v)
  
  -- | The version range @< v@
  --
  -- > withinRange v' (earlierVersion v) = v' < v
  --
  earlierVersion :: Version -> VersionRange
  earlierVersion = EarlierVersion
  
  -- | The version range @<= v@
  --
  -- > withinRange v' (orEarlierVersion v) = v' <= v
  --
  orEarlierVersion :: Version -> VersionRange
  orEarlierVersion v = UnionVersionRanges (ThisVersion v) (EarlierVersion v)
  
  -- | The version range @vr1 || vr2@
  --
  -- >   withinRange v' (unionVersionRanges vr1 vr2)
  -- > = withinRange v' vr1 || withinRange v' vr2
  --
  unionVersionRanges :: VersionRange -> VersionRange -> VersionRange
  unionVersionRanges = UnionVersionRanges
  
  -- | The version range @vr1 && vr2@
  --
  -- >   withinRange v' (intersectVersionRanges vr1 vr2)
  -- > = withinRange v' vr1 && withinRange v' vr2
  --
  intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange
  intersectVersionRanges = IntersectVersionRanges
  
  -- | The version range @== v.*@.
  --
  -- For example, for version @1.2@, the version range @== 1.2.*@ is the same as
  -- @>= 1.2 && < 1.3@
  --
  -- > withinRange v' (laterVersion v) = v' >= v && v' < upper v
  -- >   where
  -- >     upper (Version lower t) = Version (init lower ++ [last lower + 1]) t
  --
  withinVersion :: Version -> VersionRange
  withinVersion = WildcardVersion
  
  -- | The version range @>= v1 && <= v2@.
  --
  -- In practice this is not very useful because we normally use inclusive lower
  -- bounds and exclusive upper bounds.
  --
  -- > withinRange v' (laterVersion v) = v' > v
  --
  betweenVersionsInclusive :: Version -> Version -> VersionRange
  betweenVersionsInclusive v1 v2 =
    IntersectVersionRanges (orLaterVersion v1) (orEarlierVersion v2)
  
  {-# DEPRECATED betweenVersionsInclusive
      "In practice this is not very useful because we normally use inclusive lower bounds and exclusive upper bounds"
    #-}
  
  -- | Fold over the basic syntactic structure of a 'VersionRange'.
  --
  -- This provides a syntacic view of the expression defining the version range.
  -- The syntactic sugar @\">= v\"@, @\"<= v\"@ and @\"== v.*\"@ is presented
  -- in terms of the other basic syntax.
  --
  -- For a semantic view use 'asVersionIntervals'.
  --
  foldVersionRange :: a                         -- ^ @\"-any\"@ version
                   -> (Version -> a)            -- ^ @\"== v\"@
                   -> (Version -> a)            -- ^ @\"> v\"@
                   -> (Version -> a)            -- ^ @\"< v\"@
                   -> (a -> a -> a)             -- ^ @\"_ || _\"@ union
                   -> (a -> a -> a)             -- ^ @\"_ && _\"@ intersection
                   -> VersionRange -> a
  foldVersionRange anyv this later earlier union intersect = fold
    where
      fold AnyVersion                     = anyv
      fold (ThisVersion v)                = this v
      fold (LaterVersion v)               = later v
      fold (EarlierVersion v)             = earlier v
      fold (WildcardVersion v)            = fold (wildcard v)
      fold (UnionVersionRanges v1 v2)     = union (fold v1) (fold v2)
      fold (IntersectVersionRanges v1 v2) = intersect (fold v1) (fold v2)
      fold (VersionRangeParens v)         = fold v
  
      wildcard v = intersectVersionRanges
                     (orLaterVersion v)
                     (earlierVersion (wildcardUpperBound v))
  
  -- | An extended variant of 'foldVersionRange' that also provides a view of
  -- in which the syntactic sugar @\">= v\"@, @\"<= v\"@ and @\"== v.*\"@ is presented
  -- explicitly rather than in terms of the other basic syntax.
  --
  foldVersionRange' :: a                         -- ^ @\"-any\"@ version
                    -> (Version -> a)            -- ^ @\"== v\"@
                    -> (Version -> a)            -- ^ @\"> v\"@
                    -> (Version -> a)            -- ^ @\"< v\"@
                    -> (Version -> a)            -- ^ @\">= v\"@
                    -> (Version -> a)            -- ^ @\"<= v\"@
                    -> (Version -> Version -> a) -- ^ @\"== v.*\"@ wildcard. The
                                                 -- function is passed the
                                                 -- inclusive lower bound and the
                                                 -- exclusive upper bounds of the
                                                 -- range defined by the wildcard.
                    -> (a -> a -> a)             -- ^ @\"_ || _\"@ union
                    -> (a -> a -> a)             -- ^ @\"_ && _\"@ intersection
                    -> (a -> a)                  -- ^ @\"(_)\"@ parentheses
                    -> VersionRange -> a
  foldVersionRange' anyv this later earlier orLater orEarlier
                    wildcard union intersect parens = fold
    where
      fold AnyVersion                     = anyv
      fold (ThisVersion v)                = this v
      fold (LaterVersion v)               = later v
      fold (EarlierVersion v)             = earlier v
  
      fold (UnionVersionRanges (ThisVersion    v)
                               (LaterVersion   v')) | v==v' = orLater v
      fold (UnionVersionRanges (LaterVersion   v)
                               (ThisVersion    v')) | v==v' = orLater v
      fold (UnionVersionRanges (ThisVersion    v)
                               (EarlierVersion v')) | v==v' = orEarlier v
      fold (UnionVersionRanges (EarlierVersion v)
                               (ThisVersion    v')) | v==v' = orEarlier v
  
      fold (WildcardVersion v)            = wildcard v (wildcardUpperBound v)
      fold (UnionVersionRanges v1 v2)     = union (fold v1) (fold v2)
      fold (IntersectVersionRanges v1 v2) = intersect (fold v1) (fold v2)
      fold (VersionRangeParens v)         = parens (fold v)
  
  
  -- | Does this version fall within the given range?
  --
  -- This is the evaluation function for the 'VersionRange' type.
  --
  withinRange :: Version -> VersionRange -> Bool
  withinRange v = foldVersionRange
                     True
                     (\v'  -> versionBranch v == versionBranch v')
                     (\v'  -> versionBranch v >  versionBranch v')
                     (\v'  -> versionBranch v <  versionBranch v')
                     (||)
                     (&&)
  
  -- | View a 'VersionRange' as a union of intervals.
  --
  -- This provides a canonical view of the semantics of a 'VersionRange' as
  -- opposed to the syntax of the expression used to define it. For the syntactic
  -- view use 'foldVersionRange'.
  --
  -- Each interval is non-empty. The sequence is in increasing order and no
  -- intervals overlap or touch. Therefore only the first and last can be
  -- unbounded. The sequence can be empty if the range is empty
  -- (e.g. a range expression like @< 1 && > 2@).
  --
  -- Other checks are trivial to implement using this view. For example:
  --
  -- > isNoVersion vr | [] <- asVersionIntervals vr = True
  -- >                | otherwise                   = False
  --
  -- > isSpecificVersion vr
  -- >    | [(LowerBound v  InclusiveBound
  -- >       ,UpperBound v' InclusiveBound)] <- asVersionIntervals vr
  -- >    , v == v'   = Just v
  -- >    | otherwise = Nothing
  --
  asVersionIntervals :: VersionRange -> [VersionInterval]
  asVersionIntervals = versionIntervals . toVersionIntervals
  
  -- | Does this 'VersionRange' place any restriction on the 'Version' or is it
  -- in fact equivalent to 'AnyVersion'.
  --
  -- Note this is a semantic check, not simply a syntactic check. So for example
  -- the following is @True@ (for all @v@).
  --
  -- > isAnyVersion (EarlierVersion v `UnionVersionRanges` orLaterVersion v)
  --
  isAnyVersion :: VersionRange -> Bool
  isAnyVersion vr = case asVersionIntervals vr of
    [(LowerBound v InclusiveBound, NoUpperBound)] | isVersion0 v -> True
    _                                                            -> False
  
  -- | This is the converse of 'isAnyVersion'. It check if the version range is
  -- empty, if there is no possible version that satisfies the version range.
  --
  -- For example this is @True@ (for all @v@):
  --
  -- > isNoVersion (EarlierVersion v `IntersectVersionRanges` LaterVersion v)
  --
  isNoVersion :: VersionRange -> Bool
  isNoVersion vr = case asVersionIntervals vr of
    [] -> True
    _  -> False
  
  -- | Is this version range in fact just a specific version?
  --
  -- For example the version range @\">= 3 && <= 3\"@ contains only the version
  -- @3@.
  --
  isSpecificVersion :: VersionRange -> Maybe Version
  isSpecificVersion vr = case asVersionIntervals vr of
    [(LowerBound v  InclusiveBound
     ,UpperBound v' InclusiveBound)]
      | v == v' -> Just v
    _           -> Nothing
  
  -- | Simplify a 'VersionRange' expression. For non-empty version ranges
  -- this produces a canonical form. Empty or inconsistent version ranges
  -- are left as-is because that provides more information.
  --
  -- If you need a canonical form use
  -- @fromVersionIntervals . toVersionIntervals@
  --
  -- It satisfies the following properties:
  --
  -- > withinRange v (simplifyVersionRange r) = withinRange v r
  --
  -- >     withinRange v r = withinRange v r'
  -- > ==> simplifyVersionRange r = simplifyVersionRange r'
  -- >  || isNoVersion r
  -- >  || isNoVersion r'
  --
  simplifyVersionRange :: VersionRange -> VersionRange
  simplifyVersionRange vr
      -- If the version range is inconsistent then we just return the
      -- original since that has more information than ">1 && < 1", which
      -- is the canonical inconsistent version range.
      | null (versionIntervals vi) = vr
      | otherwise                  = fromVersionIntervals vi
    where
      vi = toVersionIntervals vr
  
  ----------------------------
  -- Wildcard range utilities
  --
  
  wildcardUpperBound :: Version -> Version
  wildcardUpperBound (Version lowerBound ts) = (Version upperBound ts)
    where
      upperBound = init lowerBound ++ [last lowerBound + 1]
  
  isWildcardRange :: Version -> Version -> Bool
  isWildcardRange (Version branch1 _) (Version branch2 _) = check branch1 branch2
    where check (n:[]) (m:[]) | n+1 == m = True
          check (n:ns) (m:ms) | n   == m = check ns ms
          check _      _                 = False
  
  ------------------
  -- Intervals view
  --
  
  -- | A complementary representation of a 'VersionRange'. Instead of a boolean
  -- version predicate it uses an increasing sequence of non-overlapping,
  -- non-empty intervals.
  --
  -- The key point is that this representation gives a canonical representation
  -- for the semantics of 'VersionRange's. This makes it easier to check things
  -- like whether a version range is empty, covers all versions, or requires a
  -- certain minimum or maximum version. It also makes it easy to check equality
  -- or containment. It also makes it easier to identify \'simple\' version
  -- predicates for translation into foreign packaging systems that do not
  -- support complex version range expressions.
  --
  newtype VersionIntervals = VersionIntervals [VersionInterval]
    deriving (Eq, Show)
  
  -- | Inspect the list of version intervals.
  --
  versionIntervals :: VersionIntervals -> [VersionInterval]
  versionIntervals (VersionIntervals is) = is
  
  type VersionInterval = (LowerBound, UpperBound)
  data LowerBound =                LowerBound Version !Bound deriving (Eq, Show)
  data UpperBound = NoUpperBound | UpperBound Version !Bound deriving (Eq, Show)
  data Bound      = ExclusiveBound | InclusiveBound          deriving (Eq, Show)
  
  minLowerBound :: LowerBound
  minLowerBound = LowerBound (Version [0] []) InclusiveBound
  
  isVersion0 :: Version -> Bool
  isVersion0 (Version [0] _) = True
  isVersion0 _               = False
  
  instance Ord LowerBound where
    LowerBound ver bound <= LowerBound ver' bound' = case compare ver ver' of
      LT -> True
      EQ -> not (bound == ExclusiveBound && bound' == InclusiveBound)
      GT -> False
  
  instance Ord UpperBound where
    _            <= NoUpperBound   = True
    NoUpperBound <= UpperBound _ _ = False
    UpperBound ver bound <= UpperBound ver' bound' = case compare ver ver' of
      LT -> True
      EQ -> not (bound == InclusiveBound && bound' == ExclusiveBound)
      GT -> False
  
  invariant :: VersionIntervals -> Bool
  invariant (VersionIntervals intervals) = all validInterval intervals
                                        && all doesNotTouch' adjacentIntervals
    where
      doesNotTouch' :: (VersionInterval, VersionInterval) -> Bool
      doesNotTouch' ((_,u), (l',_)) = doesNotTouch u l'
  
      adjacentIntervals :: [(VersionInterval, VersionInterval)]
      adjacentIntervals
        | null intervals = []
        | otherwise      = zip intervals (tail intervals)
  
  checkInvariant :: VersionIntervals -> VersionIntervals
  checkInvariant is = assert (invariant is) is
  
  -- | Directly construct a 'VersionIntervals' from a list of intervals.
  --
  -- Each interval must be non-empty. The sequence must be in increasing order
  -- and no invervals may overlap or touch. If any of these conditions are not
  -- satisfied the function returns @Nothing@.
  --
  mkVersionIntervals :: [VersionInterval] -> Maybe VersionIntervals
  mkVersionIntervals intervals
    | invariant (VersionIntervals intervals) = Just (VersionIntervals intervals)
    | otherwise                              = Nothing
  
  validVersion :: Version -> Bool
  validVersion (Version [] _) = False
  validVersion (Version vs _) = all (>=0) vs
  
  validInterval :: (LowerBound, UpperBound) -> Bool
  validInterval i@(l, u) = validLower l && validUpper u && nonEmpty i
    where
      validLower (LowerBound v _) = validVersion v
      validUpper NoUpperBound     = True
      validUpper (UpperBound v _) = validVersion v
  
  -- Check an interval is non-empty
  --
  nonEmpty :: VersionInterval -> Bool
  nonEmpty (_,               NoUpperBound   ) = True
  nonEmpty (LowerBound l lb, UpperBound u ub) =
    (l < u) || (l == u && lb == InclusiveBound && ub == InclusiveBound)
  
  -- Check an upper bound does not intersect, or even touch a lower bound:
  --
  --   ---|      or  ---)     but not  ---]     or  ---)     or  ---]
  --       |---         (---              (---         [---         [---
  --
  doesNotTouch :: UpperBound -> LowerBound -> Bool
  doesNotTouch NoUpperBound _ = False
  doesNotTouch (UpperBound u ub) (LowerBound l lb) =
        u <  l
    || (u == l && ub == ExclusiveBound && lb == ExclusiveBound)
  
  -- | Check an upper bound does not intersect a lower bound:
  --
  --   ---|      or  ---)     or  ---]     or  ---)     but not  ---]
  --       |---         (---         (---         [---              [---
  --
  doesNotIntersect :: UpperBound -> LowerBound -> Bool
  doesNotIntersect NoUpperBound _ = False
  doesNotIntersect (UpperBound u ub) (LowerBound l lb) =
        u <  l
    || (u == l && not (ub == InclusiveBound && lb == InclusiveBound))
  
  -- | Test if a version falls within the version intervals.
  --
  -- It exists mostly for completeness and testing. It satisfies the following
  -- properties:
  --
  -- > withinIntervals v (toVersionIntervals vr) = withinRange v vr
  -- > withinIntervals v ivs = withinRange v (fromVersionIntervals ivs)
  --
  withinIntervals :: Version -> VersionIntervals -> Bool
  withinIntervals v (VersionIntervals intervals) = any withinInterval intervals
    where
      withinInterval (lowerBound, upperBound)    = withinLower lowerBound
                                                && withinUpper upperBound
      withinLower (LowerBound v' ExclusiveBound) = v' <  v
      withinLower (LowerBound v' InclusiveBound) = v' <= v
  
      withinUpper NoUpperBound                   = True
      withinUpper (UpperBound v' ExclusiveBound) = v' >  v
      withinUpper (UpperBound v' InclusiveBound) = v' >= v
  
  -- | Convert a 'VersionRange' to a sequence of version intervals.
  --
  toVersionIntervals :: VersionRange -> VersionIntervals
  toVersionIntervals = foldVersionRange
    (         chkIvl (minLowerBound,               NoUpperBound))
    (\v    -> chkIvl (LowerBound v InclusiveBound, UpperBound v InclusiveBound))
    (\v    -> chkIvl (LowerBound v ExclusiveBound, NoUpperBound))
    (\v    -> if isVersion0 v then VersionIntervals [] else
              chkIvl (minLowerBound,               UpperBound v ExclusiveBound))
    unionVersionIntervals
    intersectVersionIntervals
    where
      chkIvl interval = checkInvariant (VersionIntervals [interval])
  
  -- | Convert a 'VersionIntervals' value back into a 'VersionRange' expression
  -- representing the version intervals.
  --
  fromVersionIntervals :: VersionIntervals -> VersionRange
  fromVersionIntervals (VersionIntervals []) = noVersion
  fromVersionIntervals (VersionIntervals intervals) =
      foldr1 UnionVersionRanges [ interval l u | (l, u) <- intervals ]
  
    where
      interval (LowerBound v  InclusiveBound)
               (UpperBound v' InclusiveBound) | v == v'
                   = ThisVersion v
      interval (LowerBound v  InclusiveBound)
               (UpperBound v' ExclusiveBound) | isWildcardRange v v'
                   = WildcardVersion v
      interval l u = lowerBound l `intersectVersionRanges'` upperBound u
  
      lowerBound (LowerBound v InclusiveBound)
                                | isVersion0 v = AnyVersion
                                | otherwise    = orLaterVersion v
      lowerBound (LowerBound v ExclusiveBound) = LaterVersion v
  
      upperBound NoUpperBound                  = AnyVersion
      upperBound (UpperBound v InclusiveBound) = orEarlierVersion v
      upperBound (UpperBound v ExclusiveBound) = EarlierVersion v
  
      intersectVersionRanges' vr AnyVersion = vr
      intersectVersionRanges' AnyVersion vr = vr
      intersectVersionRanges' vr vr'        = IntersectVersionRanges vr vr'
  
  unionVersionIntervals :: VersionIntervals -> VersionIntervals
                        -> VersionIntervals
  unionVersionIntervals (VersionIntervals is0) (VersionIntervals is'0) =
    checkInvariant (VersionIntervals (union is0 is'0))
    where
      union is []  = is
      union [] is' = is'
      union (i:is) (i':is') = case unionInterval i i' of
        Left  Nothing    -> i  : union      is  (i' :is')
        Left  (Just i'') ->      union      is  (i'':is')
        Right Nothing    -> i' : union (i  :is)      is'
        Right (Just i'') ->      union (i'':is)      is'
  
  unionInterval :: VersionInterval -> VersionInterval
                -> Either (Maybe VersionInterval) (Maybe VersionInterval)
  unionInterval (lower , upper ) (lower', upper')
  
    -- Non-intersecting intervals with the left interval ending first
    | upper `doesNotTouch` lower' = Left Nothing
  
    -- Non-intersecting intervals with the right interval first
    | upper' `doesNotTouch` lower = Right Nothing
  
    -- Complete or partial overlap, with the left interval ending first
    | upper <= upper' = lowerBound `seq`
                        Left (Just (lowerBound, upper'))
  
    -- Complete or partial overlap, with the left interval ending first
    | otherwise = lowerBound `seq`
                  Right (Just (lowerBound, upper))
    where
      lowerBound = min lower lower'
  
  intersectVersionIntervals :: VersionIntervals -> VersionIntervals
                            -> VersionIntervals
  intersectVersionIntervals (VersionIntervals is0) (VersionIntervals is'0) =
    checkInvariant (VersionIntervals (intersect is0 is'0))
    where
      intersect _  [] = []
      intersect [] _  = []
      intersect (i:is) (i':is') = case intersectInterval i i' of
        Left  Nothing    ->       intersect is (i':is')
        Left  (Just i'') -> i'' : intersect is (i':is')
        Right Nothing    ->       intersect (i:is) is'
        Right (Just i'') -> i'' : intersect (i:is) is'
  
  intersectInterval :: VersionInterval -> VersionInterval
                    -> Either (Maybe VersionInterval) (Maybe VersionInterval)
  intersectInterval (lower , upper ) (lower', upper')
  
    -- Non-intersecting intervals with the left interval ending first
    | upper `doesNotIntersect` lower' = Left Nothing
  
    -- Non-intersecting intervals with the right interval first
    | upper' `doesNotIntersect` lower = Right Nothing
  
    -- Complete or partial overlap, with the left interval ending first
    | upper <= upper' = lowerBound `seq`
                        Left (Just (lowerBound, upper))
  
    -- Complete or partial overlap, with the right interval ending first
    | otherwise = lowerBound `seq`
                  Right (Just (lowerBound, upper'))
    where
      lowerBound = max lower lower'
  
  -------------------------------
  -- Parsing and pretty printing
  --
  
  instance Text VersionRange where
    disp = fst
         . foldVersionRange'                         -- precedence:
             (         Disp.text "-any"                           , 0 :: Int)
             (\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))
             (\(r, p)   -> (Disp.parens r, p))
  
      where dispWild (Version b _) =
                 Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int b))
              <> Disp.text ".*"
            punct p p' | p < p'    = Disp.parens
                       | otherwise = id
  
    parse = expr
     where
          expr   = do Parse.skipSpaces
                      t <- term
                      Parse.skipSpaces
                      (do _  <- Parse.string "||"
                          Parse.skipSpaces
                          e <- expr
                          return (UnionVersionRanges t e)
                       +++
                       return t)
          term   = do f <- factor
                      Parse.skipSpaces
                      (do _  <- Parse.string "&&"
                          Parse.skipSpaces
                          t <- term
                          return (IntersectVersionRanges f t)
                       +++
                       return f)
          factor = Parse.choice $ parens expr
                                : parseAnyVersion
                                : parseWildcardRange
                                : map parseRangeOp rangeOps
          parseAnyVersion    = Parse.string "-any" >> return AnyVersion
  
          parseWildcardRange = do
            _ <- Parse.string "=="
            Parse.skipSpaces
            branch <- Parse.sepBy1 digits (Parse.char '.')
            _ <- Parse.char '.'
            _ <- Parse.char '*'
            return (WildcardVersion (Version branch []))
  
          parens p = Parse.between (Parse.char '(' >> Parse.skipSpaces)
                                   (Parse.char ')' >> Parse.skipSpaces)
                                   (do a <- p
                                       Parse.skipSpaces
                                       return (VersionRangeParens a))
  
          digits = do
            first <- Parse.satisfy Char.isDigit
            if first == '0'
              then return 0
              else do rest <- Parse.munch Char.isDigit
                      return (read (first : rest))
  
          parseRangeOp (s,f) = Parse.string s >> Parse.skipSpaces >> fmap f parse
          rangeOps = [ ("<",  EarlierVersion),
                       ("<=", orEarlierVersion),
                       (">",  LaterVersion),
                       (">=", orLaterVersion),
                       ("==", ThisVersion) ]
  