packages feed

semantic-version-0.0.1: src/Data/SemanticVersion/SemanticVersion.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE LambdaCase #-}

module Data.SemanticVersion.SemanticVersion where

import Control.Lens
import Data.SemanticVersion.BuildIdentifiers
import Data.SemanticVersion.PreReleaseIdentifiers
import Data.SemanticVersion.Version
import Text.Parser.Char
import Text.Parser.Combinators

-- $setup
-- >>> import Text.Parsec(parse)
-- >>> import Data.Either(isLeft)


-- <valid semver> ::= <version core>
--                  | <version core> "-" <pre-release>
--                  | <version core> "+" <build>
--                  | <version core> "-" <pre-release> "+" <build>
data SemanticVersion =
  SemanticVersionOnly Version
  | SemanticVersionPreRelease Version PreReleaseIdentifiers
  | SemanticVersionBuild Version BuildIdentifiers
  | SemanticVersionPreReleaseBuild Version PreReleaseIdentifiers BuildIdentifiers
  deriving (Eq, Show)

class HasSemanticVersion a where
  semanticVersion ::
    Lens' a SemanticVersion

instance HasSemanticVersion SemanticVersion where
  semanticVersion =
    id

class AsSemanticVersion a where
  _SemanticVersion ::
    Prism' a SemanticVersion
  _SemanticVersionOnly ::
    Prism' a Version
  _SemanticVersionOnly =
    _SemanticVersion .
    prism'
      SemanticVersionOnly
      (\case
        SemanticVersionOnly a ->
          Just a
        _ ->
          Nothing)
  _SemanticVersionPreRelease ::
    Prism' a (Version, PreReleaseIdentifiers)
  _SemanticVersionPreRelease =
    _SemanticVersion .
    prism'
      (uncurry SemanticVersionPreRelease)
      (\case
        SemanticVersionPreRelease v pri ->
          Just (v, pri)
        _ ->
          Nothing)
  _SemanticVersionBuild ::
    Prism' a (Version, BuildIdentifiers)
  _SemanticVersionBuild =
    _SemanticVersion .
    prism'
      (uncurry SemanticVersionBuild)
      (\case
        SemanticVersionBuild v bi ->
          Just (v, bi)
        _ ->
          Nothing)
  _SemanticVersionPreReleaseBuild ::
    Prism' a (Version, PreReleaseIdentifiers, BuildIdentifiers)
  _SemanticVersionPreReleaseBuild =
    _SemanticVersion .
    prism'
      (\(v, pri, bi) -> SemanticVersionPreReleaseBuild v pri bi)
      (\case
        SemanticVersionPreReleaseBuild v pri bi ->
          Just (v, pri, bi)
        _ ->
          Nothing)

instance AsSemanticVersion SemanticVersion where
  _SemanticVersion =
    id

instance HasVersion SemanticVersion where
  version f (SemanticVersionOnly v) =
    fmap SemanticVersionOnly (f v)
  version f (SemanticVersionPreRelease v pri) =
    fmap (`SemanticVersionPreRelease` pri) (f v)
  version f (SemanticVersionBuild v bi) =
    fmap (`SemanticVersionBuild` bi) (f v)
  version f (SemanticVersionPreReleaseBuild v pri bi) =
    fmap (\v' -> SemanticVersionPreReleaseBuild v' pri bi) (f v)

