module Data.SemVer where
import ClassyPrelude
import qualified Prelude as P
import Data.Text (Text)
import qualified Data.Text as T
type ReleaseTag = Text
type SemVer = (Int, Int, Int, [ReleaseTag])
data Wildcard = Any
| One Int
| Two Int Int
| Three Int Int Int [Text]
deriving (Show, Eq)
data SemVerRange
= Eq SemVer
| Gt SemVer
| Lt SemVer
| Geq SemVer
| Leq SemVer
| And SemVerRange SemVerRange
| Or SemVerRange SemVerRange
deriving (Eq, Ord)
versionsOf :: SemVerRange -> [SemVer]
versionsOf = \case
Eq sv -> [sv]
Geq sv -> [sv]
Leq sv -> [sv]
Lt sv -> [sv]
Gt sv -> [sv]
And svr1 svr2 -> versionsOf svr1 <> versionsOf svr2
Or svr1 svr2 -> versionsOf svr1 <> versionsOf svr2
semver :: Int -> Int -> Int -> SemVer
semver a b c = (a, b, c, [])
releaseTags :: SemVer -> [ReleaseTag]
releaseTags (_, _, _, tags) = tags
toTuple :: SemVer -> (Int, Int, Int)
toTuple (a, b, c, _) = (a, b, c)
tuplesOf :: SemVerRange -> [(Int, Int, Int)]
tuplesOf = map toTuple . versionsOf
rangeReleaseTags :: SemVerRange -> [ReleaseTag]
rangeReleaseTags = concatMap releaseTags . versionsOf
sharedReleaseTags :: SemVerRange -> Maybe [ReleaseTag]
sharedReleaseTags range = case map releaseTags $ versionsOf range of
[] -> Nothing
[]:_ -> Nothing
tagList:otherLists
| all (== tagList) otherLists -> Just tagList
| otherwise -> Nothing
anyVersion :: SemVerRange
anyVersion = Gt $ semver 0 0 0
renderSV :: SemVer -> Text
renderSV = pack . renderSV'
renderSV' :: SemVer -> String
renderSV' (x, y, z, []) = show x <> "." <> show y <> "." <> show z
renderSV' (x, y, z, tags) = renderSV' (x, y, z, []) <> "-" <>
(intercalate "." $ map unpack tags)
instance Show SemVerRange where
show = \case
Eq sv -> "=" <> renderSV' sv
Gt sv -> ">" <> renderSV' sv
Lt sv -> "<" <> renderSV' sv
Geq sv -> ">=" <> renderSV' sv
Leq sv -> "<=" <> renderSV' sv
And svr1 svr2 -> show svr1 <> " " <> show svr2
Or svr1 svr2 -> show svr1 <> " || " <> show svr2
matches :: SemVerRange -> SemVer -> Bool
matches range version = case (sharedReleaseTags range, releaseTags version) of
(Nothing, []) -> matchesSimple range version
(Just rTags, vTags)
| rTags == vTags -> matchesSimple range version
| tuplesOf range /= [toTuple version] -> False
| otherwise -> matchesTags range rTags vTags
(_, _) -> False
matchesSimple :: SemVerRange -> SemVer -> Bool
matchesSimple range ver = case range of
Eq sv -> ver == sv
Gt sv -> ver > sv
Lt sv -> ver < sv
Geq sv -> ver >= sv
Leq sv -> ver <= sv
And sv1 sv2 -> matchesSimple sv1 ver && matchesSimple sv2 ver
Or sv1 sv2 -> matchesSimple sv1 ver || matchesSimple sv2 ver
matchesTags :: SemVerRange -> [ReleaseTag] -> [ReleaseTag] -> Bool
matchesTags range rangeTags verTags = case range of
Eq _ -> verTags == rangeTags
Gt _ -> verTags > rangeTags
Lt _ -> verTags < rangeTags
Geq _ -> verTags >= rangeTags
Leq _ -> verTags <= rangeTags
And svr1 svr2 -> matchesTags svr1 verTags rangeTags &&
matchesTags svr2 verTags rangeTags
Or svr1 svr2 -> matchesTags svr1 verTags rangeTags ||
matchesTags svr2 verTags rangeTags
bestMatch :: SemVerRange -> [SemVer] -> Either String SemVer
bestMatch range vs = case filter (matches range) vs of
[] -> Left "No matching versions"
vs -> Right $ P.maximum vs
wildcardToSemver :: Wildcard -> SemVer
wildcardToSemver Any = (0, 0, 0, [])
wildcardToSemver (One n) = (n, 0, 0, [])
wildcardToSemver (Two n m) = (n, m, 0, [])
wildcardToSemver (Three n m o tags) = (n, m, o, tags)
wildcardToRange :: Wildcard -> SemVerRange
wildcardToRange = \case
Any -> Geq (0, 0, 0, [])
One n -> Geq (n, 0, 0, []) `And` Lt (n+1, 0, 0, [])
Two n m -> Geq (n, m, 0, []) `And` Lt (n, m + 1, 0, [])
Three n m o tags -> Eq (n, m, o, tags)
tildeToRange :: Wildcard -> SemVerRange
tildeToRange = \case
Any -> tildeToRange (Three 0 0 0 [])
One n -> tildeToRange (Three n 0 0 [])
Two n m -> tildeToRange (Three n m 0 [])
Three n m o tags -> And (Geq (n, m, o, tags)) (Lt (n, m + 1, 0, tags))
caratToRange :: Wildcard -> SemVerRange
caratToRange = \case
One n -> And (Geq (n, 0, 0, [])) (Lt (n+1, 0, 0, []))
Two n m -> And (Geq (n, m, 0, [])) (Lt (n+1, 0, 0, []))
Three 0 0 n tags -> Eq (0, 0, n, tags)
Three 0 n m tags -> And (Geq (0, n, m, tags)) (Lt (0, n + 1, 0, tags))
Three n m o tags -> And (Geq (n, m, o, tags)) (Lt (n+1, 0, 0, tags))
hyphenatedRange :: Wildcard -> Wildcard -> SemVerRange
hyphenatedRange wc1 wc2 = And sv1 sv2 where
sv1 = case wc1 of Any -> Geq (0, 0, 0, [])
One n -> Geq (n, 0, 0, [])
Two n m -> Geq (n, m, 0, [])
Three n m o tags -> Geq (n, m, o, tags)
sv2 = case wc2 of Any -> Geq (0, 0, 0, [])
One n -> Lt (n+1, 0, 0, [])
Two n m -> Lt (n, m + 1, 0, [])
Three n m o tags -> Leq (n, m, o, tags)