{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

-- | WARNING: This module should be considered private! If you find yourself
-- wanting to import something from this module, please open an issue to get
-- that thing exported from "Salve".
module Salve.Internal
  ( Version(..)
  , PreRelease(..)
  , Build(..)
  , Constraint(..)
  , makeVersion
  , initialVersion
  , parseVersion
  , parsePreRelease
  , parseBuild
  , parseConstraint
  , unsafeParseVersion
  , unsafeParsePreRelease
  , unsafeParseBuild
  , unsafeParseConstraint
  , renderVersion
  , renderPreRelease
  , renderBuild
  , renderConstraint
  , isUnstable
  , isStable
  , fromBaseVersion
  , toBaseVersion
  , bumpMajor
  , bumpMinor
  , bumpPatch
  , satisfiesConstraint
  , majorLens
  , minorLens
  , patchLens
  , preReleasesLens
  , buildsLens
  , Operator(..)
  , Wildcard(..)
  , constraintLT
  , constraintLE
  , constraintEQ
  , constraintGE
  , constraintGT
  , constraintAnd
  , constraintOr
  , constraintHyphen
  , constraintTilde
  , constraintCaret
  ) where

import qualified Control.Monad as Monad
import qualified Data.Char as Char
import qualified Data.Data as Data
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Monoid as Monoid
import qualified Data.Ord as Ord
import qualified Data.Version as Version
import qualified Data.Word as Word
import qualified GHC.Generics as Generics
import qualified Text.ParserCombinators.ReadP as ReadP

-- $setup
--
-- >>> import Control.Applicative (Const(..))
-- >>> let view lens record = getConst (lens Const record)
--
-- >>> import Data.Functor.Identity (Identity(..))
-- >>> let set lens field record = runIdentity (lens (const (Identity field)) record)
--
-- >>> import Control.Applicative ((<$>), (<*>))

-- * Public

-- | A semantic version number. Versions have five parts:
--
-- 1. 'majorLens': The major version number.
-- 2. 'minorLens': The minor version number.
-- 3. 'patchLens': The patch version number.
-- 4. 'preReleasesLens': A list of pre-release identifiers.
-- 5. 'buildsLens': A list of build metadata.
--
-- Use 'parseVersion' to create versions.
data Version = Version
  { Version -> Word64
versionMajor :: Word.Word64
  , Version -> Word64
versionMinor :: Word.Word64
  , Version -> Word64
versionPatch :: Word.Word64
  , Version -> [PreRelease]
versionPreReleases :: [PreRelease]
  , Version -> [Build]
versionBuilds :: [Build]
  }
  deriving (Typeable Version
Version -> DataType
Version -> Constr
(forall b. Data b => b -> b) -> Version -> Version
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) -> Version -> u
forall u. (forall d. Data d => d -> u) -> Version -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Version -> m Version
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Version)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Version -> m Version
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Version -> m Version
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Version -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Version -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Version -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Version -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
gmapT :: (forall b. Data b => b -> b) -> Version -> Version
$cgmapT :: (forall b. Data b => b -> b) -> Version -> Version
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Version)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Version)
dataTypeOf :: Version -> DataType
$cdataTypeOf :: Version -> DataType
toConstr :: Version -> Constr
$ctoConstr :: Version -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
Data.Data, Version -> Version -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generics.Generic, ReadPrec [Version]
ReadPrec Version
Int -> ReadS Version
ReadS [Version]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Version]
$creadListPrec :: ReadPrec [Version]
readPrec :: ReadPrec Version
$creadPrec :: ReadPrec Version
readList :: ReadS [Version]
$creadList :: ReadS [Version]
readsPrec :: Int -> ReadS Version
$creadsPrec :: Int -> ReadS Version
Read, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)

-- | In general, versions compare in the way that you would expect. First the
-- major version numbers are compared, then the minors, then the patches.
--
-- >>> compare <$> parseVersion "1.2.3" <*> parseVersion "2.0.0"
-- Just LT
-- >>> compare <$> parseVersion "1.2.3" <*> parseVersion "1.3.0"
-- Just LT
-- >>> compare <$> parseVersion "1.2.3" <*> parseVersion "1.2.4"
-- Just LT
--
-- Numbers are compared numerically, not alphabetically.
--
-- >>> compare <$> parseVersion "0.0.9" <*> parseVersion "0.0.10"
-- Just LT
--
-- If all the numbers are the same, the pre-releases are compared.
--
-- >>> compare <$> parseVersion "1.2.3-a" <*> parseVersion "1.2.3-b"
-- Just LT
--
-- A version with a pre-release is always less than a version without one as
-- long as the other parts are the same.
--
-- >>> compare <$> parseVersion "1.2.3-pre" <*> parseVersion "1.2.3"
-- Just LT
-- >>> compare <$> parseVersion "1.2.4-pre" <*> parseVersion "1.2.3"
-- Just GT
--
-- Builds are not considered when comparing versions.
--
-- >>> compare <$> parseVersion "1.2.3+a" <*> parseVersion "1.2.3+b"
-- Just EQ
-- >>> (==) <$> parseVersion "1.2.3+a" <*> parseVersion "1.2.3+b"
-- Just False
instance Ord Version where
  compare :: Version -> Version -> Ordering
compare Version
x Version
y = forall a. Monoid a => [a] -> a
Monoid.mconcat
    [ forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing Version -> Word64
versionMajor Version
x Version
y
    , forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing Version -> Word64
versionMinor Version
x Version
y
    , forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing Version -> Word64
versionPatch Version
x Version
y
    , case forall a b. (a -> b) -> (a, a) -> (b, b)
both Version -> [PreRelease]
versionPreReleases (Version
x, Version
y) of
      ([], []) -> Ordering
EQ
      ([], [PreRelease]
_) -> Ordering
GT
      ([PreRelease]
_, []) -> Ordering
LT
      ([PreRelease]
p, [PreRelease]
q) -> forall a. Ord a => a -> a -> Ordering
compare [PreRelease]
p [PreRelease]
q
    ]

-- | Pre-release information attached to a version. These can either be numeric
-- or textual. They must not be empty.
--
-- - Numeric: Can be any non-negative integer. Cannot have leading zeros.
--
-- - Textual: Can be any string of ASCII digits, letters, or hyphens. Cannot be
--   all digits, as that would be numeric.
--
-- In general, pre-releases must match the regular expression
-- @\/^[-0-9A-Za-z]+$\/@.
--
-- Use 'parsePreRelease' to create pre-releases.
data PreRelease
  = PreReleaseNumeric Word.Word64
  | PreReleaseTextual String
  deriving (Typeable PreRelease
PreRelease -> DataType
PreRelease -> Constr
(forall b. Data b => b -> b) -> PreRelease -> PreRelease
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) -> PreRelease -> u
forall u. (forall d. Data d => d -> u) -> PreRelease -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PreRelease -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PreRelease -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PreRelease -> m PreRelease
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PreRelease -> m PreRelease
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PreRelease
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PreRelease -> c PreRelease
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PreRelease)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PreRelease)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PreRelease -> m PreRelease
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PreRelease -> m PreRelease
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PreRelease -> m PreRelease
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PreRelease -> m PreRelease
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PreRelease -> m PreRelease
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PreRelease -> m PreRelease
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PreRelease -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PreRelease -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PreRelease -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PreRelease -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PreRelease -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PreRelease -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PreRelease -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PreRelease -> r
gmapT :: (forall b. Data b => b -> b) -> PreRelease -> PreRelease
$cgmapT :: (forall b. Data b => b -> b) -> PreRelease -> PreRelease
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PreRelease)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PreRelease)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PreRelease)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PreRelease)
dataTypeOf :: PreRelease -> DataType
$cdataTypeOf :: PreRelease -> DataType
toConstr :: PreRelease -> Constr
$ctoConstr :: PreRelease -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PreRelease
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PreRelease
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PreRelease -> c PreRelease
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PreRelease -> c PreRelease
Data.Data, PreRelease -> PreRelease -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreRelease -> PreRelease -> Bool
$c/= :: PreRelease -> PreRelease -> Bool
== :: PreRelease -> PreRelease -> Bool
$c== :: PreRelease -> PreRelease -> Bool
Eq, forall x. Rep PreRelease x -> PreRelease
forall x. PreRelease -> Rep PreRelease x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PreRelease x -> PreRelease
$cfrom :: forall x. PreRelease -> Rep PreRelease x
Generics.Generic, ReadPrec [PreRelease]
ReadPrec PreRelease
Int -> ReadS PreRelease
ReadS [PreRelease]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PreRelease]
$creadListPrec :: ReadPrec [PreRelease]
readPrec :: ReadPrec PreRelease
$creadPrec :: ReadPrec PreRelease
readList :: ReadS [PreRelease]
$creadList :: ReadS [PreRelease]
readsPrec :: Int -> ReadS PreRelease
$creadsPrec :: Int -> ReadS PreRelease
Read, Int -> PreRelease -> ShowS
[PreRelease] -> ShowS
PreRelease -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreRelease] -> ShowS
$cshowList :: [PreRelease] -> ShowS
show :: PreRelease -> String
$cshow :: PreRelease -> String
showsPrec :: Int -> PreRelease -> ShowS
$cshowsPrec :: Int -> PreRelease -> ShowS
Show)