-- |
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "0.0.0"
-- Right (SemanticVersion (Version NumericIdentifierZero NumericIdentifierZero NumericIdentifierZero))
--
-- >>> isLeft (parse parseSemanticVersion "parseSemanticVersion" "")
-- True
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.2.3"
-- Right (SemanticVersion (Version (NumericIdentifierDigits DecDigitNoZero1 []) (NumericIdentifierDigits DecDigitNoZero2 []) (NumericIdentifierDigits DecDigitNoZero3 [])))
--
-- >>> isLeft(parse parseSemanticVersion "parseSemanticVersion" "01.2.3")
-- True
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "10.2.3"
-- Right (SemanticVersion (Version (NumericIdentifierDigits DecDigitNoZero1 [DecDigit0]) (NumericIdentifierDigits DecDigitNoZero2 []) (NumericIdentifierDigits DecDigitNoZero3 [])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "38012.5.6"
-- Right (SemanticVersion (Version (NumericIdentifierDigits DecDigitNoZero3 [DecDigit8,DecDigit0,DecDigit1,DecDigit2]) (NumericIdentifierDigits DecDigitNoZero5 []) (NumericIdentifierDigits DecDigitNoZero6 [])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "38012.5.5432"
-- Right (SemanticVersion (Version (NumericIdentifierDigits DecDigitNoZero3 [DecDigit8,DecDigit0,DecDigit1,DecDigit2]) (NumericIdentifierDigits DecDigitNoZero5 []) (NumericIdentifierDigits DecDigitNoZero5 [DecDigit4,DecDigit3,DecDigit2])))
--
-- >>> isLeft (parse (parseSemanticVersion <* eof) "parseSemanticVersion" "38012.05.5432")
-- True
--
-- >>> isLeft (parse (parseSemanticVersion <* eof) "parseSemanticVersion" "38012.5.05432")
-- True
--
-- >>> isLeft (parse parseSemanticVersion "parseSemanticVersion" "a")
-- True
--
-- >>> isLeft (parse parseSemanticVersion "parseSemanticVersion" "-")
-- True
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.0.0-alpha"
-- Right (SemanticVersionPreRelease (Version (NumericIdentifierDigits DecDigitNoZero1 []) NumericIdentifierZero NumericIdentifierZero) (PreReleaseIdentifiers (PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaLower Lower_a)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_l)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_p)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_h)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a))]))) :| [])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.0.0-alpha.1"
-- Right (SemanticVersionPreRelease (Version (NumericIdentifierDigits DecDigitNoZero1 []) NumericIdentifierZero NumericIdentifierZero) (PreReleaseIdentifiers (PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaLower Lower_a)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_l)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_p)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_h)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a))]))) :| [PreReleaseIdentifierNumeric (NumericIdentifierDigits DecDigitNoZero1 [])])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.0.0-0.3.7"
-- Right (SemanticVersionPreRelease (Version (NumericIdentifierDigits DecDigitNoZero1 []) NumericIdentifierZero NumericIdentifierZero) (PreReleaseIdentifiers (PreReleaseIdentifierNumeric NumericIdentifierZero :| [PreReleaseIdentifierNumeric (NumericIdentifierDigits DecDigitNoZero3 []),PreReleaseIdentifierNumeric (NumericIdentifierDigits DecDigitNoZero7 [])])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.0.0-x.7.z.92"
-- Right (SemanticVersionPreRelease (Version (NumericIdentifierDigits DecDigitNoZero1 []) NumericIdentifierZero NumericIdentifierZero) (PreReleaseIdentifiers (PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigit (NonDigitLetter (AlphaLower Lower_x))) :| [PreReleaseIdentifierNumeric (NumericIdentifierDigits DecDigitNoZero7 []),PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigit (NonDigitLetter (AlphaLower Lower_z))),PreReleaseIdentifierNumeric (NumericIdentifierDigits DecDigitNoZero9 [DecDigit2])])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.0.0-x-y-z.--"
-- Right (SemanticVersionPreRelease (Version (NumericIdentifierDigits DecDigitNoZero1 []) NumericIdentifierZero NumericIdentifierZero) (PreReleaseIdentifiers (PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaLower Lower_x)) (IdentifierCharacters (IdentifierCharacterNonDigit NonDigitHyphen :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_y)),IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_z))]))) :| [PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigits NonDigitHyphen (IdentifierCharacters (IdentifierCharacterNonDigit NonDigitHyphen :| [])))])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.0.0-alpha+001"
-- Right (SemanticVersionPreReleaseBuild (Version (NumericIdentifierDigits DecDigitNoZero1 []) NumericIdentifierZero NumericIdentifierZero) (PreReleaseIdentifiers (PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaLower Lower_a)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_l)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_p)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_h)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a))]))) :| [])) (BuildIdentifiers (BuildIdentifierDigits (DecDigit0 :| [DecDigit0,DecDigit1]) :| [])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.0.0+20130313144700"
-- Right (SemanticVersionBuild (Version (NumericIdentifierDigits DecDigitNoZero1 []) NumericIdentifierZero NumericIdentifierZero) (BuildIdentifiers (BuildIdentifierDigits (DecDigit2 :| [DecDigit0,DecDigit1,DecDigit3,DecDigit0,DecDigit3,DecDigit1,DecDigit3,DecDigit1,DecDigit4,DecDigit4,DecDigit7,DecDigit0,DecDigit0]) :| [])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.0.0-beta+exp.sha.5114f85"
-- Right (SemanticVersionPreReleaseBuild (Version (NumericIdentifierDigits DecDigitNoZero1 []) NumericIdentifierZero NumericIdentifierZero) (PreReleaseIdentifiers (PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaLower Lower_b)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_e)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_t)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a))]))) :| [])) (BuildIdentifiers (BuildIdentifierAlphanumeric (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaLower Lower_e)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_x)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_p))]))) :| [BuildIdentifierAlphanumeric (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaLower Lower_s)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_h)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a))]))),BuildIdentifierAlphanumeric (AlphanumericIdentifierCharacters2 (IdentifierCharacters (IdentifierCharacterDigit DecDigit5 :| [IdentifierCharacterDigit DecDigit1,IdentifierCharacterDigit DecDigit1,IdentifierCharacterDigit DecDigit4])) (NonDigitLetter (AlphaLower Lower_f)) (IdentifierCharacters (IdentifierCharacterDigit DecDigit8 :| [IdentifierCharacterDigit DecDigit5])))])))
--
-- >>> parse (parseSemanticVersion <* eof) "parseSemanticVersion" "1.0.0+21AF26D3----117B344092BD"
-- Right (SemanticVersionBuild (Version (NumericIdentifierDigits DecDigitNoZero1 []) NumericIdentifierZero NumericIdentifierZero) (BuildIdentifiers (BuildIdentifierAlphanumeric (AlphanumericIdentifierCharacters2 (IdentifierCharacters (IdentifierCharacterDigit DecDigit2 :| [IdentifierCharacterDigit DecDigit1])) (NonDigitLetter (AlphaUpper Upper_A)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_F)) :| [IdentifierCharacterDigit DecDigit2,IdentifierCharacterDigit DecDigit6,IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_D)),IdentifierCharacterDigit DecDigit3,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterDigit DecDigit1,IdentifierCharacterDigit DecDigit1,IdentifierCharacterDigit DecDigit7,IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_B)),IdentifierCharacterDigit DecDigit3,IdentifierCharacterDigit DecDigit4,IdentifierCharacterDigit DecDigit4,IdentifierCharacterDigit DecDigit0,IdentifierCharacterDigit DecDigit9,IdentifierCharacterDigit DecDigit2,IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_B)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_D))]))) :| [])))
parseSemanticVersion ::
  CharParsing p =>
  p SemanticVersion
parseSemanticVersion =
  let parsePreRelease =
        char '-' *> parsePreReleaseIdentifiers
      parseBuild =
        char '+' *> parseBuildIdentifiers
      mkVersion v Nothing Nothing =
        SemanticVersionOnly v
      mkVersion v (Just pri) Nothing =
        SemanticVersionPreRelease v pri
      mkVersion v Nothing (Just bld) =
        SemanticVersionBuild v bld
      mkVersion v (Just pri) (Just bld) =
        SemanticVersionPreReleaseBuild v pri bld
  in  mkVersion <$> parseVersion <*> try (optional parsePreRelease) <*> try (optional parseBuild)