salve-0.0.8: Semantic version numbers and constraints.

Safe HaskellSafe
LanguageHaskell2010

Salve.Internal

Contents

Description

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.

Synopsis

Documentation

>>> import Control.Applicative
>>> import Lens.Micro
>>> let view l x = x ^. l

Public

data Version Source #

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.

Instances

Eq Version Source # 

Methods

(==) :: Version -> Version -> Bool #

(/=) :: Version -> Version -> Bool #

Ord Version Source #

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
Show Version Source # 

data PreRelease Source #

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.

Instances

Eq PreRelease Source # 
Ord PreRelease Source #

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
Show PreRelease Source # 

newtype Build Source #

Build metadata attached to a version. These are similar to PreReleases 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.

Constructors

Build String 

Instances

Eq Build Source # 

Methods

(==) :: Build -> Build -> Bool #

(/=) :: Build -> Build -> Bool #

Show Build Source # 

Methods

showsPrec :: Int -> Build -> ShowS #

show :: Build -> String #

showList :: [Build] -> ShowS #

data Constraint Source #

Constrains allowable version numbers.

Use parseConstraint to create constraints and satisfiesConstraint to see if a version number satisfies a constraint.

makeVersion :: Word64 -> Word64 -> Word64 -> [PreRelease] -> [Build] -> Version Source #

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.

initialVersion :: Version Source #

The initial version number for development.

>>> initialVersion
Version {versionMajor = 0, versionMinor = 0, versionPatch = 0, versionPreReleases = [], versionBuilds = []}

parseVersion :: String -> Maybe Version Source #

Attempts to parse a version. This parser follows SemVer's BNF.

>>> 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 not allowed and will cause the parser to fail.

>>> parseVersion " 1.2.3 "
Nothing

parsePreRelease :: String -> Maybe PreRelease Source #

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

parseBuild :: String -> Maybe Build Source #

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")

parseConstraint :: String -> Maybe Constraint Source #

Attempts to parse a constraint. This parser mostly follows npm's BNF.

>>> 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

unsafeParseVersion :: String -> Version Source #

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.

unsafeParsePreRelease :: String -> PreRelease Source #

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.

unsafeParseBuild :: String -> Build Source #

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.

unsafeParseConstraint :: String -> Constraint Source #

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.

renderVersion :: Version -> String Source #

Renders a version.

>>> renderVersion <$> parseVersion "1.2.3-p.4+b.5"
Just "1.2.3-p.4+b.5"

renderPreRelease :: PreRelease -> String Source #

Renders a pre-release.

>>> renderPreRelease <$> parsePreRelease "pre"
Just "pre"
>>> renderPreRelease <$> parsePreRelease "1"
Just "1"

renderBuild :: Build -> String Source #

Renders a build.

>>> renderBuild <$> parseBuild "build"
Just "build"
>>> renderBuild <$> parseBuild "1"
Just "1"

renderConstraint :: Constraint -> String Source #

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"

isUnstable :: Version -> Bool Source #

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

isStable :: Version -> Bool Source #

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

fromBaseVersion :: Version -> Version Source #

Converts from a 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"

toBaseVersion :: Version -> Version Source #

Converts to a 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"]})

bumpMajor :: Version -> Version Source #

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.

bumpMinor :: Version -> Version Source #

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.

bumpPatch :: Version -> Version Source #

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.

satisfiesConstraint :: Constraint -> Version -> Bool Source #

Returns True if the version satisfies the constraint, False otherwise.

>>> satisfiesConstraint <$> parseConstraint ">1.2.0" <*> parseVersion "1.2.3"
Just True

majorLens :: Functor f => (Word64 -> f Word64) -> Version -> f Version Source #

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 = []})

minorLens :: Functor f => (Word64 -> f Word64) -> Version -> f Version Source #

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 = []})

patchLens :: Functor f => (Word64 -> f Word64) -> Version -> f Version Source #

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 = []})

preReleasesLens :: Functor f => ([PreRelease] -> f [PreRelease]) -> Version -> f Version Source #

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 = []})

buildsLens :: Functor f => ([Build] -> f [Build]) -> Version -> f Version Source #

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 = []})

Private

Types

Constructors

constraintLT :: Version -> Constraint Source #

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 = []}))

constraintLE :: Version -> Constraint Source #

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 = []}))

constraintEQ :: Version -> Constraint Source #

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 = []}))

constraintGE :: Version -> Constraint Source #

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 = []}))

constraintGT :: Version -> Constraint Source #

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 = []}))

constraintAnd :: Constraint -> Constraint -> Constraint Source #

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 = []})))

constraintOr :: Constraint -> Constraint -> Constraint Source #

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 = []})))

constraintHyphen :: Version -> Version -> Constraint Source #

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 = []}))

constraintTilde :: Version -> Constraint Source #

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 = []}))

constraintCaret :: Version -> Constraint Source #

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 = []}))

Parsing

Rendering

Helpers

both :: (a -> b) -> (a, a) -> (b, b) Source #

Simple constraints

data SimpleConstraint Source #

Simple constraints are just as expressive as Constraints, but they are easier to reason about. You can think of them as the desugared version of Constraints.