109 lines
3.8 KiB
Haskell
109 lines
3.8 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
|
|
{-|
|
|
Module : GHCup.Version
|
|
Description : Version information and version handling.
|
|
Copyright : (c) Julian Ospald, 2020
|
|
License : LGPL-3.0
|
|
Maintainer : hasufell@hasufell.de
|
|
Stability : experimental
|
|
Portability : portable
|
|
-}
|
|
module GHCup.Version where
|
|
|
|
import GHCup.Types
|
|
import Paths_ghcup (version)
|
|
|
|
import Data.Version (Version(versionBranch))
|
|
import URI.ByteString
|
|
import URI.ByteString.QQ
|
|
|
|
import qualified Data.List.NonEmpty as NE
|
|
import qualified Data.Text as T
|
|
import qualified Data.Versions as V
|
|
import Control.Exception.Safe (MonadThrow)
|
|
import Data.Text (Text)
|
|
import Data.List.NonEmpty (NonEmpty((:|)))
|
|
import Data.List (intersperse)
|
|
import Control.Monad.Catch (throwM)
|
|
import GHCup.Errors (ParseError(..))
|
|
|
|
-- | This reflects the API version of the YAML.
|
|
--
|
|
-- Note that when updating this, CI requires that the file exsists AND the same file exists at
|
|
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
|
|
ghcupURL :: URI
|
|
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
|
|
|
|
-- | The current ghcup version.
|
|
ghcUpVer :: V.PVP
|
|
ghcUpVer = V.PVP . NE.fromList . fmap fromIntegral $ versionBranch version
|
|
|
|
-- | ghcup version as numeric string.
|
|
numericVer :: String
|
|
numericVer = T.unpack . V.prettyPVP $ ghcUpVer
|
|
|
|
versionCmp :: V.Versioning -> VersionCmp -> Bool
|
|
versionCmp ver1 (VR_gt ver2) = ver1 > ver2
|
|
versionCmp ver1 (VR_gteq ver2) = ver1 >= ver2
|
|
versionCmp ver1 (VR_lt ver2) = ver1 < ver2
|
|
versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
|
|
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
|
|
|
|
versionRange :: V.Versioning -> VersionRange -> Bool
|
|
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
|
|
versionRange ver' (OrRange cmps range) =
|
|
versionRange ver' (SimpleRange cmps) || versionRange ver' range
|
|
|
|
pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
|
|
pvpToVersion pvp_ rest =
|
|
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . V.version . (<> rest) . V.prettyPVP $ pvp_
|
|
|
|
-- | Convert a version to a PVP and unparsable rest.
|
|
--
|
|
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
|
|
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
|
|
versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
|
|
versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . V.pvp . V.prettyVer $ v
|
|
where
|
|
alternative :: MonadThrow m => V.Version -> m V.PVP
|
|
alternative v' = case NE.takeWhile isDigit (V._vChunks v') of
|
|
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
|
|
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
|
|
|
|
rest :: V.Version -> Text
|
|
rest (V.Version _ cs pr me) =
|
|
let chunks = NE.dropWhile isDigit cs
|
|
ver = intersperse (T.pack ".") . chunksAsT $ chunks
|
|
me' = maybe [] (\m -> [T.pack "+",m]) me
|
|
pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
|
|
prefix = case (ver, pr', me') of
|
|
(_:_, _, _) -> T.pack "."
|
|
_ -> T.pack ""
|
|
in prefix <> mconcat (ver <> pr' <> me')
|
|
where
|
|
chunksAsT :: Functor t => t V.VChunk -> t Text
|
|
chunksAsT = fmap (foldMap f)
|
|
where
|
|
f :: V.VUnit -> Text
|
|
f (V.Digits i) = T.pack $ show i
|
|
f (V.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
|
|
|
|
|
|
|
|
isDigit :: V.VChunk -> Bool
|
|
isDigit (V.Digits _ :| []) = True
|
|
isDigit _ = False
|
|
|
|
unsafeDigit :: V.VChunk -> Int
|
|
unsafeDigit (V.Digits x :| []) = fromIntegral x
|
|
unsafeDigit _ = error "unsafeDigit: wrong input"
|
|
|
|
pvpFromList :: [Int] -> V.PVP
|
|
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral
|