{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Stack.Types.Version
(Version
,Cabal.VersionRange
,IntersectingVersionRange(..)
,VersionCheck(..)
,versionRangeText
,withinRange
,Stack.Types.Version.intersectVersionRanges
,toMajorVersion
,latestApplicableVersion
,checkVersion
,nextMajorVersion
,minorVersion
,stackVersion
,stackMinorVersion)
where
import Stack.Prelude hiding (Vector)
import Pantry.Internal.AesonExtended
import qualified Data.Set as Set
import qualified Data.Text as T
import Distribution.Text (disp)
import qualified Distribution.Version as Cabal
import Distribution.Version (Version, versionNumbers, withinRange)
import qualified Paths_stack as Meta
import Text.PrettyPrint (render)
newtype IntersectingVersionRange =
IntersectingVersionRange { getIntersectingVersionRange :: Cabal.VersionRange }
deriving Show
instance Semigroup IntersectingVersionRange where
IntersectingVersionRange l <> IntersectingVersionRange r =
IntersectingVersionRange (l `Cabal.intersectVersionRanges` r)
instance Monoid IntersectingVersionRange where
mempty = IntersectingVersionRange Cabal.anyVersion
mappend = (<>)
versionRangeText :: Cabal.VersionRange -> Text
versionRangeText = T.pack . render . disp
intersectVersionRanges :: Cabal.VersionRange -> Cabal.VersionRange -> Cabal.VersionRange
intersectVersionRanges x y = Cabal.simplifyVersionRange $ Cabal.intersectVersionRanges x y
toMajorVersion :: Version -> Version
toMajorVersion v =
case versionNumbers v of
[] -> Cabal.mkVersion [0, 0]
[a] -> Cabal.mkVersion [a, 0]
a:b:_ -> Cabal.mkVersion [a, b]
latestApplicableVersion :: Cabal.VersionRange -> Set Version -> Maybe Version
latestApplicableVersion r = listToMaybe . filter (`withinRange` r) . Set.toDescList
nextMajorVersion :: Version -> Version
nextMajorVersion v =
case versionNumbers v of
[] -> Cabal.mkVersion [0, 1]
[a] -> Cabal.mkVersion [a, 1]
a:b:_ -> Cabal.mkVersion [a, b + 1]
data VersionCheck
= MatchMinor
| MatchExact
| NewerMinor
deriving (Show, Eq, Ord)
instance ToJSON VersionCheck where
toJSON MatchMinor = String "match-minor"
toJSON MatchExact = String "match-exact"
toJSON NewerMinor = String "newer-minor"
instance FromJSON VersionCheck where
parseJSON = withText expected $ \t ->
case t of
"match-minor" -> return MatchMinor
"match-exact" -> return MatchExact
"newer-minor" -> return NewerMinor
_ -> fail ("Expected " ++ expected ++ ", but got " ++ show t)
where
expected = "VersionCheck value (match-minor, match-exact, or newer-minor)"
checkVersion :: VersionCheck -> Version -> Version -> Bool
checkVersion check (versionNumbers -> wanted) (versionNumbers -> actual) =
case check of
MatchMinor -> and (take 3 matching)
MatchExact -> length wanted == length actual && and matching
NewerMinor -> and (take 2 matching) && newerMinor
where
matching = zipWith (==) wanted actual
getMinor (_a:_b:c:_) = Just c
getMinor _ = Nothing
newerMinor =
case (getMinor wanted, getMinor actual) of
(Nothing, _) -> True
(Just _, Nothing) -> False
(Just w, Just a) -> a >= w
minorVersion :: Version -> Version
minorVersion = Cabal.mkVersion . take 3 . versionNumbers
stackVersion :: Version
stackVersion = Cabal.mkVersion' Meta.version
stackMinorVersion :: Version
stackMinorVersion = minorVersion stackVersion