SemVar3.hs

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