mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 02:11:53 +00:00
adds build numbers
This commit is contained in:
@@ -20,11 +20,13 @@ import Lib.Types.Semver
|
|||||||
av = version a
|
av = version a
|
||||||
|
|
||||||
major :: AppVersion -> Word16
|
major :: AppVersion -> Word16
|
||||||
major (AppVersion (a, _, _)) = a
|
major (AppVersion (a, _, _, _)) = a
|
||||||
minor :: AppVersion -> Word16
|
minor :: AppVersion -> Word16
|
||||||
minor (AppVersion (_, a, _)) = a
|
minor (AppVersion (_, a, _, _)) = a
|
||||||
patch :: AppVersion -> Word16
|
patch :: AppVersion -> Word16
|
||||||
patch (AppVersion (_, _, a)) = a
|
patch (AppVersion (_, _, a, _)) = a
|
||||||
|
build :: AppVersion -> Word16
|
||||||
|
build (AppVersion (_, _, _, a)) = a
|
||||||
|
|
||||||
hasGiven :: (AppVersion -> Word16) -> AppVersion -> AppVersion -> Bool
|
hasGiven :: (AppVersion -> Word16) -> AppVersion -> AppVersion -> Bool
|
||||||
hasGiven projection av = (== projection av) . projection
|
hasGiven projection av = (== projection av) . projection
|
||||||
|
|||||||
@@ -19,46 +19,44 @@ import Yesod.Core
|
|||||||
------------------------------------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
newtype AppVersion = AppVersion
|
newtype AppVersion = AppVersion
|
||||||
{ unAppVersion :: (Word16, Word16, Word16) } deriving (Eq, Ord)
|
{ unAppVersion :: (Word16, Word16, Word16, Word16) } deriving (Eq, Ord)
|
||||||
|
|
||||||
instance Hashable AppVersion where
|
instance Hashable AppVersion where
|
||||||
hash (AppVersion (a, b, c)) = (2 ^ c) * (3 ^ b) * (5 ^ a)
|
hash (AppVersion (a, b, c, d)) = (2 ^ a) * (3 ^ b) * (5 ^ c) * (7 ^ d)
|
||||||
hashWithSalt _ = hash
|
hashWithSalt _ = hash
|
||||||
|
|
||||||
instance Read AppVersion where
|
instance Read AppVersion where
|
||||||
readsPrec _ s = case traverse (readMaybe . toS) $ split (=='.') (toS s) of
|
readsPrec _ s = case traverse (readMaybe . toS) $ splitOn "+" <=< splitOn "." $ (toS s) of
|
||||||
Just [major, minor, patch] -> [(AppVersion (major, minor, patch), "")]
|
Just [major, minor, patch, build] -> [(AppVersion (major, minor, patch, build), "")]
|
||||||
|
Just [major, minor, patch] -> [(AppVersion (major, minor, patch, 0), "")]
|
||||||
_ -> []
|
_ -> []
|
||||||
instance PathPiece AppVersion where
|
instance PathPiece AppVersion where
|
||||||
fromPathPiece = readMaybe . toS
|
fromPathPiece = readMaybe . toS
|
||||||
toPathPiece = show
|
toPathPiece = show
|
||||||
|
|
||||||
instance Show AppVersion where
|
instance Show AppVersion where
|
||||||
show (AppVersion (a, b, c)) = [i|#{a}.#{b}.#{c}|]
|
show (AppVersion (a, b, c, d))
|
||||||
|
| d == 0 = [i|#{a}.#{b}.#{c}|]
|
||||||
|
| otherwise = [i|#{a}.#{b}.#{c}+#{d}|]
|
||||||
|
|
||||||
instance IsString AppVersion where
|
instance IsString AppVersion where
|
||||||
fromString s = case traverse (readMaybe . toS) $ split (=='.') (toS s) of
|
fromString s = case traverse (readMaybe . toS) $ splitOn "+" <=< splitOn "." $ (toS s) of
|
||||||
Just [major, minor, patch] -> AppVersion (major, minor, patch)
|
Just [major, minor, patch, build] -> AppVersion (major, minor, patch, build)
|
||||||
|
Just [major, minor, patch] -> AppVersion (major, minor, patch, 0)
|
||||||
_ -> panic . toS $ "Invalid App Version: " <> s
|
_ -> panic . toS $ "Invalid App Version: " <> s
|
||||||
instance ToJSON AppVersion where
|
instance ToJSON AppVersion where
|
||||||
toJSON av = String . toS $ let (a,b,c) = unAppVersion av in [i|#{a}.#{b}.#{c}|]
|
toJSON = String . show
|
||||||
instance FromJSON AppVersion where
|
instance FromJSON AppVersion where
|
||||||
parseJSON = withText "app version" $ \t ->
|
parseJSON = withText "app version" $ \t ->
|
||||||
case splitOn "." t of
|
case traverse (decode . toS) $ splitOn "+" <=< splitOn "." $ t of
|
||||||
[a, b, c] ->
|
Just [a, b, c, d] -> pure $ AppVersion (a, b, c, d)
|
||||||
case traverse (decode . toS) [a, b, c] of
|
Just [a, b, c] -> pure $ AppVersion (a, b, c, 0)
|
||||||
Just [a', b', c'] -> pure $ AppVersion (a', b', c')
|
|
||||||
_ -> fail "non word16 versioning"
|
|
||||||
_ -> fail "unknown versioning"
|
_ -> fail "unknown versioning"
|
||||||
instance ToTypedContent AppVersion where
|
instance ToTypedContent AppVersion where
|
||||||
toTypedContent = toTypedContent . toJSON
|
toTypedContent = toTypedContent . toJSON
|
||||||
instance ToContent AppVersion where
|
instance ToContent AppVersion where
|
||||||
toContent = toContent . toJSON
|
toContent = toContent . toJSON
|
||||||
|
|
||||||
(\\) :: AppVersion -> AppVersion -> (Word16, Word16, Word16)
|
|
||||||
(\\) (AppVersion (a, b, c)) (AppVersion (a1, b1, c1)) = (a `diffy` a1, b `diffy` b1, c `diffy` c1)
|
|
||||||
where
|
|
||||||
d `diffy` d1 = fromIntegral . abs $ (fromIntegral d :: Integer) - (fromIntegral d1 :: Integer)
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------------------------------------
|
||||||
-- Semver AppVersionSpecification
|
-- Semver AppVersionSpecification
|
||||||
------------------------------------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------------------------------------
|
||||||
@@ -92,7 +90,7 @@ instance FromJSON AppVersionSpecification where
|
|||||||
pure $ AppVersionSpecification {..}
|
pure $ AppVersionSpecification {..}
|
||||||
|
|
||||||
mostRecentVersion :: AppVersionSpecification
|
mostRecentVersion :: AppVersionSpecification
|
||||||
mostRecentVersion = AppVersionSpecification SVGreaterThanEq $ AppVersion (0,0,0)
|
mostRecentVersion = AppVersionSpecification SVGreaterThanEq $ AppVersion (0,0,0,0)
|
||||||
|
|
||||||
------------------------------------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------------------------------------
|
||||||
-- Semver RequestModifier
|
-- Semver RequestModifier
|
||||||
|
|||||||
Reference in New Issue
Block a user