module Stackctl.Config.RequiredVersion
  ( RequiredVersion (..)
  , RequiredVersionOp (..)
  , requiredVersionToText
  , requiredVersionFromText
  , isRequiredVersionSatisfied

    -- * Exported for testing
  , (=~)
  ) where

import Stackctl.Prelude

import Data.Aeson
import Data.List (uncons)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Data.Version hiding (parseVersion)
import qualified Data.Version as Version
import Test.QuickCheck
import Text.ParserCombinators.ReadP (readP_to_S)

data RequiredVersion = RequiredVersion
  { RequiredVersion -> RequiredVersionOp
requiredVersionOp :: RequiredVersionOp
  , RequiredVersion -> Version
requiredVersionCompareWith :: Version
  }
  deriving stock (RequiredVersion -> RequiredVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequiredVersion -> RequiredVersion -> Bool
$c/= :: RequiredVersion -> RequiredVersion -> Bool
== :: RequiredVersion -> RequiredVersion -> Bool
$c== :: RequiredVersion -> RequiredVersion -> Bool
Eq, Int -> RequiredVersion -> ShowS
[RequiredVersion] -> ShowS
RequiredVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequiredVersion] -> ShowS
$cshowList :: [RequiredVersion] -> ShowS
show :: RequiredVersion -> String
$cshow :: RequiredVersion -> String
showsPrec :: Int -> RequiredVersion -> ShowS
$cshowsPrec :: Int -> RequiredVersion -> ShowS
Show)

instance Arbitrary RequiredVersion where
  arbitrary :: Gen RequiredVersion
arbitrary = RequiredVersionOp -> Version -> RequiredVersion
RequiredVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance FromJSON RequiredVersion where
  parseJSON :: Value -> Parser RequiredVersion
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RequiredVersion" forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String RequiredVersion
requiredVersionFromText

instance ToJSON RequiredVersion where
  toJSON :: RequiredVersion -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequiredVersion -> Text
requiredVersionToText
  toEncoding :: RequiredVersion -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequiredVersion -> Text
requiredVersionToText

requiredVersionToText :: RequiredVersion -> Text
requiredVersionToText :: RequiredVersion -> Text
requiredVersionToText RequiredVersion {Version
RequiredVersionOp
requiredVersionCompareWith :: Version
requiredVersionOp :: RequiredVersionOp
requiredVersionCompareWith :: RequiredVersion -> Version
requiredVersionOp :: RequiredVersion -> RequiredVersionOp
..} =
  RequiredVersionOp -> Text
requiredVersionOpToText RequiredVersionOp
requiredVersionOp
    forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall a. Semigroup a => a -> a -> a
<> String -> Text
pack
      (Version -> String
showVersion Version
requiredVersionCompareWith)

requiredVersionFromText :: Text -> Either String RequiredVersion
requiredVersionFromText :: Text -> Either String RequiredVersion
requiredVersionFromText = [Text] -> Either String RequiredVersion
fromWords forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
 where
  fromWords :: [Text] -> Either String RequiredVersion
  fromWords :: [Text] -> Either String RequiredVersion
fromWords = \case
    [Text
w] -> Text -> Text -> Either String RequiredVersion
parseRequiredVersion Text
"=" Text
w
    [Text
op, Text
w] -> Text -> Text -> Either String RequiredVersion
parseRequiredVersion Text
op Text
w
    [Text]
ws ->
      forall a b. a -> Either a b
Left
        forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (Text -> String
unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
ws)
        forall a. Semigroup a => a -> a -> a
<> String
" did not parse as optional operator and version string"

  parseRequiredVersion :: Text -> Text -> Either String RequiredVersion
  parseRequiredVersion :: Text -> Text -> Either String RequiredVersion
parseRequiredVersion Text
op Text
w = RequiredVersionOp -> Version -> RequiredVersion
RequiredVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either String RequiredVersionOp
parseOp Text
op forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either String Version
parseVersion Text
w

  parseOp :: Text -> Either String RequiredVersionOp
  parseOp :: Text -> Either String RequiredVersionOp
parseOp = \case
    Text
