{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Stack.Types.Version
( Cabal.VersionRange
, IntersectingVersionRange (..)
, VersionCheck (..)
, versionRangeText
, Cabal.withinRange
, Stack.Types.Version.intersectVersionRanges
, toMajorVersion
, latestApplicableVersion
, checkVersion
, nextMajorVersion
, minorVersion
, stackVersion
, showStackVersion
, stackMajorVersion
, stackMinorVersion
) where
import Data.List ( find )
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Version ( showVersion )
import Distribution.Pretty ( pretty )
import qualified Distribution.Version as Cabal
import Pantry.Internal.AesonExtended
( FromJSON (..), ToJSON (..), Value (..), withText )
import qualified Paths_stack as Meta
import Stack.Prelude hiding ( Vector, pretty )
import Text.PrettyPrint ( render )
newtype IntersectingVersionRange = IntersectingVersionRange
{ IntersectingVersionRange -> VersionRange
getIntersectingVersionRange :: Cabal.VersionRange }
deriving Int -> IntersectingVersionRange -> ShowS
[IntersectingVersionRange] -> ShowS
IntersectingVersionRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntersectingVersionRange] -> ShowS
$cshowList :: [IntersectingVersionRange] -> ShowS
show :: IntersectingVersionRange -> String
$cshow :: IntersectingVersionRange -> String
showsPrec :: Int -> IntersectingVersionRange -> ShowS
$cshowsPrec :: Int -> IntersectingVersionRange -> ShowS
Show
instance Semigroup IntersectingVersionRange where
IntersectingVersionRange VersionRange
l <> :: IntersectingVersionRange
-> IntersectingVersionRange -> IntersectingVersionRange
<> IntersectingVersionRange VersionRange
r =
VersionRange -> IntersectingVersionRange
IntersectingVersionRange (VersionRange
l VersionRange -> VersionRange -> VersionRange
`Cabal.intersectVersionRanges` VersionRange
r)
instance Monoid IntersectingVersionRange where
mempty :: IntersectingVersionRange
mempty = VersionRange -> IntersectingVersionRange
IntersectingVersionRange VersionRange
Cabal.anyVersion
mappend :: IntersectingVersionRange
-> IntersectingVersionRange -> IntersectingVersionRange
mappend = forall a. Semigroup a => a -> a -> a
(<>)
versionRangeText :: Cabal.VersionRange -> Text
versionRangeText :: VersionRange -> Text
versionRangeText = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty
intersectVersionRanges :: Cabal.VersionRange -> Cabal.VersionRange -> Cabal.VersionRange
intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange
intersectVersionRanges VersionRange
x VersionRange
y = VersionRange -> VersionRange
Cabal.simplifyVersionRange forall a b. (a -> b) -> a -> b
$ VersionRange -> VersionRange -> VersionRange
Cabal.intersectVersionRanges VersionRange
x VersionRange
y
toMajorVersion :: Version -> Version
toMajorVersion :: Version -> Version
toMajorVersion Version
v =
case Version -> [Int]
Cabal.versionNumbers Version
v of
[] -> [Int] -> Version
Cabal.mkVersion [Int
0, Int
0]
[Int
a] -> [Int] -> Version
Cabal.mkVersion [Int
a, Int
0]
Int
a:Int
b:[Int]
_ -> [Int] -> Version
Cabal.mkVersion [Int
a, Int
b]
latestApplicableVersion :: Cabal.VersionRange -> Set Version -> Maybe Version
latestApplicableVersion :: VersionRange -> Set Version -> Maybe Version
latestApplicableVersion VersionRange
r = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Version -> VersionRange -> Bool
`Cabal.withinRange` VersionRange
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toDescList
nextMajorVersion :: Version -> Version
nextMajorVersion :: Version -> Version
nextMajorVersion Version
v =
case Version -> [Int]
Cabal.versionNumbers Version
v of
[] -> [Int] -> Version
Cabal.mkVersion [Int
0, Int
1]
[Int
a] -> [Int] -> Version
Cabal.mkVersion [Int
a, Int
1]
Int
a:Int
b:[Int]
_ -> [Int] -> Version
Cabal.mkVersion [Int
a, Int
b forall a. Num a => a -> a -> a
+ Int
1]
data VersionCheck
= MatchMinor
| MatchExact
| NewerMinor
deriving (VersionCheck -> VersionCheck -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionCheck -> VersionCheck -> Bool
$c/= :: VersionCheck -> VersionCheck -> Bool
== :: VersionCheck -> VersionCheck -> Bool
$c== :: VersionCheck -> VersionCheck -> Bool
Eq, Eq VersionCheck
VersionCheck -> VersionCheck -> Bool
VersionCheck -> VersionCheck -> Ordering
VersionCheck -> VersionCheck -> VersionCheck
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VersionCheck -> VersionCheck -> VersionCheck
$cmin :: VersionCheck -> VersionCheck -> VersionCheck
max :: VersionCheck -> VersionCheck -> VersionCheck
$cmax :: VersionCheck -> VersionCheck -> VersionCheck
>= :: VersionCheck -> VersionCheck -> Bool
$c>= :: VersionCheck -> VersionCheck -> Bool
> :: VersionCheck -> VersionCheck -> Bool
$c> :: VersionCheck -> VersionCheck -> Bool
<= :: VersionCheck -> VersionCheck -> Bool
$c<= :: VersionCheck -> VersionCheck -> Bool
< :: VersionCheck -> VersionCheck -> Bool
$c< :: VersionCheck -> VersionCheck -> Bool
compare :: VersionCheck -> VersionCheck -> Ordering
$ccompare :: VersionCheck -> VersionCheck -> Ordering
Ord, Int -> VersionCheck -> ShowS
[VersionCheck] -> ShowS
VersionCheck -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionCheck] -> ShowS
$cshowList :: [VersionCheck] -> ShowS
show :: VersionCheck -> String
$cshow :: VersionCheck -> String
showsPrec :: Int -> VersionCheck -> ShowS
$cshowsPrec :: Int -> VersionCheck -> ShowS
Show)
instance ToJSON VersionCheck where
toJSON :: VersionCheck -> Value
toJSON VersionCheck
MatchMinor = Text -> Value
String Text
"match-minor"
toJSON VersionCheck
MatchExact = Text -> Value
String Text
"match-exact"
toJSON VersionCheck
NewerMinor = Text -> Value
String Text
"newer-minor"
instance FromJSON VersionCheck where
parseJSON :: Value -> Parser VersionCheck
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
expected forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text
t of
Text
"match-minor" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionCheck
MatchMinor
Text
"match-exact" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionCheck
MatchExact
Text
"newer-minor" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionCheck
NewerMinor
Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expected " forall a. [a] -> [a] -> [a]
++ String
expected forall a. [a] -> [a] -> [a]
++ String
", but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
t)
where
expected :: String
expected = String
"VersionCheck value (match-minor, match-exact, or newer-minor)"
checkVersion :: VersionCheck -> Version -> Version -> Bool
checkVersion :: VersionCheck -> Version -> Version -> Bool
checkVersion VersionCheck
check (Version -> [Int]
Cabal.versionNumbers -> [Int]
wanted) (Version -> [Int]
Cabal.versionNumbers -> [Int]
actual) =
case VersionCheck
check of
VersionCheck
MatchMinor -> forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a. Int -> [a] -> [a]
take Int
3 [Bool]
matching)
VersionCheck
MatchExact -> forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
wanted forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
actual Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
matching
VersionCheck
NewerMinor -> forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a. Int -> [a] -> [a]
take Int
2 [Bool]
matching) Bool -> Bool -> Bool
&& Bool
newerMinor
where
matching :: [Bool]
matching = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Eq a => a -> a -> Bool
(==) [Int]
wanted [Int]
actual
getMinor :: [a] -> Maybe a
getMinor (a
_a:a
_b:a
c:[a]
_) = forall a. a -> Maybe a
Just a
c
getMinor [a]
_ = forall a. Maybe a
Nothing
newerMinor :: Bool
newerMinor =
case (forall {a}. [a] -> Maybe a
getMinor [Int]
wanted, forall {a}. [a] -> Maybe a
getMinor [Int]
actual) of
(Maybe Int
Nothing, Maybe Int
_) -> Bool
True
(Just Int
_, Maybe Int
Nothing) -> Bool
False
(Just Int
w, Just Int
a) -> Int
a forall a. Ord a => a -> a -> Bool
>= Int
w
minorVersion :: Version -> Version
minorVersion :: Version -> Version
minorVersion = [Int] -> Version
Cabal.mkVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
Cabal.versionNumbers
stackVersion :: Version
stackVersion :: Version
stackVersion = Version -> Version
Cabal.mkVersion' Version
Meta.version
showStackVersion :: String
showStackVersion :: String
showStackVersion = Version -> String
showVersion Version
Meta.version
stackMinorVersion :: Version
stackMinorVersion :: Version
stackMinorVersion = Version -> Version
minorVersion Version
stackVersion
stackMajorVersion :: Version
stackMajorVersion :: Version
stackMajorVersion = Version -> Version
toMajorVersion Version
stackVersion