ghcup-hs/lib/GHCup/Version.hs

89 lines
3.1 KiB
Haskell
Raw Normal View History

2020-01-11 20:15:05 +00:00
{-# LANGUAGE QuasiQuotes #-}
2020-07-21 23:08:58 +00:00
{-|
Module : GHCup.Version
Description : Version information and version handling.
2020-07-21 23:08:58 +00:00
Copyright : (c) Julian Ospald, 2020
2020-07-30 18:04:02 +00:00
License : LGPL-3.0
2020-07-21 23:08:58 +00:00
Maintainer : hasufell@hasufell.de
Stability : experimental
2021-05-14 21:09:45 +00:00
Portability : portable
2020-07-21 23:08:58 +00:00
-}
2020-01-11 20:15:05 +00:00
module GHCup.Version where
import GHCup.Types
2021-02-25 14:33:52 +00:00
import Paths_ghcup (version)
2020-01-11 20:15:05 +00:00
2021-02-25 14:33:52 +00:00
import Data.Version (Version(versionBranch))
import URI.ByteString
import URI.ByteString.QQ
2021-02-25 14:33:52 +00:00
import qualified Data.List.NonEmpty as NE
2020-04-17 14:56:56 +00:00
import qualified Data.Text as T
2022-05-21 20:54:18 +00:00
import qualified Data.Versions as V
import Control.Exception.Safe (MonadThrow)
import Data.Text (Text)
import Control.Monad.Catch (throwM)
import GHCup.Errors (ParseError(..))
import Text.Megaparsec
import Data.Void (Void)
2020-04-17 14:56:56 +00:00
2020-08-09 15:39:02 +00:00
-- | This reflects the API version of the YAML.
2021-09-02 19:27:31 +00:00
--
-- 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.8.yaml|]
2020-01-11 20:15:05 +00:00
stackSetupURL :: URI
stackSetupURL = [uri|https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml|]
2023-11-13 07:37:36 +00:00
shimGenURL :: URI
shimGenURL = [uri|https://downloads.haskell.org/~ghcup/shimgen/shim-2.exe|]
shimGenSHA :: T.Text
shimGenSHA = T.pack "7c55e201f71860c5babea886007c8fa44b861abf50d1c07e5677eb0bda387a70"
2020-08-09 15:39:02 +00:00
-- | The current ghcup version.
2022-05-21 20:54:18 +00:00
ghcUpVer :: V.PVP
ghcUpVer = V.PVP . NE.fromList . fmap fromIntegral $ versionBranch version
2020-04-17 14:56:56 +00:00
2020-07-21 23:08:58 +00:00
-- | ghcup version as numeric string.
2020-04-17 14:56:56 +00:00
numericVer :: String
2022-05-21 20:54:18 +00:00
numericVer = T.unpack . V.prettyPVP $ ghcUpVer
2022-05-21 20:54:18 +00:00
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
2022-05-21 20:54:18 +00:00
versionRange :: V.Versioning -> VersionRange -> Bool
2023-07-05 08:44:47 +00:00
versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range
2022-05-21 20:54:18 +00:00
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 = case parse pvp'' "Version->PVP" $ V.prettyVer v of
Left _ -> throwM $ ParseError "Couldn't convert Version to PVP"
Right r -> pure r
2022-05-21 20:54:18 +00:00
where
pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
pvp'' = do
p <- V.pvp'
s <- getParserState
pure (p, stateInput s)
2022-05-21 20:54:18 +00:00
pvpFromList :: [Int] -> V.PVP
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral