{-# LANGUAGE DeriveDataTypeable #-}
module Distribution.Types.VersionInterval (
    -- * Version intervals
    VersionIntervals,
    toVersionIntervals,
    fromVersionIntervals,
    withinIntervals,
    versionIntervals,
    mkVersionIntervals,
    unionVersionIntervals,
    intersectVersionIntervals,
    invertVersionIntervals,
    relaxLastInterval,
    relaxHeadInterval,

    -- * Version intervals view
    asVersionIntervals,
    VersionInterval,
    LowerBound(..),
    UpperBound(..),
    Bound(..),
    ) where

import Prelude ()
import Distribution.Compat.Prelude
import Control.Exception (assert)

import Distribution.Types.Version
import Distribution.Types.VersionRange

-- NonEmpty
import qualified Prelude (foldr1)

-------------------------------------------------------------------------------
-- VersionRange
-------------------------------------------------------------------------------

-- | 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 :: VersionRange -> [VersionInterval]
asVersionIntervals = VersionIntervals -> [VersionInterval]
versionIntervals (VersionIntervals -> [VersionInterval])
-> (VersionRange -> VersionIntervals)
-> VersionRange
-> [VersionInterval]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionIntervals
toVersionIntervals


-------------------------------------------------------------------------------
-- VersionInterval
-------------------------------------------------------------------------------

-- | 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 (VersionIntervals -> VersionIntervals -> Bool
(VersionIntervals -> VersionIntervals -> Bool)
-> (VersionIntervals -> VersionIntervals -> Bool)
-> Eq VersionIntervals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionIntervals -> VersionIntervals -> Bool
$c/= :: VersionIntervals -> VersionIntervals -> Bool
== :: VersionIntervals -> VersionIntervals -> Bool
$c== :: VersionIntervals -> VersionIntervals -> Bool
Eq, Int -> VersionIntervals -> ShowS
[VersionIntervals] -> ShowS
VersionIntervals -> String
(Int -> VersionIntervals -> ShowS)
-> (VersionIntervals -> String)
-> ([VersionIntervals] -> ShowS)
-> Show VersionIntervals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionIntervals] -> ShowS
$cshowList :: [VersionIntervals] -> ShowS
show :: VersionIntervals -> String
$cshow :: VersionIntervals -> String
showsPrec :: Int -> VersionIntervals -> ShowS
$cshowsPrec :: Int -> VersionIntervals -> ShowS
Show, Typeable)

-- | Inspect the list of version intervals.
--
versionIntervals :: VersionIntervals -> [VersionInterval]
versionIntervals :: VersionIntervals -> [VersionInterval]
versionIntervals (VersionIntervals [VersionInterval]
is) = [VersionInterval]
is

type VersionInterval = (LowerBound, UpperBound)
data LowerBound =                LowerBound Version !Bound deriving (LowerBound -> LowerBound -> Bool
(LowerBound -> LowerBound -> Bool)
-> (LowerBound -> LowerBound -> Bool) -> Eq LowerBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LowerBound -> LowerBound -> Bool
$c/= :: LowerBound -> LowerBound -> Bool
== :: LowerBound -> LowerBound -> Bool
$c== :: LowerBound -> LowerBound -> Bool
Eq, Int -> LowerBound -> ShowS
[LowerBound] -> ShowS
LowerBound -> String
(Int -> LowerBound -> ShowS)
-> (LowerBound -> String)
-> ([LowerBound] -> ShowS)
-> Show LowerBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LowerBound] -> ShowS
$cshowList :: [LowerBound] -> ShowS
show :: LowerBound -> String
$cshow :: LowerBound -> String
showsPrec :: Int -> LowerBound -> ShowS
$cshowsPrec :: Int -> LowerBound -> ShowS
Show)
data UpperBound = NoUpperBound | UpperBound Version !Bound deriving (UpperBound -> UpperBound -> Bool
(UpperBound -> UpperBound -> Bool)
-> (UpperBound -> UpperBound -> Bool) -> Eq UpperBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpperBound -> UpperBound -> Bool
$c/= :: UpperBound -> UpperBound -> Bool
== :: UpperBound -> UpperBound -> Bool
$c== :: UpperBound -> UpperBound -> Bool
Eq, Int -> UpperBound -> ShowS
[UpperBound] -> ShowS
UpperBound -> String
(Int -> UpperBound -> ShowS)
-> (UpperBound -> String)
-> ([UpperBound] -> ShowS)
-> Show UpperBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpperBound] -> ShowS
$cshowList :: [UpperBound] -> ShowS
show :: UpperBound -> String
$cshow :: UpperBound -> String
showsPrec :: Int -> UpperBound -> ShowS
$cshowsPrec :: Int -> UpperBound -> ShowS
Show)
data Bound      = ExclusiveBound | InclusiveBound          deriving (Bound -> Bound -> Bool
(Bound -> Bound -> Bool) -> (Bound -> Bound -> Bool) -> Eq Bound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bound -> Bound -> Bool
$c/= :: Bound -> Bound -> Bool
== :: Bound -> Bound -> Bool
$c== :: Bound -> Bound -> Bool
Eq, Int -> Bound -> ShowS
[Bound] -> ShowS
Bound -> String
(Int -> Bound -> ShowS)
-> (Bound -> String) -> ([Bound] -> ShowS) -> Show Bound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bound] -> ShowS
$cshowList :: [Bound] -> ShowS
show :: Bound -> String
$cshow :: Bound -> String
showsPrec :: Int -> Bound -> ShowS
$cshowsPrec :: Int -> Bound -> ShowS
Show)

