{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Types.PkgconfigVersionRange (
PkgconfigVersionRange (..),
anyPkgconfigVersion,
isAnyPkgconfigVersion,
withinPkgconfigVersionRange,
versionToPkgconfigVersion,
versionRangeToPkgconfigVersionRange,
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.PkgconfigVersion
import Distribution.Types.Version
import Distribution.Types.VersionInterval
import Distribution.Types.VersionRange
import qualified Data.ByteString.Char8 as BS8
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as PP
data PkgconfigVersionRange
= PcAnyVersion
| PcThisVersion PkgconfigVersion
| PcLaterVersion PkgconfigVersion
| PcEarlierVersion PkgconfigVersion
| PcOrLaterVersion PkgconfigVersion
| PcOrEarlierVersion PkgconfigVersion
| PcUnionVersionRanges PkgconfigVersionRange PkgconfigVersionRange
| PcIntersectVersionRanges PkgconfigVersionRange PkgconfigVersionRange
deriving (forall x. Rep PkgconfigVersionRange x -> PkgconfigVersionRange
forall x. PkgconfigVersionRange -> Rep PkgconfigVersionRange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PkgconfigVersionRange x -> PkgconfigVersionRange
$cfrom :: forall x. PkgconfigVersionRange -> Rep PkgconfigVersionRange x
Generic, ReadPrec [PkgconfigVersionRange]
ReadPrec PkgconfigVersionRange
Int -> ReadS PkgconfigVersionRange
ReadS [PkgconfigVersionRange]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PkgconfigVersionRange]
$creadListPrec :: ReadPrec [PkgconfigVersionRange]
readPrec :: ReadPrec PkgconfigVersionRange
$creadPrec :: ReadPrec PkgconfigVersionRange
readList :: ReadS [PkgconfigVersionRange]
$creadList :: ReadS [PkgconfigVersionRange]
readsPrec :: Int -> ReadS PkgconfigVersionRange
$creadsPrec :: Int -> ReadS PkgconfigVersionRange
Read, Int -> PkgconfigVersionRange -> ShowS
[PkgconfigVersionRange] -> ShowS
PkgconfigVersionRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgconfigVersionRange] -> ShowS
$cshowList :: [PkgconfigVersionRange] -> ShowS
show :: PkgconfigVersionRange -> String
$cshow :: PkgconfigVersionRange -> String
showsPrec :: Int -> PkgconfigVersionRange -> ShowS
$cshowsPrec :: Int -> PkgconfigVersionRange -> ShowS
Show, PkgconfigVersionRange -> PkgconfigVersionRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgconfigVersionRange -> PkgconfigVersionRange -> Bool
$c/= :: PkgconfigVersionRange -> PkgconfigVersionRange -> Bool
== :: PkgconfigVersionRange -> PkgconfigVersionRange -> Bool
$c== :: PkgconfigVersionRange -> PkgconfigVersionRange -> Bool
Eq, Typeable, Typeable PkgconfigVersionRange
PkgconfigVersionRange -> DataType
PkgconfigVersionRange -> Constr
(forall b. Data b => b -> b)
-> PkgconfigVersionRange -> PkgconfigVersionRange
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PkgconfigVersionRange -> u
forall u.
(forall d. Data d => d -> u) -> PkgconfigVersionRange -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersionRange -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersionRange -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersionRange -> m PkgconfigVersionRange
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersionRange -> m PkgconfigVersionRange
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PkgconfigVersionRange
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PkgconfigVersionRange
-> c PkgconfigVersionRange
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersionRange)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PkgconfigVersionRange)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersionRange -> m PkgconfigVersionRange
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersionRange -> m PkgconfigVersionRange
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersionRange -> m PkgconfigVersionRange
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersionRange -> m PkgconfigVersionRange
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersionRange -> m PkgconfigVersionRange
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersionRange -> m PkgconfigVersionRange
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PkgconfigVersionRange -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PkgconfigVersionRange -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> PkgconfigVersionRange -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> PkgconfigVersionRange -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersionRange -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersionRange -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersionRange -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersionRange -> r
gmapT :: (forall b. Data b => b -> b)
-> PkgconfigVersionRange -> PkgconfigVersionRange
$cgmapT :: (forall b. Data b => b -> b)
-> PkgconfigVersionRange -> PkgconfigVersionRange
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PkgconfigVersionRange)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PkgconfigVersionRange)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersionRange)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersionRange)
dataTypeOf :: PkgconfigVersionRange -> DataType
$cdataTypeOf :: PkgconfigVersionRange -> DataType
toConstr :: PkgconfigVersionRange -> Constr
$ctoConstr :: PkgconfigVersionRange -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PkgconfigVersionRange
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PkgconfigVersionRange
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PkgconfigVersionRange
-> c PkgconfigVersionRange
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PkgconfigVersionRange
-> c PkgconfigVersionRange
Data)
instance Binary PkgconfigVersionRange
instance Structured PkgconfigVersionRange
instance NFData PkgconfigVersionRange where rnf :: PkgconfigVersionRange -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Pretty PkgconfigVersionRange where
pretty :: PkgconfigVersionRange -> Doc
pretty = Int -> PkgconfigVersionRange -> Doc
pp Int
0 where
pp :: Int -> PkgconfigVersionRange -> PP.Doc
pp :: Int -> PkgconfigVersionRange -> Doc
pp Int
_ PkgconfigVersionRange
PcAnyVersion = String -> Doc
PP.text String
"-any"
pp Int
_ (PcThisVersion PkgconfigVersion
v) = String -> Doc
PP.text String
"==" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty PkgconfigVersion
v
pp Int
_ (PcLaterVersion PkgconfigVersion
v) = String -> Doc
PP.text String
">" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty PkgconfigVersion
v
pp Int
_ (PcEarlierVersion PkgconfigVersion
v) = String -> Doc
PP.text String
"<" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty PkgconfigVersion
v
pp Int
_ (PcOrLaterVersion PkgconfigVersion
v) = String -> Doc
PP.text String
">=" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty PkgconfigVersion
v
pp Int
_ (PcOrEarlierVersion PkgconfigVersion
v) = String -> Doc
PP.text String
"<=" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty PkgconfigVersion
v
pp Int
d (PcUnionVersionRanges PkgconfigVersionRange
v PkgconfigVersionRange
u) = Bool -> Doc -> Doc
parens (Int
d forall a. Ord a => a -> a -> Bool
>= Int
1) forall a b. (a -> b) -> a -> b
$
Int -> PkgconfigVersionRange -> Doc
pp Int
1 PkgconfigVersionRange
v Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
"||" Doc -> Doc -> Doc
PP.<+> Int -> PkgconfigVersionRange -> Doc
pp Int
0 PkgconfigVersionRange
u
pp Int
d (PcIntersectVersionRanges PkgconfigVersionRange
v PkgconfigVersionRange
u) = Bool -> Doc -> Doc
parens (Int
d forall a. Ord a => a -> a -> Bool
>= Int
2) forall a b. (a -> b) -> a -> b
$
Int -> PkgconfigVersionRange -> Doc
pp Int
2 PkgconfigVersionRange
v Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
"&&" Doc -> Doc -> Doc
PP.<+> Int -> PkgconfigVersionRange -> Doc
pp Int
1 PkgconfigVersionRange
u
parens :: Bool -> Doc -> Doc
parens Bool
True = Doc -> Doc
PP.parens
parens Bool
False = forall a. a -> a
id
instance Parsec PkgconfigVersionRange where
parsec :: forall (m :: * -> *). CabalParsing m => m PkgconfigVersionRange
parsec = do
CabalSpecVersion
csv <- forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
csv forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0
then forall (m :: * -> *). CabalParsing m => m PkgconfigVersionRange
pkgconfigParser
else VersionRange -> PkgconfigVersionRange
versionRangeToPkgconfigVersionRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
CabalParsing m =>
m Int -> CabalSpecVersion -> m VersionRange
versionRangeParser forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
P.integral CabalSpecVersion
csv
pkgconfigParser :: CabalParsing m => m PkgconfigVersionRange
pkgconfigParser :: forall (m :: * -> *). CabalParsing m => m PkgconfigVersionRange
pkgconfigParser = forall (m :: * -> *). CharParsing m => m ()
P.spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m PkgconfigVersionRange
expr where
expr :: m PkgconfigVersionRange
expr = do
NonEmpty PkgconfigVersionRange
ts <- m PkgconfigVersionRange
term forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`P.sepByNonEmpty` (forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"||" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => m ()
P.spaces)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> NonEmpty a -> a
foldr1 PkgconfigVersionRange
-> PkgconfigVersionRange -> PkgconfigVersionRange
PcUnionVersionRanges NonEmpty PkgconfigVersionRange
ts
term :: m PkgconfigVersionRange
term = do
NonEmpty PkgconfigVersionRange
fs <- m PkgconfigVersionRange
factor forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`P.sepByNonEmpty` (forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"&&" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => m ()
P.spaces)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> NonEmpty a -> a
foldr1 PkgconfigVersionRange
-> PkgconfigVersionRange -> PkgconfigVersionRange
PcIntersectVersionRanges NonEmpty PkgconfigVersionRange
fs
factor :: m PkgconfigVersionRange
factor = forall {a}. m a -> m a
parens m PkgconfigVersionRange
expr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m PkgconfigVersionRange
prim
prim :: m PkgconfigVersionRange
prim = do
String
op <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isOpChar forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"operator"
case String
op of
String
"-" -> PkgconfigVersionRange
anyPkgconfigVersion forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"any" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). CharParsing m => m ()
P.spaces)
String
"==" -> forall {m :: * -> *} {t} {b}.
(Parsec t, CabalParsing m) =>
(t -> b) -> m b
afterOp PkgconfigVersion -> PkgconfigVersionRange
PcThisVersion
String
">" -> forall {m :: * -> *} {t} {b}.
(Parsec t, CabalParsing m) =>
(t -> b) -> m b
afterOp PkgconfigVersion -> PkgconfigVersionRange
PcLaterVersion
String
"<" -> forall {m :: * -> *} {t} {b}.
(Parsec t, CabalParsing m) =>
(t -> b) -> m b
afterOp PkgconfigVersion -> PkgconfigVersionRange
PcEarlierVersion
String
">=" -> forall {m :: * -> *} {t} {b}.
(Parsec t, CabalParsing m) =>
(t -> b) -> m b
afterOp PkgconfigVersion -> PkgconfigVersionRange
PcOrLaterVersion
String
"<=" -> forall {m :: * -> *} {t} {b}.
(Parsec t, CabalParsing m) =>
(t -> b) -> m b
afterOp PkgconfigVersion -> PkgconfigVersionRange
PcOrEarlierVersion
String
_ -> forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected forall a b. (a -> b) -> a -> b
$ String
"Unknown version operator " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
op
isOpChar :: Char -> Bool
isOpChar Char
'<' = Bool
True
isOpChar Char
'=' = Bool
True
isOpChar Char
'>' = Bool
True
isOpChar Char
'^' = Bool
True
isOpChar Char
'-' = Bool
True
isOpChar Char
_ = Bool
False
afterOp :: (t -> b) -> m b
afterOp t -> b
f = do
forall (m :: * -> *). CharParsing m => m ()
P.spaces
t
v <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
forall (m :: * -> *). CharParsing m => m ()
P.spaces
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> b
f t
v)
parens :: m a -> m a
parens = forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between
((forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'(' forall (m :: * -> *) a. Parsing m => m a -> String -> m a
P.<?> String
"opening paren") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => m ()
P.spaces)
(forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
')' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => m ()
P.spaces)
anyPkgconfigVersion :: PkgconfigVersionRange
anyPkgconfigVersion :: PkgconfigVersionRange
anyPkgconfigVersion = PkgconfigVersionRange
PcAnyVersion
isAnyPkgconfigVersion :: PkgconfigVersionRange -> Bool
isAnyPkgconfigVersion :: PkgconfigVersionRange -> Bool
isAnyPkgconfigVersion = (forall a. Eq a => a -> a -> Bool
== PkgconfigVersionRange
PcAnyVersion)
withinPkgconfigVersionRange :: PkgconfigVersion -> PkgconfigVersionRange -> Bool
withinPkgconfigVersionRange :: PkgconfigVersion -> PkgconfigVersionRange -> Bool
withinPkgconfigVersionRange PkgconfigVersion
v = PkgconfigVersionRange -> Bool
go where
go :: PkgconfigVersionRange -> Bool
go PkgconfigVersionRange
PcAnyVersion = Bool
True
go (PcThisVersion PkgconfigVersion
u) = PkgconfigVersion
v forall a. Eq a => a -> a -> Bool
== PkgconfigVersion
u
go (PcLaterVersion PkgconfigVersion
u) = PkgconfigVersion
v forall a. Ord a => a -> a -> Bool
> PkgconfigVersion
u
go (PcEarlierVersion PkgconfigVersion
u) = PkgconfigVersion
v forall a. Ord a => a -> a -> Bool
< PkgconfigVersion
u
go (PcOrLaterVersion PkgconfigVersion
u) = PkgconfigVersion
v forall a. Ord a => a -> a -> Bool
>= PkgconfigVersion
u
go (PcOrEarlierVersion PkgconfigVersion
u) = PkgconfigVersion
v forall a. Ord a => a -> a -> Bool
<= PkgconfigVersion
u
go (PcUnionVersionRanges PkgconfigVersionRange
a PkgconfigVersionRange
b) = PkgconfigVersionRange -> Bool
go PkgconfigVersionRange
a Bool -> Bool -> Bool
|| PkgconfigVersionRange -> Bool
go PkgconfigVersionRange
b
go (PcIntersectVersionRanges PkgconfigVersionRange
a PkgconfigVersionRange
b) = PkgconfigVersionRange -> Bool
go PkgconfigVersionRange
a Bool -> Bool -> Bool
&& PkgconfigVersionRange -> Bool
go PkgconfigVersionRange
b
versionToPkgconfigVersion :: Version -> PkgconfigVersion
versionToPkgconfigVersion :: Version -> PkgconfigVersion
versionToPkgconfigVersion = ByteString -> PkgconfigVersion
PkgconfigVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow
versionRangeToPkgconfigVersionRange :: VersionRange -> PkgconfigVersionRange
versionRangeToPkgconfigVersionRange :: VersionRange -> PkgconfigVersionRange
versionRangeToPkgconfigVersionRange VersionRange
vr
| VersionRange -> Bool
isAnyVersion VersionRange
vr
= PkgconfigVersionRange
PcAnyVersion
| Bool
otherwise
= case VersionRange -> [VersionInterval]
asVersionIntervals VersionRange
vr of
[] -> PkgconfigVersion -> PkgconfigVersionRange
PcEarlierVersion (ByteString -> PkgconfigVersion
PkgconfigVersion (String -> ByteString
BS8.pack String
"0"))
(VersionInterval
i:[VersionInterval]
is) -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\PkgconfigVersionRange
r VersionInterval
j -> PkgconfigVersionRange
-> PkgconfigVersionRange -> PkgconfigVersionRange
PcUnionVersionRanges PkgconfigVersionRange
r (VersionInterval -> PkgconfigVersionRange
conv VersionInterval
j)) (VersionInterval -> PkgconfigVersionRange
conv VersionInterval
i) [VersionInterval]
is
where
conv :: VersionInterval -> PkgconfigVersionRange
conv (VersionInterval (LowerBound Version
v Bound
b) UpperBound
NoUpperBound) = Version -> Bound -> PkgconfigVersionRange
convL Version
v Bound
b
conv (VersionInterval (LowerBound Version
v Bound
b) (UpperBound Version
u Bound
c)) = PkgconfigVersionRange
-> PkgconfigVersionRange -> PkgconfigVersionRange
PcIntersectVersionRanges (Version -> Bound -> PkgconfigVersionRange
convL Version
v Bound
b) (Version -> Bound -> PkgconfigVersionRange
convU Version
u Bound
c)
convL :: Version -> Bound -> PkgconfigVersionRange
convL Version
v Bound
ExclusiveBound = PkgconfigVersion -> PkgconfigVersionRange
PcLaterVersion (Version -> PkgconfigVersion
versionToPkgconfigVersion Version
v)
convL Version
v Bound
InclusiveBound = PkgconfigVersion -> PkgconfigVersionRange
PcOrLaterVersion (Version -> PkgconfigVersion
versionToPkgconfigVersion Version
v)
convU :: Version -> Bound -> PkgconfigVersionRange
convU Version
v Bound
ExclusiveBound = PkgconfigVersion -> PkgconfigVersionRange
PcEarlierVersion (Version -> PkgconfigVersion
versionToPkgconfigVersion Version
v)
convU Version
v Bound
InclusiveBound = PkgconfigVersion -> PkgconfigVersionRange
PcOrEarlierVersion (Version -> PkgconfigVersion
versionToPkgconfigVersion Version
v)