Last active
June 23, 2020 10:43
-
-
Save specdrake/b9a952fcfa626c300c5547bb65f0e02b to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| module SemVer3 where | |
| import Control.Applicative | |
| import Control.Monad | |
| import Data.Char | |
| import Text.Trifecta | |
| import Data.List.NonEmpty (NonEmpty(..), fromList) | |
| type Letter = Char | |
| -- parseLetter :: Parser Letter | |
| -- only parse A-Z a-z | |
| type PositiveDigit = Integer | |
| -- parsePositiveDigit :: Parser PositiveDigit | |
| -- only parse 1-9 | |
| type Zero = Integer | |
| -- parseZero :: Parser Zero | |
| -- only parse 0 | |
| -- | |
| data Digit = DigitZ Zero | DigitPD PositiveDigit deriving Show | |
| -- parseDigit :: Parser Digit | |
| newtype Digits = Digits (NonEmpty Digit) deriving Show | |
| -- parseDigits :: Parser Digits | |
| type Dash = Char | |
| -- parseDash :: Parser Dash | |
| -- only parse '-' | |
| type Dot = Char | |
| -- parseDot :: Parser Dot | |
| -- only parse '.' | |
| type Plus = Char | |
| -- parsePlus :: Parser Plus | |
| -- only parse '+' | |
| data NonDigit = NonDigitL Letter | NonDigitD Dash deriving Show | |
| -- parseNonDigit :: Parser NonDigit | |
| data IdChar = IdCharD Digit | IdCharND NonDigit deriving Show | |
| data IdChars = IdChars (NonEmpty IdChar) deriving Show | |
| data NumId = NumIdZ Zero | NumId (NonEmpty Digit) deriving Show | |
| data AlphaNumId = AlphaNumIdND NonDigit | AlphaNumIDNDIC NonDigit IdChars | AlphaNumIDICND IdChars NonDigit | AlphaNumIDICNDIC IdChars NonDigit IdChars deriving Show | |
| data BuildId = BuildIdANI AlphaNumId | BuildIDD Digits deriving Show | |
| data PreRelID = PreRelIDANI AlphaNumId | PreRELIDNI NumId deriving Show | |
| data DotSepBId = DotSepBIdBI BuildId | DotSepBIdDSBI BuildId Dot DotSepBId deriving Show | |
| type Build = DotSepBId | |
| -- | |
| data DotSepPRId = DotSepPRIdBI PreRelID | DotSepPRIdDSPRI PreRelID Dot DotSepPRId deriving Show | |
| type PreRel = DotSepPRId | |
| -- | |
| type Patch = NumId | |
| type Minor = NumId | |
| type Major = NumId | |
| data Core = Core Major Dot Minor Dot Patch deriving Show | |
| data SemVer = SemVer Core | SemVerPR Core Dash PreRel | SemVerB Core Plus Build | SemVerFull Core Dash PreRel Plus Build deriving Show | |
| -- Parsers -- | |
| parseLetter :: Parser Letter | |
| -- parseLetter = try $ mfilter isAlpha anyChar | |
| parseLetter = letter | |
| parsePositiveDigit :: Parser PositiveDigit | |
| parsePositiveDigit = toInteger <$> mfilter (>0) (subtract 48 . ord <$> digit) | |
| parseZero :: Parser Zero | |
| parseZero = toInteger <$> mfilter (==0) (subtract 48 . ord <$> digit) | |
| parseDigit :: Parser Digit | |
| parseDigit = do | |
| x <- digit | |
| case (compare (subtract 48 . ord $ x) 0) of | |
| EQ -> DigitZ . toInteger . subtract 48 . ord <$> return x | |
| GT -> DigitPD . toInteger . subtract 48 . ord <$> return x | |
| _ -> fail "Invalid Digit parse" | |
| parseDigits :: Parser Digits | |
| parseDigits = Digits . fromList <$> some parseDigit | |
| parseDash :: Parser Dash | |
| parseDash = char '-' | |
| parseDot :: Parser Dot | |
| parseDot = char '.' | |
| parsePlus :: Parser Plus | |
| parsePlus = char '+' | |
| parseNonDigit = (try $ NonDigitL <$> parseLetter) <|> (try $ NonDigitD <$> parseDash) | |
| parseIdChar = (try $ IdCharD <$> parseDigit) <|> (try $ IdCharND <$> parseNonDigit) | |
| parseIdChars = IdChars . fromList <$> some parseIdChar | |
| parseNumId = (try $ NumIdZ <$> parseZero) <|> (try $ NumId . fromList <$> some parseDigit) | |
| parseAlphaNumId = (try $ AlphaNumIDICNDIC <$> parseIdChars <*> parseNonDigit <*> parseIdChars) <|> (try $ AlphaNumIDNDIC <$> (parseNonDigit) <*> parseIdChars) <|> (try $ AlphaNumIDICND <$> parseIdChars <*> parseNonDigit) <|> (try $ AlphaNumIdND <$> parseNonDigit) | |
| parseBuildId = (try $ BuildIdANI <$> parseAlphaNumId) <|> (try $ BuildIDD <$> parseDigits) | |
| parsePreRelID = (try $ PreRelIDANI <$> parseAlphaNumId) <|> (try $ PreRELIDNI <$> parseNumId) | |
| -- parseDotSepBId = (try $ DotSepBIdBI <$> parseBuildId) <|> (try $ DotSepBIdDSBI <$> parseBuildId <*> parseDot <*> parseDotSepBId) | |
| parseDotSepBId = (try $ DotSepBIdDSBI <$> parseBuildId <*> parseDot <*> parseDotSepBId) <|> (try $ DotSepBIdBI <$> parseBuildId) | |
| parseBuild :: Parser Build | |
| parseBuild = parseDotSepBId | |
| ----------------------------- | |
| parseDotSepPRId :: Parser DotSepPRId | |
| parseDotSepPRId = (try $ DotSepPRIdDSPRI <$> parsePreRelID <*> parseDot <*> parseDotSepPRId) <|> DotSepPRIdBI <$> parsePreRelID | |
| --data DotSepPRId = DotSepPRIdBI PreRelID | DotSepPRIdDSPRI PreRelID Dot DotSepPRId | |
| ----------------------------- | |
| parsePreRel :: Parser PreRel | |
| parsePreRel = parseDotSepPRId | |
| parsePatch :: Parser Patch | |
| parsePatch = parseNumId | |
| parseMinor :: Parser Minor | |
| parseMinor = parseNumId | |
| parseMajor :: Parser Major | |
| parseMajor = parseNumId | |
| parseCore :: Parser Core | |
| parseCore = Core <$> parseMajor <*> parseDot <*> parseMinor <*> parseDot <*> parsePatch | |
| parseSemVer :: Parser SemVer | |
| parseSemVer = (try $ SemVerFull <$> parseCore <*> parseDash <*> parsePreRel <*> parsePlus <*> parseBuild) <|> (try $ SemVerPR <$> parseCore <*> parseDash <*> parsePreRel) <|> (try $ SemVerB <$> parseCore <*> parsePlus <*> parseBuild) <|> SemVer <$> parseCore |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment