{-# 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
DataType
Constr
Typeable Version
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Version -> c Version)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Version)
-> (Version -> Constr)
-> (Version -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Version -> Version)
-> (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 u. (forall d. Data d => d -> u) -> Version -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Version -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Version -> m Version)
-> Data Version
Version -> DataType
Version -> Constr
(forall b. Data b => b -> b) -> Version -> Version
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cVersion :: Constr
$tVersion :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Version -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Version -> u
gmapQ :: (forall d. Data d => d -> u) -> Version -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Version -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Version
Data.Data, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
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. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
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]
(Int -> ReadS Version)
-> ReadS [Version]
-> ReadPrec Version
-> ReadPrec [Version]
-> Read 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
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
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 = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
Monoid.mconcat
    [ (Version -> Word64) -> Version -> Version -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing Version -> Word64
versionMajor Version
x Version
y
    , (Version -> Word64) -> Version -> Version -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing Version -> Word64
versionMinor Version
x Version
y
    , (Version -> Word64) -> Version -> Version -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing Version -> Word64
versionPatch Version
x Version
y
    , case (Version -> [PreRelease])
-> (Version, Version) -> ([PreRelease], [PreRelease])
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) -> [PreRelease] -> [PreRelease] -> Ordering
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
DataType
Constr
Typeable PreRelease
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PreRelease -> c PreRelease)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PreRelease)
-> (PreRelease -> Constr)
-> (PreRelease -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> PreRelease -> PreRelease)
-> (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 u. (forall d. Data d => d -> u) -> PreRelease -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PreRelease -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PreRelease -> m PreRelease)
-> Data PreRelease
PreRelease -> DataType
PreRelease -> Constr
(forall b. Data b => b -> b) -> PreRelease -> PreRelease
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PreRelease -> c PreRelease
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cPreReleaseTextual :: Constr
$cPreReleaseNumeric :: Constr
$tPreRelease :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> PreRelease -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PreRelease -> u
gmapQ :: (forall d. Data d => d -> u) -> PreRelease -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PreRelease -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable PreRelease
Data.Data, PreRelease -> PreRelease -> Bool
(PreRelease -> PreRelease -> Bool)
-> (PreRelease -> PreRelease -> Bool) -> Eq PreRelease
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. PreRelease -> Rep PreRelease x)
-> (forall x. Rep PreRelease x -> PreRelease) -> Generic PreRelease
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]
(Int -> ReadS PreRelease)
-> ReadS [PreRelease]
-> ReadPrec PreRelease
-> ReadPrec [PreRelease]
-> Read 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
(Int -> PreRelease -> ShowS)
-> (PreRelease -> String)
-> ([PreRelease] -> ShowS)
-> Show PreRelease
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) -> Word64 -> Word64 -> Ordering
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) -> String -> String -> Ordering
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
DataType
Constr
Typeable Build
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Build -> c Build)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Build)
-> (Build -> Constr)
-> (Build -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Build -> Build)
-> (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 u. (forall d. Data d => d -> u) -> Build -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Build -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Build -> m Build)
-> Data Build
Build -> DataType
Build -> Constr
(forall b. Data b => b -> b) -> Build -> Build
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Build -> c Build
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cBuild :: Constr
$tBuild :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Build -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Build -> u
gmapQ :: (forall d. Data d => d -> u) -> Build -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Build -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Build
Data.Data, Build -> Build -> Bool
(Build -> Build -> Bool) -> (Build -> Build -> Bool) -> Eq Build
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. Build -> Rep Build x)
-> (forall x. Rep Build x -> Build) -> Generic Build
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]
(Int -> ReadS Build)
-> ReadS [Build]
-> ReadPrec Build
-> ReadPrec [Build]
-> Read 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
(Int -> Build -> ShowS)
-> (Build -> String) -> ([Build] -> ShowS) -> Show Build
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
DataType
Constr
Typeable Constraint
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Constraint -> c Constraint)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Constraint)
-> (Constraint -> Constr)
-> (Constraint -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Constraint -> Constraint)
-> (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 u. (forall d. Data d => d -> u) -> Constraint -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Constraint -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Constraint -> m Constraint)
-> Data Constraint
Constraint -> DataType
Constraint -> Constr
(forall b. Data b => b -> b) -> Constraint -> Constraint
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constraint -> c Constraint
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cConstraintOr :: Constr
$cConstraintAnd :: Constr
$cConstraintWildcard :: Constr
$cConstraintHyphen :: Constr
$cConstraintOperator :: Constr
$tConstraint :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Constraint -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Constraint -> u
gmapQ :: (forall d. Data d => d -> u) -> Constraint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Constraint -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Constraint
Data.Data, Constraint -> Constraint -> Bool
(Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool) -> Eq Constraint
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. Constraint -> Rep Constraint x)
-> (forall x. Rep Constraint x -> Constraint) -> Generic Constraint
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
Eq Constraint
-> (Constraint -> Constraint -> Ordering)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Constraint)
-> (Constraint -> Constraint -> Constraint)
-> Ord 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
$cp1Ord :: Eq Constraint
Ord, ReadPrec [Constraint]
ReadPrec Constraint
Int -> ReadS Constraint
ReadS [Constraint]
(Int -> ReadS Constraint)
-> ReadS [Constraint]
-> ReadPrec Constraint
-> ReadPrec [Constraint]
-> Read 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
(Int -> Constraint -> ShowS)
-> (Constraint -> String)
-> ([Constraint] -> ShowS)
-> Show Constraint
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 :: Word64 -> Word64 -> Word64 -> [PreRelease] -> [Build] -> Version
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 = ReadP Version -> String -> Maybe Version
forall a. ReadP a -> String -> Maybe a
parse
  (do
    ReadP ()
ReadP.skipSpaces
    Version
version <- ReadP Version
versionP
    ReadP ()
ReadP.skipSpaces
    Version -> ReadP Version
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 = ReadP PreRelease -> String -> Maybe PreRelease
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 = ReadP Build -> String -> Maybe Build
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 = ReadP Constraint -> String -> Maybe Constraint
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 -> String -> Version
forall a. HasCallStack => String -> a
error (String
"unsafeParseVersion: invalid version: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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 -> String -> PreRelease
forall a. HasCallStack => String -> a
error (String
"unsafeParsePreRelease: invalid pre-release: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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 -> String -> Build
forall a. HasCallStack => String -> a
error (String
"unsafeParseBuild: invalid build: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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 -> String -> Constraint
forall a. HasCallStack => String -> a
error (String
"unsafeParseConstraint: invalid constraint: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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 = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ Word64 -> String
forall a. Show a => a -> String
show (Version -> Word64
versionMajor Version
v)
  , String
"."
  , Word64 -> String
forall a. Show a => a -> String
show (Version -> Word64
versionMinor Version
v)
  , String
"."
  , Word64 -> 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 -> Word64 -> String
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
'<' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorLE -> Char
'<' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'=' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorEQ -> String
s
        Operator
OperatorGE -> Char
'>' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'=' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorGT -> Char
'>' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorTilde -> Char
'~' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
        Operator
OperatorCaret -> Char
'^' Char -> ShowS
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 -> Word64 -> String
forall a. Show a => a -> String
show Word64
m String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".x.x"
    WildcardPatch Word64
m Word64
n -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." [Word64 -> String
forall a. Show a => a -> String
show Word64
m, Word64 -> String
forall a. Show a => a -> String
show Word64
n, String
"x"]
  ConstraintAnd Constraint
l Constraint
r -> [String] -> String
unwords ((Constraint -> String) -> [Constraint] -> [String]
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 Word64 -> Word64 -> Bool
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 (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p)
  (Int
m : Int
n : [Int]
_) -> Word64 -> Word64 -> Word64 -> Version
mkV (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Word64
0
  (Int
m : [Int]
_) -> Word64 -> Word64 -> Word64 -> Version
mkV (Int -> Word64
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
  ((Word64 -> Int) -> [Word64] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Int
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])
  ([[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
    [ (PreRelease -> String) -> [PreRelease] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PreRelease -> String
renderPreRelease (Version -> [PreRelease]
versionPreReleases Version
v)
    , (Build -> String) -> [Build] -> [String]
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 Word64 -> Word64 -> Word64
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 Word64 -> Word64 -> Word64
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 Word64 -> Word64 -> Word64
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 :: (Word64 -> f Word64) -> Version -> f Version
majorLens Word64 -> f Word64
f Version
v = (Word64 -> Version) -> f Word64 -> f Version
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 :: (Word64 -> f Word64) -> Version -> f Version
minorLens Word64 -> f Word64
f Version
v = (Word64 -> Version) -> f Word64 -> f Version
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 :: (Word64 -> f Word64) -> Version -> f Version
patchLens Word64 -> f Word64
f Version
v = (Word64 -> Version) -> f Word64 -> f Version
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 :: ([PreRelease] -> f [PreRelease]) -> Version -> f Version
preReleasesLens [PreRelease] -> f [PreRelease]
f Version
v =
  ([PreRelease] -> Version) -> f [PreRelease] -> f Version
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 :: ([Build] -> f [Build]) -> Version -> f Version
buildsLens [Build] -> f [Build]
f Version
v = ([Build] -> Version) -> f [Build] -> f Version
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
DataType
Constr
Typeable Operator
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Operator -> c Operator)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Operator)
-> (Operator -> Constr)
-> (Operator -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Operator -> Operator)
-> (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 u. (forall d. Data d => d -> u) -> Operator -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Operator -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Operator -> m Operator)
-> Data Operator
Operator -> DataType
Operator -> Constr
(forall b. Data b => b -> b) -> Operator -> Operator
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Operator -> c Operator
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cOperatorCaret :: Constr
$cOperatorTilde :: Constr
$cOperatorGT :: Constr
$cOperatorGE :: Constr
$cOperatorEQ :: Constr
$cOperatorLE :: Constr
$cOperatorLT :: Constr
$tOperator :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Operator -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Operator -> u
gmapQ :: (forall d. Data d => d -> u) -> Operator -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Operator -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Operator
Data.Data, Operator -> Operator -> Bool
(Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool) -> Eq Operator
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. Operator -> Rep Operator x)
-> (forall x. Rep Operator x -> Operator) -> Generic Operator
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
Eq Operator
-> (Operator -> Operator -> Ordering)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Operator)
-> (Operator -> Operator -> Operator)
-> Ord 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
$cp1Ord :: Eq Operator
Ord, ReadPrec [Operator]
ReadPrec Operator
Int -> ReadS Operator
ReadS [Operator]
(Int -> ReadS Operator)
-> ReadS [Operator]
-> ReadPrec Operator
-> ReadPrec [Operator]
-> Read 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
(Int -> Operator -> ShowS)
-> (Operator -> String) -> ([Operator] -> ShowS) -> Show Operator
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
DataType
Constr
Typeable Wildcard
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Wildcard -> c Wildcard)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Wildcard)
-> (Wildcard -> Constr)
-> (Wildcard -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Wildcard -> Wildcard)
-> (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 u. (forall d. Data d => d -> u) -> Wildcard -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Wildcard -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Wildcard -> m Wildcard)
-> Data Wildcard
Wildcard -> DataType
Wildcard -> Constr
(forall b. Data b => b -> b) -> Wildcard -> Wildcard
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wildcard -> c Wildcard
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cWildcardPatch :: Constr
$cWildcardMinor :: Constr
$cWildcardMajor :: Constr
$tWildcard :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Wildcard -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Wildcard -> u
gmapQ :: (forall d. Data d => d -> u) -> Wildcard -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Wildcard -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Wildcard
Data.Data, Wildcard -> Wildcard -> Bool
(Wildcard -> Wildcard -> Bool)
-> (Wildcard -> Wildcard -> Bool) -> Eq Wildcard
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. Wildcard -> Rep Wildcard x)
-> (forall x. Rep Wildcard x -> Wildcard) -> Generic Wildcard
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
Eq Wildcard
-> (Wildcard -> Wildcard -> Ordering)
-> (Wildcard -> Wildcard -> Bool)
-> (Wildcard -> Wildcard -> Bool)
-> (Wildcard -> Wildcard -> Bool)
-> (Wildcard -> Wildcard -> Bool)
-> (Wildcard -> Wildcard -> Wildcard)
-> (Wildcard -> Wildcard -> Wildcard)
-> Ord 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
$cp1Ord :: Eq Wildcard
Ord, ReadPrec [Wildcard]
ReadPrec Wildcard
Int -> ReadS Wildcard
ReadS [Wildcard]
(Int -> ReadS Wildcard)
-> ReadS [Wildcard]
-> ReadPrec Wildcard
-> ReadPrec [Wildcard]
-> Read 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
(Int -> Wildcard -> ShowS)
-> (Wildcard -> String) -> ([Wildcard] -> ShowS) -> Show Wildcard
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
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  Word64
minor <- ReadP Word64
numberP
  ReadP Char -> ReadP ()
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 ([Build] -> Version) -> ReadP [Build] -> ReadP Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP [Build]
buildsP

preReleasesP :: ReadP.ReadP [PreRelease]
preReleasesP :: ReadP [PreRelease]
preReleasesP = [PreRelease] -> ReadP [PreRelease] -> ReadP [PreRelease]
forall a. a -> ReadP a -> ReadP a
ReadP.option
  []
  (do
    ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'-')
    ReadP PreRelease -> ReadP Char -> ReadP [PreRelease]
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 ReadP PreRelease -> ReadP PreRelease -> ReadP PreRelease
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.<++ ReadP PreRelease
preReleaseStringP

preReleaseNumberP :: ReadP.ReadP PreRelease
preReleaseNumberP :: ReadP PreRelease
preReleaseNumberP = Word64 -> PreRelease
PreReleaseNumeric (Word64 -> PreRelease) -> ReadP Word64 -> ReadP PreRelease
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 (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
Char.isDigit String
s then ReadP PreRelease
forall a. ReadP a
ReadP.pfail else PreRelease -> ReadP PreRelease
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PreRelease
PreReleaseTextual String
s)

buildsP :: ReadP.ReadP [Build]
buildsP :: ReadP [Build]
buildsP = [Build] -> ReadP [Build] -> ReadP [Build]
forall a. a -> ReadP a -> ReadP a
ReadP.option
  []
  (do
    ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'+')
    ReadP Build -> ReadP Char -> ReadP [Build]
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
  Build -> ReadP Build
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 ReadP Word64 -> ReadP Word64 -> ReadP Word64
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.<++ ReadP Word64
nonZeroP

zeroP :: ReadP.ReadP Word.Word64
zeroP :: ReadP Word64
zeroP = do
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'0')
  Word64 -> ReadP Word64
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
  ReadP Word64
-> (Word64 -> ReadP Word64) -> Maybe Word64 -> ReadP Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadP Word64
forall a. ReadP a
ReadP.pfail Word64 -> ReadP Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Word64 -> ReadP Word64)
-> (String -> Maybe Word64) -> String -> ReadP Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Word64
toWord64 (Integer -> Maybe Word64)
-> (String -> Integer) -> String -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer
forall a. Integral a => String -> a
stringToIntegral (String -> ReadP Word64) -> String -> ReadP Word64
forall a b. (a -> b) -> a -> b
$ Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
ys

constraintsP :: ReadP.ReadP Constraint
constraintsP :: ReadP Constraint
constraintsP = do
  ReadP ()
spacesP
  [Constraint]
cs <- ReadP Constraint -> ReadP () -> ReadP [Constraint]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
ReadP.sepBy1 ReadP Constraint
constraintP ReadP ()
orP
  ReadP ()
spacesP
  Constraint -> ReadP Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return ((Constraint -> Constraint -> Constraint)
-> [Constraint] -> Constraint
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 <- ReadP Constraint -> ReadP () -> ReadP [Constraint]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
ReadP.sepBy1 ReadP Constraint
simpleP ReadP ()
spaces1P
  Constraint -> ReadP Constraint
forall (m :: * -> *) a. Monad m => a -> m a
return ((Constraint -> Constraint -> Constraint)
-> [Constraint] -> Constraint
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 (Version -> Constraint) -> ReadP Version -> ReadP Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Version
versionP

simpleP :: ReadP.ReadP Constraint
simpleP :: ReadP Constraint
simpleP = [ReadP Constraint] -> ReadP Constraint
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
  ReadP Char -> ReadP ()
forall a. ReadP a -> ReadP ()
ReadP.optional (Char -> ReadP Char
ReadP.char Char
'=')
  Wildcard -> Constraint
ConstraintWildcard (Wildcard -> Constraint) -> ReadP Wildcard -> ReadP Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Wildcard
wildcardP

wildcardP :: ReadP.ReadP Wildcard
wildcardP :: ReadP Wildcard
wildcardP = [ReadP Wildcard] -> ReadP Wildcard
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
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  Word64
n <- ReadP Word64
numberP
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  Wildcard -> ReadP Wildcard
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
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  Wildcard -> ReadP Wildcard
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Wildcard
WildcardMinor Word64
m)

wildcardMajorP :: ReadP.ReadP Wildcard
wildcardMajorP :: ReadP Wildcard
wildcardMajorP = do
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (Char -> ReadP Char
ReadP.char Char
'.')
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isWildcard)
  Wildcard -> ReadP Wildcard
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 (Version -> Constraint) -> ReadP Version -> ReadP Constraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Version
versionP

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

hyphenP :: ReadP.ReadP ()
hyphenP :: ReadP ()
hyphenP = do
  ReadP ()
spaces1P
  ReadP Char -> ReadP ()
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
  ReadP String -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (String -> ReadP String
ReadP.string String
"||")
  ReadP ()
spaces1P

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

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

-- ** Rendering

renderPreReleases :: [PreRelease] -> String
renderPreReleases :: [PreRelease] -> String
renderPreReleases [PreRelease]
ps =
  if [PreRelease] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PreRelease]
ps then String
"" else Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." ((PreRelease -> String) -> [PreRelease] -> [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 [Build] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Build]
bs then String
"" else Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." ((Build -> String) -> [Build] -> [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 :: (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 Char -> Char -> Bool
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')

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

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

stringToIntegral :: Integral a => String -> a
stringToIntegral :: String -> a
stringToIntegral =
  (a -> Char -> a) -> a -> String -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
n Char
d -> (a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
10) a -> a -> a
forall a. Num a => a -> a -> a
+ (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
d) a -> a -> a
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Maybe Word64
forall a. Maybe a
Nothing
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word.Word64) = Maybe Word64
forall a. Maybe a
Nothing
  | Bool
otherwise = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Integer -> Word64
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
DataType
Constr
Typeable SimpleConstraint
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SimpleConstraint -> c SimpleConstraint)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SimpleConstraint)
-> (SimpleConstraint -> Constr)
-> (SimpleConstraint -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> SimpleConstraint -> SimpleConstraint)
-> (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 u.
    (forall d. Data d => d -> u) -> SimpleConstraint -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SimpleConstraint -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SimpleConstraint -> m SimpleConstraint)
-> Data SimpleConstraint
SimpleConstraint -> DataType
SimpleConstraint -> Constr
(forall b. Data b => b -> b)
-> SimpleConstraint -> SimpleConstraint
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleConstraint -> c SimpleConstraint
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSCOr :: Constr
$cSCAnd :: Constr
$cSCGT :: Constr
$cSCEQ :: Constr
$cSCLT :: Constr
$tSimpleConstraint :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> SimpleConstraint -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SimpleConstraint -> u
gmapQ :: (forall d. Data d => d -> u) -> SimpleConstraint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SimpleConstraint -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable SimpleConstraint
Data.Data, SimpleConstraint -> SimpleConstraint -> Bool
(SimpleConstraint -> SimpleConstraint -> Bool)
-> (SimpleConstraint -> SimpleConstraint -> Bool)
-> Eq SimpleConstraint
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. SimpleConstraint -> Rep SimpleConstraint x)
-> (forall x. Rep SimpleConstraint x -> SimpleConstraint)
-> Generic SimpleConstraint
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
Eq SimpleConstraint
-> (SimpleConstraint -> SimpleConstraint -> Ordering)
-> (SimpleConstraint -> SimpleConstraint -> Bool)
-> (SimpleConstraint -> SimpleConstraint -> Bool)
-> (SimpleConstraint -> SimpleConstraint -> Bool)
-> (SimpleConstraint -> SimpleConstraint -> Bool)
-> (SimpleConstraint -> SimpleConstraint -> SimpleConstraint)
-> (SimpleConstraint -> SimpleConstraint -> SimpleConstraint)
-> Ord 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
$cp1Ord :: Eq SimpleConstraint
Ord, ReadPrec [SimpleConstraint]
ReadPrec SimpleConstraint
Int -> ReadS SimpleConstraint
ReadS [SimpleConstraint]
(Int -> ReadS SimpleConstraint)
-> ReadS [SimpleConstraint]
-> ReadPrec SimpleConstraint
-> ReadPrec [SimpleConstraint]
-> Read 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
(Int -> SimpleConstraint -> ShowS)
-> (SimpleConstraint -> String)
-> ([SimpleConstraint] -> ShowS)
-> Show SimpleConstraint
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 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
u
  -- This uses `compare` rather than `==` to ignore build metadata.
  SCEQ Version
u -> Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Version
v Version
u Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
  SCGT Version
u -> Version
v Version -> Version -> Bool
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 Word64 -> Word64 -> Word64
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 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
          (Word64
0, Word64
n, Word64
_) -> Word64 -> Word64 -> Word64 -> Version
mkV Word64
0 (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) Word64
0
          (Word64
m, Word64
_, Word64
_) -> Word64 -> Word64 -> Word64 -> Version
mkV (Word64
m Word64 -> Word64 -> Word64
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 Word64 -> Word64 -> Word64
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 Word64 -> Word64 -> Word64
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)