minLowerBound :: LowerBound
minLowerBound :: LowerBound
minLowerBound = Version -> Bound -> LowerBound
LowerBound ([Int] -> Version
mkVersion [Int
0]) Bound
InclusiveBound

isVersion0 :: Version -> Bool
isVersion0 :: Version -> Bool
isVersion0 = Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
(==) Version
version0

instance Ord LowerBound where
  LowerBound Version
ver Bound
bound <= :: LowerBound -> LowerBound -> Bool
<= LowerBound Version
ver' Bound
bound' = case Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Version
ver Version
ver' of
    Ordering
LT -> Bool
True
    Ordering
EQ -> Bool -> Bool
not (Bound
bound Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
ExclusiveBound Bool -> Bool -> Bool
&& Bound
bound' Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
InclusiveBound)
    Ordering
GT -> Bool
False

instance Ord UpperBound where
  UpperBound
_            <= :: UpperBound -> UpperBound -> Bool
<= UpperBound
NoUpperBound   = Bool
True
  UpperBound
NoUpperBound <= UpperBound Version
_ Bound
_ = Bool
False
  UpperBound Version
ver Bound
bound <= UpperBound Version
ver' Bound
bound' = case Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Version
ver Version
ver' of
    Ordering
LT -> Bool
True
    Ordering
EQ -> Bool -> Bool
not (Bound
bound Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
InclusiveBound Bool -> Bool -> Bool
&& Bound
bound' Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
ExclusiveBound)
    Ordering
GT -> Bool
False

invariant :: VersionIntervals -> Bool
invariant :: VersionIntervals -> Bool
invariant (VersionIntervals [VersionInterval]
intervals) = (VersionInterval -> Bool) -> [VersionInterval] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all VersionInterval -> Bool
validInterval [VersionInterval]
intervals
                                      Bool -> Bool -> Bool
&& ((VersionInterval, VersionInterval) -> Bool)
-> [(VersionInterval, VersionInterval)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (VersionInterval, VersionInterval) -> Bool
doesNotTouch' [(VersionInterval, VersionInterval)]
adjacentIntervals
  where
    doesNotTouch' :: (VersionInterval, VersionInterval) -> Bool
    doesNotTouch' :: (VersionInterval, VersionInterval) -> Bool
doesNotTouch' ((LowerBound
_,UpperBound
u), (LowerBound
l',UpperBound
_)) = UpperBound -> LowerBound -> Bool
doesNotTouch UpperBound
u LowerBound
l'

    adjacentIntervals :: [(VersionInterval, VersionInterval)]
    adjacentIntervals :: [(VersionInterval, VersionInterval)]
adjacentIntervals = case [VersionInterval]
intervals of
      []     -> []
      (VersionInterval
_:[VersionInterval]
tl) -> [VersionInterval]
-> [VersionInterval] -> [(VersionInterval, VersionInterval)]
forall a b. [a] -> [b] -> [(a, b)]
zip [VersionInterval]
intervals [VersionInterval]
tl