-- | Numeric pre-releases are always less than textual pre-releases.
--
-- >>> compare <$> parsePreRelease "1" <*> parsePreRelease "a"
-- Just LT
--
-- Numeric pre-releases are compared numerically.
--
-- >>> compare <$> parsePreRelease "9" <*> parsePreRelease "10"
-- Just LT
--
-- Textual pre-releases are compared alphabetically.
--
-- >>> compare <$> parsePreRelease "p10" <*> parsePreRelease "p9"
-- Just LT
instance Ord PreRelease where
  compare :: PreRelease -> PreRelease -> Ordering
compare PreRelease
x PreRelease
y = case (PreRelease
x, PreRelease
y) of
    (PreReleaseNumeric Word64
n, PreReleaseNumeric Word64
m) -> forall a. Ord a => a -> a -> Ordering
compare Word64
n Word64
m
    (PreReleaseNumeric Word64
_, PreReleaseTextual String
_) -> Ordering
LT
    (PreReleaseTextual String
_, PreReleaseNumeric Word64
_) -> Ordering
GT
    (PreReleaseTextual String
s, PreReleaseTextual String
t) -> forall a. Ord a => a -> a -> Ordering
compare String
s String
t

-- | Build metadata attached to a version. These are similar to
-- 'PreRelease's with some key differences:
--
-- 1. There is no such thing as numeric builds. Even though builds can look
--    like numbers, all builds are textual.
-- 2. As a result, builds that look numeric are allowed to have leading zeros.
-- 3. Builds cannot be compared. That is, they do not have an 'Ord' instance.
--
-- Use 'parseBuild' to create builds.
newtype Build = Build String
  deriving (Typeable Build
Build -> DataType
Build -> Constr
(forall b. Data b => b -> b) -> Build -> Build
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) -> Build -> u
forall u. (forall d. Data d => d -> u) -> Build -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Build -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Build -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Build -> m Build
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Build -> m Build
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Build
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Build -> c Build
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Build)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Build)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Build -> m Build
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Build -> m Build
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Build -> m Build
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Build -> m Build
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Build -> m Build
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Build -> m Build
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Build -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Build -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Build -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Build -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Build -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Build -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Build -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Build -> r
gmapT :: (forall b. Data b => b -> b) -> Build -> Build
$cgmapT :: (forall b. Data b => b -> b) -> Build -> Build
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Build)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Build)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Build)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Build)
dataTypeOf :: Build -> DataType
$cdataTypeOf :: Build -> DataType
toConstr :: Build -> Constr
$ctoConstr :: Build -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Build
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Build
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Build -> c Build
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Build -> c Build
Data.Data, Build -> Build -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Build -> Build -> Bool
$c/= :: Build -> Build -> Bool
== :: Build -> Build -> Bool
$c== :: Build -> Build -> Bool
Eq, forall x. Rep Build x -> Build
forall x. Build -> Rep Build x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Build x -> Build
$cfrom :: forall x. Build -> Rep Build x
Generics.Generic, ReadPrec [Build]
ReadPrec Build
Int -> ReadS Build
ReadS [Build]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Build]
$creadListPrec :: ReadPrec [Build]
readPrec :: ReadPrec Build
$creadPrec :: ReadPrec Build
readList :: ReadS [Build]
$creadList :: ReadS [Build]
readsPrec :: Int -> ReadS Build
$creadsPrec :: Int -> ReadS Build
Read, Int -> Build -> ShowS
[Build] -> ShowS
Build -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Build] -> ShowS
$cshowList :: [Build] -> ShowS
show :: Build -> String
$cshow :: Build -> String
showsPrec :: Int -> Build -> ShowS
$cshowsPrec :: Int -> Build -> ShowS
Show)

-- | Constrains allowable version numbers.
--
-- Use 'parseConstraint' to create constraints and 'satisfiesConstraint' to see
-- if a version number satisfies a constraint.
data Constraint
  = ConstraintOperator Operator Version
  | ConstraintHyphen Version Version
  | ConstraintWildcard Wildcard
  | ConstraintAnd Constraint Constraint
  | ConstraintOr Constraint Constraint
  deriving (Typeable Constraint
Constraint -> DataType
Constraint -> Constr
(forall b. Data b => b -> b) -> Constraint -> Constraint
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) -> Constraint -> u
forall u. (forall d. Data d => d -> u) -> Constraint -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constraint
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constraint -> c Constraint
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Constraint)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constraint)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Constraint -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Constraint -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Constraint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Constraint -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
gmapT :: (forall b. Data b => b -> b) -> Constraint -> Constraint
$cgmapT :: (forall b. Data b => b -> b) -> Constraint -> Constraint
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constraint)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constraint)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Constraint)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Constraint)
dataTypeOf :: Constraint -> DataType
$cdataTypeOf :: Constraint -> DataType
toConstr :: Constraint -> Constr
$ctoConstr :: Constraint -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constraint
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constraint
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constraint -> c Constraint
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constraint -> c Constraint
Data.Data, Constraint -> Constraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c== :: Constraint -> Constraint -> Bool
Eq, forall x. Rep Constraint x -> Constraint
forall x. Constraint -> Rep Constraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Constraint x -> Constraint
$cfrom :: forall x. Constraint -> Rep Constraint x
Generics.Generic, Eq Constraint
Constraint -> Constraint -> Bool
Constraint -> Constraint -> Ordering
Constraint -> Constraint -> Constraint
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 :: Constraint -> Constraint -> Constraint
$cmin :: Constraint -> Constraint -> Constraint
max :: Constraint -> Constraint -> Constraint
$cmax :: Constraint -> Constraint -> Constraint
>= :: Constraint -> Constraint -> Bool
$c>= :: Constraint -> Constraint -> Bool
> :: Constraint -> Constraint -> Bool
$c> :: Constraint -> Constraint -> Bool
<= :: Constraint -> Constraint -> Bool
$c<= :: Constraint -> Constraint -> Bool
< :: Constraint -> Constraint -> Bool
$c< :: Constraint -> Constraint -> Bool
compare :: Constraint -> Constraint -> Ordering
$ccompare :: Constraint -> Constraint -> Ordering
Ord, ReadPrec [Constraint]
ReadPrec Constraint
Int -> ReadS Constraint
ReadS [Constraint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Constraint]
$creadListPrec :: ReadPrec [Constraint]
readPrec :: ReadPrec Constraint
$creadPrec :: ReadPrec Constraint
readList :: ReadS [Constraint]
$creadList :: ReadS [Constraint]
readsPrec :: Int -> ReadS Constraint
$creadsPrec :: Int -> ReadS Constraint
Read, Int -> Constraint -> ShowS
[Constraint] -> ShowS
Constraint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constraint] -> ShowS
$cshowList :: [Constraint] -> ShowS
show :: Constraint -> String
$cshow :: Constraint -> String
showsPrec :: Int -> Constraint -> ShowS
$cshowsPrec :: Int -> Constraint -> ShowS
Show)

-- | Makes a new version number.
--
-- >>> makeVersion 1 2 3 [unsafeParsePreRelease "pre"] [unsafeParseBuild "build"]
-- Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [PreReleaseTextual "pre"], versionBuilds = [Build "build"]}
--
-- This can be a useful alternative to 'parseVersion' if you want a total way
-- to create a version.
makeVersion
  :: Word.Word64
  -> Word.Word64
  -> Word.Word64
  -> [PreRelease]
  -> [Build]
  -> Version
makeVersion :: Word64 -> Word64 -> Word64 -> [PreRelease] -> [Build] -> Version
makeVersion Word64
major Word64
minor Word64
patch [PreRelease]
preReleases [Build]
builds = Version
  { versionMajor :: Word64
versionMajor = Word64
major
  , versionMinor :: Word64
versionMinor = Word64
minor
  , versionPatch :: Word64
versionPatch = Word64
patch
  , versionPreReleases :: [PreRelease]
versionPreReleases = [PreRelease]
preReleases
  , versionBuilds :: [Build]
versionBuilds = [Build]
builds
  }

-- | The initial version number for development.
--
-- >>> initialVersion
-- Version {versionMajor = 0, versionMinor = 0, versionPatch = 0, versionPreReleases = [], versionBuilds = []}
initialVersion :: Version
initialVersion :: Version
initialVersion = Word64 -> Word64 -> Word64 -> [PreRelease] -> [Build] -> Version
makeVersion Word64
0 Word64
0 Word64
0 [] []

-- | Attempts to parse a version. This parser follows
-- [SemVer's BNF](https://github.com/mojombo/semver/blob/eb9aac5/semver.md#backusnaur-form-grammar-for-valid-semver-versions).
--
-- >>> parseVersion "1.2.3-p.4+b.5"
-- Just (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [PreReleaseTextual "p",PreReleaseNumeric 4], versionBuilds = [Build "b",Build "5"]})
--
-- Returns 'Nothing' if the parse fails.
--
-- >>> parseVersion "wrong"
-- Nothing
--
-- Whitespace is allowed.
--
-- >>> parseVersion " 1.2.3 "
-- Just (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})
parseVersion :: String -> Maybe Version
parseVersion :: String -> Maybe Version
parseVersion = forall a. ReadP a -> String -> Maybe a
parse
  (do
    ReadP ()
ReadP.skipSpaces
    Version
version <- ReadP Version
versionP
    ReadP ()
ReadP.skipSpaces
    forall (m :: * -> *) a. Monad m => a -> m a
return Version
version
  )

