diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -0,0 +1,27 @@ +Copyright 2023 Tony Morris + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +0.0.1 + +* This change log starts diff --git a/semantic-version.cabal b/semantic-version.cabal new file mode 100644 --- /dev/null +++ b/semantic-version.cabal @@ -0,0 +1,46 @@ +name: semantic-version +version: 0.0.1 +synopsis: Semantic Version +description: Semantic Version +license: BSD3 +license-file: LICENCE +author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> +maintainer: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> +copyright: Copyright (C) 2023 Tony Morris +category: Test +build-type: Simple +extra-source-files: changelog.md +cabal-version: >=1.10 +homepage: https://gitlab.com/tonymorris/semantic-version +bug-reports: https://gitlab.com/tonymorris/semantic-version/issues +tested-with: GHC == 8.6.5, GHC == 9.0.2 + +source-repository head + type: git + location: git@gitlab.com:tonymorris/semantic-version.git + +library + exposed-modules: + Data.SemanticVersion + Data.SemanticVersion.AlphanumericIdentifier + Data.SemanticVersion.BuildIdentifier + Data.SemanticVersion.BuildIdentifiers + Data.SemanticVersion.IdentifierCharacter + Data.SemanticVersion.IdentifierCharacters + Data.SemanticVersion.NonDigit + Data.SemanticVersion.NumericIdentifier + Data.SemanticVersion.PreReleaseIdentifier + Data.SemanticVersion.PreReleaseIdentifiers + Data.SemanticVersion.SemanticVersion + Data.SemanticVersion.Version + + build-depends: base >= 4 && < 6 + , lens >= 4 && < 6 + , digit >= 0.14 && < 1 + , alphachar >= 0.0.4 && < 1 + , parsers >= 0.12.11 && < 1 + , parsec >= 3.1.13.0 && < 4 + + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall diff --git a/src/Data/SemanticVersion.hs b/src/Data/SemanticVersion.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wall #-} + +-- https://semver.org/ + +module Data.SemanticVersion( module M ) where + +import Data.SemanticVersion.AlphanumericIdentifier as M +import Data.SemanticVersion.BuildIdentifier as M +import Data.SemanticVersion.BuildIdentifiers as M +import Data.SemanticVersion.IdentifierCharacter as M +import Data.SemanticVersion.IdentifierCharacters as M +import Data.SemanticVersion.NonDigit as M +import Data.SemanticVersion.NumericIdentifier as M +import Data.SemanticVersion.PreReleaseIdentifier as M +import Data.SemanticVersion.PreReleaseIdentifiers as M +import Data.SemanticVersion.SemanticVersion as M +import Data.SemanticVersion.Version as M diff --git a/src/Data/SemanticVersion/AlphanumericIdentifier.hs b/src/Data/SemanticVersion/AlphanumericIdentifier.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/AlphanumericIdentifier.hs @@ -0,0 +1,136 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE LambdaCase #-} + +module Data.SemanticVersion.AlphanumericIdentifier where + +import Control.Applicative +import Control.Lens +import Data.Digit +import Data.List.NonEmpty +import Data.SemanticVersion.NonDigit +import Data.SemanticVersion.IdentifierCharacter +import Data.SemanticVersion.IdentifierCharacters +import Text.Parser.Char +import Text.Parser.Combinators + +-- $setup +-- >>> import Text.Parsec(parse) +-- >>> import Data.Either(isLeft) + +-- ::= +-- | +-- | +-- | +data AlphanumericIdentifier = + AlphanumericIdentifierNonDigit NonDigit + | AlphanumericIdentifierNonDigits NonDigit IdentifierCharacters + | AlphanumericIdentifierCharacters IdentifierCharacters NonDigit + | AlphanumericIdentifierCharacters2 IdentifierCharacters NonDigit IdentifierCharacters + deriving (Eq, Show) + +class HasAlphanumericIdentifier a where + alphanumericIdentifier :: + Lens' a AlphanumericIdentifier + +instance HasAlphanumericIdentifier AlphanumericIdentifier where + alphanumericIdentifier = + id + +class AsAlphanumericIdentifier a where + _AlphanumericIdentifier :: + Prism' a AlphanumericIdentifier + _AlphanumericIdentifierNonDigit :: + Prism' a NonDigit + _AlphanumericIdentifierNonDigit = + _AlphanumericIdentifier . + prism' + AlphanumericIdentifierNonDigit + (\case + AlphanumericIdentifierNonDigit a -> + Just a + _ -> + Nothing) + _AlphanumericIdentifierNonDigits :: + Prism' a (NonDigit, IdentifierCharacters) + _AlphanumericIdentifierNonDigits = + _AlphanumericIdentifier . + prism' + (uncurry AlphanumericIdentifierNonDigits) + (\case + AlphanumericIdentifierNonDigits d cs -> + Just (d, cs) + _ -> + Nothing) + _AlphanumericIdentifierCharacters :: + Prism' a (IdentifierCharacters, NonDigit) + _AlphanumericIdentifierCharacters = + _AlphanumericIdentifier . + prism' + (uncurry AlphanumericIdentifierCharacters) + (\case + AlphanumericIdentifierCharacters cs d -> + Just (cs, d) + _ -> + Nothing) + _AlphanumericIdentifierCharacters2 :: + Prism' a (IdentifierCharacters, NonDigit, IdentifierCharacters) + _AlphanumericIdentifierCharacters2 = + _AlphanumericIdentifier . + prism' + (\(cs1, d, cs2) -> AlphanumericIdentifierCharacters2 cs1 d cs2) + (\case + AlphanumericIdentifierCharacters2 cs1 d cs2 -> + Just (cs1, d, cs2) + _ -> + Nothing) + +instance AsAlphanumericIdentifier AlphanumericIdentifier where + _AlphanumericIdentifier = + id + +instance HasNonDigit AlphanumericIdentifier where + nonDigit f (AlphanumericIdentifierNonDigit d) = + fmap AlphanumericIdentifierNonDigit (f d) + nonDigit f (AlphanumericIdentifierNonDigits d cs) = + fmap (`AlphanumericIdentifierNonDigits` cs) (f d) + nonDigit f (AlphanumericIdentifierCharacters cs d) = + fmap (AlphanumericIdentifierCharacters cs) (f d) + nonDigit f (AlphanumericIdentifierCharacters2 cs1 d cs2) = + fmap (\d' -> AlphanumericIdentifierCharacters2 cs1 d' cs2) (f d) + +-- | +-- +-- >>> parse (parseAlphanumericIdentifier <* eof) "parseAlphanumericIdentifier" "A" +-- Right (AlphanumericIdentifierNonDigit (NonDigitLetter (AlphaUpper Upper_A))) +-- +-- >>> isLeft (parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "") +-- True +-- +-- >>> parse (parseAlphanumericIdentifier <* eof) "parseAlphanumericIdentifier" "Abc-123--XYZ" +-- Right (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 parseAlphanumericIdentifier "parseAlphanumericIdentifier" "+") +-- True +-- +-- >>> isLeft (parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "0") +-- True +-- +-- >>> isLeft (parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "0+") +-- True +-- +-- >>> parse (parseAlphanumericIdentifier <* eof) "parseAlphanumericIdentifier" "0a" +-- Right (AlphanumericIdentifierCharacters (IdentifierCharacters (IdentifierCharacterDigit DecDigit0 :| [])) (NonDigitLetter (AlphaLower Lower_a))) +-- +-- >>> parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "-" +-- Right (AlphanumericIdentifierNonDigit NonDigitHyphen) +-- +-- >>> parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "Abc-123--XYZ+" +-- Right (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))]))) +parseAlphanumericIdentifier :: + CharParsing p => + p AlphanumericIdentifier +parseAlphanumericIdentifier = + try (liftA2 maybe AlphanumericIdentifierNonDigit AlphanumericIdentifierNonDigits <$> parseNonDigit <*> try (optional parseIdentifierCharacters)) <|> + (\c d -> + let c' = IdentifierCharacters (IdentifierCharacterDigit <$> c) + in maybe (AlphanumericIdentifierCharacters c' d) (AlphanumericIdentifierCharacters2 c' d)) <$> some1 parseDecimal <*> parseNonDigit <*> try (optional parseIdentifierCharacters) diff --git a/src/Data/SemanticVersion/BuildIdentifier.hs b/src/Data/SemanticVersion/BuildIdentifier.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/BuildIdentifier.hs @@ -0,0 +1,101 @@ +{-# 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 diff --git a/src/Data/SemanticVersion/BuildIdentifiers.hs b/src/Data/SemanticVersion/BuildIdentifiers.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/BuildIdentifiers.hs @@ -0,0 +1,53 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module Data.SemanticVersion.BuildIdentifiers where + +import Control.Lens +import Data.List.NonEmpty +import Data.SemanticVersion.BuildIdentifier +import Text.Parser.Char +import Text.Parser.Combinators + +-- $setup +-- >>> import Text.Parsec(parse) +-- >>> import Data.Either(isLeft) + +-- ::= +-- | "." +newtype BuildIdentifiers = + BuildIdentifiers (NonEmpty BuildIdentifier) + deriving (Eq, Show) + +class HasBuildIdentifiers a where + buildIdentifiers :: + Lens' a BuildIdentifiers + +instance HasBuildIdentifiers BuildIdentifiers where + buildIdentifiers = + id + +class AsBuildIdentifiers a where + _BuildIdentifiers :: + Prism' a BuildIdentifiers + +instance AsBuildIdentifiers BuildIdentifiers where + _BuildIdentifiers = + id + +instance BuildIdentifiers ~ t => Rewrapped BuildIdentifiers t + +instance Wrapped BuildIdentifiers where + type Unwrapped BuildIdentifiers = NonEmpty BuildIdentifier + _Wrapped' = + iso + (\(BuildIdentifiers x) -> x) + BuildIdentifiers + +parseBuildIdentifiers :: + CharParsing p => + p BuildIdentifiers +parseBuildIdentifiers = + BuildIdentifiers <$> sepByNonEmpty parseBuildIdentifier (char '.') diff --git a/src/Data/SemanticVersion/IdentifierCharacter.hs b/src/Data/SemanticVersion/IdentifierCharacter.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/IdentifierCharacter.hs @@ -0,0 +1,166 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE LambdaCase #-} + +module Data.SemanticVersion.IdentifierCharacter where + +import Control.Applicative +import Control.Lens +import Data.Char.Alpha +import Data.Digit +import Data.SemanticVersion.NonDigit +import Text.Parser.Char + +-- $setup +-- >>> import Text.Parsec(parse) +-- >>> import Data.Either(isLeft) + +-- ::= +-- | +data IdentifierCharacter = + IdentifierCharacterDigit DecDigit + | IdentifierCharacterNonDigit NonDigit + deriving (Eq, Show) + +class HasIdentifierCharacter a where + identifierCharacter :: + Lens' a IdentifierCharacter + +instance HasIdentifierCharacter IdentifierCharacter where + identifierCharacter = + id + +class AsIdentifierCharacter a where + _IdentifierCharacter :: + Prism' a IdentifierCharacter + _IdentifierCharacterDigit :: + Prism' a DecDigit + _IdentifierCharacterDigit = + _IdentifierCharacter . + prism' + IdentifierCharacterDigit + (\case + IdentifierCharacterDigit a -> + Just a + _ -> + Nothing) + +instance AsIdentifierCharacter IdentifierCharacter where + _IdentifierCharacter = + id + +instance AsNonDigit IdentifierCharacter where + _NonDigit = + prism' + IdentifierCharacterNonDigit + (\case + IdentifierCharacterNonDigit a -> + Just a + _ -> + Nothing) + +instance CA IdentifierCharacter where _A' = _NonDigit . _A' +instance CB IdentifierCharacter where _B' = _NonDigit . _B' +instance CC IdentifierCharacter where _C' = _NonDigit . _C' +instance CD IdentifierCharacter where _D' = _NonDigit . _D' +instance CE IdentifierCharacter where _E' = _NonDigit . _E' +instance CF IdentifierCharacter where _F' = _NonDigit . _F' +instance CG IdentifierCharacter where _G' = _NonDigit . _G' +instance CH IdentifierCharacter where _H' = _NonDigit . _H' +instance CI IdentifierCharacter where _I' = _NonDigit . _I' +instance CJ IdentifierCharacter where _J' = _NonDigit . _J' +instance CK IdentifierCharacter where _K' = _NonDigit . _K' +instance CL IdentifierCharacter where _L' = _NonDigit . _L' +instance CM IdentifierCharacter where _M' = _NonDigit . _M' +instance CN IdentifierCharacter where _N' = _NonDigit . _N' +instance CO IdentifierCharacter where _O' = _NonDigit . _O' +instance CP IdentifierCharacter where _P' = _NonDigit . _P' +instance CQ IdentifierCharacter where _Q' = _NonDigit . _Q' +instance CR IdentifierCharacter where _R' = _NonDigit . _R' +instance CS IdentifierCharacter where _S' = _NonDigit . _S' +instance CT IdentifierCharacter where _T' = _NonDigit . _T' +instance CU IdentifierCharacter where _U' = _NonDigit . _U' +instance CV IdentifierCharacter where _V' = _NonDigit . _V' +instance CW IdentifierCharacter where _W' = _NonDigit . _W' +instance CX IdentifierCharacter where _X' = _NonDigit . _X' +instance CY IdentifierCharacter where _Y' = _NonDigit . _Y' +instance CZ IdentifierCharacter where _Z' = _NonDigit . _Z' +instance Ca IdentifierCharacter where _a' = _NonDigit . _a' +instance Cb IdentifierCharacter where _b' = _NonDigit . _b' +instance Cc IdentifierCharacter where _c' = _NonDigit . _c' +instance Cd IdentifierCharacter where _d' = _NonDigit . _d' +instance Ce IdentifierCharacter where _e' = _NonDigit . _e' +instance Cf IdentifierCharacter where _f' = _NonDigit . _f' +instance Cg IdentifierCharacter where _g' = _NonDigit . _g' +instance Ch IdentifierCharacter where _h' = _NonDigit . _h' +instance Ci IdentifierCharacter where _i' = _NonDigit . _i' +instance Cj IdentifierCharacter where _j' = _NonDigit . _j' +instance Ck IdentifierCharacter where _k' = _NonDigit . _k' +instance Cl IdentifierCharacter where _l' = _NonDigit . _l' +instance Cm IdentifierCharacter where _m' = _NonDigit . _m' +instance Cn IdentifierCharacter where _n' = _NonDigit . _n' +instance Co IdentifierCharacter where _o' = _NonDigit . _o' +instance Cp IdentifierCharacter where _p' = _NonDigit . _p' +instance Cq IdentifierCharacter where _q' = _NonDigit . _q' +instance Cr IdentifierCharacter where _r' = _NonDigit . _r' +instance Cs IdentifierCharacter where _s' = _NonDigit . _s' +instance Ct IdentifierCharacter where _t' = _NonDigit . _t' +instance Cu IdentifierCharacter where _u' = _NonDigit . _u' +instance Cv IdentifierCharacter where _v' = _NonDigit . _v' +instance Cw IdentifierCharacter where _w' = _NonDigit . _w' +instance Cx IdentifierCharacter where _x' = _NonDigit . _x' +instance Cy IdentifierCharacter where _y' = _NonDigit . _y' +instance Cz IdentifierCharacter where _z' = _NonDigit . _z' +instance D0 IdentifierCharacter where d0 = _IdentifierCharacterDigit . d0 +instance D1 IdentifierCharacter where d1 = _IdentifierCharacterDigit . d1 +instance D2 IdentifierCharacter where d2 = _IdentifierCharacterDigit . d2 +instance D3 IdentifierCharacter where d3 = _IdentifierCharacterDigit . d3 +instance D4 IdentifierCharacter where d4 = _IdentifierCharacterDigit . d4 +instance D5 IdentifierCharacter where d5 = _IdentifierCharacterDigit . d5 +instance D6 IdentifierCharacter where d6 = _IdentifierCharacterDigit . d6 +instance D7 IdentifierCharacter where d7 = _IdentifierCharacterDigit . d7 +instance D8 IdentifierCharacter where d8 = _IdentifierCharacterDigit . d8 +instance D9 IdentifierCharacter where d9 = _IdentifierCharacterDigit . d9 + +-- | +-- +-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "a" +-- Right (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a))) +-- +-- >>> isLeft (parse parseIdentifierCharacter "parseIdentifierCharacter" "") +-- True +-- +-- >>> parse parseIdentifierCharacter "parseIdentifierCharacter" "Abc" +-- Right (IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_A))) +-- +-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "-" +-- Right (IdentifierCharacterNonDigit NonDigitHyphen) +-- +-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "0" +-- Right (IdentifierCharacterDigit DecDigit0) +-- +-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "9" +-- Right (IdentifierCharacterDigit DecDigit9) +-- +-- >>> isLeft (parse parseIdentifierCharacter "parseIdentifierCharacter" "+") +-- True +-- +-- >>> isLeft (parse parseIdentifierCharacter "parseIdentifierCharacter" "") +-- True +-- +-- >>> parse parseIdentifierCharacter "parseIdentifierCharacter" "01" +-- Right (IdentifierCharacterDigit DecDigit0) +-- +-- >>> parse parseIdentifierCharacter "parseIdentifierCharacter" "10" +-- Right (IdentifierCharacterDigit DecDigit1) +-- +-- >>> parse parseIdentifierCharacter "parseIdentifierCharacter" "38012" +-- Right (IdentifierCharacterDigit DecDigit3) +-- +-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "a" +-- Right (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a))) +parseIdentifierCharacter :: + CharParsing p => + p IdentifierCharacter +parseIdentifierCharacter = + IdentifierCharacterDigit <$> parseDecimal <|> + IdentifierCharacterNonDigit <$> parseNonDigit diff --git a/src/Data/SemanticVersion/IdentifierCharacters.hs b/src/Data/SemanticVersion/IdentifierCharacters.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/IdentifierCharacters.hs @@ -0,0 +1,81 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module Data.SemanticVersion.IdentifierCharacters where + +import Control.Lens hiding (cons) +import Data.List.NonEmpty +import Data.SemanticVersion.IdentifierCharacter +import Text.Parser.Char + +-- $setup +-- >>> import Text.Parsec(parse) +-- >>> import Data.Either(isLeft) + +-- ::= +-- | +newtype IdentifierCharacters = + IdentifierCharacters (NonEmpty IdentifierCharacter) + deriving (Eq, Show) + +class HasIdentifierCharacters a where + identifierCharacters :: + Lens' a IdentifierCharacters + +instance HasIdentifierCharacters IdentifierCharacters where + identifierCharacters = + id + +class AsIdentifierCharacters a where + _IdentifierCharacters :: + Prism' a IdentifierCharacters + +instance AsIdentifierCharacters IdentifierCharacters where + _IdentifierCharacters = + id + +instance IdentifierCharacters ~ t => Rewrapped IdentifierCharacters t + +instance Wrapped IdentifierCharacters where + type Unwrapped IdentifierCharacters = NonEmpty IdentifierCharacter + _Wrapped' = + iso + (\(IdentifierCharacters x) -> x) + IdentifierCharacters + + +-- | +-- +-- >>> parse (parseIdentifierCharacters <* eof) "parseIdentifierCharacters" "a" +-- Right (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a)) :| [])) +-- +-- >>> isLeft (parse parseIdentifierCharacters "parseIdentifierCharacters" "") +-- True +-- +-- >>> parse (parseIdentifierCharacters <* eof) "parseIdentifierCharacters" "0" +-- Right (IdentifierCharacters (IdentifierCharacterDigit DecDigit0 :| [])) +-- +-- >>> parse (parseIdentifierCharacters <* eof) "parseIdentifierCharacters" "Abc" +-- Right (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_A)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_b)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_c))])) +-- +-- >>> parse (parseIdentifierCharacters <* eof) "parseIdentifierCharacters" "-" +-- Right (IdentifierCharacters (IdentifierCharacterNonDigit NonDigitHyphen :| [])) +-- +-- >>> parse (parseIdentifierCharacters <* eof) "parseIdentifierCharacters" "Abc-123" +-- Right (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_A)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_b)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_c)),IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterDigit DecDigit1,IdentifierCharacterDigit DecDigit2,IdentifierCharacterDigit DecDigit3])) +-- +-- >>> parse (parseIdentifierCharacters <* eof) "parseIdentifierCharacters" "Ab-c-12--3" +-- Right (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_A)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_b)),IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_c)),IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterDigit DecDigit1,IdentifierCharacterDigit DecDigit2,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterDigit DecDigit3])) +-- +-- >>> parse parseIdentifierCharacters "parseIdentifierCharacters" "ABC+" +-- Right (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_A)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_B)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_C))])) +-- +-- >>> isLeft (parse parseIdentifierCharacters "parseIdentifierCharacters" "+") +-- True +parseIdentifierCharacters :: + CharParsing p => + p IdentifierCharacters +parseIdentifierCharacters = + IdentifierCharacters <$> some1 parseIdentifierCharacter diff --git a/src/Data/SemanticVersion/NonDigit.hs b/src/Data/SemanticVersion/NonDigit.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/NonDigit.hs @@ -0,0 +1,140 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE LambdaCase #-} + +module Data.SemanticVersion.NonDigit where + +import Control.Applicative +import Control.Lens +import Data.Char.Alpha +import Text.Parser.Char + +-- $setup +-- >>> import Text.Parsec(parse) +-- >>> import Data.Either(isLeft) + +-- ::= +-- | "-" +data NonDigit = + NonDigitHyphen + | NonDigitLetter Alpha + deriving (Eq, Show) + +class HasNonDigit a where + nonDigit :: + Lens' a NonDigit + +instance HasNonDigit NonDigit where + nonDigit = + id + +class AsNonDigit a where + _NonDigit :: + Prism' a NonDigit + _NonDigitHyphen :: + Prism' a () + _NonDigitHyphen = + _NonDigit . + prism' + (\() -> NonDigitHyphen) + (\case + NonDigitHyphen -> + Just () + _ -> + Nothing) + _NonDigitLetter :: + Prism' a Alpha + _NonDigitLetter = + _NonDigit . + prism' + NonDigitLetter + (\case + NonDigitLetter a -> + Just a + _ -> + Nothing) + +instance AsNonDigit NonDigit where + _NonDigit = + id + +instance CA NonDigit where _A' = _NonDigitLetter . _A' +instance CB NonDigit where _B' = _NonDigitLetter . _B' +instance CC NonDigit where _C' = _NonDigitLetter . _C' +instance CD NonDigit where _D' = _NonDigitLetter . _D' +instance CE NonDigit where _E' = _NonDigitLetter . _E' +instance CF NonDigit where _F' = _NonDigitLetter . _F' +instance CG NonDigit where _G' = _NonDigitLetter . _G' +instance CH NonDigit where _H' = _NonDigitLetter . _H' +instance CI NonDigit where _I' = _NonDigitLetter . _I' +instance CJ NonDigit where _J' = _NonDigitLetter . _J' +instance CK NonDigit where _K' = _NonDigitLetter . _K' +instance CL NonDigit where _L' = _NonDigitLetter . _L' +instance CM NonDigit where _M' = _NonDigitLetter . _M' +instance CN NonDigit where _N' = _NonDigitLetter . _N' +instance CO NonDigit where _O' = _NonDigitLetter . _O' +instance CP NonDigit where _P' = _NonDigitLetter . _P' +instance CQ NonDigit where _Q' = _NonDigitLetter . _Q' +instance CR NonDigit where _R' = _NonDigitLetter . _R' +instance CS NonDigit where _S' = _NonDigitLetter . _S' +instance CT NonDigit where _T' = _NonDigitLetter . _T' +instance CU NonDigit where _U' = _NonDigitLetter . _U' +instance CV NonDigit where _V' = _NonDigitLetter . _V' +instance CW NonDigit where _W' = _NonDigitLetter . _W' +instance CX NonDigit where _X' = _NonDigitLetter . _X' +instance CY NonDigit where _Y' = _NonDigitLetter . _Y' +instance CZ NonDigit where _Z' = _NonDigitLetter . _Z' +instance Ca NonDigit where _a' = _NonDigitLetter . _a' +instance Cb NonDigit where _b' = _NonDigitLetter . _b' +instance Cc NonDigit where _c' = _NonDigitLetter . _c' +instance Cd NonDigit where _d' = _NonDigitLetter . _d' +instance Ce NonDigit where _e' = _NonDigitLetter . _e' +instance Cf NonDigit where _f' = _NonDigitLetter . _f' +instance Cg NonDigit where _g' = _NonDigitLetter . _g' +instance Ch NonDigit where _h' = _NonDigitLetter . _h' +instance Ci NonDigit where _i' = _NonDigitLetter . _i' +instance Cj NonDigit where _j' = _NonDigitLetter . _j' +instance Ck NonDigit where _k' = _NonDigitLetter . _k' +instance Cl NonDigit where _l' = _NonDigitLetter . _l' +instance Cm NonDigit where _m' = _NonDigitLetter . _m' +instance Cn NonDigit where _n' = _NonDigitLetter . _n' +instance Co NonDigit where _o' = _NonDigitLetter . _o' +instance Cp NonDigit where _p' = _NonDigitLetter . _p' +instance Cq NonDigit where _q' = _NonDigitLetter . _q' +instance Cr NonDigit where _r' = _NonDigitLetter . _r' +instance Cs NonDigit where _s' = _NonDigitLetter . _s' +instance Ct NonDigit where _t' = _NonDigitLetter . _t' +instance Cu NonDigit where _u' = _NonDigitLetter . _u' +instance Cv NonDigit where _v' = _NonDigitLetter . _v' +instance Cw NonDigit where _w' = _NonDigitLetter . _w' +instance Cx NonDigit where _x' = _NonDigitLetter . _x' +instance Cy NonDigit where _y' = _NonDigitLetter . _y' +instance Cz NonDigit where _z' = _NonDigitLetter . _z' + +-- | +-- +-- >>> parse parseNonDigit "parseNonDigit" "a" +-- Right (NonDigitLetter (AlphaLower Lower_a)) +-- +-- >>> isLeft (parse parseNonDigit "parseNonDigit" "") +-- True +-- +-- >>> parse parseIdentifierCharacter "parseNonDigit" "Abc" +-- Right (IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_A))) +-- +-- >>> parse parseIdentifierCharacter "parseNonDigit" "0" +-- Right (IdentifierCharacterDigit DecDigit0) +-- +-- >>> parse parseIdentifierCharacter "parseNonDigit" "-" +-- Right (IdentifierCharacterNonDigit NonDigitHyphen) +-- +-- >>> isLeft (parse parseNonDigit "parseNonDigit" "+") +-- True +-- +-- >>> isLeft (parse parseNonDigit "parseNonDigit" "9") +-- True +parseNonDigit :: + CharParsing p => + p NonDigit +parseNonDigit = + NonDigitLetter <$> parse_alpha <|> + NonDigitHyphen <$ char '-' diff --git a/src/Data/SemanticVersion/NumericIdentifier.hs b/src/Data/SemanticVersion/NumericIdentifier.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/NumericIdentifier.hs @@ -0,0 +1,88 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE LambdaCase #-} + +module Data.SemanticVersion.NumericIdentifier where + +import Control.Applicative +import Control.Lens +import Data.Digit +import Text.Parser.Char + +-- $setup +-- >>> import Text.Parsec(parse) +-- >>> import Data.Either(isLeft) + +-- ::= "0" +-- | +-- | +data NumericIdentifier = + NumericIdentifierZero + | NumericIdentifierDigits DecDigitNoZero [DecDigit] + deriving (Eq, Show) + +class HasNumericIdentifier a where + numericIdentifier :: + Lens' a NumericIdentifier + +instance HasNumericIdentifier NumericIdentifier where + numericIdentifier = + id + +class AsNumericIdentifier a where + _NumericIdentifier :: + Prism' a NumericIdentifier + _NumericIdentifierZero :: + Prism' a () + _NumericIdentifierZero = + _NumericIdentifier . + prism' + (\() -> NumericIdentifierZero) + (\case + NumericIdentifierZero -> + Just () + _ -> + Nothing) + _NumericIdentifierDigits :: + Prism' a (DecDigitNoZero, [DecDigit]) + _NumericIdentifierDigits = + _NumericIdentifier . + prism' + (uncurry NumericIdentifierDigits) + (\case + NumericIdentifierDigits d ds -> + Just (d, ds) + _ -> + Nothing) + +instance AsNumericIdentifier NumericIdentifier where + _NumericIdentifier = + id + +-- | +-- +-- >>> parse (parseNumericIdentifier <* eof) "parseNumericIdentifier" "0" +-- Right NumericIdentifierZero +-- +-- >>> isLeft (parse parseNumericIdentifier "parseNumericIdentifier" "") +-- True +-- +-- >>> parse parseNumericIdentifier "parseNumericIdentifier" "01" +-- Right NumericIdentifierZero +-- +-- >>> parse parseNumericIdentifier "parseNumericIdentifier" "10" +-- Right (NumericIdentifierDigits DecDigitNoZero1 [DecDigit0]) +-- +-- >>> parse parseNumericIdentifier "parseNumericIdentifier" "38012" +-- Right (NumericIdentifierDigits DecDigitNoZero3 [DecDigit8,DecDigit0,DecDigit1,DecDigit2]) +-- +-- >>> isLeft (parse parseNumericIdentifier "parseNumericIdentifier" "a") +-- True +-- +-- >>> isLeft (parse parseNumericIdentifier "parseNumericIdentifier" "-") +-- True +parseNumericIdentifier :: + CharParsing p => + p NumericIdentifier +parseNumericIdentifier = + NumericIdentifierZero <$ char '0' <|> + NumericIdentifierDigits <$> parseDecimalNoZero <*> many parseDecimal diff --git a/src/Data/SemanticVersion/PreReleaseIdentifier.hs b/src/Data/SemanticVersion/PreReleaseIdentifier.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/PreReleaseIdentifier.hs @@ -0,0 +1,78 @@ +{-# 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) + +-- ::= +-- | +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 diff --git a/src/Data/SemanticVersion/PreReleaseIdentifiers.hs b/src/Data/SemanticVersion/PreReleaseIdentifiers.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/PreReleaseIdentifiers.hs @@ -0,0 +1,72 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module Data.SemanticVersion.PreReleaseIdentifiers where + +import Control.Lens +import Data.List.NonEmpty +import Data.SemanticVersion.PreReleaseIdentifier +import Text.Parser.Char +import Text.Parser.Combinators + +-- $setup +-- >>> import Text.Parsec(parse) +-- >>> import Data.Either(isLeft) + +-- ::= +-- | "." +newtype PreReleaseIdentifiers = + PreReleaseIdentifiers (NonEmpty PreReleaseIdentifier) + deriving (Eq, Show) + +class HasPreReleaseIdentifiers a where + preReleaseIdentifiers :: + Lens' a PreReleaseIdentifiers + +instance HasPreReleaseIdentifiers PreReleaseIdentifiers where + preReleaseIdentifiers = + id + +class AsPreReleaseIdentifiers a where + _PreReleaseIdentifiers :: + Prism' a PreReleaseIdentifiers + +instance AsPreReleaseIdentifiers PreReleaseIdentifiers where + _PreReleaseIdentifiers = + id + +instance PreReleaseIdentifiers ~ t => Rewrapped PreReleaseIdentifiers t + +instance Wrapped PreReleaseIdentifiers where + type Unwrapped PreReleaseIdentifiers = NonEmpty PreReleaseIdentifier + _Wrapped' = + iso + (\(PreReleaseIdentifiers x) -> x) + PreReleaseIdentifiers + +-- | +-- +-- >>> parse (parsePreReleaseIdentifiers <* eof) "parsePreReleaseIdentifiers" "A" +-- Right (PreReleaseIdentifiers (PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigit (NonDigitLetter (AlphaUpper Upper_A))) :| [])) +-- +-- >>> isLeft (parse parsePreReleaseIdentifiers "parsePreReleaseIdentifiers" "") +-- True +-- +-- >>> parse (parsePreReleaseIdentifiers <* eof) "parsePreReleaseIdentifiers" "Abc-123--XYZ" +-- Right (PreReleaseIdentifiers (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 parsePreReleaseIdentifiers "parsePreReleaseIdentifiers" "+") +-- True +-- +-- >>> parse (parsePreReleaseIdentifiers <* eof) "parsePreReleaseIdentifiers" "Abc-123--XYZ.456.abc" +-- Right (PreReleaseIdentifiers (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))]))) :| [PreReleaseIdentifierNumeric (NumericIdentifierDigits DecDigitNoZero4 [DecDigit5,DecDigit6]),PreReleaseIdentifierAlphanumeric (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaLower Lower_a)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_b)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_c))])))])) +-- +-- >>> parse (parsePreReleaseIdentifiers <* eof) "parsePreReleaseIdentifiers" "Abc-123--XYZ.Abc-123--XYZ.Abc-123--XYZ" +-- Right (PreReleaseIdentifiers (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))]))) :| [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))]))),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))])))])) +parsePreReleaseIdentifiers :: + CharParsing p => + p PreReleaseIdentifiers +parsePreReleaseIdentifiers = + PreReleaseIdentifiers <$> sepByNonEmpty parsePreReleaseIdentifier (char '.') diff --git a/src/Data/SemanticVersion/SemanticVersion.hs b/src/Data/SemanticVersion/SemanticVersion.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/SemanticVersion.hs @@ -0,0 +1,177 @@ +{-# 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) + + +-- ::= +-- | "-" +-- | "+" +-- | "-" "+" +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) + diff --git a/src/Data/SemanticVersion/Version.hs b/src/Data/SemanticVersion/Version.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemanticVersion/Version.hs @@ -0,0 +1,84 @@ +{-# OPTIONS_GHC -Wall #-} + +module Data.SemanticVersion.Version where + +import Control.Lens +import Data.SemanticVersion.NumericIdentifier +import Text.Parser.Char + +-- $setup +-- >>> import Text.Parsec(parse) +-- >>> import Data.Either(isLeft) + +-- ::= "." "." +data Version = + Version NumericIdentifier NumericIdentifier NumericIdentifier + deriving (Eq, Show) + +class HasVersion a where + version :: + Lens' a Version + versionMajor :: + Lens' a NumericIdentifier + versionMajor = + version . \f (Version j n p) -> fmap (\j' -> Version j' n p) (f j) + versionMinor :: + Lens' a NumericIdentifier + versionMinor = + version . \f (Version j n p) -> fmap (\n' -> Version j n' p) (f n) + versionPatch :: + Lens' a NumericIdentifier + versionPatch = + version . \f (Version j n p) -> fmap (Version j n) (f p) + +instance HasVersion Version where + version = + id + +class AsVersion a where + _Version :: + Prism' a Version + +instance AsVersion Version where + _Version = + id + +-- | +-- +-- >>> parse (parseVersion <* eof) "parseVersion" "0.0.0" +-- Right (Version NumericIdentifierZero NumericIdentifierZero NumericIdentifierZero) +-- +-- >>> isLeft (parse parseVersion "parseVersion" "") +-- True +-- +-- >>> parse (parseVersion <* eof) "parseVersion" "1.2.3" +-- Right (Version (NumericIdentifierDigits DecDigitNoZero1 []) (NumericIdentifierDigits DecDigitNoZero2 []) (NumericIdentifierDigits DecDigitNoZero3 [])) +-- +-- >>> isLeft(parse parseVersion "parseVersion" "01.2.3") +-- True +-- +-- >>> parse (parseVersion <* eof) "parseVersion" "10.2.3" +-- Right (Version (NumericIdentifierDigits DecDigitNoZero1 [DecDigit0]) (NumericIdentifierDigits DecDigitNoZero2 []) (NumericIdentifierDigits DecDigitNoZero3 [])) +-- +-- >>> parse (parseVersion <* eof) "parseVersion" "38012.5.6" +-- Right (Version (NumericIdentifierDigits DecDigitNoZero3 [DecDigit8,DecDigit0,DecDigit1,DecDigit2]) (NumericIdentifierDigits DecDigitNoZero5 []) (NumericIdentifierDigits DecDigitNoZero6 [])) +-- +-- >>> parse (parseVersion <* eof) "parseVersion" "38012.5.5432" +-- Right (Version (NumericIdentifierDigits DecDigitNoZero3 [DecDigit8,DecDigit0,DecDigit1,DecDigit2]) (NumericIdentifierDigits DecDigitNoZero5 []) (NumericIdentifierDigits DecDigitNoZero5 [DecDigit4,DecDigit3,DecDigit2])) +-- +-- >>> isLeft (parse (parseVersion <* eof) "parseVersion" "38012.05.5432") +-- True +-- +-- >>> isLeft (parse (parseVersion <* eof) "parseVersion" "38012.5.05432") +-- True +-- +-- >>> isLeft (parse parseVersion "parseVersion" "a") +-- True +-- +-- >>> isLeft (parse parseVersion "parseVersion" "-") +-- True +parseVersion :: + CharParsing p => + p Version +parseVersion = + Version <$> parseNumericIdentifier <* char '.' <*> parseNumericIdentifier <* char '.' <*> parseNumericIdentifier