Distribution/Version.hs

    {-# LANGUAGE CPP, DeriveDataTypeable, StandaloneDeriving #-}
    -----------------------------------------------------------------------------
    -- |
    -- 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.Data        ( Data )
    import Data.Typeable    ( Typeable )
    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,Typeable,Data)

    #if __GLASGOW_HASKELL__ < 707
    -- starting with ghc-7.7/base-4.7 this instance is provided in "Data.Data"
    deriving instance Data Version
    #endif

    {-# 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) ]