-- | Attempts to parse a pre-release.
--
-- >>> parsePreRelease "pre"
-- Just (PreReleaseTextual "pre")
-- >>> parsePreRelease "1"
-- Just (PreReleaseNumeric 1)
--
-- Returns 'Nothing' if the parse fails.
--
-- >>> parsePreRelease "wrong!"
-- Nothing
--
-- Numeric pre-releases cannot contain leading zeros.
--
-- >>> parsePreRelease "01"
-- Nothing
parsePreRelease :: String -> Maybe PreRelease
parsePreRelease :: String -> Maybe PreRelease
parsePreRelease = forall a. ReadP a -> String -> Maybe a
parse ReadP PreRelease
preReleaseP

-- | Attempts to parse a build.
--
-- >>> parseBuild "build"
-- Just (Build "build")
-- >>> parseBuild "1"
-- Just (Build "1")
--
-- Returns 'Nothing' if the parse fails.
--
-- >>> parseBuild "wrong!"
-- Nothing
--
-- Unlike pre-releases, numeric builds can have leading zeros.
--
-- >>> parseBuild "01"
-- Just (Build "01")
parseBuild :: String -> Maybe Build
parseBuild :: String -> Maybe Build
parseBuild = forall a. ReadP a -> String -> Maybe a
parse ReadP Build
buildP

