{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}

module Distribution.Types.VersionRange
  ( -- * Version Range
    VersionRange

    -- ** Predicates
    -- $predicate-examples

    -- *** Lower Bound
  , hasLowerBound
  , hasGTLowerBound

    -- *** Upper Bound
  , hasUpperBound
  , hasLEUpperBound
  , hasTrailingZeroUpperBound

    -- *** Any Version
  , isAnyVersion
  , isAnyVersionLight

    -- ** Constructing
  , anyVersion
  , noVersion
  , thisVersion
  , notThisVersion
  , laterVersion
  , earlierVersion
  , orLaterVersion
  , orEarlierVersion
  , unionVersionRanges
  , intersectVersionRanges
  , withinVersion
  , majorBoundVersion

    -- ** Modification
  , normaliseVersionRange
  , stripParensVersionRange

    -- ** Inspection
  , withinRange
  , foldVersionRange

    -- ** Parser
  , versionRangeParser

    -- * Version F-Algebra
  , VersionRangeF (..)
  , projectVersionRange
  , embedVersionRange
  , cataVersionRange
  , anaVersionRange
  , hyloVersionRange

    -- * Version Utilities

  -- See "Distribution.Version" for more utilities.
  , wildcardUpperBound
  , majorUpperBound
  , isWildcardRange
  ) where

import Distribution.Compat.Prelude
import Distribution.Types.Version
import Distribution.Types.VersionInterval
import Distribution.Types.VersionRange.Internal
import Prelude ()