checkInvariant :: VersionIntervals -> VersionIntervals
checkInvariant :: VersionIntervals -> VersionIntervals
checkInvariant VersionIntervals
is = Bool -> VersionIntervals -> VersionIntervals
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (VersionIntervals -> Bool
invariant VersionIntervals
is) VersionIntervals
is

-- | Directly construct a 'VersionIntervals' from a list of intervals.
--
-- In @Cabal-2.2@ the 'Maybe' is dropped from the result type.
--
mkVersionIntervals :: [VersionInterval] -> VersionIntervals
mkVersionIntervals :: [VersionInterval] -> VersionIntervals
mkVersionIntervals [VersionInterval]
intervals
    | VersionIntervals -> Bool
invariant ([VersionInterval] -> VersionIntervals
VersionIntervals [VersionInterval]
intervals) = [VersionInterval] -> VersionIntervals
VersionIntervals [VersionInterval]
intervals
    | Bool
otherwise
        = VersionIntervals -> VersionIntervals
checkInvariant
        (VersionIntervals -> VersionIntervals)
-> ([VersionInterval] -> VersionIntervals)
-> [VersionInterval]
-> VersionIntervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VersionIntervals -> VersionInterval -> VersionIntervals)
-> VersionIntervals -> [VersionInterval] -> VersionIntervals
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((VersionInterval -> VersionIntervals -> VersionIntervals)
-> VersionIntervals -> VersionInterval -> VersionIntervals
forall a b c. (a -> b -> c) -> b -> a -> c
flip VersionInterval -> VersionIntervals -> VersionIntervals
insertInterval) ([VersionInterval] -> VersionIntervals
VersionIntervals [])
        ([VersionInterval] -> VersionIntervals)
-> ([VersionInterval] -> [VersionInterval])
-> [VersionInterval]
-> VersionIntervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VersionInterval -> Bool) -> [VersionInterval] -> [VersionInterval]
forall a. (a -> Bool) -> [a] -> [a]
filter VersionInterval -> Bool
validInterval
        ([VersionInterval] -> VersionIntervals)
-> [VersionInterval] -> VersionIntervals
forall a b. (a -> b) -> a -> b
$ [VersionInterval]
intervals

insertInterval :: VersionInterval -> VersionIntervals -> VersionIntervals
insertInterval :: VersionInterval -> VersionIntervals -> VersionIntervals
insertInterval VersionInterval
i VersionIntervals
is = VersionIntervals -> VersionIntervals -> VersionIntervals
unionVersionIntervals ([VersionInterval] -> VersionIntervals
VersionIntervals [VersionInterval
i]) VersionIntervals
is

validInterval :: (LowerBound, UpperBound) -> Bool
validInterval :: VersionInterval -> Bool
validInterval i :: VersionInterval
i@(LowerBound
l, UpperBound
u) = LowerBound -> Bool
validLower LowerBound
l Bool -> Bool -> Bool
&& UpperBound -> Bool
validUpper UpperBound
u Bool -> Bool -> Bool
&& VersionInterval -> Bool
nonEmpty VersionInterval
i
  where
    validLower :: LowerBound -> Bool
validLower (LowerBound Version
v Bound
_) = Version -> Bool
validVersion Version
v
    validUpper :: UpperBound -> Bool
validUpper UpperBound
NoUpperBound     = Bool
True
    validUpper (UpperBound Version
v Bound
_) = Version -> Bool
validVersion Version
v

-- Check an interval is non-empty
--
nonEmpty :: VersionInterval -> Bool
nonEmpty :: VersionInterval -> Bool
nonEmpty (LowerBound
_,               UpperBound
NoUpperBound   ) = Bool
True
nonEmpty (LowerBound Version
l Bound
lb, UpperBound Version
u Bound
ub) =
  (Version
l Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
u) Bool -> Bool -> Bool
|| (Version
l Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
u Bool -> Bool -> Bool
&& Bound
lb Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
InclusiveBound Bool -> Bool -> Bool
&& Bound
ub Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
InclusiveBound)

