module Data.Versions
(
Versioning(..)
, SemVer(..)
, Version(..)
, Mess(..)
, VUnit(..)
, VChunk
, VSep(..)
, VParser(..)
, semver
, semver'
, version
, version'
, mess
, mess'
, parseV
, semverP
, versionP
, messP
, prettyV
, prettySemVer
, prettyVer
, prettyMess ) where
import Data.List (intersperse)
import Data.Semigroup
import Data.Text (Text,pack,unpack,snoc)
import Text.ParserCombinators.Parsec
import TextShow (showt)
data Versioning = Ideal SemVer | General Version | Complex Mess
deriving (Eq,Show)
instance Ord Versioning where
compare (Ideal s) (Ideal s') = compare s s'
compare (General v) (General v') = compare v v'
compare (Complex m) (Complex m') = compare m m'
compare (Ideal s) (General v) = cmpSV s v
compare (General v) (Ideal s) = opposite $ cmpSV s v
compare (General v) (Complex m) = compare (mFromV v) m
compare (Complex m) (General v) = opposite $ compare (mFromV v) m
compare (Ideal s) m@(Complex _) = compare (General $ vFromS s) m
compare m@(Complex _) (Ideal s) = compare m (General $ vFromS s)
cmpSV :: SemVer -> Version -> Ordering
cmpSV s (Version cs re) = compare (cs' ++ re') $ cs ++ re
where (Version cs' re') = vFromS s
vFromS :: SemVer -> Version
vFromS (SemVer m i p r _) = Version [[Digits m], [Digits i], [Digits p]] r
mFromV :: Version -> Mess
mFromV (Version v r) = VNode (chunksAsT v) VHyphen $ VLeaf (chunksAsT r)
data SemVer = SemVer { svMajor :: Int
, svMinor :: Int
, svPatch :: Int
, svPreRel :: [VChunk]
, svMeta :: [VChunk] } deriving (Show)
instance Eq SemVer where
(SemVer ma mi pa pr _) == (SemVer ma' mi' pa' pr' _) =
(ma,mi,pa,pr) == (ma',mi',pa',pr')
instance Ord SemVer where
compare (SemVer ma mi pa pr _) (SemVer ma' mi' pa' pr' _) =
case compare (ma,mi,pa) (ma',mi',pa') of
LT -> LT
GT -> GT
EQ -> case (pr,pr') of
([],[]) -> EQ
([],_) -> GT
(_,[]) -> LT
_ -> compare pr pr'
data VUnit = Digits Int | Str Text deriving (Eq,Show,Read,Ord)
type VChunk = [VUnit]
data Version = Version { vChunks :: [VChunk]
, vRel :: [VChunk] } deriving (Eq,Ord,Show)
data Mess = VLeaf [Text] | VNode [Text] VSep Mess deriving (Eq,Show)
instance Ord Mess where
compare (VLeaf l1) (VLeaf l2) = compare l1 l2
compare (VNode t1 _ _) (VLeaf t2) = compare t1 t2
compare (VLeaf t1) (VNode t2 _ _) = compare t1 t2
compare (VNode t1 _ v1) (VNode t2 _ v2) | t1 < t2 = LT
| t1 > t2 = GT
| otherwise = compare v1 v2
data VSep = VColon | VHyphen | VPlus | VUnder deriving (Eq,Show)
newtype VParser = VParser { runVP :: Text -> Either ParseError Versioning }
instance Semigroup VParser where
(VParser f) <> (VParser g) = VParser h
where h t = either (const (g t)) Right $ f t
parseV :: Text -> Either ParseError Versioning
parseV = runVP $ semverP <> versionP <> messP
semverP :: VParser
semverP = VParser $ fmap Ideal . semver
semver :: Text -> Either ParseError SemVer
semver = semver' . unpack
semver' :: String -> Either ParseError SemVer
semver' = parse semanticVersion "Semantic Version"
semanticVersion :: Parser SemVer
semanticVersion = p <* eof
where p = SemVer <$> major <*> minor <*> patch <*> preRel <*> metaData
digits :: Parser Int
digits = read <$> (string "0" <|> many1 digit)
major :: Parser Int
major = digits <* char '.'
minor :: Parser Int
minor = major
patch :: Parser Int
patch = digits
preRel :: Parser [VChunk]
preRel = (char '-' *> chunks) <|> pure []
metaData :: Parser [VChunk]
metaData = (char '+' *> chunks) <|> pure []
chunks :: Parser [VChunk]
chunks = (oneZero <|> many (iunit <|> sunit)) `sepBy` char '.'
where oneZero = (:[]) . Digits . read <$> string "0"
iunit :: Parser VUnit
iunit = Digits . read <$> many1 digit
sunit :: Parser VUnit
sunit = Str . pack <$> many1 letter
versionP :: VParser
versionP = VParser $ fmap General . version
version :: Text -> Either ParseError Version
version = version' . unpack
version' :: String -> Either ParseError Version
version' = parse versionNum "Version"
versionNum :: Parser Version
versionNum = Version <$> chunks <*> preRel <* eof
messP :: VParser
messP = VParser $ fmap Complex . mess
mess :: Text -> Either ParseError Mess
mess = mess' . unpack
mess' :: String -> Either ParseError Mess
mess' = parse messNumber "Mess"
messNumber :: Parser Mess
messNumber = try node <|> leaf
leaf :: Parser Mess
leaf = VLeaf <$> tchunks <* eof
node :: Parser Mess
node = VNode <$> tchunks <*> sep <*> messNumber
tchunks :: Parser [Text]
tchunks = (pack <$> many1 (letter <|> digit)) `sepBy` char '.'
sep :: Parser VSep
sep = choice [ VColon <$ char ':'
, VHyphen <$ char '-'
, VPlus <$ char '+'
, VUnder <$ char '_' ]
sepCh :: VSep -> Char
sepCh VColon = ':'
sepCh VHyphen = '-'
sepCh VPlus = '+'
sepCh VUnder = '_'
prettyV :: Versioning -> Text
prettyV (Ideal sv) = prettySemVer sv
prettyV (General v) = prettyVer v
prettyV (Complex m) = prettyMess m
prettySemVer :: SemVer -> Text
prettySemVer (SemVer ma mi pa pr me) = mconcat $ ver <> pr' <> me'
where ver = intersperse "." [ showt ma, showt mi, showt pa ]
pr' = foldable [] ("-" :) $ intersperse "." (chunksAsT pr)
me' = foldable [] ("+" :) $ intersperse "." (chunksAsT me)
prettyVer :: Version -> Text
prettyVer (Version cs pr) = mconcat $ ver <> pr'
where ver = intersperse "." $ chunksAsT cs
pr' = foldable [] ("-" :) $ intersperse "." (chunksAsT pr)
prettyMess :: Mess -> Text
prettyMess (VLeaf t) = mconcat $ intersperse "." t
prettyMess (VNode t s v) = snoc t' (sepCh s) <> prettyMess v
where t' = mconcat $ intersperse "." t
chunksAsT :: [VChunk] -> [Text]
chunksAsT = map (mconcat . map f)
where f (Digits i) = showt i
f (Str s) = s
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable d g f | null f = d
| otherwise = g f
opposite :: Ordering -> Ordering
opposite EQ = EQ
opposite LT = GT
opposite GT = LT