{-# LANGUAGE BangPatterns #-}
module VersionInterval (
VersionIntervals,
unVersionIntervals,
toVersionIntervals,
fromVersionIntervals,
ConversionProblem (..),
normaliseVersionRange,
VersionInterval (..),
LB(..),
MB(..),
UB(..),
Bound(..),
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 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
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)
unVersionIntervals :: VersionIntervals -> [VersionInterval]
unVersionIntervals :: VersionIntervals -> [VersionInterval]
unVersionIntervals (VersionIntervals [VersionInterval]
is) = [VersionInterval]
is
data VersionInterval = VI !LB !MB !UB
deriving (VersionInterval -> VersionInterval -> Bool
(VersionInterval -> VersionInterval -> Bool)
-> (VersionInterval -> VersionInterval -> Bool)
-> Eq VersionInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionInterval -> VersionInterval -> Bool
== :: VersionInterval -> VersionInterval -> Bool
$c/= :: VersionInterval -> VersionInterval -> Bool
/= :: VersionInterval -> VersionInterval -> Bool
Eq, Int -> VersionInterval -> ShowS
[VersionInterval] -> ShowS
VersionInterval -> String
(Int -> VersionInterval -> ShowS)
-> (VersionInterval -> String)
-> ([VersionInterval] -> ShowS)
-> Show VersionInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionInterval -> ShowS
showsPrec :: Int -> VersionInterval -> ShowS
$cshow :: VersionInterval -> String
show :: VersionInterval -> String
$cshowList :: [VersionInterval] -> ShowS
showList :: [VersionInterval] -> ShowS
Show)
data LB = LB !Version
deriving (LB -> LB -> Bool
(LB -> LB -> Bool) -> (LB -> LB -> Bool) -> Eq LB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LB -> LB -> Bool
== :: LB -> LB -> Bool
$c/= :: LB -> LB -> Bool
/= :: LB -> LB -> Bool
Eq, Eq LB
Eq LB =>
(LB -> LB -> Ordering)
-> (LB -> LB -> Bool)
-> (LB -> LB -> Bool)
-> (LB -> LB -> Bool)
-> (LB -> LB -> Bool)
-> (LB -> LB -> LB)
-> (LB -> LB -> LB)
-> Ord 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
$ccompare :: LB -> LB -> Ordering
compare :: LB -> LB -> Ordering
$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
>= :: LB -> LB -> Bool
$cmax :: LB -> LB -> LB
max :: LB -> LB -> LB
$cmin :: LB -> LB -> LB
min :: LB -> LB -> LB
Ord, Int -> LB -> ShowS
[LB] -> ShowS
LB -> String
(Int -> LB -> ShowS)
-> (LB -> String) -> ([LB] -> ShowS) -> Show LB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LB -> ShowS
showsPrec :: Int -> LB -> ShowS
$cshow :: LB -> String
show :: LB -> String
$cshowList :: [LB] -> ShowS
showList :: [LB] -> ShowS
Show)
data UB
= UB !Version
| NoUB
deriving (UB -> UB -> Bool
(UB -> UB -> Bool) -> (UB -> UB -> Bool) -> Eq UB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UB -> UB -> Bool
== :: UB -> UB -> Bool
$c/= :: UB -> UB -> Bool
/= :: UB -> UB -> Bool
Eq, Eq UB
Eq UB =>
(UB -> UB -> Ordering)
-> (UB -> UB -> Bool)
-> (UB -> UB -> Bool)
-> (UB -> UB -> Bool)
-> (UB -> UB -> Bool)
-> (UB -> UB -> UB)
-> (UB -> UB -> UB)
-> Ord 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
$ccompare :: UB -> UB -> Ordering
compare :: UB -> UB -> Ordering
$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
>= :: UB -> UB -> Bool
$cmax :: UB -> UB -> UB
max :: UB -> UB -> UB
$cmin :: UB -> UB -> UB
min :: UB -> UB -> UB
Ord, Int -> UB -> ShowS
[UB] -> ShowS
UB -> String
(Int -> UB -> ShowS)
-> (UB -> String) -> ([UB] -> ShowS) -> Show UB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UB -> ShowS
showsPrec :: Int -> UB -> ShowS
$cshow :: UB -> String
show :: UB -> String
$cshowList :: [UB] -> ShowS
showList :: [UB] -> ShowS
Show)
data Bound
= Incl
| Excl
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, Eq Bound
Eq Bound =>
(Bound -> Bound -> Ordering)
-> (Bound -> Bound -> Bool)
-> (Bound -> Bound -> Bool)
-> (Bound -> Bound -> Bool)
-> (Bound -> Bound -> Bool)
-> (Bound -> Bound -> Bound)
-> (Bound -> Bound -> Bound)
-> Ord 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
$ccompare :: Bound -> Bound -> Ordering
compare :: Bound -> Bound -> Ordering
$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
>= :: Bound -> Bound -> Bool
$cmax :: Bound -> Bound -> Bound
max :: Bound -> Bound -> Bound
$cmin :: Bound -> Bound -> Bound
min :: Bound -> Bound -> Bound
Ord, 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)
data MB
= MB !Version
| NoMB
deriving (MB -> MB -> Bool
(MB -> MB -> Bool) -> (MB -> MB -> Bool) -> Eq MB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MB -> MB -> Bool
== :: MB -> MB -> Bool
$c/= :: MB -> MB -> Bool
/= :: MB -> MB -> Bool
Eq, Eq MB
Eq MB =>
(MB -> MB -> Ordering)
-> (MB -> MB -> Bool)
-> (MB -> MB -> Bool)
-> (MB -> MB -> Bool)
-> (MB -> MB -> Bool)
-> (MB -> MB -> MB)
-> (MB -> MB -> MB)
-> Ord 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
$ccompare :: MB -> MB -> Ordering
compare :: MB -> MB -> Ordering
$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
>= :: MB -> MB -> Bool
$cmax :: MB -> MB -> MB
max :: MB -> MB -> MB
$cmin :: MB -> MB -> MB
min :: MB -> MB -> MB
Ord, Int -> MB -> ShowS
[MB] -> ShowS
MB -> String
(Int -> MB -> ShowS)
-> (MB -> String) -> ([MB] -> ShowS) -> Show MB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MB -> ShowS
showsPrec :: Int -> MB -> ShowS
$cshow :: MB -> String
show :: MB -> String
$cshowList :: [MB] -> ShowS
showList :: [MB] -> ShowS
Show)
zeroLB :: LB
zeroLB :: LB
zeroLB = Version -> LB
LB Version
version0
isVersion0 :: Version -> Bool
isVersion0 :: Version -> Bool
isVersion0 = Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
(==) Version
version0
succVersion :: Version -> Version
succVersion :: Version -> Version
succVersion Version
v = [Int] -> Version
mkVersion (Version -> [Int]
versionNumbers Version
v [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
0])
stage1 :: ([VersionInterval] -> [VersionInterval]) -> VersionRange -> [VersionInterval]
stage1 :: ([VersionInterval] -> [VersionInterval])
-> VersionRange -> [VersionInterval]
stage1 [VersionInterval] -> [VersionInterval]
opt = (VersionRangeF [VersionInterval] -> [VersionInterval])
-> VersionRange -> [VersionInterval]
forall a. (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange VersionRangeF [VersionInterval] -> [VersionInterval]
alg where
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))]
alg (MajorBoundVersionF Version
v) = [LB -> MB -> UB -> VersionInterval
VI (Version -> LB
LB Version
v) (Version -> MB
MB (Version -> Version
majorUpperBound Version
v)) UB
NoUB]
alg (UnionVersionRangesF [VersionInterval]
v1 [VersionInterval]
v2) = [VersionInterval]
v1 [VersionInterval] -> [VersionInterval] -> [VersionInterval]
forall a. [a] -> [a] -> [a]
++ [VersionInterval]
v2
alg (IntersectVersionRangesF [VersionInterval]
v1 [VersionInterval]
v2) = [Maybe VersionInterval] -> [VersionInterval]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe VersionInterval] -> [VersionInterval])
-> [Maybe VersionInterval] -> [VersionInterval]
forall a b. (a -> b) -> a -> b
$ (VersionInterval -> VersionInterval -> Maybe VersionInterval)
-> [VersionInterval]
-> [VersionInterval]
-> [Maybe VersionInterval]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
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 :: [VersionInterval] -> [VersionInterval]
stage2 :: [VersionInterval] -> [VersionInterval]
stage2 = (VersionInterval -> LB) -> [VersionInterval] -> [VersionInterval]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(VI LB
l MB
_ UB
_) -> LB
l)
stage2and3 :: [VersionInterval] -> [VersionInterval]
stage2and3 :: [VersionInterval] -> [VersionInterval]
stage2and3 = [VersionInterval] -> [VersionInterval]
stage3 ([VersionInterval] -> [VersionInterval])
-> ([VersionInterval] -> [VersionInterval])
-> [VersionInterval]
-> [VersionInterval]
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 LB -> LB -> Bool
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 VersionInterval -> [VersionInterval] -> [VersionInterval]
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 VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:)
viCons VersionInterval
_ = [VersionInterval] -> [VersionInterval]
forall a. a -> a
id
trimLB :: UB -> LB -> UB
trimLB :: UB -> LB -> UB
trimLB UB
_ (LB Version
l) = Version -> UB
UB Version
l
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 = VersionInterval -> Maybe VersionInterval
forall a. a -> Maybe a
Just VersionInterval
xy
| Bool
otherwise = Maybe VersionInterval
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
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 Version -> Version -> Ordering
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 (Version -> Version -> Version
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 (Version -> Version -> Version
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 (Version -> Version -> Version
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 (Version -> Version -> Version
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 (Version -> Version -> Version
forall a. Ord a => a -> a -> a
min Version
v Version
u)
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 (Version -> Version -> Version
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 (Version -> Version -> Version
forall a. Ord a => a -> a -> a
max Version
v Version
u)
data Overlap
= NoOverlap
| OverlapM
| OverlapU
deriving (Overlap -> Overlap -> Bool
(Overlap -> Overlap -> Bool)
-> (Overlap -> Overlap -> Bool) -> Eq Overlap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Overlap -> Overlap -> Bool
== :: Overlap -> Overlap -> Bool
$c/= :: Overlap -> Overlap -> Bool
/= :: Overlap -> Overlap -> Bool
Eq, Int -> Overlap -> ShowS
[Overlap] -> ShowS
Overlap -> String
(Int -> Overlap -> ShowS)
-> (Overlap -> String) -> ([Overlap] -> ShowS) -> Show Overlap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Overlap -> ShowS
showsPrec :: Int -> Overlap -> ShowS
$cshow :: Overlap -> String
show :: Overlap -> String
$cshowList :: [Overlap] -> ShowS
showList :: [Overlap] -> ShowS
Show)
overlap :: MB -> UB -> LB -> Overlap
overlap :: MB -> UB -> LB -> Overlap
overlap MB
_ (UB Version
u ) (LB Version
l) | Version
u Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
l = Overlap
NoOverlap
overlap (MB Version
m ) UB
_ (LB Version
l) | Version
m Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
l = Overlap
OverlapU
overlap MB
_ UB
_ LB
_ = Overlap
OverlapM
validVersionIntervals :: VersionIntervals -> Bool
validVersionIntervals :: VersionIntervals -> Bool
validVersionIntervals (VersionIntervals [VersionInterval]
intervals) =
(VersionInterval -> Bool) -> [VersionInterval] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all VersionInterval -> Bool
validVersionInterval [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, VersionInterval)]
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 LB -> LB -> Bool
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 Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
lv
pairs :: [a] -> [(a,a)]
pairs :: forall a. [a] -> [(a, a)]
pairs [a]
xs = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs ([a] -> [a]
forall a. HasCallStack => [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 Version -> Version -> Bool
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 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= Version
m
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 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
u
toVersionIntervals :: VersionRange -> VersionIntervals
toVersionIntervals :: VersionRange -> VersionIntervals
toVersionIntervals = [VersionInterval] -> VersionIntervals
VersionIntervals ([VersionInterval] -> VersionIntervals)
-> (VersionRange -> [VersionInterval])
-> VersionRange
-> VersionIntervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VersionInterval] -> [VersionInterval]
stage2and3 ([VersionInterval] -> [VersionInterval])
-> (VersionRange -> [VersionInterval])
-> VersionRange
-> [VersionInterval]
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
(ConversionProblem -> ConversionProblem -> Bool)
-> (ConversionProblem -> ConversionProblem -> Bool)
-> Eq ConversionProblem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversionProblem -> ConversionProblem -> Bool
== :: ConversionProblem -> ConversionProblem -> Bool
$c/= :: ConversionProblem -> ConversionProblem -> Bool
/= :: ConversionProblem -> ConversionProblem -> Bool
Eq, Int -> ConversionProblem -> ShowS
[ConversionProblem] -> ShowS
ConversionProblem -> String
(Int -> ConversionProblem -> ShowS)
-> (ConversionProblem -> String)
-> ([ConversionProblem] -> ShowS)
-> Show ConversionProblem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversionProblem -> ShowS
showsPrec :: Int -> ConversionProblem -> ShowS
$cshow :: ConversionProblem -> String
show :: ConversionProblem -> String
$cshowList :: [ConversionProblem] -> ShowS
showList :: [ConversionProblem] -> ShowS
Show)
fromVersionIntervals :: VersionIntervals -> Either ConversionProblem VersionRange
fromVersionIntervals :: VersionIntervals -> Either ConversionProblem VersionRange
fromVersionIntervals (VersionIntervals []) = VersionRange -> Either ConversionProblem VersionRange
forall a b. b -> Either a b
Right VersionRange
noVersion
fromVersionIntervals (VersionIntervals (VersionInterval
x:[VersionInterval]
xs)) =
case NonEmpty (NonEmpty VersionRange) -> NonEmpty VersionRange
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (NonEmpty (NonEmpty VersionRange) -> NonEmpty VersionRange)
-> Maybe (NonEmpty (NonEmpty VersionRange))
-> Maybe (NonEmpty VersionRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VersionInterval -> Maybe (NonEmpty VersionRange))
-> NonEmpty VersionInterval
-> Maybe (NonEmpty (NonEmpty VersionRange))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse VersionInterval -> Maybe (NonEmpty VersionRange)
intervalToVersionRange (VersionInterval -> [VersionInterval] -> NonEmpty VersionInterval
preprocess VersionInterval
x [VersionInterval]
xs) of
Just NonEmpty VersionRange
vrs -> VersionRange -> Either ConversionProblem VersionRange
forall a b. b -> Either a b
Right ((VersionRange -> VersionRange -> VersionRange)
-> NonEmpty VersionRange -> VersionRange
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 VersionRange -> VersionRange -> VersionRange
unionVersionRanges NonEmpty VersionRange
vrs)
Maybe (NonEmpty VersionRange)
Nothing -> ConversionProblem -> Either ConversionProblem VersionRange
forall a b. a -> Either a b
Left (ConversionProblem -> Either ConversionProblem VersionRange)
-> ConversionProblem -> Either ConversionProblem VersionRange
forall a b. (a -> b) -> a -> b
$
if (VersionInterval -> Bool) -> [VersionInterval] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all VersionInterval -> Bool
seemsEmpty (VersionInterval
xVersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
xs)
then ConversionProblem
IntervalsEmpty
else ConversionProblem
OtherConversionProblem
where
preprocess :: VersionInterval -> [VersionInterval] -> NonEmpty VersionInterval
preprocess :: VersionInterval -> [VersionInterval] -> NonEmpty VersionInterval
preprocess VersionInterval
i [] = VersionInterval
i VersionInterval -> [VersionInterval] -> NonEmpty VersionInterval
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' -> VersionInterval
-> NonEmpty VersionInterval -> NonEmpty VersionInterval
forall a. a -> NonEmpty a -> NonEmpty a
cons (LB -> MB -> UB -> VersionInterval
VI LB
l MB
m UB
NoUB) NonEmpty VersionInterval
js'
UB
_ -> VersionInterval
-> NonEmpty VersionInterval -> NonEmpty VersionInterval
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 Version -> Version -> Bool
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 Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
u
mbEqUB (MB Version
_) UB
NoUB = Bool
False
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 = NonEmpty VersionRange -> Maybe (NonEmpty VersionRange)
forall a. a -> Maybe a
Just (VersionRange -> NonEmpty VersionRange
forall a. a -> NonEmpty a
singleton (LB -> UB -> VersionRange
intervalToVersionRange1 LB
l UB
u))
intervalToVersionRange (VI LB
l MB
m UB
u) = (NonEmpty VersionRange -> NonEmpty VersionRange)
-> Maybe (NonEmpty VersionRange) -> Maybe (NonEmpty VersionRange)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((VersionRange -> VersionRange)
-> NonEmpty VersionRange -> NonEmpty VersionRange
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
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 Version -> Version -> Bool
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
NoMB = NonEmpty VersionRange -> Maybe (NonEmpty VersionRange)
forall a. a -> Maybe a
Just (VersionRange -> NonEmpty VersionRange
forall a. a -> NonEmpty a
singleton VersionRange
lowerBound)
where
lowerBound :: VersionRange
lowerBound :: VersionRange
lowerBound = LB -> VersionRange
lbToVR (Version -> LB
LB Version
l)
intervalToVersionRange2 (LB Version
l) (MB Version
m)
| Version -> Int
supermajor Version
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Int
supermajor Version
m
= ([Version] -> NonEmpty Version)
-> Version -> Maybe (NonEmpty VersionRange)
go (Version
l Version -> [Version] -> NonEmpty Version
forall a. a -> [a] -> NonEmpty a
:|) (Version -> Version
majorUpperBound Version
l)
| [Int
a,Int
b] <- Version -> [Int]
versionNumbers Version
m
, let m' :: Version
m' = [Int] -> Version
mkVersion [Int
a,Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
, Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
, Version
m' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
l
= NonEmpty VersionRange -> Maybe (NonEmpty VersionRange)
forall a. a -> Maybe a
Just (NonEmpty VersionRange -> Maybe (NonEmpty VersionRange))
-> NonEmpty VersionRange -> Maybe (NonEmpty VersionRange)
forall a b. (a -> b) -> a -> b
$
(UB -> VersionRange -> VersionRange
ubToVR (Version -> UB
UB Version
m') (LB -> VersionRange
lbToVR (Version -> LB
LB Version
l)))
VersionRange -> [VersionRange] -> NonEmpty VersionRange
forall a. a -> [a] -> NonEmpty a
:| [ Version -> VersionRange
majorBoundVersion ([Int] -> Version
mkVersion [Int
a, Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) ]
| Bool
otherwise
= Maybe (NonEmpty VersionRange)
forall a. Maybe a
Nothing
where
go :: ([Version] -> NonEmpty Version) -> Version -> Maybe (NonEmpty VersionRange)
go :: ([Version] -> NonEmpty Version)
-> Version -> Maybe (NonEmpty VersionRange)
go ![Version] -> NonEmpty Version
acc Version
v = case Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Version
v Version
m of
Ordering
LT -> ([Version] -> NonEmpty Version)
-> Version -> Maybe (NonEmpty VersionRange)
go (([Version] -> NonEmpty Version)
-> Version -> [Version] -> NonEmpty Version
forall {a} {c}. ([a] -> c) -> a -> [a] -> c
snoc [Version] -> NonEmpty Version
acc Version
v) (Version -> Version
majorUpperBound Version
v)
Ordering
EQ -> NonEmpty VersionRange -> Maybe (NonEmpty VersionRange)
forall a. a -> Maybe a
Just ((Version -> VersionRange)
-> NonEmpty Version -> NonEmpty VersionRange
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> VersionRange
majorBoundVersion ([Version] -> NonEmpty Version
acc []))
Ordering
GT -> Maybe (NonEmpty VersionRange)
forall a. Maybe a
Nothing
snoc :: ([a] -> c) -> a -> [a] -> c
snoc [a] -> c
xs a
x = [a] -> c
xs ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
supermajor :: Version -> Int
supermajor :: Version -> Int
supermajor Version
v = case Version -> [Int]
versionNumbers Version
v of
[] -> -Int
1
Int
s:[Int]
_ -> Int
s
normaliseVersionRange :: VersionRange -> Either ConversionProblem VersionRange
normaliseVersionRange :: VersionRange -> Either ConversionProblem VersionRange
normaliseVersionRange = VersionIntervals -> Either ConversionProblem VersionRange
fromVersionIntervals (VersionIntervals -> Either ConversionProblem VersionRange)
-> (VersionRange -> VersionIntervals)
-> VersionRange
-> Either ConversionProblem VersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionIntervals
toVersionIntervals