-- Check an upper bound does not intersect, or even touch a lower bound:
--
--   ---|      or  ---)     but not  ---]     or  ---)     or  ---]
--       |---         (---              (---         [---         [---
--
doesNotTouch :: UpperBound -> LowerBound -> Bool
doesNotTouch :: UpperBound -> LowerBound -> Bool
doesNotTouch UpperBound
NoUpperBound LowerBound
_ = Bool
False
doesNotTouch (UpperBound Version
u Bound
ub) (LowerBound Version
l Bound
lb) =
      Version
u Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<  Version
l
  Bool -> Bool -> Bool
|| (Version
u Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
l Bool -> Bool -> Bool
&& Bound
ub Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
ExclusiveBound Bool -> Bool -> Bool
&& Bound
lb Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
ExclusiveBound)

-- | Check an upper bound does not intersect a lower bound:
--
--   ---|      or  ---)     or  ---]     or  ---)     but not  ---]
--       |---         (---         (---         [---              [---
--
doesNotIntersect :: UpperBound -> LowerBound -> Bool
doesNotIntersect :: UpperBound -> LowerBound -> Bool
doesNotIntersect UpperBound
NoUpperBound LowerBound
_ = Bool
False
doesNotIntersect (UpperBound Version
u Bound
ub) (LowerBound Version
l Bound
lb) =
      Version
u Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<  Version
l
  Bool -> Bool -> Bool
|| (Version
u Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
l Bool -> Bool -> Bool
&& Bool -> Bool
not (Bound
ub Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
InclusiveBound Bool -> Bool -> Bool
&& Bound
lb Bound -> Bound -> Bool
forall a. Eq a => a -> a -> Bool
== Bound
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 :: Version -> VersionIntervals -> Bool
withinIntervals Version
v (VersionIntervals [VersionInterval]
intervals) = (VersionInterval -> Bool) -> [VersionInterval] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any VersionInterval -> Bool
withinInterval [VersionInterval]
intervals
  where
    withinInterval :: VersionInterval -> Bool
withinInterval (LowerBound
lowerBound, UpperBound
upperBound)    = LowerBound -> Bool
withinLower LowerBound
lowerBound
                                              Bool -> Bool -> Bool
&& UpperBound -> Bool
withinUpper UpperBound
upperBound
    withinLower :: LowerBound -> Bool
withinLower (LowerBound Version
v' Bound
ExclusiveBound) = Version
v' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<  Version
v
    withinLower (LowerBound Version
v' Bound
InclusiveBound) = Version
v' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= Version
v

    withinUpper :: UpperBound -> Bool
withinUpper UpperBound
NoUpperBound                   = Bool
True
    withinUpper (UpperBound Version
v' Bound
ExclusiveBound) = Version
v' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>  Version
v
    withinUpper (UpperBound Version
v' Bound
InclusiveBound) = Version
v' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
v

-- | Convert a 'VersionRange' to a sequence of version intervals.
--
toVersionIntervals :: VersionRange -> VersionIntervals
toVersionIntervals :: VersionRange -> VersionIntervals
toVersionIntervals = VersionIntervals
-> (Version -> VersionIntervals)
-> (Version -> VersionIntervals)
-> (Version -> VersionIntervals)
-> (VersionIntervals -> VersionIntervals -> VersionIntervals)
-> (VersionIntervals -> VersionIntervals -> VersionIntervals)
-> VersionRange
-> VersionIntervals
forall a.
a
-> (Version -> a)
-> (Version -> a)
-> (Version -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> VersionRange
-> a
foldVersionRange
  (         VersionInterval -> VersionIntervals
chkIvl (LowerBound
minLowerBound,               UpperBound
NoUpperBound))
  (\Version
v    -> VersionInterval -> VersionIntervals
chkIvl (Version -> Bound -> LowerBound
LowerBound Version
v Bound
InclusiveBound, Version -> Bound -> UpperBound
UpperBound Version
v Bound
InclusiveBound))
  (\Version
v    -> VersionInterval -> VersionIntervals
chkIvl (Version -> Bound -> LowerBound
LowerBound Version
v Bound
ExclusiveBound, UpperBound
NoUpperBound))
  (\Version
v    -> if Version -> Bool
isVersion0 Version
v then [VersionInterval] -> VersionIntervals
VersionIntervals [] else
            VersionInterval -> VersionIntervals
chkIvl (LowerBound
minLowerBound,               Version -> Bound -> UpperBound
UpperBound Version
v Bound
ExclusiveBound))
  VersionIntervals -> VersionIntervals -> VersionIntervals
unionVersionIntervals
  VersionIntervals -> VersionIntervals -> VersionIntervals
intersectVersionIntervals
  where
    chkIvl :: VersionInterval -> VersionIntervals
chkIvl VersionInterval
interval = VersionIntervals -> VersionIntervals
checkInvariant ([VersionInterval] -> VersionIntervals
VersionIntervals [VersionInterval
interval])

-- | Convert a 'VersionIntervals' value back into a 'VersionRange' expression
-- representing the version intervals.
--
fromVersionIntervals :: VersionIntervals -> VersionRange
fromVersionIntervals :: VersionIntervals -> VersionRange
fromVersionIntervals (VersionIntervals []) = VersionRange
noVersion
fromVersionIntervals (VersionIntervals [VersionInterval]
intervals) =
    (VersionRange -> VersionRange -> VersionRange)
-> [VersionRange] -> VersionRange
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Prelude.foldr1 VersionRange -> VersionRange -> VersionRange
unionVersionRanges [ LowerBound -> UpperBound -> VersionRange
interval LowerBound
l UpperBound
u | (LowerBound
l, UpperBound
u) <- [VersionInterval]
intervals ]

  where
    interval :: LowerBound -> UpperBound -> VersionRange
interval (LowerBound Version
v  Bound
InclusiveBound)
             (UpperBound Version
v' Bound
InclusiveBound) | Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v'
                 = Version -> VersionRange
thisVersion Version
v
    interval (LowerBound Version
v  Bound
InclusiveBound)
             (UpperBound Version
v' Bound
ExclusiveBound) | Version -> Version -> Bool
isWildcardRange Version
v Version
v'
                 = Version -> VersionRange
withinVersion Version
v
    interval LowerBound
l UpperBound
u = LowerBound -> Maybe VersionRange
lowerBound LowerBound
l Maybe VersionRange -> Maybe VersionRange -> VersionRange
`intersectVersionRanges'` UpperBound -> Maybe VersionRange
upperBound UpperBound
u

    lowerBound :: LowerBound -> Maybe VersionRange
lowerBound (LowerBound Version
v Bound
InclusiveBound)
                              | Version -> Bool
isVersion0 Version
v = Maybe VersionRange
forall a. Maybe a
Nothing
                              | Bool
otherwise    = VersionRange -> Maybe VersionRange
forall a. a -> Maybe a
Just (Version -> VersionRange
orLaterVersion Version
v)
    lowerBound (LowerBound Version
v Bound
ExclusiveBound) = VersionRange -> Maybe VersionRange
forall a. a -> Maybe a
Just (Version -> VersionRange
laterVersion Version
v)

    upperBound :: UpperBound -> Maybe VersionRange
upperBound UpperBound
NoUpperBound                  = Maybe VersionRange
forall a. Maybe a
Nothing
    upperBound (UpperBound Version
v Bound
InclusiveBound) = VersionRange -> Maybe VersionRange
forall a. a -> Maybe a
Just (Version -> VersionRange
orEarlierVersion Version
v)
    upperBound (UpperBound Version
v Bound
ExclusiveBound) = VersionRange -> Maybe VersionRange
forall a. a -> Maybe a
Just (Version -> VersionRange
earlierVersion Version
v)

    intersectVersionRanges' :: Maybe VersionRange -> Maybe VersionRange -> VersionRange
intersectVersionRanges' Maybe VersionRange
Nothing Maybe VersionRange
Nothing      = VersionRange
anyVersion
    intersectVersionRanges' (Just VersionRange
vr) Maybe VersionRange
Nothing    = VersionRange
vr
    intersectVersionRanges' Maybe VersionRange
Nothing (Just VersionRange
vr)    = VersionRange
vr
    intersectVersionRanges' (Just VersionRange
vr) (Just VersionRange
vr') = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
vr VersionRange
vr'

unionVersionIntervals :: VersionIntervals -> VersionIntervals
                      -> VersionIntervals
unionVersionIntervals :: VersionIntervals -> VersionIntervals -> VersionIntervals
unionVersionIntervals (VersionIntervals [VersionInterval]
is0) (VersionIntervals [VersionInterval]
is'0) =
  VersionIntervals -> VersionIntervals
checkInvariant ([VersionInterval] -> VersionIntervals
VersionIntervals ([VersionInterval] -> [VersionInterval] -> [VersionInterval]
union [VersionInterval]
is0 [VersionInterval]
is'0))
  where
    union :: [VersionInterval] -> [VersionInterval] -> [VersionInterval]
union [VersionInterval]
is []  = [VersionInterval]
is
    union [] [VersionInterval]
is' = [VersionInterval]
is'
    union (VersionInterval
i:[VersionInterval]
is) (VersionInterval
i':[VersionInterval]
is') = case VersionInterval
-> VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
unionInterval VersionInterval
i VersionInterval
i' of
      Left  Maybe VersionInterval
Nothing    -> VersionInterval
i  VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
: [VersionInterval] -> [VersionInterval] -> [VersionInterval]
union      [VersionInterval]
is  (VersionInterval
i' VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is')
      Left  (Just VersionInterval
i'') ->      [VersionInterval] -> [VersionInterval] -> [VersionInterval]
union      [VersionInterval]
is  (VersionInterval
i''VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is')
      Right Maybe VersionInterval
Nothing    -> VersionInterval
i' VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
: [VersionInterval] -> [VersionInterval] -> [VersionInterval]
union (VersionInterval
i  VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is)      [VersionInterval]
is'
      Right (Just VersionInterval
i'') ->      [VersionInterval] -> [VersionInterval] -> [VersionInterval]
union (VersionInterval
i''VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is)      [VersionInterval]
is'

unionInterval :: VersionInterval -> VersionInterval
              -> Either (Maybe VersionInterval) (Maybe VersionInterval)
unionInterval :: VersionInterval
-> VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
unionInterval (LowerBound
lower , UpperBound
upper ) (LowerBound
lower', UpperBound
upper')

  -- Non-intersecting intervals with the left interval ending first
  | UpperBound
upper UpperBound -> LowerBound -> Bool
`doesNotTouch` LowerBound
lower' = Maybe VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
forall a b. a -> Either a b
Left Maybe VersionInterval
forall a. Maybe a
Nothing

  -- Non-intersecting intervals with the right interval first
  | UpperBound
upper' UpperBound -> LowerBound -> Bool
`doesNotTouch` LowerBound
lower = Maybe VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
forall a b. b -> Either a b
Right Maybe VersionInterval
forall a. Maybe a
Nothing

  -- Complete or partial overlap, with the left interval ending first
  | UpperBound
upper UpperBound -> UpperBound -> Bool
forall a. Ord a => a -> a -> Bool
<= UpperBound
upper' = LowerBound
lowerBound LowerBound
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
`seq`
                      Maybe VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
forall a b. a -> Either a b
Left (VersionInterval -> Maybe VersionInterval
forall a. a -> Maybe a
Just (LowerBound
lowerBound, UpperBound
upper'))

  -- Complete or partial overlap, with the left interval ending first
  | Bool
otherwise = LowerBound
lowerBound LowerBound
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
`seq`
                Maybe VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
forall a b. b -> Either a b
Right (VersionInterval -> Maybe VersionInterval
forall a. a -> Maybe a
Just (LowerBound
lowerBound, UpperBound
upper))
  where
    lowerBound :: LowerBound
lowerBound = LowerBound -> LowerBound -> LowerBound
forall a. Ord a => a -> a -> a
min LowerBound
lower LowerBound
lower'

intersectVersionIntervals :: VersionIntervals -> VersionIntervals
                          -> VersionIntervals
intersectVersionIntervals :: VersionIntervals -> VersionIntervals -> VersionIntervals
intersectVersionIntervals (VersionIntervals [VersionInterval]
is0) (VersionIntervals [VersionInterval]
is'0) =
  VersionIntervals -> VersionIntervals
checkInvariant ([VersionInterval] -> VersionIntervals
VersionIntervals ([VersionInterval] -> [VersionInterval] -> [VersionInterval]
intersect [VersionInterval]
is0 [VersionInterval]
is'0))
  where
    intersect :: [VersionInterval] -> [VersionInterval] -> [VersionInterval]
intersect [VersionInterval]
_  [] = []
    intersect [] [VersionInterval]
_  = []
    intersect (VersionInterval
i:[VersionInterval]
is) (VersionInterval
i':[VersionInterval]
is') = case VersionInterval
-> VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
intersectInterval VersionInterval
i VersionInterval
i' of
      Left  Maybe VersionInterval
Nothing    ->       [VersionInterval] -> [VersionInterval] -> [VersionInterval]
intersect [VersionInterval]
is (VersionInterval
i'VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is')
      Left  (Just VersionInterval
i'') -> VersionInterval
i'' VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
: [VersionInterval] -> [VersionInterval] -> [VersionInterval]
intersect [VersionInterval]
is (VersionInterval
i'VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is')
      Right Maybe VersionInterval
Nothing    ->       [VersionInterval] -> [VersionInterval] -> [VersionInterval]
intersect (VersionInterval
iVersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is) [VersionInterval]
is'
      Right (Just VersionInterval
i'') -> VersionInterval
i'' VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
: [VersionInterval] -> [VersionInterval] -> [VersionInterval]
intersect (VersionInterval
iVersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is) [VersionInterval]
is'

intersectInterval :: VersionInterval -> VersionInterval
                  -> Either (Maybe VersionInterval) (Maybe VersionInterval)
intersectInterval :: VersionInterval
-> VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
intersectInterval (LowerBound
lower , UpperBound
upper ) (LowerBound
lower', UpperBound
upper')

  -- Non-intersecting intervals with the left interval ending first
  | UpperBound
upper UpperBound -> LowerBound -> Bool
`doesNotIntersect` LowerBound
lower' = Maybe VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
forall a b. a -> Either a b
Left Maybe VersionInterval
forall a. Maybe a
Nothing

  -- Non-intersecting intervals with the right interval first
  | UpperBound
upper' UpperBound -> LowerBound -> Bool
`doesNotIntersect` LowerBound
lower = Maybe VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
forall a b. b -> Either a b
Right Maybe VersionInterval
forall a. Maybe a
Nothing

  -- Complete or partial overlap, with the left interval ending first
  | UpperBound
upper UpperBound -> UpperBound -> Bool
forall a. Ord a => a -> a -> Bool
<= UpperBound
upper' = LowerBound
lowerBound LowerBound
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
`seq`
                      Maybe VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
forall a b. a -> Either a b
Left (VersionInterval -> Maybe VersionInterval
forall a. a -> Maybe a
Just (LowerBound
lowerBound, UpperBound
upper))

  -- Complete or partial overlap, with the right interval ending first
  | Bool
otherwise = LowerBound
lowerBound LowerBound
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
`seq`
                Maybe VersionInterval
-> Either (Maybe VersionInterval) (Maybe VersionInterval)
forall a b. b -> Either a b
Right (VersionInterval -> Maybe VersionInterval
forall a. a -> Maybe a
Just (LowerBound
lowerBound, UpperBound
upper'))
  where
    lowerBound :: LowerBound
lowerBound = LowerBound -> LowerBound -> LowerBound
forall a. Ord a => a -> a -> a
max LowerBound
lower LowerBound
lower'

invertVersionIntervals :: VersionIntervals
                       -> VersionIntervals
invertVersionIntervals :: VersionIntervals -> VersionIntervals
invertVersionIntervals (VersionIntervals [VersionInterval]
xs) =
    case [VersionInterval]
xs of
      -- Empty interval set
      [] -> [VersionInterval] -> VersionIntervals
VersionIntervals [(LowerBound
noLowerBound, UpperBound
NoUpperBound)]
      -- Interval with no lower bound
      ((LowerBound
lb, UpperBound
ub) : [VersionInterval]
more) | LowerBound
lb LowerBound -> LowerBound -> Bool
forall a. Eq a => a -> a -> Bool
== LowerBound
noLowerBound ->
        [VersionInterval] -> VersionIntervals
VersionIntervals ([VersionInterval] -> VersionIntervals)
-> [VersionInterval] -> VersionIntervals
forall a b. (a -> b) -> a -> b
$ UpperBound -> [VersionInterval] -> [VersionInterval]
invertVersionIntervals' UpperBound
ub [VersionInterval]
more
      -- Interval with a lower bound
      ((LowerBound
lb, UpperBound
ub) : [VersionInterval]
more) ->
          [VersionInterval] -> VersionIntervals
VersionIntervals ([VersionInterval] -> VersionIntervals)
-> [VersionInterval] -> VersionIntervals
forall a b. (a -> b) -> a -> b
$ (LowerBound
noLowerBound, LowerBound -> UpperBound
invertLowerBound LowerBound
lb)
          VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
: UpperBound -> [VersionInterval] -> [VersionInterval]
invertVersionIntervals' UpperBound
ub [VersionInterval]
more
    where
      -- Invert subsequent version intervals given the upper bound of
      -- the intervals already inverted.
      invertVersionIntervals' :: UpperBound
                              -> [(LowerBound, UpperBound)]
                              -> [(LowerBound, UpperBound)]
      invertVersionIntervals' :: UpperBound -> [VersionInterval] -> [VersionInterval]
invertVersionIntervals' UpperBound
NoUpperBound [] = []
      invertVersionIntervals' UpperBound
ub0 [] = [(UpperBound -> LowerBound
invertUpperBound UpperBound
ub0, UpperBound
NoUpperBound)]
      invertVersionIntervals' UpperBound
ub0 [(LowerBound
lb, UpperBound
NoUpperBound)] =
          [(UpperBound -> LowerBound
invertUpperBound UpperBound
ub0, LowerBound -> UpperBound
invertLowerBound LowerBound
lb)]
      invertVersionIntervals' UpperBound
ub0 ((LowerBound
lb, UpperBound
ub1) : [VersionInterval]
more) =
          (UpperBound -> LowerBound
invertUpperBound UpperBound
ub0, LowerBound -> UpperBound
invertLowerBound LowerBound
lb)
            VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
: UpperBound -> [VersionInterval] -> [VersionInterval]
invertVersionIntervals' UpperBound
ub1 [VersionInterval]
more

      invertLowerBound :: LowerBound -> UpperBound
      invertLowerBound :: LowerBound -> UpperBound
invertLowerBound (LowerBound Version
v Bound
b) = Version -> Bound -> UpperBound
UpperBound Version
v (Bound -> Bound
invertBound Bound
b)

      invertUpperBound :: UpperBound -> LowerBound
      invertUpperBound :: UpperBound -> LowerBound
invertUpperBound (UpperBound Version
v Bound
b) = Version -> Bound -> LowerBound
LowerBound Version
v (Bound -> Bound
invertBound Bound
b)
      invertUpperBound UpperBound
NoUpperBound = String -> LowerBound
forall a. (?callStack::CallStack) => String -> a
error String
"NoUpperBound: unexpected"

      invertBound :: Bound -> Bound
      invertBound :: Bound -> Bound
invertBound Bound
ExclusiveBound = Bound
InclusiveBound
      invertBound Bound
InclusiveBound = Bound
ExclusiveBound

      noLowerBound :: LowerBound
      noLowerBound :: LowerBound
noLowerBound = Version -> Bound -> LowerBound
LowerBound ([Int] -> Version
mkVersion [Int
0]) Bound
InclusiveBound


relaxLastInterval :: VersionIntervals -> VersionIntervals
relaxLastInterval :: VersionIntervals -> VersionIntervals
relaxLastInterval (VersionIntervals [VersionInterval]
xs) = [VersionInterval] -> VersionIntervals
VersionIntervals ([VersionInterval] -> [VersionInterval]
forall a. [(a, UpperBound)] -> [(a, UpperBound)]
relaxLastInterval' [VersionInterval]
xs)
  where
    relaxLastInterval' :: [(a, UpperBound)] -> [(a, UpperBound)]
relaxLastInterval' []      = []
    relaxLastInterval' [(a
l,UpperBound
_)] = [(a
l, UpperBound
NoUpperBound)]
    relaxLastInterval' ((a, UpperBound)
i:[(a, UpperBound)]
is)  = (a, UpperBound)
i (a, UpperBound) -> [(a, UpperBound)] -> [(a, UpperBound)]
forall a. a -> [a] -> [a]
: [(a, UpperBound)] -> [(a, UpperBound)]
relaxLastInterval' [(a, UpperBound)]
is

relaxHeadInterval :: VersionIntervals -> VersionIntervals
relaxHeadInterval :: VersionIntervals -> VersionIntervals
relaxHeadInterval (VersionIntervals [VersionInterval]
xs) = [VersionInterval] -> VersionIntervals
VersionIntervals ([VersionInterval] -> [VersionInterval]
forall b. [(LowerBound, b)] -> [(LowerBound, b)]
relaxHeadInterval' [VersionInterval]
xs)
  where
    relaxHeadInterval' :: [(LowerBound, b)] -> [(LowerBound, b)]
relaxHeadInterval' []         = []
    relaxHeadInterval' ((LowerBound
_,b
u):[(LowerBound, b)]
is) = (LowerBound
minLowerBound,b
u) (LowerBound, b) -> [(LowerBound, b)] -> [(LowerBound, b)]
forall a. a -> [a] -> [a]
: [(LowerBound, b)]
is