Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-30 19:54:47 +00:00
Code Issues Packages Projects Releases Wiki Activity

updates emver lib with negatable operators

Browse Source
This commit is contained in:
Keagan McClelland
2020-11-02 11:14:35 -07:00
parent 28edfc2f87
commit fd9550bb7a
1 changed files with 36 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

75
src/Lib/Types/Emver.hs
View File

@@ -1,6 +1,6 @@
{- | {- |
Module : Lib.Types.SemverQuad Module : Lib.Types.Emver
Description : Semver with 4th digit extension Description : Semver with 4th digit extension for Embassy
License : Start9 Non-Commercial License : Start9 Non-Commercial
Maintainer : keagan@start9labs.com Maintainer : keagan@start9labs.com
Stability : experimental Stability : experimental
@@ -20,7 +20,7 @@ module Lib.Types.Emver
( major ( major
, minor , minor
, patch , patch
, quad , revision
, satisfies , satisfies
, (<||) , (<||)
, (||>) , (||>)
@@ -76,12 +76,12 @@ patch (Version (_, _, z, _)) = z
-- speaking, if you are both the package author and maintainer, you should not ever increment this number, as it is -- speaking, if you are both the package author and maintainer, you should not ever increment this number, as it is
-- redundant with 'patch'. However, if you maintain a package on some distribution channel, and you are /not/ the -- redundant with 'patch'. However, if you maintain a package on some distribution channel, and you are /not/ the
-- original author, then it is encouraged for you to increment 'quad' instead of 'patch'. -- original author, then it is encouraged for you to increment 'quad' instead of 'patch'.
quad :: Version -> Word revision :: Version -> Word
quad (Version (_, _, _, q)) = q revision (Version (_, _, _, q)) = q
-- | 'Operator' is the type that specifies how to compare against the target version. Right includes equality, Left -- | 'Operator' is the type that specifies how to compare against the target version. Right represents the ordering,
-- excludes it -- Left negates it
type Operator = Either Ordering Ordering type Operator = Either Ordering Ordering
-- | 'VersionRange' is the algebra of sets of versions. They can be constructed by having an 'Anchor' term which -- | 'VersionRange' is the algebra of sets of versions. They can be constructed by having an 'Anchor' term which
@@ -130,23 +130,21 @@ exactly :: Version -> VersionRange
exactly = Anchor (Left EQ) exactly = Anchor (Left EQ)
instance Show VersionRange where instance Show VersionRange where
show (Anchor ( Left EQ) v ) = '=' : show v show (Anchor (Left EQ) v) = '!' : '=' : show v
show (Anchor ( Right EQ) v ) = '=' : show v show (Anchor (Right EQ) v) = '=' : show v
show (Anchor ( Left LT) v ) = '<' : show v show (Anchor (Left LT) v) = '>' : '=' : show v
show (Anchor ( Right LT) v ) = '<' : '=' : show v show (Anchor (Right LT) v) = '<' : show v
show (Anchor ( Left GT) v ) = '>' : show v show (Anchor (Left GT) v) = '<' : '=' : show v
show (Anchor ( Right GT) v ) = '>' : '=' : show v show (Anchor (Right GT) v) = '>' : show v
show (Conj a@(Disj _ _) b@(Disj _ _)) = paren (show a) <> " " <> paren (show b) show (Conj a b) = paren $ show a <> (' ' : show b)
show (Conj a@(Disj _ _) b ) = paren (show a) <> " " <> show b show (Disj a b) = paren $ show a <> " || " <> show b
show (Conj a b@(Disj _ _)) = show a <> " " <> paren (show b) show Any = "*"
show (Conj a b ) = show a <> " " <> show b show None = "!"
show (Disj a b ) = show a <> " || " <> show b
show Any = "*"
show None = "!"
instance Read VersionRange where instance Read VersionRange where
readsPrec _ s = case Atto.parseOnly parseRange (T.pack s) of readsPrec _ s = case Atto.parse parseRange (T.pack s) of
Left _ -> [] Atto.Fail _ _ _ -> []
Right a -> [(a, "")] Atto.Partial _ -> []
Atto.Done i r -> [(r, T.unpack i)]
paren :: String -> String paren :: String -> String
paren = mappend "(" . flip mappend ")" paren = mappend "(" . flip mappend ")"
@@ -165,12 +163,11 @@ instance Monoid AllRange where
-- | Predicate for deciding whether the 'Version' is in the 'VersionRange' -- | Predicate for deciding whether the 'Version' is in the 'VersionRange'
satisfies :: Version -> VersionRange -> Bool satisfies :: Version -> VersionRange -> Bool
satisfies v (Anchor op v') = satisfies v (Anchor op v') = either (\c x y -> compare x y /= c) (\c x y -> compare x y == c) op v v'
either (\c x y -> compare x y == c) (\c x y -> let c' = compare x y in c' == c || c' == EQ) op v v' satisfies v (Conj a b ) = v `satisfies` a && v `satisfies` b
satisfies v (Conj a b) = v `satisfies` a && v `satisfies` b satisfies v (Disj a b ) = v `satisfies` a || v `satisfies` b
satisfies v (Disj a b) = v `satisfies` a || v `satisfies` b satisfies _ Any = True
satisfies _ Any = True satisfies _ None = False
satisfies _ None = False
(<||) :: Version -> VersionRange -> Bool (<||) :: Version -> VersionRange -> Bool
(<||) = satisfies (<||) = satisfies
@@ -201,7 +198,7 @@ parseVersion = do
pure $ Version (major', minor', patch', quad') pure $ Version (major', minor', patch', quad')
-- >>> Atto.parseOnly parseRange "=2.3.4 1.2.3.4 - 2.3.4.5 (>3.0.0 || <3.4.5)" -- >>> Atto.parseOnly parseRange "=2.3.4 1.2.3.4 - 2.3.4.5 (>3.0.0 || <3.4.5)"
-- Right =2.3.4 >=1.2.3.4 <=2.3.4.5 ((>3.0.0 || <3.4.5)) -- Right (=2.3.4 ((>=1.2.3.4 <=2.3.4.5) (>3.0.0 || <3.4.5)))
parseRange :: Atto.Parser VersionRange parseRange :: Atto.Parser VersionRange
parseRange = s <|> (Atto.char '*' *> pure Any) parseRange = s <|> (Atto.char '*' *> pure Any)
where where
@@ -213,17 +210,17 @@ parseRange = s <|> (Atto.char '*' *> pure Any)
p = unAllRange . foldMap AllRange <$> ((a <|> sub) `Atto.sepBy1` Atto.space) p = unAllRange . foldMap AllRange <$> ((a <|> sub) `Atto.sepBy1` Atto.space)
a = liftA2 Anchor parseOperator parseVersion <|> caret <|> tilde <|> wildcard <|> hyphen a = liftA2 Anchor parseOperator parseVersion <|> caret <|> tilde <|> wildcard <|> hyphen
-- >>> Atto.parseOnly parseRange "^2.3.4.5" -- >>> Atto.parseOnly parseRange "^2.3.0.5"
-- Right >=2.3.4.5 <3.0.0 -- Right (>=2.3.0.5 <3.0.0)
caret :: Atto.Parser VersionRange caret :: Atto.Parser VersionRange
caret = (Atto.char '^' *> parseVersion) <&> \case caret = (Atto.char '^' *> parseVersion) <&> \case
v@(Version (0, 0, 0, _)) -> Anchor (Left EQ) v v@(Version (0, 0, 0, _)) -> Anchor (Right EQ) v
v@(Version (0, 0, z, _)) -> rangeIE v (Version (0, 0, z + 1, 0)) v@(Version (0, 0, z, _)) -> rangeIE v (Version (0, 0, z + 1, 0))
v@(Version (0, y, _, _)) -> rangeIE v (Version (0, y + 1, 0, 0)) v@(Version (0, y, _, _)) -> rangeIE v (Version (0, y + 1, 0, 0))
v@(Version (x, _, _, _)) -> rangeIE v (Version (x + 1, 0, 0, 0)) v@(Version (x, _, _, _)) -> rangeIE v (Version (x + 1, 0, 0, 0))
-- >>> Atto.parseOnly tilde "~1.2.3.4" -- >>> Atto.parseOnly tilde "~1.2.3.4"
-- Right >=1.2.3.4 <1.2.4 -- Right (>=1.2.3.4 <1.2.4)
tilde :: Atto.Parser VersionRange tilde :: Atto.Parser VersionRange
tilde = (Atto.char '~' *> (Atto.decimal `Atto.sepBy1` Atto.char '.')) >>= \case tilde = (Atto.char '~' *> (Atto.decimal `Atto.sepBy1` Atto.char '.')) >>= \case
[x, y, z, q] -> pure $ rangeIE (Version (x, y, z, q)) (Version (x, y, z + 1, 0)) [x, y, z, q] -> pure $ rangeIE (Version (x, y, z, q)) (Version (x, y, z + 1, 0))
@@ -234,15 +231,15 @@ tilde = (Atto.char '~' *> (Atto.decimal `Atto.sepBy1` Atto.char '.')) >>= \case
range :: Bool -> Bool -> Version -> Version -> VersionRange range :: Bool -> Bool -> Version -> Version -> VersionRange
range inc0 inc1 v0 v1 = range inc0 inc1 v0 v1 =
let f = if inc0 then Right else Left let lo = if inc0 then Left LT else Right GT
g = if inc1 then Right else Left hi = if inc1 then Left GT else Right LT
in Conj (Anchor (f GT) v0) (Anchor (g LT) v1) in Conj (Anchor lo v0) (Anchor hi v1)
rangeIE :: Version -> Version -> VersionRange rangeIE :: Version -> Version -> VersionRange
rangeIE = range True False rangeIE = range True False
-- >>> Atto.parseOnly wildcard "1.2.3.x" -- >>> Atto.parseOnly wildcard "1.2.3.x"
-- Right >=1.2.3 <1.2.4 -- Right (>=1.2.3 <1.2.4)
wildcard :: Atto.Parser VersionRange wildcard :: Atto.Parser VersionRange
wildcard = (Atto.many1 (Atto.decimal <* Atto.char '.') <* Atto.char 'x') >>= \case wildcard = (Atto.many1 (Atto.decimal <* Atto.char '.') <* Atto.char 'x') >>= \case
[x, y, z] -> pure $ rangeIE (Version (x, y, z, 0)) (Version (x, y, z + 1, 0)) [x, y, z] -> pure $ rangeIE (Version (x, y, z, 0)) (Version (x, y, z + 1, 0))
@@ -251,6 +248,6 @@ wildcard = (Atto.many1 (Atto.decimal <* Atto.char '.') <* Atto.char 'x') >>= \ca
o -> fail $ "Invalid number of version numbers: " <> show (length o) o -> fail $ "Invalid number of version numbers: " <> show (length o)
-- >>> Atto.parseOnly hyphen "0.1.2.3 - 1.2.3.4" -- >>> Atto.parseOnly hyphen "0.1.2.3 - 1.2.3.4"
-- Right >=0.1.2.3 <=1.2.3.4 -- Right (>=0.1.2.3 <=1.2.3.4)
hyphen :: Atto.Parser VersionRange hyphen :: Atto.Parser VersionRange
hyphen = liftA2 (range True True) parseVersion (Atto.skipSpace *> Atto.char '-' *> Atto.skipSpace *> parseVersion) hyphen = liftA2 (range True True) parseVersion (Atto.skipSpace *> Atto.char '-' *> Atto.skipSpace *> parseVersion)