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

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

module Data.SemanticVersion.PreReleaseIdentifier where

import Control.Applicative
import Control.Lens
import Data.SemanticVersion.AlphanumericIdentifier
import Data.SemanticVersion.NumericIdentifier
import Text.Parser.Char
import Text.Parser.Combinators

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

-- <pre-release identifier> ::= <alphanumeric identifier>
--                            | <numeric identifier>
data PreReleaseIdentifier =
  PreReleaseIdentifierAlphanumeric AlphanumericIdentifier
  | PreReleaseIdentifierNumeric NumericIdentifier
  deriving (Eq, Show)

class HasPreReleaseIdentifier a where
  preReleaseIdentifier ::
    Lens' a PreReleaseIdentifier

instance HasPreReleaseIdentifier PreReleaseIdentifier where
  preReleaseIdentifier =
    id

class AsPreReleaseIdentifier a where
  _PreReleaseIdentifier ::
    Prism' a PreReleaseIdentifier

instance AsPreReleaseIdentifier PreReleaseIdentifier where
  _PreReleaseIdentifier =
    id

instance AsAlphanumericIdentifier PreReleaseIdentifier where
  _AlphanumericIdentifier =
    prism'
      PreReleaseIdentifierAlphanumeric
      (\case
        PreReleaseIdentifierAlphanumeric a ->
          Just a
        _ ->
          Nothing)

instance AsNumericIdentifier PreReleaseIdentifier where
  _NumericIdentifier =
    prism'
      PreReleaseIdentifierNumeric
      (\case
        PreReleaseIdentifierNumeric a ->
          Just a
        _ ->
          Nothing)

-- |
--
-- >>> parse (parsePreReleaseIdentifier <* eof) "parsePreReleaseIdentifier" "A"
-- Right (PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigit (NonDigitLetter (AlphaUpper Upper_A))))
--
-- >>> isLeft (parse parsePreReleaseIdentifier "parsePreReleaseIdentifier" "")
-- True
--
-- >>> parse (parsePreReleaseIdentifier <* eof) "parsePreReleaseIdentifier" "Abc-123--XYZ"
-- Right (PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaUpper Upper_A)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_b)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_c)),IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterDigit DecDigit1,IdentifierCharacterDigit DecDigit2,IdentifierCharacterDigit DecDigit3,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_X)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_Y)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_Z))]))))
--
-- >>> isLeft (parse parsePreReleaseIdentifier "parsePreReleaseIdentifier" "+")
-- True
parsePreReleaseIdentifier ::
  CharParsing p =>
  p PreReleaseIdentifier
parsePreReleaseIdentifier =
  try (PreReleaseIdentifierAlphanumeric <$> parseAlphanumericIdentifier) <|>
  PreReleaseIdentifierNumeric <$> parseNumericIdentifier