-- | Attempts to parse a constraint. This parser mostly follows
-- [npm's BNF](https://github.com/npm/npm/blob/d081cc6/doc/misc/semver.md#range-grammar).
--
-- >>> parseConstraint ">1.2.3"
-- Just (ConstraintOperator OperatorGT (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
--
-- Returns 'Nothing' if the parse fails.
--
-- >>> parseConstraint "wrong"
-- Nothing
--
-- The two departures from npm's BNF are that x-ranges cannot be used with
-- other operators and partial version numbers are not allowed.
--
-- >>> parseConstraint "1.2.x"
-- Just (ConstraintWildcard (WildcardPatch 1 2))
-- >>> parseConstraint ">=1.2.x"
-- Nothing
--
-- >>> parseConstraint "1.2"
-- Nothing
-- >>> parseConstraint ">=1.2"
-- Nothing
parseConstraint :: String -> Maybe Constraint
parseConstraint :: String -> Maybe Constraint
parseConstraint = forall a. ReadP a -> String -> Maybe a
parse ReadP Constraint
constraintsP

-- | Parses a version.
--
-- >>> unsafeParseVersion "1.2.3-p.4+b.5"
-- Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [PreReleaseTextual "p",PreReleaseNumeric 4], versionBuilds = [Build "b",Build "5"]}
--
-- Raises an exception if the parse fails.
--
-- >>> unsafeParseVersion "wrong"
-- *** Exception: unsafeParseVersion: invalid version: "wrong"
-- ...
--
-- See 'parseVersion' for a safe version of this function.
unsafeParseVersion :: String -> Version
unsafeParseVersion :: String -> Version
unsafeParseVersion String
s = case String -> Maybe Version
parseVersion String
s of
  Maybe Version
Nothing -> forall a. HasCallStack => String -> a
error (String
"unsafeParseVersion: invalid version: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s)
  Just Version
v -> Version
v

-- | Parses a pre-release.
--
-- >>> unsafeParsePreRelease "pre"
-- PreReleaseTextual "pre"
--
-- Raises an exception if the parse fails.
--
-- >>> unsafeParsePreRelease "wrong!"
-- *** Exception: unsafeParsePreRelease: invalid pre-release: "wrong!"
-- ...
--
-- See 'parsePreRelease' for a safe version of this function.
unsafeParsePreRelease :: String -> PreRelease
unsafeParsePreRelease :: String -> PreRelease
unsafeParsePreRelease String
s = case String -> Maybe PreRelease
parsePreRelease String
s of
  Maybe PreRelease
Nothing -> forall a. HasCallStack => String -> a
error (String
"unsafeParsePreRelease: invalid pre-release: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s)
  Just PreRelease
p -> PreRelease
p

-- | Parses a build.
--
-- >>> unsafeParseBuild "build"
-- Build "build"
--
-- Raises an exception if the parse fails.
--
-- >>> unsafeParseBuild "wrong!"
-- Build "*** Exception: unsafeParseBuild: invalid build: "wrong!"
-- ...
--
-- See 'parseBuild' for a safe version of this function.
unsafeParseBuild :: String -> Build
unsafeParseBuild :: String -> Build
unsafeParseBuild String
s = case String -> Maybe Build
parseBuild String
s of
  Maybe Build
Nothing -> forall a. HasCallStack => String -> a
error (String
"unsafeParseBuild: invalid build: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s)
  Just Build
b -> Build
b

-- | Parses a constraint.
--
-- >>> unsafeParseConstraint ">1.2.3"
-- ConstraintOperator OperatorGT (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})
--
-- Raises an exception if the parse fails.
--
-- >>> unsafeParseConstraint "wrong"
-- *** Exception: unsafeParseConstraint: invalid constraint: "wrong"
-- ...
--
-- See 'parseConstraint' for a safe version of this function.
unsafeParseConstraint :: String -> Constraint
unsafeParseConstraint :: String -> Constraint
unsafeParseConstraint String
s = case String -> Maybe Constraint
parseConstraint String
s of
  Maybe Constraint
Nothing -> forall a. HasCallStack => String -> a
error (String
"unsafeParseConstraint: invalid constraint: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s)
  Just Constraint
c -> Constraint
c

-- | Renders a version.
--
-- >>> renderVersion <$> parseVersion "1.2.3-p.4+b.5"
-- Just "1.2.3-p.4+b.5"
renderVersion :: Version -> String
renderVersion :: Version -> String
renderVersion Version
v = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ forall a. Show a => a -> String
show (Version -> Word64
versionMajor Version
v)
  , String
"."
  , forall a. Show a => a -> String
show (Version -> Word64
versionMinor Version
v)
  , String
"."
  , forall a. Show a => a -> String
show (Version -> Word64
versionPatch Version
v)
  , [PreRelease] -> String
renderPreReleases (Version -> [PreRelease]
versionPreReleases Version
v)
  , [Build] -> String
renderBuilds (Version -> [Build]
versionBuilds Version
v)
  ]

-- | Renders a pre-release.
--
-- >>> renderPreRelease <$> parsePreRelease "pre"
-- Just "pre"
-- >>> renderPreRelease <$> parsePreRelease "1"
-- Just "1"
renderPreRelease :: PreRelease -> String
renderPreRelease :: PreRelease -> String
renderPreRelease PreRelease
p = case PreRelease
p of
  PreReleaseNumeric Word64
n -> forall a. Show a => a -> String
show Word64
n
  PreReleaseTextual String
s -> String
s

-- | Renders a build.
--
-- >>> renderBuild <$> parseBuild "build"
-- Just "build"
-- >>> renderBuild <$> parseBuild "1"
-- Just "1"
renderBuild :: Build -> String
renderBuild :: Build -> String
renderBuild (Build String
b) = String
b

-- | Renders a constraint.
--
-- >>> renderConstraint <$> parseConstraint ">1.2.3"
-- Just ">1.2.3"
--
-- Parsing and rendering a constraint doesn't always return what you started
-- with.
--
-- >>> renderConstraint <$> parseConstraint "=1.2.3"
-- Just "1.2.3"
renderConstraint :: Constraint -> String
renderConstraint :: Constraint -> String
renderConstraint Constraint
c = case Constraint
c of
  ConstraintOperator Operator
o Version
v ->
    let s :: String
s = Version -> String
renderVersion Version
v
    in
      case Operator
o of
        Operator
OperatorLT -> Char
'<' forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorLE -> Char
'<' forall a. a -> [a] -> [a]
: Char
'=' forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorEQ -> String
s
        Operator
OperatorGE -> Char
'>' forall a. a -> [a] -> [a]
: Char
'=' forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorGT -> Char
'>' forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorTilde -> Char
'~' forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorCaret -> Char
'^' forall a. a -> [a] -> [a]
: String
s
  ConstraintHyphen Version
l Version
r -> [String] -> String
unwords [Version -> String
renderVersion Version
l, String
"-", Version -> String
renderVersion Version
r]
  ConstraintWildcard Wildcard
w -> case Wildcard
w of
    Wildcard
WildcardMajor -> String
"x.x.x"
    WildcardMinor Word64
m -> forall a. Show a => a -> String
show Word64
m forall a. Semigroup a => a -> a -> a
<> String
".x.x"
    WildcardPatch Word64
m Word64
n -> forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." [forall a. Show a => a -> String
show Word64
m, forall a. Show a => a -> String
show Word64
n, String
"x"]
  ConstraintAnd Constraint
l Constraint
r -> [String] -> String
unwords (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Constraint -> String
renderConstraint [Constraint
l, Constraint
r])
  ConstraintOr Constraint
l Constraint
r -> [String] -> String
unwords [Constraint -> String
renderConstraint Constraint
l, String
"||", Constraint -> String
renderConstraint Constraint
r]

-- | Returns 'True' if the major version number is zero, 'False' otherwise.
--
-- >>> isUnstable <$> parseVersion "0.1.2"
-- Just True
-- >>> isUnstable <$> parseVersion "1.0.0"
-- Just False
isUnstable :: Version -> Bool
isUnstable :: Version -> Bool
isUnstable Version
v = Version -> Word64
versionMajor Version
v forall a. Eq a => a -> a -> Bool
== Word64
0

-- | Returns 'True' if the major version number is not zero, 'False' otherwise.
--
-- >>> isStable <$> parseVersion "1.0.0"
-- Just True
-- >>> isStable <$> parseVersion "0.1.2"
-- Just False
isStable :: Version -> Bool
isStable :: Version -> Bool
isStable Version
v = Bool -> Bool
not (Version -> Bool
isUnstable Version
v)

-- | Converts from a 'Version.Version' from the @base@ package.
--
-- >>> renderVersion . fromBaseVersion $ Version.makeVersion [1, 2, 3]
-- "1.2.3"
--
-- Missing version components are set to zero.
--
-- >>> renderVersion . fromBaseVersion $ Version.makeVersion []
-- "0.0.0"
-- >>> renderVersion . fromBaseVersion $ Version.makeVersion [1]
-- "1.0.0"
-- >>> renderVersion . fromBaseVersion $ Version.makeVersion [1, 2]
-- "1.2.0"
--
-- Extra version components are ignored.
--
-- >>> renderVersion . fromBaseVersion $ Version.makeVersion [1, 2, 3, 4]
-- "1.2.3"
--
-- Tags are ignored.
--
-- >>> renderVersion . fromBaseVersion $ Version.Version [] ["ignored"]
-- "0.0.0"
fromBaseVersion :: Version.Version -> Version
fromBaseVersion :: Version -> Version
fromBaseVersion Version
v = case Version -> [Int]
Version.versionBranch Version
v of
  (Int
m : Int
n : Int
p : [Int]
_) -> Word64 -> Word64 -> Word64 -> Version
mkV (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p)
  (Int
m : Int
n : [Int]
_) -> Word64 -> Word64 -> Word64 -> Version
mkV (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Word64
0
  (Int
m : [Int]
_) -> Word64 -> Word64 -> Word64 -> Version
mkV (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) Word64
0 Word64
0
  [Int]
_ -> Word64 -> Word64 -> Word64 -> Version
mkV Word64
0 Word64
0 Word64
0

-- | Converts to a 'Version.Version' from the @base@ package.
--
-- >>> toBaseVersion <$> parseVersion "1.2.3"
-- Just (Version {versionBranch = [1,2,3], versionTags = []})
--
-- Pre-releases and builds are converted to tags.
--
-- >>> toBaseVersion <$> parseVersion "1.2.3-pre+build"
-- Just (Version {versionBranch = [1,2,3], versionTags = ["pre","build"]})
toBaseVersion :: Version -> Version.Version
toBaseVersion :: Version -> Version
toBaseVersion Version
v = [Int] -> [String] -> Version
Version.Version
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral [Version -> Word64
versionMajor Version
v, Version -> Word64
versionMinor Version
v, Version -> Word64
versionPatch Version
v])
  (forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PreRelease -> String
renderPreRelease (Version -> [PreRelease]
versionPreReleases Version
v)
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Build -> String
renderBuild (Version -> [Build]
versionBuilds Version
v)
    ]
  )

-- | Increments the major version number.
--
-- >>> bumpMajor <$> parseVersion "0.0.0"
-- Just (Version {versionMajor = 1, versionMinor = 0, versionPatch = 0, versionPreReleases = [], versionBuilds = []})
--
-- The minor and patch numbers are reset to zero.
--
-- >>> bumpMajor <$> parseVersion "1.2.3"
-- Just (Version {versionMajor = 2, versionMinor = 0, versionPatch = 0, versionPreReleases = [], versionBuilds = []})
--
-- The pre-releases and builds are removed.
--
-- >>> bumpMajor <$> parseVersion "0.0.0-pre+build"
-- Just (Version {versionMajor = 1, versionMinor = 0, versionPatch = 0, versionPreReleases = [], versionBuilds = []})
--
-- Consider using 'majorLens' if you want to arbitrarily change the major
-- number, or if you don't want the other parts of the version to change.
bumpMajor :: Version -> Version
bumpMajor :: Version -> Version
bumpMajor Version
v = Word64 -> Word64 -> Word64 -> [PreRelease] -> [Build] -> Version
makeVersion (Version -> Word64
versionMajor Version
v forall a. Num a => a -> a -> a
+ Word64
1) Word64
0 Word64
0 [] []

-- | Increments the minor version number.
--
-- >>> bumpMinor <$> parseVersion "0.0.0"
-- Just (Version {versionMajor = 0, versionMinor = 1, versionPatch = 0, versionPreReleases = [], versionBuilds = []})
--
-- The patch number is reset to zero.
--
-- >>> bumpMinor <$> parseVersion "1.2.3"
-- Just (Version {versionMajor = 1, versionMinor = 3, versionPatch = 0, versionPreReleases = [], versionBuilds = []})
--
-- The pre-releases and builds are removed.
--
-- >>> bumpMinor <$> parseVersion "0.0.0-pre+build"
-- Just (Version {versionMajor = 0, versionMinor = 1, versionPatch = 0, versionPreReleases = [], versionBuilds = []})
--
-- Consider using 'minorLens' if you want to arbitrarily change the minor
-- number, or if you don't want the other parts of the version to change.
bumpMinor :: Version -> Version
bumpMinor :: Version -> Version
bumpMinor Version
v = Word64 -> Word64 -> Word64 -> [PreRelease] -> [Build] -> Version
makeVersion (Version -> Word64
versionMajor Version
v) (Version -> Word64
versionMinor Version
v forall a. Num a => a -> a -> a
+ Word64
1) Word64
0 [] []

-- | Increments the patch number.
--
-- >>> bumpPatch <$> parseVersion "0.0.0"
-- Just (Version {versionMajor = 0, versionMinor = 0, versionPatch = 1, versionPreReleases = [], versionBuilds = []})
--
-- The major and minor numbers are not changed.
--
-- >>> bumpPatch <$> parseVersion "1.2.3"
-- Just (Version {versionMajor = 1, versionMinor = 2, versionPatch = 4, versionPreReleases = [], versionBuilds = []})
--
-- The pre-releases and builds are removed.
--
-- >>> bumpPatch <$> parseVersion "0.0.0-pre+build"
-- Just (Version {versionMajor = 0, versionMinor = 0, versionPatch = 1, versionPreReleases = [], versionBuilds = []})
--
-- Consider using 'patchLens' if you want to arbitrarily change the patch
-- number, or if you don't want the other parts of the version to change.
bumpPatch :: Version -> Version
bumpPatch :: Version -> Version
bumpPatch Version
v =
  Word64 -> Word64 -> Word64 -> [PreRelease] -> [Build] -> Version
makeVersion (Version -> Word64
versionMajor Version
v) (Version -> Word64
versionMinor Version
v) (Version -> Word64
versionPatch Version
v forall a. Num a => a -> a -> a
+ Word64
1) [] []

-- | Returns 'True' if the version satisfies the constraint, 'False' otherwise.
--
-- >>> satisfiesConstraint <$> parseConstraint ">1.2.0" <*> parseVersion "1.2.3"
-- Just True
satisfiesConstraint :: Constraint -> Version -> Bool
satisfiesConstraint :: Constraint -> Version -> Bool
satisfiesConstraint Constraint
c = SimpleConstraint -> Version -> Bool
satisfiesSC (Constraint -> SimpleConstraint
toSC Constraint
c)

-- | Focuses on the major version number.
--
-- >>> view majorLens <$> parseVersion "1.2.3-pre.4+build.5"
-- Just 1
-- >>> set majorLens 4 <$> parseVersion "1.2.3"
-- Just (Version {versionMajor = 4, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})
majorLens
  :: Functor f => (Word.Word64 -> f Word.Word64) -> Version -> f Version
majorLens :: forall (f :: * -> *).
Functor f =>
(Word64 -> f Word64) -> Version -> f Version
majorLens Word64 -> f Word64
f Version
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
m -> Version
v { versionMajor :: Word64
versionMajor = Word64
m }) (Word64 -> f Word64
f (Version -> Word64
versionMajor Version
v))

-- | Focuses on the minor version number.
--
-- >>> view minorLens <$> parseVersion "1.2.3-pre.4+build.5"
-- Just 2
-- >>> set minorLens 4 <$> parseVersion "1.2.3"
-- Just (Version {versionMajor = 1, versionMinor = 4, versionPatch = 3, versionPreReleases = [], versionBuilds = []})
minorLens
  :: Functor f => (Word.Word64 -> f Word.Word64) -> Version -> f Version
minorLens :: forall (f :: * -> *).
Functor f =>
(Word64 -> f Word64) -> Version -> f Version
minorLens Word64 -> f Word64
f Version
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
n -> Version
v { versionMinor :: Word64
versionMinor = Word64
n }) (Word64 -> f Word64
f (Version -> Word64
versionMinor Version
v))

-- | Focuses on the patch version number.
--
-- >>> view patchLens <$> parseVersion "1.2.3-pre.4+build.5"
-- Just 3
-- >>> set patchLens 4 <$> parseVersion "1.2.3"
-- Just (Version {versionMajor = 1, versionMinor = 2, versionPatch = 4, versionPreReleases = [], versionBuilds = []})
patchLens
  :: Functor f => (Word.Word64 -> f Word.Word64) -> Version -> f Version
patchLens :: forall (f :: * -> *).
Functor f =>
(Word64 -> f Word64) -> Version -> f Version
patchLens Word64 -> f Word64
f Version
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
p -> Version
v { versionPatch :: Word64
versionPatch = Word64
p }) (Word64 -> f Word64
f (Version -> Word64
versionPatch Version
v))

-- | Focuses on the pre-release identifiers.
--
-- >>> view preReleasesLens <$> parseVersion "1.2.3-pre.4+build.5"
-- Just [PreReleaseTextual "pre",PreReleaseNumeric 4]
-- >>> set preReleasesLens [] <$> parseVersion "1.2.3-pre"
-- Just (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})
preReleasesLens
  :: Functor f => ([PreRelease] -> f [PreRelease]) -> Version -> f Version
preReleasesLens :: forall (f :: * -> *).
Functor f =>
([PreRelease] -> f [PreRelease]) -> Version -> f Version
preReleasesLens [PreRelease] -> f [PreRelease]
f Version
v =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[PreRelease]
ps -> Version
v { versionPreReleases :: [PreRelease]
versionPreReleases = [PreRelease]
ps }) ([PreRelease] -> f [PreRelease]
f (Version -> [PreRelease]
versionPreReleases Version
v))

-- | Focuses on the build metadata.
--
-- >>> view buildsLens <$> parseVersion "1.2.3-pre.4+build.5"
-- Just [Build "build",Build "5"]
-- >>> set buildsLens [] <$> parseVersion "1.2.3+build"
-- Just (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})
buildsLens :: Functor f => ([Build] -> f [Build]) -> Version -> f Version
buildsLens :: forall (f :: * -> *).
Functor f =>
([Build] -> f [Build]) -> Version -> f Version
buildsLens [Build] -> f [Build]
f Version
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Build]
bs -> Version
v { versionBuilds :: [Build]
versionBuilds = [Build]
bs }) ([Build] -> f [Build]
f (Version -> [Build]
versionBuilds Version
v))

-- * Private

-- ** Types

data Operator
  = OperatorLT
  | OperatorLE
  | OperatorEQ
  | OperatorGE
  | OperatorGT
  | OperatorTilde
  | OperatorCaret
  deriving (Typeable Operator
Operator -> DataType
Operator -> Constr
(forall b. Data b => b -> b) -> Operator -> Operator
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) -> Operator -> u
forall u. (forall d. Data d => d -> u) -> Operator -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Operator -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Operator -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Operator -> m Operator
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Operator -> m Operator
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Operator
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Operator -> c Operator
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Operator)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Operator)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Operator -> m Operator
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Operator -> m Operator
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Operator -> m Operator
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Operator -> m Operator
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Operator -> m Operator
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Operator -> m Operator
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Operator -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Operator -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Operator -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Operator -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Operator -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Operator -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Operator -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Operator -> r
gmapT :: (forall b. Data b => b -> b) -> Operator -> Operator
$cgmapT :: (forall b. Data b => b -> b) -> Operator -> Operator
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Operator)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Operator)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Operator)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Operator)
dataTypeOf :: Operator -> DataType
$cdataTypeOf :: Operator -> DataType
toConstr :: Operator -> Constr
$ctoConstr :: Operator -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Operator
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Operator
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Operator -> c Operator
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Operator -> c Operator
Data.Data, Operator -> Operator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c== :: Operator -> Operator -> Bool
Eq, forall x. Rep Operator x -> Operator
forall x. Operator -> Rep Operator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Operator x -> Operator
$cfrom :: forall x. Operator -> Rep Operator x
Generics.Generic, Eq Operator
Operator -> Operator -> Bool
Operator -> Operator -> Ordering
Operator -> Operator -> Operator
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 :: Operator -> Operator -> Operator
$cmin :: Operator -> Operator -> Operator
max :: Operator -> Operator -> Operator
$cmax :: Operator -> Operator -> Operator
>= :: Operator -> Operator -> Bool
$c>= :: Operator -> Operator -> Bool
> :: Operator -> Operator -> Bool
$c> :: Operator -> Operator -> Bool
<= :: Operator -> Operator -> Bool
$c<= :: Operator -> Operator -> Bool
< :: Operator -> Operator -> Bool
$c< :: Operator -> Operator -> Bool
compare :: Operator -> Operator -> Ordering
$ccompare :: Operator -> Operator -> Ordering
Ord, ReadPrec [Operator]
ReadPrec Operator
Int -> ReadS Operator
ReadS [Operator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Operator]
$creadListPrec :: ReadPrec [Operator]
readPrec :: ReadPrec Operator
$creadPrec :: ReadPrec Operator
readList :: ReadS [Operator]
$creadList :: ReadS [Operator]
readsPrec :: Int -> ReadS Operator
$creadsPrec :: Int -> ReadS Operator
Read, Int -> Operator -> ShowS
[Operator] -> ShowS
Operator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operator] -> ShowS
$cshowList :: [Operator] -> ShowS
show :: Operator -> String
$cshow :: Operator -> String
showsPrec :: Int -> Operator -> ShowS
$cshowsPrec :: Int -> Operator -> ShowS
Show)

data Wildcard
  = WildcardMajor
  | WildcardMinor Word.Word64
  | WildcardPatch Word.Word64 Word.Word64
  deriving (Typeable Wildcard
Wildcard -> DataType
Wildcard -> Constr
(forall b. Data b => b -> b) -> Wildcard -> Wildcard
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) -> Wildcard -> u
forall u. (forall d. Data d => d -> u) -> Wildcard -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Wildcard -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Wildcard -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Wildcard -> m Wildcard
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wildcard -> m Wildcard
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wildcard
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wildcard -> c Wildcard
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Wildcard)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wildcard)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wildcard -> m Wildcard
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wildcard -> m Wildcard
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wildcard -> m Wildcard
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wildcard -> m Wildcard
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Wildcard -> m Wildcard
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Wildcard -> m Wildcard
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Wildcard -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Wildcard -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Wildcard -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Wildcard -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Wildcard -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Wildcard -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Wildcard -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Wildcard -> r
gmapT :: (forall b. Data b => b -> b) -> Wildcard -> Wildcard
$cgmapT :: (forall b. Data b => b -> b) -> Wildcard -> Wildcard
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wildcard)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wildcard)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Wildcard)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Wildcard)
dataTypeOf :: Wildcard -> DataType
$cdataTypeOf :: Wildcard -> DataType
toConstr :: Wildcard -> Constr
$ctoConstr :: Wildcard -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wildcard
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wildcard
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wildcard -> c Wildcard
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wildcard -> c Wildcard
Data.Data, Wildcard -> Wildcard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wildcard -> Wildcard -> Bool
$c/= :: Wildcard -> Wildcard -> Bool
== :: Wildcard -> Wildcard -> Bool
$c== :: Wildcard -> Wildcard -> Bool
Eq, forall x. Rep Wildcard x -> Wildcard
forall x. Wildcard -> Rep Wildcard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Wildcard x -> Wildcard
$cfrom :: forall x. Wildcard -> Rep Wildcard x
Generics.Generic, Eq Wildcard
Wildcard -> Wildcard -> Bool
Wildcard -> Wildcard -> Ordering
Wildcard -> Wildcard -> Wildcard
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 :: Wildcard -> Wildcard -> Wildcard
$cmin :: Wildcard -> Wildcard -> Wildcard
max :: Wildcard -> Wildcard -> Wildcard
$cmax :: Wildcard -> Wildcard -> Wildcard
>= :: Wildcard -> Wildcard -> Bool
$c>= :: Wildcard -> Wildcard -> Bool
> :: Wildcard -> Wildcard -> Bool
$c> :: Wildcard -> Wildcard -> Bool
<= :: Wildcard -> Wildcard -> Bool
$c<= :: Wildcard -> Wildcard -> Bool
< :: Wildcard -> Wildcard -> Bool
$c< :: Wildcard -> Wildcard -> Bool
compare :: Wildcard -> Wildcard -> Ordering
$ccompare :: Wildcard -> Wildcard -> Ordering
Ord, ReadPrec [Wildcard]
ReadPrec Wildcard
Int -> ReadS Wildcard
ReadS [Wildcard]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Wildcard]
$creadListPrec :: ReadPrec [Wildcard]
readPrec :: ReadPrec Wildcard
$creadPrec :: ReadPrec Wildcard
readList :: ReadS [Wildcard]
$creadList :: ReadS [Wildcard]
readsPrec :: Int -> ReadS Wildcard
$creadsPrec :: Int -> ReadS Wildcard
Read, Int -> Wildcard -> ShowS
[Wildcard] -> ShowS
Wildcard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wildcard] -> ShowS
$cshowList :: [Wildcard] -> ShowS
show :: Wildcard -> String
$cshow :: Wildcard -> String
showsPrec :: Int -> Wildcard -> ShowS
$cshowsPrec :: Int -> Wildcard -> ShowS
Show)

-- ** Constructors

