BuildIdentifier.hs

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

module Data.SemanticVersion.BuildIdentifier where

import Control.Applicative
import Control.Lens
import Data.Digit
import Data.List.NonEmpty
import Data.SemanticVersion.AlphanumericIdentifier
import Text.Parser.Char
import Text.Parser.Combinators

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

-- <build identifier> ::= <alphanumeric identifier>
--                      | <digits>
data BuildIdentifier =
  BuildIdentifierAlphanumeric AlphanumericIdentifier
  | BuildIdentifierDigits (NonEmpty DecDigit)
  deriving (Eq, Show)

class HasBuildIdentifier a where
  buildIdentifier ::
    Lens' a BuildIdentifier

instance HasBuildIdentifier BuildIdentifier where
  buildIdentifier =
    id

class AsBuildIdentifier a where
  _BuildIdentifier ::
    Prism' a BuildIdentifier
  _BuildIdentifierDigits ::
    Prism' a (NonEmpty DecDigit)
  _BuildIdentifierDigits =
    _BuildIdentifier .
    prism'
      BuildIdentifierDigits
      (\case
        BuildIdentifierDigits a ->
          Just a
        _ ->
          Nothing)

instance AsBuildIdentifier BuildIdentifier where
  _BuildIdentifier =
    id

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

-- |
--
-- >>> parse (parseBuildIdentifier <* eof) "parseBuildIdentifier" "A"
-- Right (BuildIdentifierAlphanumeric (AlphanumericIdentifierNonDigit (NonDigitLetter (AlphaUpper Upper_A))))
--
-- >>> isLeft (parse parseBuildIdentifier "parseBuildIdentifier" "")
-- True
--
-- >>> parse (parseBuildIdentifier <* eof) "parseBuildIdentifier" "Abc-123--XYZ"
-- Right (BuildIdentifierAlphanumeric (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 parseBuildIdentifier "parseBuildIdentifier" "+")
-- True
--
-- >>> parse parseBuildIdentifier "parseBuildIdentifier" "0"
-- Right (BuildIdentifierDigits (DecDigit0 :| []))
--
-- >>> parse parseBuildIdentifier "parseBuildIdentifier" "0+"
-- Right (BuildIdentifierDigits (DecDigit0 :| []))
--
-- >>> parse (parseBuildIdentifier <* eof) "parseBuildIdentifier" "0a"
-- Right (BuildIdentifierAlphanumeric (AlphanumericIdentifierCharacters (IdentifierCharacters (IdentifierCharacterDigit DecDigit0 :| [])) (NonDigitLetter (AlphaLower Lower_a))))
--
-- >>> parse parseBuildIdentifier "parseBuildIdentifier" "-"
-- Right (BuildIdentifierAlphanumeric (AlphanumericIdentifierNonDigit NonDigitHyphen))
--
-- >>> parse parseBuildIdentifier "parseBuildIdentifier" "Abc-123--XYZ+"
-- Right (BuildIdentifierAlphanumeric (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))]))))
--
-- >>> parse parseBuildIdentifier "parseBuildIdentifier" "0901010"
-- Right (BuildIdentifierDigits (DecDigit0 :| [DecDigit9,DecDigit0,DecDigit1,DecDigit0,DecDigit1,DecDigit0]))
--
-- >>> parse parseBuildIdentifier "parseBuildIdentifier" "90109010"
-- Right (BuildIdentifierDigits (DecDigit9 :| [DecDigit0,DecDigit1,DecDigit0,DecDigit9,DecDigit0,DecDigit1,DecDigit0]))
parseBuildIdentifier ::
  CharParsing p =>
  p BuildIdentifier
parseBuildIdentifier =
  try (BuildIdentifierAlphanumeric <$> parseAlphanumericIdentifier) <|>
  BuildIdentifierDigits <$> some1 parseDecimal