{-# LANGUAGE DeriveDataTypeable #-}

-- | This module implements a view of a 'VersionRange' as a finite
-- list of separated version intervals and provides the Boolean
-- algebra operations union, intersection, and complement.
--
-- It interprets the caret operator @^>=x.y@ as simply @==x.y.*@.
-- Until @Cabal < 3.6@, this module was called "Distribution.Types.VersionInterval".
-- The current module "Distribution.Types.VersionInterval" (refurbished since
-- @Cabal >= 3.6@) makes some effort to preserve the caret operator,
-- but so far does not expose the Boolean algebra structure.
--
module Distribution.Types.VersionInterval.Legacy (
    -- * 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.Internal

-- NonEmpty
import qualified Prelude (foldr1)

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

-- | View a 'VersionRange' as a sequence of separated 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'.
--
-- /Canonical/ means that two semantically equal ranges translate to the /same/
-- @['VersionInterval']@, thus its 'Eq' instance can decide semantical equality
-- of ranges.
--
-- In the returned sequence, each interval is non-empty.
-- The sequence is in increasing order and the intervals are separated, i.e., they
-- neither overlap nor touch. Therefore only the first and last interval can be
-- unbounded. The sequence can be empty if the range is empty
-- (e.g. a range expression like @> 2 && < 1@).
--
-- 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',
-- using an increasing sequence of separated (i.e., non-overlapping, non-touching)
-- non-empty intervals.
-- The represented range is the union of these intervals, meaning
-- that the empty sequence denotes the empty range.
--
-- As ranges form a Boolean algebra, we can compute union,
-- intersection, and complement.  These operations are all linear in
-- the size of the input, thanks to the ordered representation.
--
-- The interval-sequence 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 (just '==')
-- 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
$c== :: VersionIntervals -> VersionIntervals -> Bool
== :: VersionIntervals -> VersionIntervals -> Bool
$c/= :: VersionIntervals -> VersionIntervals -> Bool
/= :: 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
$cshowsPrec :: Int -> VersionIntervals -> ShowS
showsPrec :: Int -> VersionIntervals -> ShowS
$cshow :: VersionIntervals -> String
show :: VersionIntervals -> String
$cshowList :: [VersionIntervals] -> ShowS
showList :: [VersionIntervals] -> ShowS
Show, Typeable)

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

-- | Version intervals with exclusive or inclusive bounds, in all combinations:
--
-- 1. \( (lb,ub) \) meaning \( lb < \_ < ub \).
-- 2. \( (lb,ub] \) meaning \( lb < \_ ≤ ub \).
-- 3. \( [lb,ub) \) meaning \( lb ≤ \_ < ub \).
-- 4. \( [lb,ub] \) meaning \( lb ≤ \_ < ub \).
--
-- The upper bound can also be missing, meaning "\( ..,∞) \)".
--
type VersionInterval = (LowerBound, UpperBound)

data LowerBound
  = LowerBound Version !Bound  -- ^ Either exclusive @(v,..@ or inclusive @[v,..@.
  deriving (LowerBound -> LowerBound -> Bool
(LowerBound -> LowerBound -> Bool)
-> (LowerBound -> LowerBound -> Bool) -> Eq LowerBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LowerBound -> LowerBound -> Bool
== :: LowerBound -> LowerBound -> Bool
$c/= :: LowerBound -> LowerBound -> Bool
/= :: 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
$cshowsPrec :: Int -> LowerBound -> ShowS
showsPrec :: Int -> LowerBound -> ShowS
$cshow :: LowerBound -> String
show :: LowerBound -> String
$cshowList :: [LowerBound] -> ShowS
showList :: [LowerBound] -> ShowS
Show)

data UpperBound
  = NoUpperBound               -- ^ @..,∞)@
  | UpperBound Version !Bound  -- ^ Either exclusive @..,v)@ or inclusive @..,v]@.
  deriving (UpperBound -> UpperBound -> Bool
(UpperBound -> UpperBound -> Bool)
-> (UpperBound -> UpperBound -> Bool) -> Eq UpperBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpperBound -> UpperBound -> Bool
== :: UpperBound -> UpperBound -> Bool
$c/= :: UpperBound -> UpperBound -> Bool
/= :: 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
$cshowsPrec :: Int -> UpperBound -> ShowS
showsPrec :: Int -> UpperBound -> ShowS
$cshow :: UpperBound -> String
show :: UpperBound -> String
$cshowList :: [UpperBound] -> ShowS
showList :: [UpperBound] -> ShowS
Show)