-- | Makes a new constraint that must be less than the version number.
--
-- >>> constraintLT <$> parseVersion "1.2.3"
-- Just (ConstraintOperator OperatorLT (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
-- >>> parseConstraint "<1.2.3"
-- Just (ConstraintOperator OperatorLT (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
constraintLT :: Version -> Constraint
constraintLT :: Version -> Constraint
constraintLT = Operator -> Version -> Constraint
ConstraintOperator Operator
OperatorLT

-- | Makes a new constraint that must be less than or euqal to the version
-- number.
--
-- >>> constraintLE <$> parseVersion "1.2.3"
-- Just (ConstraintOperator OperatorLE (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
-- >>> parseConstraint "<=1.2.3"
-- Just (ConstraintOperator OperatorLE (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
constraintLE :: Version -> Constraint
constraintLE :: Version -> Constraint
constraintLE = Operator -> Version -> Constraint
ConstraintOperator Operator
OperatorLE

-- | Makes a new constraint that must be equal to the version number.
--
-- >>> constraintEQ <$> parseVersion "1.2.3"
-- Just (ConstraintOperator OperatorEQ (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
-- >>> parseConstraint "=1.2.3"
-- Just (ConstraintOperator OperatorEQ (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
constraintEQ :: Version -> Constraint
constraintEQ :: Version -> Constraint
constraintEQ = Operator -> Version -> Constraint
ConstraintOperator Operator
OperatorEQ

-- | Makes a new constraint that must be greater than or equal to the version
-- number.
--
-- >>> constraintGE <$> parseVersion "1.2.3"
-- Just (ConstraintOperator OperatorGE (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
-- >>> parseConstraint ">=1.2.3"
-- Just (ConstraintOperator OperatorGE (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
constraintGE :: Version -> Constraint
constraintGE :: Version -> Constraint
constraintGE = Operator -> Version -> Constraint
ConstraintOperator Operator
OperatorGE

-- | Makes a new constraint that must be greater than the version number.
--
-- >>> constraintGT <$> parseVersion "1.2.3"
-- Just (ConstraintOperator OperatorGT (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
-- >>> parseConstraint ">1.2.3"
-- Just (ConstraintOperator OperatorGT (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
constraintGT :: Version -> Constraint
constraintGT :: Version -> Constraint
constraintGT = Operator -> Version -> Constraint
ConstraintOperator Operator
OperatorGT

-- | Makes a new constraint that must satisfy both constraints.
--
-- >>> constraintAnd <$> (constraintGE <$> parseVersion "1.2.3") <*> (constraintLT <$> parseVersion "2.0.0")
-- Just (ConstraintAnd (ConstraintOperator OperatorGE (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})) (ConstraintOperator OperatorLT (Version {versionMajor = 2, versionMinor = 0, versionPatch = 0, versionPreReleases = [], versionBuilds = []})))
-- >>> parseConstraint ">=1.2.3 <2.0.0"
-- Just (ConstraintAnd (ConstraintOperator OperatorGE (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})) (ConstraintOperator OperatorLT (Version {versionMajor = 2, versionMinor = 0, versionPatch = 0, versionPreReleases = [], versionBuilds = []})))
constraintAnd :: Constraint -> Constraint -> Constraint
constraintAnd :: Constraint -> Constraint -> Constraint
constraintAnd = Constraint -> Constraint -> Constraint
ConstraintAnd

-- | Makes a new constraint that must satisfy either constraint.
--
-- >>> constraintOr <$> (constraintEQ <$> parseVersion "1.2.3") <*> (constraintGT <$> parseVersion "1.2.3")
-- Just (ConstraintOr (ConstraintOperator OperatorEQ (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})) (ConstraintOperator OperatorGT (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})))
-- >>> parseConstraint "=1.2.3 || >1.2.3"
-- Just (ConstraintOr (ConstraintOperator OperatorEQ (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})) (ConstraintOperator OperatorGT (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []})))
constraintOr :: Constraint -> Constraint -> Constraint
constraintOr :: Constraint -> Constraint -> Constraint
constraintOr = Constraint -> Constraint -> Constraint
ConstraintOr

-- | Makes a new constraint that must be between the versions, inclusive.
--
-- >>> constraintHyphen <$> parseVersion "1.2.3" <*> parseVersion "2.3.4"
-- Just (ConstraintHyphen (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}) (Version {versionMajor = 2, versionMinor = 3, versionPatch = 4, versionPreReleases = [], versionBuilds = []}))
-- >>> parseConstraint "1.2.3 - 2.3.4"
-- Just (ConstraintHyphen (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}) (Version {versionMajor = 2, versionMinor = 3, versionPatch = 4, versionPreReleases = [], versionBuilds = []}))
constraintHyphen :: Version -> Version -> Constraint
constraintHyphen :: Version -> Version -> Constraint
constraintHyphen = Version -> Version -> Constraint
ConstraintHyphen

-- | Makes a new constraint that allows changes to the patch version number.
--
-- >>> constraintTilde <$> parseVersion "1.2.3"
-- Just (ConstraintOperator OperatorTilde (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
-- >>> parseConstraint "~1.2.3"
-- Just (ConstraintOperator OperatorTilde (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
constraintTilde :: Version -> Constraint
constraintTilde :: Version -> Constraint
constraintTilde = Operator -> Version -> Constraint
ConstraintOperator Operator
OperatorTilde

-- | Makes a new constraint that allows changes that do not modify the
-- left-most non-zero version number.
--
-- >>> constraintCaret <$> parseVersion "1.2.3"
-- Just (ConstraintOperator OperatorCaret (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
-- >>> parseConstraint "^1.2.3"
-- Just (ConstraintOperator OperatorCaret (Version {versionMajor = 1, versionMinor = 2, versionPatch = 3, versionPreReleases = [], versionBuilds = []}))
constraintCaret :: Version -> Constraint
constraintCaret :: Version -> Constraint
constraintCaret = Operator -> Version -> Constraint
ConstraintOperator Operator
OperatorCaret

-- ** Parsing

versionP :: ReadP.ReadP Version
versionP :: ReadP Version
versionP = do
  Word64
major <- ReadP Word64
numberP
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  Word64
minor <- ReadP Word64
numberP
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  Word64
patch <- ReadP Word64
numberP
  [PreRelease]
preReleases <- ReadP [PreRelease]
preReleasesP
  Word64 -> Word64 -> Word64 -> [PreRelease] -> [Build] -> Version
makeVersion Word64
major Word64
minor Word64
patch [PreRelease]
preReleases forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP [Build]
buildsP

preReleasesP :: ReadP.ReadP [PreRelease]
preReleasesP :: ReadP [PreRelease]
preReleasesP = forall a. a -> ReadP a -> ReadP a
ReadP.option
  []
  (do
    forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'-')
    forall a sep. ReadP a -> ReadP sep -> ReadP [a]
ReadP.sepBy1 ReadP PreRelease
preReleaseP (Char -> ReadP Char
ReadP.char Char
'.')
  )

preReleaseP :: ReadP.ReadP PreRelease
preReleaseP :: ReadP PreRelease
preReleaseP = ReadP PreRelease
preReleaseNumberP forall a. ReadP a -> ReadP a -> ReadP a
ReadP.<++ ReadP PreRelease
preReleaseStringP

preReleaseNumberP :: ReadP.ReadP PreRelease
preReleaseNumberP :: ReadP PreRelease
preReleaseNumberP = Word64 -> PreRelease
PreReleaseNumeric forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Word64
numberP

preReleaseStringP :: ReadP.ReadP PreRelease
preReleaseStringP :: ReadP PreRelease
preReleaseStringP = do
  String
s <- (Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
isIdentifier
  if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
Char.isDigit String
s then forall a. ReadP a
ReadP.pfail else forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PreRelease
PreReleaseTextual String
s)

buildsP :: ReadP.ReadP [Build]
buildsP :: ReadP [Build]
buildsP = forall a. a -> ReadP a -> ReadP a
ReadP.option
  []
  (do
    forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'+')
    forall a sep. ReadP a -> ReadP sep -> ReadP [a]
ReadP.sepBy1 ReadP Build
buildP (Char -> ReadP Char
ReadP.char Char
'.')
  )

buildP :: ReadP.ReadP Build
buildP :: ReadP Build
buildP = do
  String
b <- (Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
isIdentifier
  forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Build
Build String
b)

numberP :: ReadP.ReadP Word.Word64
numberP :: ReadP Word64
numberP = ReadP Word64
zeroP forall a. ReadP a -> ReadP a -> ReadP a
ReadP.<++ ReadP Word64
nonZeroP

zeroP :: ReadP.ReadP Word.Word64
zeroP :: ReadP Word64
zeroP = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'0')
  forall (m :: * -> *) a. Monad m => a -> m a
return Word64
0

nonZeroP :: ReadP.ReadP Word.Word64
nonZeroP :: ReadP Word64
nonZeroP = do
  Char
x <- (Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isAsciiDigitNonZero
  String
ys <- (Char -> Bool) -> ReadP String
ReadP.munch Char -> Bool
Char.isDigit
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadP a
ReadP.pfail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Word64
toWord64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => String -> a
stringToIntegral forall a b. (a -> b) -> a -> b
$ Char
x forall a. a -> [a] -> [a]
: String
ys

constraintsP :: ReadP.ReadP Constraint
constraintsP :: ReadP Constraint
constraintsP = do
  ReadP ()
spacesP
  [Constraint]
cs <- forall a sep. ReadP a -> ReadP sep -> ReadP [a]
ReadP.sepBy1 ReadP Constraint
constraintP ReadP ()
orP
  ReadP ()
spacesP
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Constraint -> Constraint -> Constraint
constraintOr [Constraint]
cs)

constraintP :: ReadP.ReadP Constraint
constraintP :: ReadP Constraint
constraintP = do
  [Constraint]
cs <- forall a sep. ReadP a -> ReadP sep -> ReadP [a]
ReadP.sepBy1 ReadP Constraint
simpleP ReadP ()
spaces1P
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Constraint -> Constraint -> Constraint
constraintAnd [Constraint]
cs)

hyphenatedP :: ReadP.ReadP Constraint
hyphenatedP :: ReadP Constraint
hyphenatedP = do
  Version
v <- ReadP Version
versionP
  ReadP ()
hyphenP
  Version -> Version -> Constraint
constraintHyphen Version
v forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Version
versionP

simpleP :: ReadP.ReadP Constraint
simpleP :: ReadP Constraint
simpleP = forall a. [ReadP a] -> ReadP a
ReadP.choice [ReadP Constraint
hyphenatedP, ReadP Constraint
wildcardConstraintP, ReadP Constraint
primitiveP]

wildcardConstraintP :: ReadP.ReadP Constraint
wildcardConstraintP :: ReadP Constraint
wildcardConstraintP = do
  forall a. ReadP a -> ReadP ()
ReadP.optional (Char -> ReadP Char
ReadP.char Char
'=')
  Wildcard -> Constraint
ConstraintWildcard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Wildcard
wildcardP

wildcardP :: ReadP.ReadP Wildcard
wildcardP :: ReadP Wildcard
wildcardP = forall a. [ReadP a] -> ReadP a
ReadP.choice [ReadP Wildcard
wildcardPatchP, ReadP Wildcard
wildcardMinorP, ReadP Wildcard
wildcardMajorP]

wildcardPatchP :: ReadP.ReadP Wildcard
wildcardPatchP :: ReadP Wildcard
wildcardPatchP = do
  Word64
m <- ReadP Word64
numberP
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  Word64
n <- ReadP Word64
numberP
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Wildcard
WildcardPatch Word64
m Word64
n)

wildcardMinorP :: ReadP.ReadP Wildcard
wildcardMinorP :: ReadP Wildcard
wildcardMinorP = do
  Word64
m <- ReadP Word64
numberP
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Wildcard
WildcardMinor Word64
m)

wildcardMajorP :: ReadP.ReadP Wildcard
wildcardMajorP :: ReadP Wildcard
wildcardMajorP = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  forall (m :: * -> *) a. Monad m => a -> m a
return Wildcard
WildcardMajor

primitiveP :: ReadP.ReadP Constraint
primitiveP :: ReadP Constraint
primitiveP = do
  Operator
o <- ReadP Operator
operatorP
  ReadP ()
spacesP
  Operator -> Version -> Constraint
ConstraintOperator Operator
o forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Version
versionP

operatorP :: ReadP.ReadP Operator
operatorP :: ReadP Operator
operatorP = forall a. [ReadP a] -> ReadP a
ReadP.choice
  [ String -> ReadP String
ReadP.string String
"<=" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Operator
OperatorLE
  , String -> ReadP String
ReadP.string String
">=" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Operator
OperatorGE
  , Char -> ReadP Char
ReadP.char Char
'<' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Operator
OperatorLT
  , Char -> ReadP Char
ReadP.char Char
'>' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Operator
OperatorGT
  , Char -> ReadP Char
ReadP.char Char
'=' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Operator
OperatorEQ
  , Char -> ReadP Char
ReadP.char Char
'^' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Operator
OperatorCaret
  , Char -> ReadP Char
ReadP.char Char
'~' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Operator
OperatorTilde
  , forall (m :: * -> *) a. Monad m => a -> m a
return Operator
OperatorEQ
  ]

hyphenP :: ReadP.ReadP ()
hyphenP :: ReadP ()
hyphenP = do
  ReadP ()
spaces1P
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'-')
  ReadP ()
spaces1P

orP :: ReadP.ReadP ()
orP :: ReadP ()
orP = do
  ReadP ()
spaces1P
  forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (String -> ReadP String
ReadP.string String
"||")
  ReadP ()
spaces1P

spaces1P :: ReadP.ReadP ()
spaces1P :: ReadP ()
spaces1P = forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP String
ReadP.munch1 (forall a. Eq a => a -> a -> Bool
== Char
' '))

spacesP :: ReadP.ReadP ()
spacesP :: ReadP ()
spacesP = forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP String
ReadP.munch (forall a. Eq a => a -> a -> Bool
== Char
' '))

-- ** Rendering

renderPreReleases :: [PreRelease] -> String
renderPreReleases :: [PreRelease] -> String
renderPreReleases [PreRelease]
ps =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PreRelease]
ps then String
"" else Char
'-' forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PreRelease -> String
renderPreRelease [PreRelease]
ps)

renderBuilds :: [Build] -> String
renderBuilds :: [Build] -> String
renderBuilds [Build]
bs =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Build]
bs then String
"" else Char
'+' forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Build -> String
renderBuild [Build]
bs)

-- ** Helpers

both :: (a -> b) -> (a, a) -> (b, b)
both :: forall a b. (a -> b) -> (a, a) -> (b, b)
both a -> b
f (a
x, a
y) = (a -> b
f a
x, a -> b
f a
y)

isAsciiDigitNonZero :: Char -> Bool
isAsciiDigitNonZero :: Char -> Bool
isAsciiDigitNonZero Char
c = Char -> Bool
Char.isDigit Char
c Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'0')

isIdentifier :: Char -> Bool
isIdentifier :: Char -> Bool
isIdentifier Char
c = (Char -> Bool
Char.isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
Char.isAlphaNum Char
c) Bool -> Bool -> Bool
|| (Char
c forall a. Eq a => a -> a -> Bool
== Char
'-')

isWildcard :: Char -> Bool
isWildcard :: Char -> Bool
isWildcard Char
c = (Char
c forall a. Eq a => a -> a -> Bool
== Char
'x') Bool -> Bool -> Bool
|| (Char
c forall a. Eq a => a -> a -> Bool
== Char
'*') Bool -> Bool -> Bool
|| (Char
c forall a. Eq a => a -> a -> Bool
== Char
'X')

parse :: ReadP.ReadP a -> String -> Maybe a
parse :: forall a. ReadP a -> String -> Maybe a
parse ReadP a
p String
s =
  let p' :: ReadS a
p' = forall a. ReadP a -> ReadS a
ReadP.readP_to_S ReadP a
p
  in
    forall a. [a] -> Maybe a
Maybe.listToMaybe
      (do
        (a
x, String
"") <- ReadS a
p' String
s
        forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      )

stringToIntegral :: Integral a => String -> a
stringToIntegral :: forall a. Integral a => String -> a
stringToIntegral =
  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
n Char
d -> (a
n forall a. Num a => a -> a -> a
* a
10) forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Char
d) forall a. Num a => a -> a -> a
- a
48)) a
0

toWord64 :: Integer -> Maybe Word.Word64
toWord64 :: Integer -> Maybe Word64
toWord64 Integer
n
  | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a. Maybe a
Nothing
  | Integer
n forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word.Word64) = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)