"=" -> forall a b. b -> Either a b
Right RequiredVersionOp
RequiredVersionEQ
    Text
"==" -> forall a b. b -> Either a b
Right RequiredVersionOp
RequiredVersionEQ
    Text
"<" -> forall a b. b -> Either a b
Right RequiredVersionOp
RequiredVersionLT
    Text
"<=" -> forall a b. b -> Either a b
Right RequiredVersionOp
RequiredVersionLTE
    Text
">" -> forall a b. b -> Either a b
Right RequiredVersionOp
RequiredVersionGT
    Text
">=" -> forall a b. b -> Either a b
Right RequiredVersionOp
RequiredVersionGTE
    Text
"=~" -> forall a b. b -> Either a b
Right RequiredVersionOp
RequiredVersionIsh
    Text
op ->
      forall a b. a -> Either a b
Left
        forall a b. (a -> b) -> a -> b
$ String
"Invalid comparison operator ("
        forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
op
        forall a. Semigroup a => a -> a -> a
<> String
"), may only be =, <, <=, >, >=, or =~"

  parseVersion :: Text -> Either String Version
  parseVersion :: Text -> Either String Version
parseVersion Text
t =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.last)
      forall a b. (a -> b) -> a -> b
$ forall a b. a -> Maybe b -> Either a b
note (String
"Failed to parse as a version " forall a. Semigroup a => a -> a -> a
<> String
s)
      forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
      forall a b. (a -> b) -> a -> b
$ forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
Version.parseVersion String
s
   where
    s :: String
s = Text -> String
unpack Text
t

isRequiredVersionSatisfied :: RequiredVersion -> Version -> Bool
isRequiredVersionSatisfied :: RequiredVersion -> Version -> Bool
isRequiredVersionSatisfied RequiredVersion {Version
RequiredVersionOp
requiredVersionCompareWith :: Version
requiredVersionOp :: RequiredVersionOp
requiredVersionCompareWith :: RequiredVersion -> Version
requiredVersionOp :: RequiredVersion -> RequiredVersionOp
..} =
  (Version -> Version -> Bool
`requiredVersionCompare` Version
requiredVersionCompareWith)
 where
  requiredVersionCompare :: Version -> Version -> Bool
requiredVersionCompare = RequiredVersionOp -> Version -> Version -> Bool
requiredVersionOpCompare RequiredVersionOp
requiredVersionOp

data RequiredVersionOp
  = RequiredVersionEQ
  | RequiredVersionLT
  | RequiredVersionLTE
  | RequiredVersionGT
  | RequiredVersionGTE
  | RequiredVersionIsh
  deriving stock (RequiredVersionOp -> RequiredVersionOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequiredVersionOp -> RequiredVersionOp -> Bool
$c/= :: RequiredVersionOp -> RequiredVersionOp -> Bool
== :: RequiredVersionOp -> RequiredVersionOp -> Bool
$c== :: RequiredVersionOp -> RequiredVersionOp -> Bool
Eq, Int -> RequiredVersionOp -> ShowS
[RequiredVersionOp] -> ShowS
RequiredVersionOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequiredVersionOp] -> ShowS
$cshowList :: [RequiredVersionOp] -> ShowS
show :: RequiredVersionOp -> String
$cshow :: RequiredVersionOp -> String
showsPrec :: Int -> RequiredVersionOp -> ShowS
$cshowsPrec :: Int -> RequiredVersionOp -> ShowS
Show, RequiredVersionOp
forall a. a -> a -> Bounded a
maxBound :: RequiredVersionOp
$cmaxBound :: RequiredVersionOp
minBound :: RequiredVersionOp
$cminBound :: RequiredVersionOp
Bounded, Int -> RequiredVersionOp
RequiredVersionOp -> Int
RequiredVersionOp -> [RequiredVersionOp]
RequiredVersionOp -> RequiredVersionOp
RequiredVersionOp -> RequiredVersionOp -> [RequiredVersionOp]
RequiredVersionOp
-> RequiredVersionOp -> RequiredVersionOp -> [RequiredVersionOp]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RequiredVersionOp
-> RequiredVersionOp -> RequiredVersionOp -> [RequiredVersionOp]
$cenumFromThenTo :: RequiredVersionOp
-> RequiredVersionOp -> RequiredVersionOp -> [RequiredVersionOp]
enumFromTo :: RequiredVersionOp -> RequiredVersionOp -> [RequiredVersionOp]
$cenumFromTo :: RequiredVersionOp -> RequiredVersionOp -> [RequiredVersionOp]
enumFromThen :: RequiredVersionOp -> RequiredVersionOp -> [RequiredVersionOp]
$cenumFromThen :: RequiredVersionOp -> RequiredVersionOp -> [RequiredVersionOp]
enumFrom :: RequiredVersionOp -> [RequiredVersionOp]
$cenumFrom :: RequiredVersionOp -> [RequiredVersionOp]
fromEnum :: RequiredVersionOp -> Int
$cfromEnum :: RequiredVersionOp -> Int
toEnum :: Int -> RequiredVersionOp
$ctoEnum :: Int -> RequiredVersionOp
pred :: RequiredVersionOp -> RequiredVersionOp
$cpred :: RequiredVersionOp -> RequiredVersionOp
succ :: RequiredVersionOp -> RequiredVersionOp
$csucc :: RequiredVersionOp -> RequiredVersionOp
Enum)

