{-# LANGUAGE QuasiQuotes #-}
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(..))
ghcupURL :: URI
ghcupURL :: URI
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
ghcUpVer :: V.PVP
ghcUpVer :: PVP
ghcUpVer = NonEmpty Word -> PVP
V.PVP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
version
numericVer :: String
numericVer :: String
numericVer = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVP -> Text
V.prettyPVP forall a b. (a -> b) -> a -> b
$ PVP
ghcUpVer
versionCmp :: V.Versioning -> VersionCmp -> Bool
versionCmp :: Versioning -> VersionCmp -> Bool
versionCmp Versioning
ver1 (VR_gt Versioning
ver2) = Versioning
ver1 forall a. Ord a => a -> a -> Bool
> Versioning
ver2
versionCmp Versioning
ver1 (VR_gteq Versioning
ver2) = Versioning
ver1 forall a. Ord a => a -> a -> Bool
>= Versioning
ver2
versionCmp Versioning
ver1 (VR_lt Versioning
ver2) = Versioning
ver1 forall a. Ord a => a -> a -> Bool
< Versioning
ver2
versionCmp Versioning
ver1 (VR_lteq Versioning
ver2) = Versioning
ver1 forall a. Ord a => a -> a -> Bool
<= Versioning
ver2
versionCmp Versioning
ver1 (VR_eq Versioning
ver2) = Versioning
ver1 forall a. Eq a => a -> a -> Bool
== Versioning
ver2
versionRange :: V.Versioning -> VersionRange -> Bool
versionRange :: Versioning -> VersionRange -> Bool
versionRange Versioning
ver' (SimpleRange NonEmpty VersionCmp
cmps) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Versioning -> VersionCmp -> Bool
versionCmp Versioning
ver') NonEmpty VersionCmp
cmps
versionRange Versioning
ver' (OrRange NonEmpty VersionCmp
cmps VersionRange
range) =
Versioning -> VersionRange -> Bool
versionRange Versioning
ver' (NonEmpty VersionCmp -> VersionRange
SimpleRange NonEmpty VersionCmp
cmps) Bool -> Bool -> Bool
|| Versioning -> VersionRange -> Bool
versionRange Versioning
ver' VersionRange
range
pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
pvpToVersion :: forall (m :: * -> *). MonadThrow m => PVP -> Text -> m Version
pvpToVersion PVP
pvp_ Text
rest =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParsingError
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"Couldn't convert PVP to Version") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Version
V.version forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Text
rest) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVP -> Text
V.prettyPVP forall a b. (a -> b) -> a -> b
$ PVP
pvp_
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
versionToPVP :: forall (m :: * -> *). MonadThrow m => Version -> m (PVP, Text)
versionToPVP (V.Version (Just Word
_) NonEmpty VChunk
_ [VChunk]
_ Maybe Text
_) = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"Unexpected epoch"
versionToPVP Version
v = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParsingError
_ -> (, Version -> Text
rest Version
v) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => Version -> m PVP
alternative Version
v) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, forall a. Monoid a => a
mempty)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError PVP
V.pvp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
V.prettyVer forall a b. (a -> b) -> a -> b
$ Version
v
where
alternative :: MonadThrow m => V.Version -> m V.PVP
alternative :: forall (m :: * -> *). MonadThrow m => Version -> m PVP
alternative Version
v' = case forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.takeWhile VChunk -> Bool
isDigit (Version -> NonEmpty VChunk
V._vChunks Version
v') of
[] -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"Couldn't convert Version to PVP"
[VChunk]
xs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Int] -> PVP
pvpFromList (VChunk -> Int
unsafeDigit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VChunk]
xs)
rest :: V.Version -> Text
rest :: Version -> Text
rest (V.Version Maybe Word
_ NonEmpty VChunk
cs [VChunk]
pr Maybe Text
me) =
let chunks :: [VChunk]
chunks = forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.dropWhile VChunk -> Bool
isDigit NonEmpty VChunk
cs
ver :: [Text]
ver = forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT forall a b. (a -> b) -> a -> b
$ [VChunk]
chunks
me' :: [Text]
me' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
m -> [String -> Text
T.pack String
"+",Text
m]) Maybe Text
me
pr' :: [Text]
pr' = forall (f :: * -> *) b a.
Foldable f =>
f b -> (f a -> f b) -> f a -> f b
foldable [] (String -> Text
T.pack String
"-" forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
".") (forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT [VChunk]
pr)
prefix :: Text
prefix = case ([Text]
ver, [Text]
pr', [Text]
me') of
(Text
_:[Text]
_, [Text]
_, [Text]
_) -> String -> Text
T.pack String
"."
([Text], [Text], [Text])
_ -> String -> Text
T.pack String
""
in Text
prefix forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat ([Text]
ver forall a. Semigroup a => a -> a -> a
<> [Text]
pr' forall a. Semigroup a => a -> a -> a
<> [Text]
me')
where
chunksAsT :: Functor t => t V.VChunk -> t Text
chunksAsT :: forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VUnit -> Text
f)
where
f :: V.VUnit -> Text
f :: VUnit -> Text
f (V.Digits Word
i) = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Word
i
f (V.Str Text
s) = Text
s
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable :: forall (f :: * -> *) b a.
Foldable f =>
f b -> (f a -> f b) -> f a -> f b
foldable f b
d f a -> f b
g f a
f | forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
f = f b
d
| Bool
otherwise = f a -> f b
g f a
f
isDigit :: V.VChunk -> Bool
isDigit :: VChunk -> Bool
isDigit (V.Digits Word
_ :| []) = Bool
True
isDigit VChunk
_ = Bool
False
unsafeDigit :: V.VChunk -> Int
unsafeDigit :: VChunk -> Int
unsafeDigit (V.Digits Word
x :| []) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x
unsafeDigit VChunk
_ = forall a. HasCallStack => String -> a
error String
"unsafeDigit: wrong input"
pvpFromList :: [Int] -> V.PVP
pvpFromList :: [Int] -> PVP
pvpFromList = NonEmpty Word -> PVP
V.PVP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral