{-# LANGUAGE BangPatterns #-}

-- |
--
-- Author:          Oleg Grenrus <oleg.grenrus@iki.fi>
-- SPDX-License-Id: GPL-2.0-or-later
--
-- This module implements a view of a 'VersionRange' as a finite
-- list of separated version intervals.
--
-- In conversion from and to 'VersionRange' it makes some effort to
-- preserve the caret operator @^>=x.y@.  This constraint a priori
-- specifies the same interval as @==x.y.*@, but indicates that newer
-- versions could be acceptable (@allow-newer: ^@).
--
module VersionInterval (
    -- * Version intervals
    VersionIntervals,
    unVersionIntervals,

    -- * Conversions
    toVersionIntervals,
    fromVersionIntervals,
    ConversionProblem (..),

    -- ** Normalisation
    normaliseVersionRange,

    -- * Version intervals view
    VersionInterval (..),
    LB(..),
    MB(..),
    UB(..),
    Bound(..),

    -- * For testing
    validVersionInterval,
    validVersionIntervals,
    intersectInterval,
    stage1, stage2, stage3,
)  where

import Control.Applicative (liftA2)
import Control.Monad       (join)
import Data.List           (sortOn)
import Data.List.NonEmpty  (NonEmpty (..), cons)
import Data.Maybe          (catMaybes)

import Distribution.Types.Version
       (Version, mkVersion, validVersion, version0, versionNumbers)
import Distribution.Types.VersionRange.Internal
       (VersionRange, VersionRangeF (..), cataVersionRange, earlierVersion,
       intersectVersionRanges, majorBoundVersion, majorUpperBound, noVersion,
       orLaterVersion, thisVersion, unionVersionRanges)

singleton :: a -> NonEmpty a
singleton :: forall a. a -> NonEmpty a
singleton a
x = a
x forall a. a -> [a] -> NonEmpty a
:| []

-------------------------------------------------------------------------------
-- Data
-------------------------------------------------------------------------------

-- | A complementary representation of a 'VersionRange'. Instead of a boolean
-- version predicate it uses an increasing sequence of non-overlapping,
-- non-empty intervals.
--
-- This version is different than in @Cabal-3.8@ and previous,
-- as it tries to preserve @^>=@ version ranges under default and @transformCaretUpper@ semantics.
-- Slighly simplifying, 'normalizeVersionRange' shouldn't destroy @^>=@ in version range expressions.
--
newtype VersionIntervals = VersionIntervals [VersionInterval]
  deriving (VersionIntervals -> VersionIntervals -> Bool
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
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)

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

-- | Version interval.
--
-- Invariants:
--
-- * Interval is non-empty
-- * 'MB' is between 'LB' and 'UB'.
--
data VersionInterval = VI !LB !MB !UB
  deriving (VersionInterval -> VersionInterval -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionInterval -> VersionInterval -> Bool
$c/= :: VersionInterval -> VersionInterval -> Bool
== :: VersionInterval -> VersionInterval -> Bool
$c== :: VersionInterval -> VersionInterval -> Bool
Eq, Int -> VersionInterval -> ShowS
[VersionInterval] -> ShowS
VersionInterval -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionInterval] -> ShowS
$cshowList :: [VersionInterval] -> ShowS
show :: VersionInterval -> String
$cshow :: VersionInterval -> String
showsPrec :: Int -> VersionInterval -> ShowS
$cshowsPrec :: Int -> VersionInterval -> ShowS
Show)

-- | Lower bound. For intervals it always exist: 'zeroLB' i.e. @>= 0@.
--
-- All lower bound intervals are inclusive, i.e. @>=v@. @>x.y.z@ is converted into @>=x.y.z.0@.
--
data LB = LB !Version
  deriving (LB -> LB -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LB -> LB -> Bool
$c/= :: LB -> LB -> Bool
== :: LB -> LB -> Bool
$c== :: LB -> LB -> Bool
Eq, Eq LB
LB -> LB -> Bool
LB -> LB -> Ordering
LB -> LB -> LB
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LB -> LB -> LB
$cmin :: LB -> LB -> LB
max :: LB -> LB -> LB
$cmax :: LB -> LB -> LB
>= :: LB -> LB -> Bool
$c>= :: LB -> LB -> Bool
> :: LB -> LB -> Bool
$c> :: LB -> LB -> Bool
<= :: LB -> LB -> Bool
$c<= :: LB -> LB -> Bool
< :: LB -> LB -> Bool
$c< :: LB -> LB -> Bool
compare :: LB -> LB -> Ordering
$ccompare :: LB -> LB -> Ordering
Ord, Int -> LB -> ShowS
[LB] -> ShowS
LB -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LB] -> ShowS
$cshowList :: [LB] -> ShowS
show :: LB -> String
$cshow :: LB -> String
showsPrec :: Int -> LB -> ShowS
$cshowsPrec :: Int -> LB -> ShowS
Show)

-- | Upper bound.
--
-- All upper bounds are exclusive, i.e. @<v@. @<=x.y.z@ is converted to @<x.y.z.0@.
--
--
data UB
    = UB !Version   -- ^ upper bound
    | NoUB          -- ^ no upper bound (i.e. infinite)
  deriving (UB -> UB -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UB -> UB -> Bool
$c/= :: UB -> UB -> Bool
== :: UB -> UB -> Bool
$c== :: UB -> UB -> Bool
Eq, Eq UB
UB -> UB -> Bool
UB -> UB -> Ordering
UB -> UB -> UB
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UB -> UB -> UB
$cmin :: UB -> UB -> UB
max :: UB -> UB -> UB
$cmax :: UB -> UB -> UB
>= :: UB -> UB -> Bool
$c>= :: UB -> UB -> Bool
> :: UB -> UB -> Bool
$c> :: UB -> UB -> Bool
<= :: UB -> UB -> Bool
$c<= :: UB -> UB -> Bool
< :: UB -> UB -> Bool
$c< :: UB -> UB -> Bool
compare :: UB -> UB -> Ordering
$ccompare :: UB -> UB -> Ordering
Ord, Int -> UB -> ShowS
[UB] -> ShowS
UB -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UB] -> ShowS
$cshowList :: [UB] -> ShowS
show :: UB -> String
$cshow :: UB -> String
showsPrec :: Int -> UB -> ShowS
$cshowsPrec :: Int -> UB -> ShowS
Show)

-- | Bound variant.
data Bound
    = Incl  -- ^ inclusive: @>=@ or @<=@
    | Excl  -- ^ exclusive: @>@ or @<@
  deriving (Bound -> Bound -> Bool
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, Eq Bound
Bound -> Bound -> Bool
Bound -> Bound -> Ordering
Bound -> Bound -> Bound
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bound -> Bound -> Bound
$cmin :: Bound -> Bound -> Bound
max :: Bound -> Bound -> Bound
$cmax :: Bound -> Bound -> Bound
>= :: Bound -> Bound -> Bool
$c>= :: Bound -> Bound -> Bool
> :: Bound -> Bound -> Bool
$c> :: Bound -> Bound -> Bool
<= :: Bound -> Bound -> Bool
$c<= :: Bound -> Bound -> Bool
< :: Bound -> Bound -> Bool
$c< :: Bound -> Bound -> Bool
compare :: Bound -> Bound -> Ordering
$ccompare :: Bound -> Bound -> Ordering
Ord, Int -> Bound -> ShowS
[Bound] -> ShowS
Bound -> String
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)

-- | Middle bound.
data MB
    = MB !Version  -- ^ major bound.
    | NoMB         -- ^ no major bound (i.e. infinite)
  deriving (MB -> MB -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MB -> MB -> Bool
$c/= :: MB -> MB -> Bool
== :: MB -> MB -> Bool
$c== :: MB -> MB -> Bool
Eq, Eq MB
MB -> MB -> Bool
MB -> MB -> Ordering
MB -> MB -> MB
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MB -> MB -> MB
$cmin :: MB -> MB -> MB
max :: MB -> MB -> MB
$cmax :: MB -> MB -> MB
>= :: MB -> MB -> Bool
$c>= :: MB -> MB -> Bool
> :: MB -> MB -> Bool
$c> :: MB -> MB -> Bool
<= :: MB -> MB -> Bool
$c<= :: MB -> MB -> Bool
< :: MB -> MB -> Bool
$c< :: MB -> MB -> Bool
compare :: MB -> MB -> Ordering
$ccompare :: MB -> MB -> Ordering
Ord, Int -> MB -> ShowS
[MB] -> ShowS
MB -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MB] -> ShowS
$cshowList :: [MB] -> ShowS
show :: MB -> String
$cshow :: MB -> String
showsPrec :: Int -> MB -> ShowS
$cshowsPrec :: Int -> MB -> ShowS
Show)

-- | @>=0@
zeroLB :: LB
zeroLB :: LB
zeroLB = Version -> LB
LB Version
version0

-- | Whether the version is @0@.
isVersion0 :: Version -> Bool
isVersion0 :: Version -> Bool
isVersion0 = forall a. Eq a => a -> a -> Bool
(==) Version
version0

-- | Versions are not separated type.
succVersion :: Version -> Version
succVersion :: Version -> Version
succVersion Version
v = [Int] -> Version
mkVersion (Version -> [Int]
versionNumbers Version
v forall a. [a] -> [a] -> [a]
++ [Int
0])

-------------------------------------------------------------------------------
-- Stage1
-------------------------------------------------------------------------------

stage1 :: ([VersionInterval] -> [VersionInterval]) -> VersionRange -> [VersionInterval]
stage1 :: ([VersionInterval] -> [VersionInterval])
-> VersionRange -> [VersionInterval]
stage1 [VersionInterval] -> [VersionInterval]
opt = forall a. (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange VersionRangeF [VersionInterval] -> [VersionInterval]
alg where
    -- version range leafs transform into singleton intervals
    alg :: VersionRangeF [VersionInterval] -> [VersionInterval]
alg (ThisVersionF Version
v)                = [LB -> MB -> UB -> VersionInterval
VI (Version -> LB
LB Version
v)                (Version -> MB
MB (Version -> Version
succVersion Version
v))      (Version -> UB
UB (Version -> Version
succVersion Version
v))]
    alg (LaterVersionF Version
v)               = [LB -> MB -> UB -> VersionInterval
VI (Version -> LB
LB (Version -> Version
succVersion Version
v))  MB
NoMB                      UB
NoUB]
    alg (OrLaterVersionF Version
v)             = [LB -> MB -> UB -> VersionInterval
VI (Version -> LB
LB Version
v)                MB
NoMB                      UB
NoUB]
    alg (EarlierVersionF Version
v)
        | Version -> Bool
isVersion0 Version
v                  = []
        | Bool
otherwise                     = [LB -> MB -> UB -> VersionInterval
VI LB
zeroLB                (Version -> MB
MB Version
v)                    (Version -> UB
UB Version
v)]
    alg (OrEarlierVersionF Version
v)           = [LB -> MB -> UB -> VersionInterval
VI LB
zeroLB                (Version -> MB
MB (Version -> Version
succVersion Version
v))      (Version -> UB
UB (Version -> Version
succVersion Version
v))]

    -- ^>= version-range's upper bound should be MajorBound
    alg (MajorBoundVersionF Version
v)          = [LB -> MB -> UB -> VersionInterval
VI (Version -> LB
LB Version
v)                (Version -> MB
MB (Version -> Version
majorUpperBound Version
v))  UB
NoUB]

    -- union: just merge the version intervals
    alg (UnionVersionRangesF [VersionInterval]
v1 [VersionInterval]
v2)     = [VersionInterval]
v1 forall a. [a] -> [a] -> [a]
++ [VersionInterval]
v2

    -- intersection: pairwise intersect. Strip empty intervals. Sort to restore the invariant.
    alg (IntersectVersionRangesF [VersionInterval]
v1 [VersionInterval]
v2) = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 VersionInterval -> VersionInterval -> Maybe VersionInterval
intersectInterval ([VersionInterval] -> [VersionInterval]
opt [VersionInterval]
v1) ([VersionInterval] -> [VersionInterval]
opt [VersionInterval]
v2)

-------------------------------------------------------------------------------
-- Stage2
-------------------------------------------------------------------------------

stage2 :: [VersionInterval] -> [VersionInterval]
stage2 :: [VersionInterval] -> [VersionInterval]
stage2 = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(VI LB
l MB
_ UB
_) -> LB
l)

-------------------------------------------------------------------------------
-- Postprocess
-------------------------------------------------------------------------------

stage2and3 :: [VersionInterval] -> [VersionInterval]
stage2and3 :: [VersionInterval] -> [VersionInterval]
stage2and3 = [VersionInterval] -> [VersionInterval]
stage3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VersionInterval] -> [VersionInterval]
stage2

stage3 :: [VersionInterval] -> [VersionInterval]
stage3 :: [VersionInterval] -> [VersionInterval]
stage3 []                = []
stage3 (VI LB
l MB
m UB
u : [VersionInterval]
rest) = LB -> MB -> UB -> [VersionInterval] -> [VersionInterval]
stage3go LB
l MB
m UB
u [VersionInterval]
rest

stage3go :: LB -> MB -> UB -> [VersionInterval] -> [VersionInterval]
stage3go :: LB -> MB -> UB -> [VersionInterval] -> [VersionInterval]
stage3go LB
l MB
m UB
u []                 = [LB -> MB -> UB -> VersionInterval
VI LB
l MB
m UB
u]
stage3go LB
l MB
m UB
u (VI LB
l' MB
m' UB
u' : [VersionInterval]
is)
    | LB
l forall a. Eq a => a -> a -> Bool
== LB
l'   = LB -> MB -> UB -> [VersionInterval] -> [VersionInterval]
stage3go LB
l' (MB -> MB -> MB
unionMB MB
m MB
m') (UB -> UB -> UB
unionUB UB
u UB
u') [VersionInterval]
is
    | Bool
otherwise = case MB -> UB -> LB -> Overlap
overlap MB
m UB
u LB
l' of
        Overlap
NoOverlap -> LB -> MB -> UB -> VersionInterval
VI LB
l MB
m UB
u forall a. a -> [a] -> [a]
: LB -> MB -> UB -> [VersionInterval] -> [VersionInterval]
stage3go LB
l' MB
m' UB
u' [VersionInterval]
is
        Overlap
OverlapU  -> VersionInterval -> [VersionInterval] -> [VersionInterval]
viCons (LB -> MB -> UB -> VersionInterval
VI LB
l MB
m (UB -> LB -> UB
trimLB UB
u LB
l')) (LB -> MB -> UB -> [VersionInterval] -> [VersionInterval]
stage3go LB
l' MB
m' (UB -> UB -> UB
unionUB UB
u UB
u') [VersionInterval]
is)
        Overlap
OverlapM  -> LB -> MB -> UB -> [VersionInterval] -> [VersionInterval]
stage3go LB
l (MB -> MB -> MB
unionMB MB
m MB
m') (UB -> UB -> UB
unionUB UB
u UB
u') [VersionInterval]
is
  where
    viCons :: VersionInterval -> [VersionInterval] -> [VersionInterval]
    viCons :: VersionInterval -> [VersionInterval] -> [VersionInterval]
viCons VersionInterval
i | VersionInterval -> Bool
nonEmptyVI VersionInterval
i = (VersionInterval
i forall a. a -> [a] -> [a]
:)
    viCons VersionInterval
_                = forall a. a -> a
id

trimLB :: UB -> LB -> UB
trimLB :: UB -> LB -> UB
trimLB UB
_    (LB Version
l) = Version -> UB
UB Version
l

-------------------------------------------------------------------------------
-- Intersections
-------------------------------------------------------------------------------

intersectInterval :: VersionInterval -> VersionInterval -> Maybe VersionInterval
intersectInterval :: VersionInterval -> VersionInterval -> Maybe VersionInterval
intersectInterval (VI LB
xl MB
xm UB
xu) (VI LB
yl MB
ym UB
yu)
    | VersionInterval -> Bool
nonEmptyVI VersionInterval
xy = forall a. a -> Maybe a
Just VersionInterval
xy
    | Bool
otherwise     = forall a. Maybe a
Nothing
  where
    l :: LB
l = LB -> LB -> LB
intersectLB LB
xl LB
yl
    m :: MB
m = MB -> MB -> MB
intersectMB MB
xm MB
ym
    u :: UB
u = UB -> UB -> UB
intersectUB UB
xu UB
yu

    -- make middle bound be between l and u
    m' :: MB
m' = MB -> UB -> MB
rtrimMB (LB -> MB -> MB
ltrimMB LB
l MB
m) UB
u

    xy :: VersionInterval
xy = LB -> MB -> UB -> VersionInterval
VI LB
l MB
m' UB
u

ltrimMB :: LB -> MB -> MB
ltrimMB :: LB -> MB -> MB
ltrimMB LB
_         MB
NoMB      = MB
NoMB
ltrimMB (LB Version
l) (MB Version
m) = case forall a. Ord a => a -> a -> Ordering
compare Version
l Version
m of
    Ordering
LT -> Version -> MB
MB Version
m
    Ordering
EQ -> Version -> MB
MB Version
m
    Ordering
GT -> Version -> MB
MB Version
l

rtrimMB :: MB -> UB -> MB
rtrimMB :: MB -> UB -> MB
rtrimMB MB
m      UB
NoUB   = MB
m
rtrimMB MB
NoMB   (UB Version
u) = Version -> MB
MB Version
u
rtrimMB (MB Version
m) (UB Version
u) = Version -> MB
MB (forall a. Ord a => a -> a -> a
min Version
m Version
u)

intersectLB :: LB -> LB -> LB
intersectLB :: LB -> LB -> LB
intersectLB (LB Version
v) (LB Version
u) = Version -> LB
LB (forall a. Ord a => a -> a -> a
max Version
v Version
u)

intersectMB :: MB -> MB -> MB
intersectMB :: MB -> MB -> MB
intersectMB MB
NoMB   MB
b      = MB
b
intersectMB MB
b      MB
NoMB   = MB
b
intersectMB (MB Version
v) (MB Version
u) = Version -> MB
MB (forall a. Ord a => a -> a -> a
min Version
v Version
u)

intersectUB :: UB -> UB -> UB
intersectUB :: UB -> UB -> UB
intersectUB UB
NoUB   UB
b      = UB
b
intersectUB UB
b      UB
NoUB   = UB
b
intersectUB (UB Version
v) (UB Version
u) = Version -> UB
UB (forall a. Ord a => a -> a -> a
min Version
v Version
u)

intersectMBandUB :: MB -> UB -> UB
intersectMBandUB :: MB -> UB -> UB
intersectMBandUB MB
NoMB   UB
b      = UB
b
intersectMBandUB (MB Version
v) UB
NoUB   = Version -> UB
UB Version
v
intersectMBandUB (MB Version
v) (UB Version
u) = Version -> UB
UB (forall a. Ord a => a -> a -> a
min Version
v Version
u)

-------------------------------------------------------------------------------
-- Unions
-------------------------------------------------------------------------------

unionMB :: MB -> MB -> MB
unionMB :: MB -> MB -> MB
unionMB MB
NoMB   MB
_      = MB
NoMB
unionMB MB
_      MB
NoMB   = MB
NoMB
unionMB (MB Version
v) (MB Version
u) = Version -> MB
MB (forall a. Ord a => a -> a -> a
max Version
v Version
u)

unionUB :: UB -> UB -> UB
unionUB :: UB -> UB -> UB
unionUB UB
NoUB   UB
_      = UB
NoUB
unionUB UB
_      UB
NoUB   = UB
NoUB
unionUB (UB Version
v) (UB Version
u) = Version -> UB
UB (forall a. Ord a => a -> a -> a
max Version
v Version
u)

-------------------------------------------------------------------------------
-- Helpers
-------------------------------------------------------------------------------

-- | Overlaps.
--
data Overlap
    = NoOverlap  -- ^ no overlap, next interval's @l@ is greater than @u@
    | OverlapM   -- ^ overlaps, next interval's @l@ is less than @m@
    | OverlapU   -- ^ overlaps, next interval's @l@ is less than @u@ (but greater than @m@)
  deriving (Overlap -> Overlap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Overlap -> Overlap -> Bool
$c/= :: Overlap -> Overlap -> Bool
== :: Overlap -> Overlap -> Bool
$c== :: Overlap -> Overlap -> Bool
Eq, Int -> Overlap -> ShowS
[Overlap] -> ShowS
Overlap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Overlap] -> ShowS
$cshowList :: [Overlap] -> ShowS
show :: Overlap -> String
$cshow :: Overlap -> String
showsPrec :: Int -> Overlap -> ShowS
$cshowsPrec :: Int -> Overlap -> ShowS
Show)

overlap :: MB -> UB -> LB -> Overlap
overlap :: MB -> UB -> LB -> Overlap
overlap MB
_           (UB Version
u ) (LB Version
l) | Version
u forall a. Ord a => a -> a -> Bool
<  Version
l = Overlap
NoOverlap
overlap (MB Version
m ) UB
_           (LB Version
l) | Version
m forall a. Ord a => a -> a -> Bool
<  Version
l = Overlap
OverlapU
overlap MB
_           UB
_           LB
_           = Overlap
OverlapM

-------------------------------------------------------------------------------
-- Invariants
-------------------------------------------------------------------------------

-- | 'VersionIntervals' invariant:
--
-- * all intervals are valid (lower bound is less then upper bound, middle bound is in between)
-- * intervals doesn't touch each other (distinct)
--
validVersionIntervals :: VersionIntervals -> Bool
validVersionIntervals :: VersionIntervals -> Bool
validVersionIntervals (VersionIntervals [VersionInterval]
intervals) =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all VersionInterval -> Bool
validVersionInterval [VersionInterval]
intervals Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (VersionInterval, VersionInterval) -> Bool
doesNotTouch' (forall a. [a] -> [(a, a)]
pairs [VersionInterval]
intervals)
  where
    doesNotTouch' :: (VersionInterval, VersionInterval) -> Bool
    doesNotTouch' :: (VersionInterval, VersionInterval) -> Bool