instance Arbitrary RequiredVersionOp where
  arbitrary :: Gen RequiredVersionOp
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

requiredVersionOpToText :: RequiredVersionOp -> Text
requiredVersionOpToText :: RequiredVersionOp -> Text
requiredVersionOpToText = \case
  RequiredVersionOp
RequiredVersionEQ -> Text
"=="
  RequiredVersionOp
RequiredVersionLT -> Text
"<"
  RequiredVersionOp
RequiredVersionLTE -> Text
"<="
  RequiredVersionOp
RequiredVersionGT -> Text
">"
  RequiredVersionOp
RequiredVersionGTE -> Text
">="
  RequiredVersionOp
RequiredVersionIsh -> Text
"=~"

requiredVersionOpCompare :: RequiredVersionOp -> Version -> Version -> Bool
requiredVersionOpCompare :: RequiredVersionOp -> Version -> Version -> Bool
requiredVersionOpCompare = \case
  RequiredVersionOp
RequiredVersionEQ -> forall a. Eq a => a -> a -> Bool
(==)
  RequiredVersionOp
RequiredVersionLT -> forall a. Ord a => a -> a -> Bool
(<)
  RequiredVersionOp
RequiredVersionLTE -> forall a. Ord a => a -> a -> Bool
(<=)
  RequiredVersionOp
RequiredVersionGT -> forall a. Ord a => a -> a -> Bool
(>)
  RequiredVersionOp
RequiredVersionGTE -> forall a. Ord a => a -> a -> Bool
(>=)
  RequiredVersionOp
RequiredVersionIsh -> Version -> Version -> Bool
(=~)

(=~) :: Version -> Version -> Bool
Version
a =~ :: Version -> Version -> Bool
=~ Version
b = Version
a forall a. Ord a => a -> a -> Bool
>= Version
b Bool -> Bool -> Bool
&& Version
a forall a. Ord a => a -> a -> Bool
< Version -> Version
incrementVersion Version
b
 where
  incrementVersion :: Version -> Version
incrementVersion = ([Int] -> [Int]) -> Version -> Version
onVersion forall a b. (a -> b) -> a -> b
$ forall {a} {a}. ([a] -> [a]) -> [a] -> [a]
backwards forall a b. (a -> b) -> a -> b
$ forall {a}. (a -> a) -> [a] -> [a]
onHead (forall a. Num a => a -> a -> a
+ Int
1)
  onVersion :: ([Int] -> [Int]) -> Version -> Version
onVersion [Int] -> [Int]
f = [Int] -> Version
makeVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionBranch
  backwards :: ([a] -> [a]) -> [a] -> [a]
backwards [a] -> [a]
f = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
  onHead :: (a -> a) -> [a] -> [a]
onHead a -> a
f [a]
as = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
as (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> a
f) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (a, [a])
uncons [a]
as