{-# 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
(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 l :: VersionRange
l <> :: IntersectingVersionRange
-> IntersectingVersionRange -> IntersectingVersionRange
<> IntersectingVersionRange r :: 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
(<>)

-- | Display a version range
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

-- | A modified intersection which also simplifies, for better display.
intersectVersionRanges :: Cabal.VersionRange -> Cabal.VersionRange -> Cabal.VersionRange
intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange
intersectVersionRanges x :: VersionRange
x y :: 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

-- | Returns the first two components, defaulting to 0 if not present
toMajorVersion :: Version -> Version
toMajorVersion :: Version -> Version
toMajorVersion v :: Version
v =
  case Version -> [Int]
Cabal.versionNumbers Version
v of
    []    -> [Int] -> Version
Cabal.mkVersion [0, 0]
    [a :: Int
a]   -> [Int] -> Version
Cabal.mkVersion [Int
a, 0]
    a :: Int
a:b :: Int
b:_ -> [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 r :: 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

-- | Get the next major version number for the given version
nextMajorVersion :: Version -> Version
nextMajorVersion :: Version -> Version
nextMajorVersion v :: Version
v =
  case Version -> [Int]
Cabal.versionNumbers Version
v of
    []    -> [Int] -> Version
Cabal.mkVersion [0, 1]
    [a :: Int
a]   -> [Int] -> Version
Cabal.mkVersion [Int
a, 1]
    a :: Int
a:b :: Int
b:_ -> [Int] -> Version
Cabal.mkVersion [Int
a, Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 MatchMinor = Text -> Value
String "match-minor"
    toJSON MatchExact = Text -> Value
String "match-exact"
    toJSON NewerMinor = Text -> Value
String "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
$ \t :: Text
t ->
        case Text
t of
            "match-minor" -> VersionCheck -> Parser VersionCheck
forall (m :: * -> *) a. Monad m => a -> m a
return VersionCheck
MatchMinor
            "match-exact" -> VersionCheck -> Parser VersionCheck
forall (m :: * -> *) a. Monad m => a -> m a
return VersionCheck
MatchExact
            "newer-minor" -> VersionCheck -> Parser VersionCheck
forall (m :: * -> *) a. Monad m => a -> m a
return VersionCheck
NewerMinor
            _ -> String -> Parser VersionCheck
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t)
      where
        expected :: String
expected = "VersionCheck value (match-minor, match-exact, or newer-minor)"

checkVersion :: VersionCheck -> Version -> Version -> Bool
checkVersion :: VersionCheck -> Version -> Version -> Bool
checkVersion check :: VersionCheck
check (Version -> [Int]
Cabal.versionNumbers -> [Int]
wanted) (Version -> [Int]
Cabal.versionNumbers -> [Int]
actual) =
    case VersionCheck
check of
        MatchMinor -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take 3 [Bool]
matching)
        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
        NewerMinor -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take 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
_b:c :: a
c:_) = a -> Maybe a
forall a. a -> Maybe a
Just a
c
    getMinor _ = 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
            (Nothing, _) -> Bool
True
            (Just _, Nothing) -> Bool
False
            (Just w :: Int
w, Just a :: Int
a) -> Int
a Int -> Int -> Bool
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 ([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 3 ([Int] -> [Int]) -> (Version -> [Int]) -> Version -> [Int]
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