doesNotTouch' (VI LB
l MB
m UB
u, VI LB
l' MB
_ UB
_) = LB
l forall a. Ord a => a -> a -> Bool
< LB
l' Bool -> Bool -> Bool
&& case MB -> UB -> LB -> Overlap
overlap MB
m UB
u LB
l' of
        Overlap
NoOverlap -> Bool
True
        Overlap
OverlapM  -> Bool
False
        Overlap
OverlapU  -> case UB
u of
            UB
NoUB     -> Bool
True
            UB Version
uv -> case LB
l' of LB Version
lv -> Version
uv forall a. Eq a => a -> a -> Bool
== Version
lv

pairs :: [a] -> [(a,a)]
pairs :: forall a. [a] -> [(a, a)]
pairs [a]
xs = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs (forall a. [a] -> [a]
tail [a]
xs)

validLB :: LB -> Bool
validLB :: LB -> Bool
validLB (LB Version
v) = Version -> Bool
validVersion Version
v

validUB :: UB -> Bool
validUB :: UB -> Bool
validUB UB
NoUB   = Bool
True
validUB (UB Version
v) = Version -> Bool
validVersion Version
v

validMB :: MB -> Bool
validMB :: MB -> Bool
validMB MB
NoMB   = Bool
True
validMB (MB Version
v) = Version -> Bool
validVersion Version
v

