{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Stack.Types.Version
(Version
,Cabal.VersionRange
,IntersectingVersionRange(..)
,VersionCheck(..)
,versionRangeText
,Cabal.withinRange
,Stack.Types.Version.intersectVersionRanges
,toMajorVersion
,latestApplicableVersion
,checkVersion
,nextMajorVersion
,minorVersion
,stackVersion
,stackMinorVersion)
where
import Stack.Prelude hiding (Vector)
import Pantry.Internal.AesonExtended
import Data.List (find)
import qualified Data.Set as Set
import qualified Data.Text as T
import Distribution.Pretty (pretty)
import qualified Distribution.Version as Cabal
import qualified Paths_stack as Meta
import Text.PrettyPrint (render)
newtype IntersectingVersionRange =
IntersectingVersionRange { IntersectingVersionRange -> VersionRange
getIntersectingVersionRange :: Cabal.VersionRange }
deriving Int -> IntersectingVersionRange -> ShowS
[IntersectingVersionRange] -> ShowS
IntersectingVersionRange -> String
(Int -> IntersectingVersionRange -> ShowS)
-> (IntersectingVersionRange -> String)
-> ([IntersectingVersionRange] -> ShowS)
-> Show IntersectingVersionRange
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 = IntersectingVersionRange
-> IntersectingVersionRange -> IntersectingVersionRange
forall a. Semigroup a => a -> a -> a
(<>)
versionRangeText :: Cabal.VersionRange -> Text
versionRangeText :: VersionRange -> Text
versionRangeText = String -> Text
T.pack (String -> Text)
-> (VersionRange -> String) -> VersionRange -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render (Doc -> String) -> (VersionRange -> Doc) -> VersionRange -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> Doc
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 (VersionRange -> VersionRange) -> VersionRange -> VersionRange
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 = (Version -> Bool) -> [Version] -> Maybe Version
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Version -> VersionRange -> Bool
`Cabal.withinRange` VersionRange
r) ([Version] -> Maybe Version)
-> (Set Version -> [Version]) -> Set Version -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Version -> [Version]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]
data VersionCheck
= MatchMinor
| MatchExact
| NewerMinor
deriving (Int -> VersionCheck -> ShowS
[VersionCheck] -> ShowS
VersionCheck -> String
(Int -> VersionCheck -> ShowS)
-> (VersionCheck -> String)
-> ([VersionCheck] -> ShowS)
-> Show VersionCheck
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, VersionCheck -> VersionCheck -> Bool
(VersionCheck -> VersionCheck -> Bool)
-> (VersionCheck -> VersionCheck -> Bool) -> Eq VersionCheck
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
Eq VersionCheck
-> (VersionCheck -> VersionCheck -> Ordering)
-> (VersionCheck -> VersionCheck -> Bool)
-> (VersionCheck -> VersionCheck -> Bool)
-> (VersionCheck -> VersionCheck -> Bool)
-> (VersionCheck -> VersionCheck -> Bool)
-> (VersionCheck -> VersionCheck -> VersionCheck)
-> (VersionCheck -> VersionCheck -> VersionCheck)
-> Ord 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
$cp1Ord :: Eq VersionCheck
Ord)
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 = String
-> (Text -> Parser VersionCheck) -> Value -> Parser VersionCheck
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
expected ((Text -> Parser VersionCheck) -> Value -> Parser VersionCheck)
-> (Text -> Parser VersionCheck) -> Value -> Parser VersionCheck
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case Text
t of
Text
"match-minor" -> VersionCheck -> Parser VersionCheck
forall (m :: * -> *) a. Monad m => a -> m a
return VersionCheck
MatchMinor
Text
"match-exact" -> VersionCheck -> Parser VersionCheck
forall (m :: * -> *) a. Monad m => a -> m a
return VersionCheck
MatchExact
Text
"newer-minor" -> VersionCheck -> Parser VersionCheck
forall (m :: * -> *) a. Monad m => a -> m a
return VersionCheck
NewerMinor
Text
_ -> String -> Parser VersionCheck
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
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 -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
3 [Bool]
matching)
VersionCheck
MatchExact -> [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
wanted Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
actual Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
matching
VersionCheck
NewerMinor -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
2 [Bool]
matching) Bool -> Bool -> Bool
&& Bool
newerMinor
where
matching :: [Bool]
matching = (Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Int]
wanted [Int]
actual
getMinor :: [a] -> Maybe a
getMinor (a
_a:a
_b:a
c:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
c
getMinor [a]
_ = Maybe a
forall a. Maybe a
Nothing
newerMinor :: Bool
newerMinor =
case ([Int] -> Maybe Int
forall a. [a] -> Maybe a
getMinor [Int]
wanted, [Int] -> Maybe Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w
minorVersion :: Version -> Version
minorVersion :: Version -> Version
minorVersion = [Int] -> Version
Cabal.mkVersion ([Int] -> Version) -> (Version -> [Int]) -> Version -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
3 ([Int] -> [Int]) -> (Version -> [Int]) -> Version -> [Int]
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
stackMinorVersion :: Version
stackMinorVersion :: Version
stackMinorVersion = Version -> Version
minorVersion Version
stackVersion