-- | 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 :: forall a.
a
-> (Version -> a)
-> (Version -> a)
-> (Version -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> VersionRange
-> a
foldVersionRange a
_any Version -> a
this Version -> a
later Version -> a
earlier a -> a -> a
union a -> a -> a
intersect = VersionRange -> a
fold
  where
    fold :: VersionRange -> a
fold = (VersionRangeF a -> a) -> VersionRange -> a
forall a. (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange VersionRangeF a -> a
alg

    alg :: VersionRangeF a -> a
alg (ThisVersionF Version
v) = Version -> a
this Version
v
    alg (LaterVersionF Version
v) = Version -> a
later Version
v
    alg (OrLaterVersionF Version
v) = a -> a -> a
union (Version -> a
this Version
v) (Version -> a
later Version
v)
    alg (EarlierVersionF Version
v) = Version -> a
earlier Version
v
    alg (OrEarlierVersionF Version
v) = a -> a -> a
union (Version -> a
this Version
v) (Version -> a
earlier Version
v)
    alg (MajorBoundVersionF Version
v) = VersionRange -> a
fold (Version -> VersionRange
majorBound Version
v)
    alg (UnionVersionRangesF a
v1 a
v2) = a -> a -> a
union a
v1 a
v2
    alg (IntersectVersionRangesF a
v1 a
v2) = a -> a -> a
intersect a
v1 a
v2

    majorBound :: Version -> VersionRange
majorBound Version
v =
      VersionRange -> VersionRange -> VersionRange
intersectVersionRanges
        (Version -> VersionRange
orLaterVersion Version
v)
        (Version -> VersionRange
earlierVersion (Version -> Version
majorUpperBound Version
v))

-- | Normalise 'VersionRange'.
--
-- In particular collapse @(== v || > v)@ into @>= v@, and so on.
normaliseVersionRange :: VersionRange -> VersionRange
normaliseVersionRange :: VersionRange -> VersionRange
normaliseVersionRange = (VersionRangeF VersionRange -> VersionRange)
-> (VersionRange -> VersionRangeF VersionRange)
-> VersionRange
-> VersionRange
hyloVersionRange VersionRangeF VersionRange -> VersionRange
embed VersionRange -> VersionRangeF VersionRange
projectVersionRange
  where
    -- == v || > v, > v || == v  ==>  >= v
    embed :: VersionRangeF VersionRange -> VersionRange
embed (UnionVersionRangesF (ThisVersion Version
v) (LaterVersion Version
v'))
      | Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v' =
          Version -> VersionRange
orLaterVersion Version
v
    embed (UnionVersionRangesF (LaterVersion Version
v) (ThisVersion Version
v'))
      | Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v' =
          Version -> VersionRange
orLaterVersion Version
v
    -- == v || < v, < v || == v  ==>  <= v
    embed (UnionVersionRangesF (ThisVersion Version
v) (EarlierVersion Version
v'))
      | Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v' =
          Version -> VersionRange
orEarlierVersion Version
v
    embed (UnionVersionRangesF (EarlierVersion Version
v) (ThisVersion Version
v'))
      | Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v' =
          Version -> VersionRange
orEarlierVersion Version
v
    -- otherwise embed normally
    embed VersionRangeF VersionRange
vr = VersionRangeF VersionRange -> VersionRange
embedVersionRange VersionRangeF VersionRange
vr

-- |  Remove 'VersionRangeParens' constructors.
--
-- Since version 3.4 this function is 'id', there aren't 'VersionRangeParens' constructor in 'VersionRange' anymore.
--
-- @since 2.2
stripParensVersionRange :: VersionRange -> VersionRange
stripParensVersionRange :: VersionRange -> VersionRange
stripParensVersionRange = VersionRange -> VersionRange
forall a. a -> a
id

-- | Does this version fall within the given range?
--
-- This is the evaluation function for the 'VersionRange' type.
withinRange :: Version -> VersionRange -> Bool
withinRange :: Version -> VersionRange -> Bool
withinRange Version
v =
  Bool
-> (Version -> Bool)
-> (Version -> Bool)
-> (Version -> Bool)
-> (Bool -> Bool -> Bool)
-> (Bool -> Bool -> Bool)
-> VersionRange
-> Bool
forall a.
a
-> (Version -> a)
-> (Version -> a)
-> (Version -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> VersionRange
-> a
foldVersionRange
    Bool
True
    (\Version
v' -> Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v')
    (\Version
v' -> Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
v')
    (\Version
v' -> Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
v')
    Bool -> Bool -> Bool
(||)
    Bool -> Bool -> Bool
(&&)

-- | Does this 'VersionRange' place any restriction on the 'Version' or is it
-- in fact equivalent to 'AnyVersion'.
--
-- Note this is a semantic check, not simply a syntactic check. So for example
-- the following is @True@ (for all @v@).
--
-- > isAnyVersion (EarlierVersion v `UnionVersionRanges` orLaterVersion v)
isAnyVersion :: VersionRange -> Bool
isAnyVersion :: VersionRange -> Bool
isAnyVersion VersionRange
vr = case VersionRange -> [VersionInterval]
asVersionIntervals VersionRange
vr of
  [VersionInterval (LowerBound Version
v Bound
InclusiveBound) UpperBound
NoUpperBound] -> Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
version0
  [VersionInterval]
_ -> Bool
False

-- A fast and non-precise version of 'isAnyVersion',
-- returns 'True' only for @>= 0@ 'VersionRange's.
--
-- /Do not use/. The "VersionIntervals don't destroy MajorBoundVersion"
-- https://github.com/haskell/cabal/pull/6736 pull-request
-- will change 'simplifyVersionRange' to properly preserve semantics.
-- Then we can use it to normalise 'VersionRange's in tests.
--
isAnyVersionLight :: VersionRange -> Bool
isAnyVersionLight :: VersionRange -> Bool
isAnyVersionLight (OrLaterVersion Version
v) = Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
version0
isAnyVersionLight VersionRange
_vr = Bool
False

----------------------------
-- Wildcard range utilities
--

isWildcardRange :: Version -> Version -> Bool
isWildcardRange :: Version -> Version -> Bool
isWildcardRange Version
ver1 Version
ver2 = [Int] -> [Int] -> Bool
forall {a}. (Eq a, Num a) => [a] -> [a] -> Bool
check (Version -> [Int]
versionNumbers Version
ver1) (Version -> [Int]
versionNumbers Version
ver2)
  where
    check :: [a] -> [a] -> Bool
check (a
n : []) (a
m : []) | a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
m = Bool
True
    check (a
n : [a]
ns) (a
m : [a]
ms) | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
m = [a] -> [a] -> Bool
check [a]
ns [a]
ms
    check [a]
_ [a]
_ = Bool
False

-- | Does the version range have an upper bound?
--
-- @since 1.24.0.0
--
-- >>> forM ["< 1", ">= 0 && < 1", ">= 0 || < 1", "^>= 4.20.0.0"] (fmap hasUpperBound . simpleParsec)
-- Just [True,True,False,True]
hasUpperBound :: VersionRange -> Bool
hasUpperBound :: VersionRange -> Bool
hasUpperBound =
  Bool
-> (Version -> Bool)
-> (Version -> Bool)
-> (Version -> Bool)
-> (Bool -> Bool -> Bool)
-> (Bool -> Bool -> Bool)
-> VersionRange
-> Bool
forall a.
a
-> (Version -> a)
-> (Version -> a)
-> (Version -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> VersionRange
-> a
foldVersionRange
    Bool
False
    (Bool -> Version -> Bool
forall a b. a -> b -> a
const Bool
True)
    (Bool -> Version -> Bool
forall a b. a -> b -> a
const Bool
False)
    (Bool -> Version -> Bool
forall a b. a -> b -> a
const Bool
True)
    Bool -> Bool -> Bool
(&&)
    Bool -> Bool -> Bool
(||)

-- | 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
--
-- >>> forM ["< 1", ">= 0 && < 1", ">= 0 || < 1", "^>= 4.20.0.0"] (fmap hasLowerBound . simpleParsec)
-- Just [False,True,False,True]
hasLowerBound :: VersionRange -> Bool
hasLowerBound :: VersionRange -> Bool
hasLowerBound =
  Bool
-> (Version -> Bool)
-> (Version -> Bool)
-> (Version -> Bool)
-> (Bool -> Bool -> Bool)
-> (Bool -> Bool -> Bool)
-> VersionRange
-> Bool
forall a.
a
-> (Version -> a)
-> (Version -> a)
-> (Version -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> VersionRange
-> a
foldVersionRange
    Bool
False
    (Bool -> Version -> Bool
forall a b. a -> b -> a
const Bool
True)
    (Bool -> Version -> Bool
forall a b. a -> b -> a
const Bool
True)
    (Bool -> Version -> Bool
forall a b. a -> b -> a
const Bool
False)
    Bool -> Bool -> Bool
(&&)
    Bool -> Bool -> Bool
(||)

-- | Is the upper bound version range (less than or equal (LE, <=)?
--
-- >>> forM ["< 1", "<= 1", ">= 0 && < 1", ">= 0 || < 1", ">= 0 && <= 1", ">= 0 || <= 1", "^>= 4.20.0.0"] (fmap hasLEUpperBound . simpleParsec)
-- Just [False,True,False,False,True,True,False]
hasLEUpperBound :: VersionRange -> Bool
hasLEUpperBound :: VersionRange -> Bool
hasLEUpperBound = (VersionRangeF VersionRange -> Bool)
-> (VersionRange -> Bool) -> VersionRange -> Bool
queryVersionRange (\case VersionRangeF VersionRange
LEUpperBound -> Bool
True; VersionRangeF VersionRange
_ -> Bool
False) VersionRange -> Bool
hasLEUpperBound

-- | Is the lower bound version range greater than (GT, >)?
--
-- >>> forM ["< 1", ">= 0 && < 1", ">= 0 || < 1", "> 0 && < 1", "> 0 || < 1", "^>= 4.20.0.0"] (fmap hasGTLowerBound . simpleParsec)
-- Just [False,False,False,True,True,False]
hasGTLowerBound :: VersionRange -> Bool
hasGTLowerBound :: VersionRange -> Bool
hasGTLowerBound = (VersionRangeF VersionRange -> Bool)
-> (VersionRange -> Bool) -> VersionRange -> Bool
queryVersionRange (\case VersionRangeF VersionRange
GTLowerBound -> Bool
True; VersionRangeF VersionRange
_ -> Bool
False) VersionRange -> Bool
hasGTLowerBound

-- | Does the upper bound version range have a trailing zero?
--
-- >>> forM ["< 1", "< 1.1", "< 1.0", "< 1.1.0", "^>= 4.20.0.0"] (fmap hasTrailingZeroUpperBound . simpleParsec)
-- Just [False,False,True,True,False]
hasTrailingZeroUpperBound :: VersionRange -> Bool
hasTrailingZeroUpperBound :: VersionRange -> Bool
hasTrailingZeroUpperBound = (VersionRangeF VersionRange -> Bool)
-> (VersionRange -> Bool) -> VersionRange -> Bool
queryVersionRange (\case VersionRangeF VersionRange
TZUpperBound -> Bool
True; VersionRangeF VersionRange
_ -> Bool
False) VersionRange -> Bool
hasTrailingZeroUpperBound

queryVersionRange :: (VersionRangeF VersionRange -> Bool) -> (VersionRange -> Bool) -> VersionRange -> Bool
queryVersionRange :: (VersionRangeF VersionRange -> Bool)
-> (VersionRange -> Bool) -> VersionRange -> Bool
queryVersionRange VersionRangeF VersionRange -> Bool
pf VersionRange -> Bool
p (VersionRange -> VersionRangeF VersionRange
projectVersionRange -> VersionRangeF VersionRange
v) =
  let f :: VersionRange -> Bool
f = (VersionRangeF VersionRange -> Bool)
-> (VersionRange -> Bool) -> VersionRange -> Bool
queryVersionRange VersionRangeF VersionRange -> Bool
pf VersionRange -> Bool
p
   in VersionRangeF VersionRange -> Bool
pf VersionRangeF VersionRange
v Bool -> Bool -> Bool
|| case VersionRangeF VersionRange
v of
        IntersectVersionRangesF VersionRange
x VersionRange
y -> VersionRange -> Bool
f VersionRange
x Bool -> Bool -> Bool
|| VersionRange -> Bool
f VersionRange
y
        UnionVersionRangesF VersionRange
x VersionRange
y -> VersionRange -> Bool
f VersionRange
x Bool -> Bool -> Bool
|| VersionRange -> Bool
f VersionRange
y
        VersionRangeF VersionRange
_ -> Bool
False

-- $setup
-- >>> import Distribution.Parsec
-- >>> import Data.Traversable

-- $predicate-examples
--
-- The parsed 'VersionRange' of each version constraint used in the examples for
-- 'hasUpperBound' and 'hasLowerBound' are:
--
-- >>> simpleParsec "< 1" :: Maybe VersionRange
-- Just (EarlierVersion (mkVersion [1]))
-- >>> simpleParsec ">= 0 && < 1" :: Maybe VersionRange
-- Just (IntersectVersionRanges (OrLaterVersion (mkVersion [0])) (EarlierVersion (mkVersion [1])))
-- >>> simpleParsec ">= 0 || < 1" :: Maybe VersionRange
-- Just (UnionVersionRanges (OrLaterVersion (mkVersion [0])) (EarlierVersion (mkVersion [1])))
-- >>> simpleParsec "^>= 4.20.0.0" :: Maybe VersionRange
-- Just (MajorBoundVersion (mkVersion [4,20,0,0]))