validVersionInterval :: VersionInterval -> Bool
validVersionInterval :: VersionInterval -> Bool
validVersionInterval i :: VersionInterval
i@(VI LB
l MB
m UB
u) = LB -> Bool
validLB LB
l Bool -> Bool -> Bool
&& MB -> Bool
validMB MB
m Bool -> Bool -> Bool
&& UB -> Bool
validUB UB
u Bool -> Bool -> Bool
&& VersionInterval -> Bool
nonEmptyVI VersionInterval
i Bool -> Bool -> Bool
&& LB -> MB -> Bool
lbLessThanMB LB
l MB
m Bool -> Bool -> Bool
&& MB -> UB -> Bool
mbLessThanUB MB
m UB
u

mbLessThanUB :: MB -> UB -> Bool
mbLessThanUB :: MB -> UB -> Bool
mbLessThanUB (MB Version
m) (UB Version
u) = Version
m forall a. Ord a => a -> a -> Bool
<= Version
u
mbLessThanUB MB
NoMB   (UB Version
_) = Bool
False
mbLessThanUB MB
_       UB
NoUB  = Bool
True

lbLessThanMB :: LB -> MB -> Bool
lbLessThanMB :: LB -> MB -> Bool
lbLessThanMB LB
_      MB
NoMB   = Bool
True
lbLessThanMB (LB Version
l) (MB Version
m) = Version
l forall a. Ord a => a -> a -> Bool
<= Version
m

-- Check an interval is non-empty
--
nonEmptyVI :: VersionInterval -> Bool
nonEmptyVI :: VersionInterval -> Bool
nonEmptyVI (VI (LB Version
_) MB
_ UB
NoUB)   = Bool
True
nonEmptyVI (VI (LB Version
l) MB
_ (UB Version
u)) = Version
l forall a. Ord a => a -> a -> Bool
< Version
u

-------------------------------------------------------------------------------
-- Conversions
-------------------------------------------------------------------------------

-- | Convert a 'VersionRange' to a sequence of version intervals.
--
toVersionIntervals :: VersionRange -> VersionIntervals
toVersionIntervals :: VersionRange -> VersionIntervals
toVersionIntervals = [VersionInterval] -> VersionIntervals
VersionIntervals forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VersionInterval] -> [VersionInterval]
stage2and3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([VersionInterval] -> [VersionInterval])
-> VersionRange -> [VersionInterval]
stage1 [VersionInterval] -> [VersionInterval]
stage2and3

data ConversionProblem
    = IntervalsEmpty
    | OtherConversionProblem
  deriving (ConversionProblem -> ConversionProblem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConversionProblem -> ConversionProblem -> Bool
$c/= :: ConversionProblem -> ConversionProblem -> Bool
== :: ConversionProblem -> ConversionProblem -> Bool
$c== :: ConversionProblem -> ConversionProblem -> Bool
Eq, Int -> ConversionProblem -> ShowS
[ConversionProblem] -> ShowS
ConversionProblem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConversionProblem] -> ShowS
$cshowList :: [ConversionProblem] -> ShowS
show :: ConversionProblem -> String
$cshow :: ConversionProblem -> String
showsPrec :: Int -> ConversionProblem -> ShowS
$cshowsPrec :: Int -> ConversionProblem -> ShowS
Show)

