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

-- | Versions for packages.


module Stack.Types.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
  , 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
(<>)

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

-- | 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 version in the same format as yielded by

-- 'Data.Version.showVersion'.

showStackVersion :: String
showStackVersion :: String
showStackVersion = Version -> String
showVersion Version
Meta.version

-- | Current Stack minor version (excludes patchlevel)

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

-- | Current Stack major version. Returns the first two components, defaulting

-- to 0 if not present

stackMajorVersion :: Version
stackMajorVersion :: Version
stackMajorVersion = Version -> Version
toMajorVersion Version
stackVersion