{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

-- | Versions for packages.


module Stack.Types.Version
  (Version
  ,Cabal.VersionRange -- TODO in the future should have a newtype wrapper

  ,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
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
(<>)

-- | Display a version range

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

-- | A modified intersection which also simplifies, for better display.

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

-- | Returns the first two components, defaulting to 0 if not present

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]

-- | Given a version range and a set of versions, find the latest version from

-- the set that is within the range.

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

-- | Get the next major version number for the given version

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 (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, 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)
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 (m :: * -> *) a. Monad m => a -> m a
return VersionCheck
MatchMinor
            Text
"match-exact" -> forall (m :: * -> *) a. Monad m => a -> m a
return VersionCheck
MatchExact
            Text
"newer-minor" -> forall (m :: * -> *) a. Monad m => a -> m a
return 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

-- | Get minor version (excludes any patchlevel)

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

-- | Current Stack version

stackVersion :: Version
stackVersion :: Version
stackVersion = Version -> Version
Cabal.mkVersion' Version
Meta.version

-- | Current Stack minor version (excludes patchlevel)

stackMinorVersion :: Version
stackMinorVersion :: Version
stackMinorVersion = Version -> Version
minorVersion Version
stackVersion