Cabal-2.2.0.0: Distribution/Types/VersionRange.hs
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
module Distribution.Types.VersionRange (
-- * Version ranges
VersionRange(..),
-- ** Constructing
anyVersion, noVersion,
thisVersion, notThisVersion,
laterVersion, earlierVersion,
orLaterVersion, orEarlierVersion,
unionVersionRanges, intersectVersionRanges,
withinVersion,
majorBoundVersion,
-- ** Inspection
--
-- See "Distribution.Version" for more utilities.
withinRange,
foldVersionRange,
normaliseVersionRange,
stripParensVersionRange,
hasUpperBound,
hasLowerBound,
-- ** Cata & ana
VersionRangeF (..),
cataVersionRange,
anaVersionRange,
hyloVersionRange,
projectVersionRange,
embedVersionRange,
-- ** Utilities
wildcardUpperBound,
majorUpperBound,
isWildcardRange,
) where
import Distribution.Compat.Prelude
import Distribution.Types.Version
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Parsec.Class
import Distribution.Pretty
import Distribution.Text
import Text.PrettyPrint ((<+>))
import qualified Distribution.Compat.CharParsing as P
import qualified Distribution.Compat.DList as DList
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
data VersionRange
= AnyVersion
| ThisVersion Version -- = version
| LaterVersion Version -- > version (NB. not >=)
| OrLaterVersion Version -- >= version
| EarlierVersion Version -- < version
| OrEarlierVersion Version -- <= version
| WildcardVersion Version -- == ver.* (same as >= ver && < ver+1)
| MajorBoundVersion Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1)
| UnionVersionRanges VersionRange VersionRange
| IntersectVersionRanges VersionRange VersionRange
| VersionRangeParens VersionRange -- just '(exp)' parentheses syntax
deriving (Data, Eq, Generic, Read, Show, Typeable)
instance Binary VersionRange
instance NFData VersionRange where rnf = genericRnf
{-# DeprecateD AnyVersion
"Use 'anyVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
{-# DEPRECATED ThisVersion
"Use 'thisVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
{-# DEPRECATED LaterVersion
"Use 'laterVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
{-# DEPRECATED EarlierVersion
"Use 'earlierVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
{-# DEPRECATED WildcardVersion
"Use 'anyVersion', 'foldVersionRange' or 'asVersionIntervals'" #-}
{-# DEPRECATED UnionVersionRanges
"Use 'unionVersionRanges', 'foldVersionRange' or 'asVersionIntervals'" #-}
{-# DEPRECATED IntersectVersionRanges
"Use 'intersectVersionRanges', 'foldVersionRange' or 'asVersionIntervals'"#-}
-- | The version range @-any@. That is, a version range containing all
-- versions.
--
-- > withinRange v anyVersion = True
--
anyVersion :: VersionRange
anyVersion = AnyVersion
-- | The empty version range, that is a version range containing no versions.
--
-- This can be constructed using any unsatisfiable version range expression,
-- for example @> 1 && < 1@.
--
-- > withinRange v noVersion = False
--
noVersion :: VersionRange
noVersion = IntersectVersionRanges (LaterVersion v) (EarlierVersion v)
where v = mkVersion [1]
-- | The version range @== v@
--
-- > withinRange v' (thisVersion v) = v' == v
--
thisVersion :: Version -> VersionRange
thisVersion = ThisVersion
-- | The version range @< v || > v@
--
-- > withinRange v' (notThisVersion v) = v' /= v
--
notThisVersion :: Version -> VersionRange
notThisVersion v = UnionVersionRanges (EarlierVersion v) (LaterVersion v)
-- | The version range @> v@
--
-- > withinRange v' (laterVersion v) = v' > v
--
laterVersion :: Version -> VersionRange
laterVersion = LaterVersion
-- | The version range @>= v@
--
-- > withinRange v' (orLaterVersion v) = v' >= v
--
orLaterVersion :: Version -> VersionRange
orLaterVersion = OrLaterVersion
-- | The version range @< v@
--
-- > withinRange v' (earlierVersion v) = v' < v
--
earlierVersion :: Version -> VersionRange
earlierVersion = EarlierVersion
-- | The version range @<= v@
--
-- > withinRange v' (orEarlierVersion v) = v' <= v
--
orEarlierVersion :: Version -> VersionRange
orEarlierVersion = OrEarlierVersion
-- | The version range @vr1 || vr2@
--
-- > withinRange v' (unionVersionRanges vr1 vr2)
-- > = withinRange v' vr1 || withinRange v' vr2
--
unionVersionRanges :: VersionRange -> VersionRange -> VersionRange
unionVersionRanges = UnionVersionRanges
-- | The version range @vr1 && vr2@
--
-- > withinRange v' (intersectVersionRanges vr1 vr2)
-- > = withinRange v' vr1 && withinRange v' vr2
--
intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange
intersectVersionRanges = IntersectVersionRanges
-- | The version range @== v.*@.
--
-- For example, for version @1.2@, the version range @== 1.2.*@ is the same as
-- @>= 1.2 && < 1.3@
--
-- > withinRange v' (laterVersion v) = v' >= v && v' < upper v
-- > where
-- > upper (Version lower t) = Version (init lower ++ [last lower + 1]) t
--
withinVersion :: Version -> VersionRange
withinVersion = WildcardVersion
-- | The version range @^>= v@.
--
-- For example, for version @1.2.3.4@, the version range @^>= 1.2.3.4@ is the same as
-- @>= 1.2.3.4 && < 1.3@.
--
-- Note that @^>= 1@ is equivalent to @>= 1 && < 1.1@.
--
-- @since 2.0.0.2
majorBoundVersion :: Version -> VersionRange
majorBoundVersion = MajorBoundVersion
-- | F-Algebra of 'VersionRange'. See 'cataVersionRange'.
--
-- @since 2.2
data VersionRangeF a
= AnyVersionF
| ThisVersionF Version -- = version
| LaterVersionF Version -- > version (NB. not >=)
| OrLaterVersionF Version -- >= version
| EarlierVersionF Version -- < version
| OrEarlierVersionF Version -- <= version
| WildcardVersionF Version -- == ver.* (same as >= ver && < ver+1)
| MajorBoundVersionF Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1)
| UnionVersionRangesF a a
| IntersectVersionRangesF a a
| VersionRangeParensF a
deriving (Data, Eq, Generic, Read, Show, Typeable, Functor, Foldable, Traversable)
-- | @since 2.2
projectVersionRange :: VersionRange -> VersionRangeF VersionRange
projectVersionRange AnyVersion = AnyVersionF
projectVersionRange (ThisVersion v) = ThisVersionF v
projectVersionRange (LaterVersion v) = LaterVersionF v
projectVersionRange (OrLaterVersion v) = OrLaterVersionF v
projectVersionRange (EarlierVersion v) = EarlierVersionF v
projectVersionRange (OrEarlierVersion v) = OrEarlierVersionF v
projectVersionRange (WildcardVersion v) = WildcardVersionF v
projectVersionRange (MajorBoundVersion v) = MajorBoundVersionF v
projectVersionRange (UnionVersionRanges a b) = UnionVersionRangesF a b
projectVersionRange (IntersectVersionRanges a b) = IntersectVersionRangesF a b
projectVersionRange (VersionRangeParens a) = VersionRangeParensF a
-- | Fold 'VersionRange'.
--
-- @since 2.2
cataVersionRange :: (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange f = c where c = f . fmap c . projectVersionRange
-- | @since 2.2
embedVersionRange :: VersionRangeF VersionRange -> VersionRange
embedVersionRange AnyVersionF = AnyVersion
embedVersionRange (ThisVersionF v) = ThisVersion v
embedVersionRange (LaterVersionF v) = LaterVersion v
embedVersionRange (OrLaterVersionF v) = OrLaterVersion v
embedVersionRange (EarlierVersionF v) = EarlierVersion v
embedVersionRange (OrEarlierVersionF v) = OrEarlierVersion v
embedVersionRange (WildcardVersionF v) = WildcardVersion v
embedVersionRange (MajorBoundVersionF v) = MajorBoundVersion v
embedVersionRange (UnionVersionRangesF a b) = UnionVersionRanges a b
embedVersionRange (IntersectVersionRangesF a b) = IntersectVersionRanges a b
embedVersionRange (VersionRangeParensF a) = VersionRangeParens a
-- | Unfold 'VersionRange'.
--
-- @since 2.2
anaVersionRange :: (a -> VersionRangeF a) -> a -> VersionRange
anaVersionRange g = a where a = embedVersionRange . fmap a . g
-- | Fold over the basic syntactic structure of a 'VersionRange'.
--
-- This provides a syntactic view of the expression defining the version range.
-- The syntactic sugar @\">= v\"@, @\"<= v\"@ and @\"== v.*\"@ is presented
-- in terms of the other basic syntax.
--
-- For a semantic view use 'asVersionIntervals'.
--
foldVersionRange :: a -- ^ @\"-any\"@ version
-> (Version -> a) -- ^ @\"== v\"@
-> (Version -> a) -- ^ @\"> v\"@
-> (Version -> a) -- ^ @\"< v\"@
-> (a -> a -> a) -- ^ @\"_ || _\"@ union
-> (a -> a -> a) -- ^ @\"_ && _\"@ intersection
-> VersionRange -> a
foldVersionRange anyv this later earlier union intersect = fold
where
fold = cataVersionRange alg
alg AnyVersionF = anyv
alg (ThisVersionF v) = this v
alg (LaterVersionF v) = later v
alg (OrLaterVersionF v) = union (this v) (later v)
alg (EarlierVersionF v) = earlier v
alg (OrEarlierVersionF v) = union (this v) (earlier v)
alg (WildcardVersionF v) = fold (wildcard v)
alg (MajorBoundVersionF v) = fold (majorBound v)
alg (UnionVersionRangesF v1 v2) = union v1 v2
alg (IntersectVersionRangesF v1 v2) = intersect v1 v2
alg (VersionRangeParensF v) = v
wildcard v = intersectVersionRanges
(orLaterVersion v)
(earlierVersion (wildcardUpperBound v))
majorBound v = intersectVersionRanges
(orLaterVersion v)
(earlierVersion (majorUpperBound v))
-- | Refold 'VersionRange'
--
-- @since 2.2
hyloVersionRange :: (VersionRangeF VersionRange -> VersionRange)
-> (VersionRange -> VersionRangeF VersionRange)
-> VersionRange -> VersionRange
hyloVersionRange f g = h where h = f . fmap h . g
-- | Normalise 'VersionRange'.
--
-- In particular collapse @(== v || > v)@ into @>= v@, and so on.
normaliseVersionRange :: VersionRange -> VersionRange
normaliseVersionRange = hyloVersionRange embed projectVersionRange
where
-- == v || > v, > v || == v ==> >= v
embed (UnionVersionRangesF (ThisVersion v) (LaterVersion v')) | v == v' =
orLaterVersion v
embed (UnionVersionRangesF (LaterVersion v) (ThisVersion v')) | v == v' =
orLaterVersion v
-- == v || < v, < v || == v ==> <= v
embed (UnionVersionRangesF (ThisVersion v) (EarlierVersion v')) | v == v' =
orEarlierVersion v
embed (UnionVersionRangesF (EarlierVersion v) (ThisVersion v')) | v == v' =
orEarlierVersion v
-- otherwise embed normally
embed vr = embedVersionRange vr
-- | Remove 'VersionRangeParens' constructors.
--
-- @since 2.2
stripParensVersionRange :: VersionRange -> VersionRange
stripParensVersionRange = hyloVersionRange embed projectVersionRange
where
embed (VersionRangeParensF vr) = vr
embed vr = embedVersionRange vr
-- | Does this version fall within the given range?
--
-- This is the evaluation function for the 'VersionRange' type.
--
withinRange :: Version -> VersionRange -> Bool
withinRange v = foldVersionRange
True
(\v' -> v == v')
(\v' -> v > v')
(\v' -> v < v')
(||)
(&&)
----------------------------
-- Wildcard range utilities
--
-- | @since 2.2
wildcardUpperBound :: Version -> Version
wildcardUpperBound = alterVersion $
\lowerBound -> init lowerBound ++ [last lowerBound + 1]
isWildcardRange :: Version -> Version -> Bool
isWildcardRange ver1 ver2 = check (versionNumbers ver1) (versionNumbers ver2)
where check (n:[]) (m:[]) | n+1 == m = True
check (n:ns) (m:ms) | n == m = check ns ms
check _ _ = False
-- | Compute next greater major version to be used as upper bound
--
-- Example: @0.4.1@ produces the version @0.5@ which then can be used
-- to construct a range @>= 0.4.1 && < 0.5@
--
-- @since 2.2
majorUpperBound :: Version -> Version
majorUpperBound = alterVersion $ \numbers -> case numbers of
[] -> [0,1] -- should not happen
[m1] -> [m1,1] -- e.g. version '1'
(m1:m2:_) -> [m1,m2+1]
-------------------------------------------------------------------------------
-- Parsec & Pretty
-------------------------------------------------------------------------------
instance Pretty VersionRange where
pretty = fst . cataVersionRange alg
where
alg AnyVersionF = (Disp.text "-any", 0 :: Int)
alg (ThisVersionF v) = (Disp.text "==" <<>> pretty v, 0)
alg (LaterVersionF v) = (Disp.char '>' <<>> pretty v, 0)
alg (OrLaterVersionF v) = (Disp.text ">=" <<>> pretty v, 0)
alg (EarlierVersionF v) = (Disp.char '<' <<>> pretty v, 0)
alg (OrEarlierVersionF v) = (Disp.text "<=" <<>> pretty v, 0)
alg (WildcardVersionF v) = (Disp.text "==" <<>> dispWild v, 0)
alg (MajorBoundVersionF v) = (Disp.text "^>=" <<>> pretty v, 0)
alg (UnionVersionRangesF (r1, p1) (r2, p2)) =
(punct 1 p1 r1 <+> Disp.text "||" <+> punct 2 p2 r2 , 2)
alg (IntersectVersionRangesF (r1, p1) (r2, p2)) =
(punct 0 p1 r1 <+> Disp.text "&&" <+> punct 1 p2 r2 , 1)
alg (VersionRangeParensF (r, _)) =
(Disp.parens r, 0)
dispWild ver =
Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int $ versionNumbers ver))
<<>> Disp.text ".*"
punct p p' | p < p' = Disp.parens
| otherwise = id
instance Parsec VersionRange where
parsec = expr
where
expr = do P.spaces
t <- term
P.spaces
(do _ <- P.string "||"
P.spaces
e <- expr
return (unionVersionRanges t e)
<|>
return t)
term = do f <- factor
P.spaces
(do _ <- P.string "&&"
P.spaces
t <- term
return (intersectVersionRanges f t)
<|>
return f)
factor = parens expr <|> prim
prim = do
op <- P.munch1 (`elem` "<>=^-") P.<?> "operator"
case op of
"-" -> anyVersion <$ P.string "any" <|> P.string "none" *> noVersion'
"==" -> do
P.spaces
(wild, v) <- verOrWild
pure $ (if wild then withinVersion else thisVersion) v
_ -> do
P.spaces
(wild, v) <- verOrWild
when wild $ P.unexpected $
"wild-card version after non-== operator: " ++ show op
case op of
">=" -> pure $ orLaterVersion v
"<" -> pure $ earlierVersion v
"^>=" -> majorBoundVersion' v
"<=" -> pure $ orEarlierVersion v
">" -> pure $ laterVersion v
_ -> fail $ "Unknown version operator " ++ show op
-- Note: There are other features:
-- && and || since 1.8
-- x.y.* (wildcard) since 1.6
-- -none version range is available since 1.22
noVersion' = do
csv <- askCabalSpecVersion
if csv >= CabalSpecV1_22
then pure noVersion
else fail $ unwords
[ "-none version range used."
, "To use this syntax the package needs to specify at least 'cabal-version: 1.22'."
, "Alternatively, if broader compatibility is important then use"
, "<0 or other empty range."
]
-- ^>= is available since 2.0
majorBoundVersion' v = do
csv <- askCabalSpecVersion
if csv >= CabalSpecV2_0
then pure $ majorBoundVersion v
else fail $ unwords
[ "major bounded version syntax (caret, ^>=) used."
, "To use this syntax the package need to specify at least 'cabal-version: 2.0'."
, "Alternatively, if broader compatibility is important then use:"
, prettyShow $ eliminateMajorBoundSyntax $ majorBoundVersion v
]
where
eliminateMajorBoundSyntax = hyloVersionRange embed projectVersionRange
embed (MajorBoundVersionF u) = intersectVersionRanges
(orLaterVersion u) (earlierVersion (majorUpperBound u))
embed vr = embedVersionRange vr
-- either wildcard or normal version
verOrWild :: CabalParsing m => m (Bool, Version)
verOrWild = do
x <- P.integral
verLoop (DList.singleton x)
-- trailing: wildcard (.y.*) or normal version (optional tags) (.y.z-tag)
verLoop :: CabalParsing m => DList.DList Int -> m (Bool, Version)
verLoop acc = verLoop' acc <|> (tags *> pure (False, mkVersion (DList.toList acc)))
verLoop' :: CabalParsing m => DList.DList Int -> m (Bool, Version)
verLoop' acc = do
_ <- P.char '.'
let digit = P.integral >>= verLoop . DList.snoc acc
let wild = (True, mkVersion (DList.toList acc)) <$ P.char '*'
digit <|> wild
parens p = P.between
((P.char '(' P.<?> "opening paren") >> P.spaces)
(P.char ')' >> P.spaces)
(do a <- p
P.spaces
return (VersionRangeParens a))
tags :: CabalParsing m => m ()
tags = do
ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum)
case ts of
[] -> pure ()
(_ : _) -> parsecWarning PWTVersionTag "version with tags"
instance Text VersionRange where
parse = expr
where
expr = do Parse.skipSpaces
t <- term
Parse.skipSpaces
(do _ <- Parse.string "||"
Parse.skipSpaces
e <- expr
return (UnionVersionRanges t e)
Parse.+++
return t)
term = do f <- factor
Parse.skipSpaces
(do _ <- Parse.string "&&"
Parse.skipSpaces
t <- term
return (IntersectVersionRanges f t)
Parse.+++
return f)
factor = Parse.choice $ parens expr
: parseAnyVersion
: parseNoVersion
: parseWildcardRange
: map parseRangeOp rangeOps
parseAnyVersion = Parse.string "-any" >> return AnyVersion
parseNoVersion = Parse.string "-none" >> return noVersion
parseWildcardRange = do
_ <- Parse.string "=="
Parse.skipSpaces
branch <- Parse.sepBy1 digits (Parse.char '.')
_ <- Parse.char '.'
_ <- Parse.char '*'
return (WildcardVersion (mkVersion branch))
parens p = Parse.between (Parse.char '(' >> Parse.skipSpaces)
(Parse.char ')' >> Parse.skipSpaces)
(do a <- p
Parse.skipSpaces
return (VersionRangeParens a))
digits = do
firstDigit <- Parse.satisfy isDigit
if firstDigit == '0'
then return 0
else do rest <- Parse.munch isDigit
return (read (firstDigit : rest)) -- TODO: eradicateNoParse
parseRangeOp (s,f) = Parse.string s >> Parse.skipSpaces >> fmap f parse
rangeOps = [ ("<", EarlierVersion),
("<=", orEarlierVersion),
(">", LaterVersion),
(">=", orLaterVersion),
("^>=", MajorBoundVersion),
("==", ThisVersion) ]
-- | Does the version range have an upper bound?
--
-- @since 1.24.0.0
hasUpperBound :: VersionRange -> Bool
hasUpperBound = foldVersionRange
False
(const True)
(const False)
(const True)
(&&) (||)
-- | Does the version range have an explicit lower bound?
--
-- Note: this function only considers the user-specified lower bounds, but not
-- the implicit >=0 lower bound.
--
-- @since 1.24.0.0
hasLowerBound :: VersionRange -> Bool
hasLowerBound = foldVersionRange
False
(const True)
(const True)
(const False)
(&&) (||)