-- * Simple constraints
-- | Simple constraints are just as expressive as 'Constraint's, but they are
-- easier to reason about. You can think of them as the desugared version of
-- 'Constraint's.

data SimpleConstraint
  = SCLT Version
  | SCEQ Version
  | SCGT Version
  | SCAnd SimpleConstraint SimpleConstraint
  | SCOr SimpleConstraint SimpleConstraint
  deriving (Typeable SimpleConstraint
SimpleConstraint -> DataType
SimpleConstraint -> Constr
(forall b. Data b => b -> b)
-> SimpleConstraint -> SimpleConstraint
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) -> SimpleConstraint -> u
forall u. (forall d. Data d => d -> u) -> SimpleConstraint -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleConstraint -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleConstraint -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SimpleConstraint -> m SimpleConstraint
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleConstraint -> m SimpleConstraint
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleConstraint
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleConstraint -> c SimpleConstraint
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleConstraint)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleConstraint)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleConstraint -> m SimpleConstraint
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleConstraint -> m SimpleConstraint
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleConstraint -> m SimpleConstraint
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleConstraint -> m SimpleConstraint
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SimpleConstraint -> m SimpleConstraint
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SimpleConstraint -> m SimpleConstraint
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SimpleConstraint -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SimpleConstraint -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SimpleConstraint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SimpleConstraint -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleConstraint -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleConstraint -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleConstraint -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleConstraint -> r
gmapT :: (forall b. Data b => b -> b)
-> SimpleConstraint -> SimpleConstraint
$cgmapT :: (forall b. Data b => b -> b)
-> SimpleConstraint -> SimpleConstraint
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleConstraint)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleConstraint)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleConstraint)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleConstraint)
dataTypeOf :: SimpleConstraint -> DataType
$cdataTypeOf :: SimpleConstraint -> DataType
toConstr :: SimpleConstraint -> Constr
$ctoConstr :: SimpleConstraint -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleConstraint
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleConstraint
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleConstraint -> c SimpleConstraint
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleConstraint -> c SimpleConstraint
Data.Data, SimpleConstraint -> SimpleConstraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleConstraint -> SimpleConstraint -> Bool
$c/= :: SimpleConstraint -> SimpleConstraint -> Bool
== :: SimpleConstraint -> SimpleConstraint -> Bool
$c== :: SimpleConstraint -> SimpleConstraint -> Bool
Eq, forall x. Rep SimpleConstraint x -> SimpleConstraint
forall x. SimpleConstraint -> Rep SimpleConstraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimpleConstraint x -> SimpleConstraint
$cfrom :: forall x. SimpleConstraint -> Rep SimpleConstraint x
Generics.Generic, Eq SimpleConstraint
SimpleConstraint -> SimpleConstraint -> Bool
SimpleConstraint -> SimpleConstraint -> Ordering
SimpleConstraint -> SimpleConstraint -> SimpleConstraint
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 :: SimpleConstraint -> SimpleConstraint -> SimpleConstraint
$cmin :: SimpleConstraint -> SimpleConstraint -> SimpleConstraint
max :: SimpleConstraint -> SimpleConstraint -> SimpleConstraint
$cmax :: SimpleConstraint -> SimpleConstraint -> SimpleConstraint
>= :: SimpleConstraint -> SimpleConstraint -> Bool
$c>= :: SimpleConstraint -> SimpleConstraint -> Bool
> :: SimpleConstraint -> SimpleConstraint -> Bool
$c> :: SimpleConstraint -> SimpleConstraint -> Bool
<= :: SimpleConstraint -> SimpleConstraint -> Bool
$c<= :: SimpleConstraint -> SimpleConstraint -> Bool
< :: SimpleConstraint -> SimpleConstraint -> Bool
$c< :: SimpleConstraint -> SimpleConstraint -> Bool
compare :: SimpleConstraint -> SimpleConstraint -> Ordering
$ccompare :: SimpleConstraint -> SimpleConstraint -> Ordering
Ord, ReadPrec [SimpleConstraint]
ReadPrec SimpleConstraint
Int -> ReadS SimpleConstraint
ReadS [SimpleConstraint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SimpleConstraint]
$creadListPrec :: ReadPrec [SimpleConstraint]
readPrec :: ReadPrec SimpleConstraint
$creadPrec :: ReadPrec SimpleConstraint
readList :: ReadS [SimpleConstraint]
$creadList :: ReadS [SimpleConstraint]
readsPrec :: Int -> ReadS SimpleConstraint
$creadsPrec :: Int -> ReadS SimpleConstraint
Read, Int -> SimpleConstraint -> ShowS
[SimpleConstraint] -> ShowS
SimpleConstraint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleConstraint] -> ShowS
$cshowList :: [SimpleConstraint] -> ShowS
show :: SimpleConstraint -> String
$cshow :: SimpleConstraint -> String
showsPrec :: Int -> SimpleConstraint -> ShowS
$cshowsPrec :: Int -> SimpleConstraint -> ShowS
Show)

