{-# 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) -- ::= -- | 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