-- | Convert a 'VersionIntervals' value back into a 'VersionRange' expression
-- representing the version intervals.
--
fromVersionIntervals :: VersionIntervals -> Either ConversionProblem VersionRange
fromVersionIntervals :: VersionIntervals -> Either ConversionProblem VersionRange
fromVersionIntervals (VersionIntervals [])     = forall a b. b -> Either a b
Right VersionRange
noVersion
fromVersionIntervals (VersionIntervals (VersionInterval
x:[VersionInterval]
xs)) =
    case forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse VersionInterval -> Maybe (NonEmpty VersionRange)
intervalToVersionRange (VersionInterval -> [VersionInterval] -> NonEmpty VersionInterval
preprocess VersionInterval
x [VersionInterval]
xs) of
        Just NonEmpty VersionRange
vrs -> forall a b. b -> Either a b
Right (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 VersionRange -> VersionRange -> VersionRange
unionVersionRanges NonEmpty VersionRange
vrs)
        Maybe (NonEmpty VersionRange)
Nothing  -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
            if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all VersionInterval -> Bool
seemsEmpty (VersionInterval
xforall a. a -> [a] -> [a]
:[VersionInterval]
xs)
            then ConversionProblem
IntervalsEmpty
            else ConversionProblem
OtherConversionProblem
  where
    -- we can remove upper bounds, if they touch next interval, and the next interval doesn't have upper bound
    preprocess :: VersionInterval -> [VersionInterval] -> NonEmpty VersionInterval
    preprocess :: VersionInterval -> [VersionInterval] -> NonEmpty VersionInterval
preprocess VersionInterval
i [] = VersionInterval
i forall a. a -> [a] -> NonEmpty a
:| []
    preprocess i :: VersionInterval
i@(VI LB
l MB
m UB
u) (VersionInterval
j:[VersionInterval]
js) = case UB
u' of
        UB
NoUB | UB -> LB -> Bool
touchesUB UB
u LB
l' -> forall a. a -> NonEmpty a -> NonEmpty a
cons (LB -> MB -> UB -> VersionInterval
VI LB
l MB
m UB
NoUB) NonEmpty VersionInterval
js'
        UB
_                     -> forall a. a -> NonEmpty a -> NonEmpty a
cons VersionInterval
i             NonEmpty VersionInterval
js'
      where
        js' :: NonEmpty VersionInterval
js'@(VI LB
l' MB
_ UB
u' :| [VersionInterval]
_)  = VersionInterval -> [VersionInterval] -> NonEmpty VersionInterval
preprocess VersionInterval
j [VersionInterval]
js

    seemsEmpty :: VersionInterval -> Bool
    seemsEmpty :: VersionInterval -> Bool
seemsEmpty (VI LB
l MB
m UB
u) = Bool -> Bool
not (VersionInterval -> Bool
nonEmptyVI (LB -> MB -> UB -> VersionInterval
VI LB
l MB
NoMB (MB -> UB -> UB
intersectMBandUB MB
m UB
u)))

touchesUB :: UB -> LB -> Bool
touchesUB :: UB -> LB -> Bool
touchesUB UB
NoUB   LB
_      = Bool
True
touchesUB (UB Version
u) (LB Version
l) = Version
u forall a. Ord a => a -> a -> Bool
>= Version
l

lbToVR :: LB -> VersionRange
lbToVR :: LB -> VersionRange
lbToVR (LB Version
l) = Version -> VersionRange
orLaterVersion Version
l

ubToVR :: UB -> VersionRange -> VersionRange
ubToVR :: UB -> VersionRange -> VersionRange
ubToVR UB
NoUB   VersionRange
vr = VersionRange
vr
ubToVR (UB Version
u) VersionRange
vr = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
vr (Version -> VersionRange
earlierVersion Version
u)

mbEqUB :: MB -> UB -> Bool
mbEqUB :: MB -> UB -> Bool
mbEqUB MB
NoMB   UB
NoUB   = Bool
True
mbEqUB MB
NoMB   (UB Version
_) = Bool
False
mbEqUB (MB Version
m) (UB Version
u) = Version
m forall a. Eq a => a -> a -> Bool
== Version
u
mbEqUB (MB Version
_) UB
NoUB   = Bool
False

-- return the unions of version ranges.
intervalToVersionRange :: VersionInterval -> Maybe (NonEmpty VersionRange)
intervalToVersionRange :: VersionInterval -> Maybe (NonEmpty VersionRange)
intervalToVersionRange (VI LB
l MB
m UB
u) | MB -> UB -> Bool
mbEqUB MB
m UB
u = forall a. a -> Maybe a
Just (forall a. a -> NonEmpty a
singleton (LB -> UB -> VersionRange
intervalToVersionRange1 LB
l UB
u))
intervalToVersionRange (VI LB
l MB
m UB
u)              = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UB -> VersionRange -> VersionRange
ubToVR UB
u)) (LB -> MB -> Maybe (NonEmpty VersionRange)
intervalToVersionRange2 LB
l MB
m)

intervalToVersionRange1 :: LB -> UB -> VersionRange
intervalToVersionRange1 :: LB -> UB -> VersionRange
intervalToVersionRange1 (LB Version
v) UB
upper' = case UB
upper' of
    UB
NoUB
        -> VersionRange
lowerBound

    UB Version
u
        | Version -> Version
succVersion Version
v forall a. Eq a => a -> a -> Bool
== Version
u
        -> Version -> VersionRange
thisVersion Version
v

    UB Version
u -> VersionRange -> VersionRange
withLowerBound (Version -> VersionRange
makeUpperBound Version
u)
  where
    lowerBound :: VersionRange
    lowerBound :: VersionRange
lowerBound = LB -> VersionRange
lbToVR (Version -> LB
LB Version
v)

    withLowerBound :: VersionRange -> VersionRange
    withLowerBound :: VersionRange -> VersionRange
withLowerBound VersionRange
vr
        | Version -> Bool
isVersion0 Version
v = VersionRange
vr
        | Bool
otherwise    = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
lowerBound VersionRange
vr

    makeUpperBound :: Version -> VersionRange
    makeUpperBound :: Version -> VersionRange
makeUpperBound Version
u = Version -> VersionRange
earlierVersion Version
u

intervalToVersionRange2 :: LB -> MB -> Maybe (NonEmpty VersionRange)
intervalToVersionRange2 :: LB -> MB -> Maybe (NonEmpty VersionRange)
intervalToVersionRange2 (LB Version
l) MB
major = case MB
major of
    MB
NoMB -> forall a. a -> Maybe a
Just (forall a. a -> NonEmpty a
singleton VersionRange
lowerBound)
    MB Version
m
        | Version -> Version
majorUpperBound Version
l forall a. Eq a => a -> a -> Bool
== Version
m
        -> forall a. a -> Maybe a
Just (forall a. a -> NonEmpty a
singleton (Version -> VersionRange
majorBoundVersion Version
l))

{-
    MB m
        | [a,b]  <- versionNumbers m
        , a' : _ <- versionNumbers l
        , a' == a
        , b >= 1
        , majorUpperBound l <= m
        -> Just $ go (majorBoundVersion l :|) (majorUpperBound l)
      where
        go acc v = if v >= m then acc [] else go (acc . (majorBoundVersion v :)) (majorUpperBound v)
-}

    MB Version
m
        | [Int
a,Int
b] <- Version -> [Int]
versionNumbers Version
m
        , let m' :: Version
m' = [Int] -> Version
mkVersion [Int
a,Int
bforall a. Num a => a -> a -> a
-Int
1]
        , Int
b forall a. Ord a => a -> a -> Bool
>= Int
1
        , Version
m' forall a. Ord a => a -> a -> Bool
> Version
l
        -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            (UB -> VersionRange -> VersionRange
ubToVR (Version -> UB
UB Version
m') (LB -> VersionRange
lbToVR (Version -> LB
LB Version
l)))
            forall a. a -> [a] -> NonEmpty a
:| [ Version -> VersionRange
majorBoundVersion ([Int] -> Version
mkVersion [Int
a, Int
bforall a. Num a => a -> a -> a
-Int
1]) ]

    MB
_ -> forall a. Maybe a
Nothing
  where
    lowerBound :: VersionRange
    lowerBound :: VersionRange
lowerBound = LB -> VersionRange
lbToVR (Version -> LB
LB Version
l)

-------------------------------------------------------------------------------
-- Normalisation
-------------------------------------------------------------------------------

-- | Convert 'VersionRange' to 'VersionIntervals' and back.
--
normaliseVersionRange :: VersionRange -> Either ConversionProblem VersionRange
normaliseVersionRange :: VersionRange -> Either ConversionProblem VersionRange
normaliseVersionRange = VersionIntervals -> Either ConversionProblem VersionRange
fromVersionIntervals forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionIntervals
toVersionIntervals