data Bound
  = ExclusiveBound   -- ^ @(v,..@ if used as lower bound, @..,v)@ if used as upper bound.
  | InclusiveBound   -- ^ @[v,..@ if used as lower bound, @..,v]@ if used as upper bound.
  deriving (Bound -> Bound -> Bool
(Bound -> Bound -> Bool) -> (Bound -> Bound -> Bool) -> Eq Bound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bound -> Bound -> Bool
== :: Bound -> Bound -> Bool
$c/= :: Bound -> Bound -> Bool
/= :: 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
$cshowsPrec :: Int -> Bound -> ShowS
showsPrec :: Int -> Bound -> ShowS
$cshow :: Bound -> String
show :: Bound -> String
$cshowList :: [Bound] -> ShowS
showList :: [Bound] -> ShowS
Show)

-- | @[0,..@.
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

-- | @lb1 <= lb2@ holds iff interval @lb1..@ is contained in interval @lb2..@.
--
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

-- | @ub1 <= ub2@ holds iff interval @0..ub1@ is contained in interval @0..ub2@.
--
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

-- | Check that the sequence is ordered,
-- adjacent intervals are separated (do not overlap),
-- an no interval is empty (which would be a redundant entry).
--
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 = zip intervals (tail intervals)
    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

-- | The partial identity function, erroring out on illformed 'VersionIntervals'.
--
checkInvariant :: VersionIntervals -> VersionIntervals
checkInvariant :: VersionIntervals -> VersionIntervals
checkInvariant VersionIntervals
is = Bool -> VersionIntervals -> VersionIntervals
forall a. HasCallStack => Bool -> a -> a
assert (VersionIntervals -> Bool
invariant VersionIntervals
is) VersionIntervals
is

-- | Directly construct a 'VersionIntervals' from a list of intervals.
--
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 b a. (b -> a -> b) -> b -> [a] -> b
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

-- | Add an interval to the sequence, fusing with existing intervals if necessary.
--
insertInterval :: VersionInterval -> VersionIntervals -> VersionIntervals
insertInterval :: VersionInterval -> VersionIntervals -> VersionIntervals
insertInterval VersionInterval
i VersionIntervals
is = VersionIntervals -> VersionIntervals -> VersionIntervals
unionVersionIntervals ([VersionInterval] -> VersionIntervals
VersionIntervals [VersionInterval
i]) VersionIntervals
is

-- | A valid interval is non-empty.
--
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
nonEmptyVI 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 that an interval is non-empty.
--
nonEmptyVI :: VersionInterval -> Bool
nonEmptyVI :: VersionInterval -> Bool
nonEmptyVI (LowerBound
_,               UpperBound
NoUpperBound   ) = Bool
True
nonEmptyVI (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 = (VersionRangeF VersionIntervals -> VersionIntervals)
-> VersionRange -> VersionIntervals
forall a. (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange VersionRangeF VersionIntervals -> VersionIntervals
alg where
    -- @== v@
    alg :: VersionRangeF VersionIntervals -> VersionIntervals
alg (ThisVersionF Version
v)                = VersionInterval -> VersionIntervals
chkIvl (Version -> Bound -> LowerBound
LowerBound Version
v Bound
InclusiveBound, Version -> Bound -> UpperBound
UpperBound Version
v Bound
InclusiveBound)
    -- @>  v@
    alg (LaterVersionF Version
v)               = VersionInterval -> VersionIntervals
chkIvl (Version -> Bound -> LowerBound
LowerBound Version
v Bound
ExclusiveBound, UpperBound
NoUpperBound)
    -- @>= v@
    alg (OrLaterVersionF Version
v)             = VersionInterval -> VersionIntervals
chkIvl (Version -> Bound -> LowerBound
LowerBound Version
v Bound
InclusiveBound, UpperBound
NoUpperBound)
    -- @<  v@
    alg (EarlierVersionF Version
v)
        | Version -> Bool
isVersion0 Version
v                  = [VersionInterval] -> VersionIntervals
VersionIntervals []
        | Bool
otherwise                     = VersionInterval -> VersionIntervals
chkIvl (LowerBound
minLowerBound,               Version -> Bound -> UpperBound
UpperBound Version
v Bound
ExclusiveBound)
    -- @<= v@
    alg (OrEarlierVersionF Version
v)           = VersionInterval -> VersionIntervals
chkIvl (LowerBound
minLowerBound,               Version -> Bound -> UpperBound
UpperBound Version
v Bound
InclusiveBound)
    -- @^>= v@
    alg (MajorBoundVersionF Version
v)          = VersionInterval -> VersionIntervals
chkIvl (Version -> Bound -> LowerBound
LowerBound Version
v Bound
InclusiveBound, Version -> Bound -> UpperBound
UpperBound (Version -> Version
majorUpperBound Version
v) Bound
ExclusiveBound)
    -- @r || r'@
    alg (UnionVersionRangesF VersionIntervals
v1 VersionIntervals
v2)     = VersionIntervals -> VersionIntervals -> VersionIntervals
unionVersionIntervals VersionIntervals
v1 VersionIntervals
v2
    -- @r && r'@
    alg (IntersectVersionRangesF VersionIntervals
v1 VersionIntervals
v2) = VersionIntervals -> VersionIntervals -> VersionIntervals
intersectVersionIntervals VersionIntervals
v1 VersionIntervals
v2

    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 a. (a -> a -> a) -> [a] -> a
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
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'

-- | Union two interval sequences, fusing intervals where necessary.
-- Computed \( O(n+m) \) time, resulting in sequence of length \( ≤ n+m \).
--
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

      -- @i < i'@ and separated: keep @i@.
      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')

      -- @i'' = i ∪ i'@ and @i@ ends first: drop @i@, replace @i'@ by @i''@.
      Left  (Just VersionInterval
i'') ->      [VersionInterval] -> [VersionInterval] -> [VersionInterval]
union      [VersionInterval]
is  (VersionInterval
i''VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is')

      -- @i' < i@ and separated: keep @i'@.
      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'

      -- @i'' = i ∪ i'@ and @i'@ ends first: drop @i'@, replace @i@ by @i''@.
      Right (Just VersionInterval
i'') ->      [VersionInterval] -> [VersionInterval] -> [VersionInterval]
union (VersionInterval
i''VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is)      [VersionInterval]
is'

-- | Given two version intervals @i1@ and @i2@, return one of the following:
--
-- [@Left Nothing@]     when @i1 < i2@ and the intervals are separated.
-- [@Right Nothing@]    when @i2 < i1@ and the intervals are separated.
-- [@Left (i1 \/ i2)@]  when @ub(i1) <= ub(i2)@ and the intervals are not separated.
-- [@Right (i1 \/ i2)@] when @ub(i2) < ub(i1)@ and the intervals are not separated.
--
-- Herein, @i < i'@ means that the whole of the interval @i@ is strictly left of the whole of @i'@,
-- and @ub(i)@ returns the right boundary of interval @i@ which could be inclusive or exclusive.
--
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)
forall a b. a -> b -> b
`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)
forall a b. a -> b -> b
`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'

-- | The intersection \( is \cap is' \) of two interval sequences \( is \) and \( is' \)
-- of lengths \( n \) and \( m \), resp.,
-- satisfies the specification \( is ∩ is' = \{ i ∩ i' \mid i ∈ is, i' ∈ is' \} \).
-- Thanks to the ordered representation of intervals it can be computed in \( O(n+m) \)
-- (rather than the naive \( O(nm) \).
--
-- The length of \( is \cap is' \) is \( ≤ \min(n,m) \).
--
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

      -- @i < i'@: throw out @i@
      Left  Maybe VersionInterval
Nothing    ->       [VersionInterval] -> [VersionInterval] -> [VersionInterval]
intersect [VersionInterval]
is (VersionInterval
i'VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is')

      -- @i'' = i /\ i'@ and @i@ ends first: replace @i@ by @i''@.
      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')

      -- @i' < i@: throw out @i'@
      Right Maybe VersionInterval
Nothing    ->       [VersionInterval] -> [VersionInterval] -> [VersionInterval]
intersect (VersionInterval
iVersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is) [VersionInterval]
is'

      -- @i'' = i /\ i'@ and @i'@ ends first: replace @i'@ by @i''@.
      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'

-- | Given two version intervals @i1@ and @i2@, return one of the following:
--
-- [@Left Nothing@]     when @i1 < i2@.
-- [@Right Nothing@]    when @i2 < i1@.
-- [@Left (i1 /\ i2)@]  when @ub(i1) <= ub(i2)@.
-- [@Right (i1 /\ i2)@] when @ub(i2) < ub(i1)@.
--
-- Herein, @i < i'@ means that the whole of the interval @i@ is strictly left of the whole of @i'@,
-- and @ub(i)@ returns the right boundary of interval @i@ which could be inclusive or exclusive.
--
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)
forall a b. a -> b -> b
`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)
forall a b. a -> b -> b
`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'

-- | Compute the complement.
-- \( O(n) \).
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. HasCallStack => 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

-- | Remove the last upper bound, enlarging the range.
-- But empty ranges stay empty.
-- \( O(n) \).
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

-- | Remove the first lower bound (i.e, make it \( [0 \).
-- Empty ranges stay empty.
-- \( O(1) \).
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