mkV :: Word.Word64 -> Word.Word64 -> Word.Word64 -> Version
mkV :: Word64 -> Word64 -> Word64 -> Version
mkV Word64
m Word64
n Word64
p = Word64 -> Word64 -> Word64 -> [PreRelease] -> [Build] -> Version
makeVersion Word64
m Word64
n Word64
p [] []

{- hlint ignore satisfiesSC "Redundant compare" -}
satisfiesSC :: SimpleConstraint -> Version -> Bool
satisfiesSC :: SimpleConstraint -> Version -> Bool
satisfiesSC SimpleConstraint
c Version
v = case SimpleConstraint
c of
  SCLT Version
u -> Version
v forall a. Ord a => a -> a -> Bool
< Version
u
  -- This uses `compare` rather than `==` to ignore build metadata.
  SCEQ Version
u -> forall a. Ord a => a -> a -> Ordering
compare Version
v Version
u forall a. Eq a => a -> a -> Bool
== Ordering
EQ
  SCGT Version
u -> Version
v forall a. Ord a => a -> a -> Bool
> Version
u
  SCAnd SimpleConstraint
l SimpleConstraint
r -> SimpleConstraint -> Version -> Bool
satisfiesSC SimpleConstraint
l Version
v Bool -> Bool -> Bool
&& SimpleConstraint -> Version -> Bool
satisfiesSC SimpleConstraint
r Version
v
  SCOr SimpleConstraint
l SimpleConstraint
r -> SimpleConstraint -> Version -> Bool
satisfiesSC SimpleConstraint
l Version
v Bool -> Bool -> Bool
|| SimpleConstraint -> Version -> Bool
satisfiesSC SimpleConstraint
r Version
v

scLE :: Version -> SimpleConstraint
scLE :: Version -> SimpleConstraint
scLE Version
v = SimpleConstraint -> SimpleConstraint -> SimpleConstraint
SCOr (Version -> SimpleConstraint
SCLT Version
v) (Version -> SimpleConstraint
SCEQ Version
v)

scGE :: Version -> SimpleConstraint
scGE :: Version -> SimpleConstraint
scGE Version
v = SimpleConstraint -> SimpleConstraint -> SimpleConstraint
SCOr (Version -> SimpleConstraint
SCGT Version
v) (Version -> SimpleConstraint
SCEQ Version
v)

toSC :: Constraint -> SimpleConstraint
toSC :: Constraint -> SimpleConstraint
toSC Constraint
c = case Constraint
c of
  ConstraintOperator Operator
o Version
v -> case Operator
o of
    Operator
OperatorLT -> Version -> SimpleConstraint
SCLT Version
v
    Operator
OperatorLE -> Version -> SimpleConstraint
scLE Version
v
    Operator
OperatorEQ -> Version -> SimpleConstraint
SCEQ Version
v
    Operator
OperatorGE -> Version -> SimpleConstraint
scGE Version
v
    Operator
OperatorGT -> Version -> SimpleConstraint
SCGT Version
v
    Operator
OperatorTilde ->
      SimpleConstraint -> SimpleConstraint -> SimpleConstraint
SCAnd (Version -> SimpleConstraint
scGE Version
v) (Version -> SimpleConstraint
SCLT (Word64 -> Word64 -> Word64 -> Version
mkV (Version -> Word64
versionMajor Version
v) (Version -> Word64
versionMinor Version
v forall a. Num a => a -> a -> a
+ Word64
1) Word64
0))
    Operator
OperatorCaret -> SimpleConstraint -> SimpleConstraint -> SimpleConstraint
SCAnd
      (Version -> SimpleConstraint
scGE Version
v)
      (Version -> SimpleConstraint
SCLT
        (case (Version -> Word64
versionMajor Version
v, Version -> Word64
versionMinor Version
v, Version -> Word64
versionPatch Version
v) of
          (Word64
0, Word64
0, Word64
p) -> Word64 -> Word64 -> Word64 -> Version
mkV Word64
0 Word64
0 (Word64
p forall a. Num a => a -> a -> a
+ Word64
1)
          (Word64
0, Word64
n, Word64
_) -> Word64 -> Word64 -> Word64 -> Version
mkV Word64
0 (Word64
n forall a. Num a => a -> a -> a
+ Word64
1) Word64
0
          (Word64
m, Word64
_, Word64
_) -> Word64 -> Word64 -> Word64 -> Version
mkV (Word64
m forall a. Num a => a -> a -> a
+ Word64
1) Word64
0 Word64
0
        )
      )
  ConstraintHyphen Version
l Version
h -> SimpleConstraint -> SimpleConstraint -> SimpleConstraint
SCAnd (Version -> SimpleConstraint
scGE Version
l) (Version -> SimpleConstraint
scLE Version
h)
  ConstraintWildcard Wildcard
w -> case Wildcard
w of
    Wildcard
WildcardMajor -> Version -> SimpleConstraint
scGE Version
initialVersion
    WildcardMinor Word64
m -> SimpleConstraint -> SimpleConstraint -> SimpleConstraint
SCAnd (Version -> SimpleConstraint
scGE (Word64 -> Word64 -> Word64 -> Version
mkV Word64
m Word64
0 Word64
0)) (Version -> SimpleConstraint
SCLT (Word64 -> Word64 -> Word64 -> Version
mkV (Word64
m forall a. Num a => a -> a -> a
+ Word64
1) Word64
0 Word64
0))
    WildcardPatch Word64
m Word64
n -> SimpleConstraint -> SimpleConstraint -> SimpleConstraint
SCAnd (Version -> SimpleConstraint
scGE (Word64 -> Word64 -> Word64 -> Version
mkV Word64
m Word64
n Word64
0)) (Version -> SimpleConstraint
SCLT (Word64 -> Word64 -> Word64 -> Version
mkV Word64
m (Word64
n forall a. Num a => a -> a -> a
+ Word64
1) Word64
0))
  ConstraintAnd Constraint
l Constraint
r -> SimpleConstraint -> SimpleConstraint -> SimpleConstraint
SCAnd (Constraint -> SimpleConstraint
toSC Constraint
l) (Constraint -> SimpleConstraint
toSC Constraint
r)
  ConstraintOr Constraint
l Constraint
r -> SimpleConstraint -> SimpleConstraint -> SimpleConstraint
SCOr (Constraint -> SimpleConstraint
toSC Constraint
l) (Constraint -> SimpleConstraint
toSC Constraint
r)