{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Aeson.Types
                   ( FromJSON (..), ToJSON (..), Value (..), withText )
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 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
(Int -> IntersectingVersionRange -> ShowS)
-> (IntersectingVersionRange -> String)
-> ([IntersectingVersionRange] -> ShowS)
-> Show IntersectingVersionRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntersectingVersionRange -> ShowS
showsPrec :: Int -> IntersectingVersionRange -> ShowS
$cshow :: IntersectingVersionRange -> String
show :: IntersectingVersionRange -> String
$cshowList :: [IntersectingVersionRange] -> ShowS
showList :: [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
(<>)

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

-- | 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 = (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 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 (VersionCheck -> VersionCheck -> Bool
(VersionCheck -> VersionCheck -> Bool)
-> (VersionCheck -> VersionCheck -> Bool) -> Eq VersionCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionCheck -> VersionCheck -> Bool
== :: VersionCheck -> VersionCheck -> Bool
$c/= :: VersionCheck -> VersionCheck -> Bool
/= :: 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
$ccompare :: VersionCheck -> VersionCheck -> Ordering
compare :: VersionCheck -> VersionCheck -> Ordering
$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
>= :: VersionCheck -> VersionCheck -> Bool
$cmax :: VersionCheck -> VersionCheck -> VersionCheck
max :: VersionCheck -> VersionCheck -> VersionCheck
$cmin :: VersionCheck -> VersionCheck -> VersionCheck
min :: VersionCheck -> VersionCheck -> VersionCheck
Ord, 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
$cshowsPrec :: Int -> VersionCheck -> ShowS
showsPrec :: Int -> VersionCheck -> ShowS
$cshow :: VersionCheck -> String
show :: VersionCheck -> String
$cshowList :: [VersionCheck] -> ShowS
showList :: [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 = 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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionCheck
MatchMinor
      Text
"match-exact" -> VersionCheck -> Parser VersionCheck
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionCheck
MatchExact
      Text
"newer-minor" -> VersionCheck -> Parser VersionCheck
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionCheck
NewerMinor
      Text
_ -> String -> Parser VersionCheck
forall a. String -> Parser a
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 a. [a] -> 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 a. [a] -> 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

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