{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Data.SemVer.Constraint
( Constraint(..)
, satisfies
, fromText
)
where
import Control.Applicative
import Data.Attoparsec.Text
import Data.Monoid ((<>))
import Data.SemVer.Internal
import qualified Data.SemVer.Delimited as DL
import Data.Text (Text)
data Constraint
= CAny
| CLt !Version
| CLtEq !Version
| CGt !Version
| CGtEq !Version
| CEq !Version
| CAnd !Constraint !Constraint
| COr !Constraint !Constraint
deriving (Constraint -> Constraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c== :: Constraint -> Constraint -> Bool
Eq, Int -> Constraint -> ShowS
[Constraint] -> ShowS
Constraint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constraint] -> ShowS
$cshowList :: [Constraint] -> ShowS
show :: Constraint -> String
$cshow :: Constraint -> String
showsPrec :: Int -> Constraint -> ShowS
$cshowsPrec :: Int -> Constraint -> ShowS
Show)
satisfies :: Version -> Constraint -> Bool
satisfies :: Version -> Constraint -> Bool
satisfies Version
version Constraint
constraint = if Version -> Bool
containsPrerelease Version
version
then if Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((Version -> (Int, Int, Int)
triple Version
version forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> (Int, Int, Int)
triple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ (Constraint -> [(Version -> Constraint, Version)]
prereleaseComparators Constraint
constraint)
then Version -> Constraint -> Bool
go Version
version Constraint
constraint
else if Constraint
constraint forall a. Eq a => a -> a -> Bool
== Constraint
CAny then Bool
True else Bool
False
else Version -> Constraint -> Bool
go Version
version Constraint
constraint
where
triple :: Version -> (Int, Int, Int)
triple :: Version -> (Int, Int, Int)
triple = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,) Version -> Int
_versionMajor Version -> Int
_versionMinor Version -> Int
_versionPatch
containsPrerelease :: Version -> Bool
containsPrerelease :: Version -> Bool
containsPrerelease Version
v = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Identifier]
_versionRelease forall a b. (a -> b) -> a -> b
$ Version
v
prereleaseComparators :: Constraint -> [(Version -> Constraint, Version)]
prereleaseComparators :: Constraint -> [(Version -> Constraint, Version)]
prereleaseComparators = \case
Constraint
CAny -> []
CLt Version
v -> if Version -> Bool
containsPrerelease Version
v then [(Version -> Constraint
CLt, Version
v)] else []
CLtEq Version
v -> if Version -> Bool
containsPrerelease Version
v then [(Version -> Constraint
CLtEq, Version
v)] else []
CGt Version
v -> if Version -> Bool
containsPrerelease Version
v then [(Version -> Constraint
CGt, Version
v)] else []
CGtEq Version
v -> if Version -> Bool
containsPrerelease Version
v then [(Version -> Constraint
CGtEq, Version
v)] else []
CEq Version
v -> if Version -> Bool
containsPrerelease Version
v then [(Version -> Constraint
CEq, Version
v)] else []
CAnd Constraint
a Constraint
b -> Constraint -> [(Version -> Constraint, Version)]
prereleaseComparators Constraint
a forall a. Semigroup a => a -> a -> a
<> Constraint -> [(Version -> Constraint, Version)]
prereleaseComparators Constraint
b
COr Constraint
a Constraint
b -> Constraint -> [(Version -> Constraint, Version)]
prereleaseComparators Constraint
a forall a. Semigroup a => a -> a -> a
<> Constraint -> [(Version -> Constraint, Version)]
prereleaseComparators Constraint
b
go :: Version -> Constraint -> Bool
go :: Version -> Constraint -> Bool
go Version
v Constraint
c = case Constraint
c of
Constraint
CAny -> Bool
True
CLt Version
vc -> Version
v forall a. Ord a => a -> a -> Bool
< Version
vc
CLtEq Version
vc -> Version
v forall a. Ord a => a -> a -> Bool
<= Version
vc
CGt Version
vc -> Version
v forall a. Ord a => a -> a -> Bool
> Version
vc
CGtEq Version
vc -> Version
v forall a. Ord a => a -> a -> Bool
>= Version
vc
CEq Version
vc -> Version
v forall a. Eq a => a -> a -> Bool
== Version
vc
CAnd Constraint
a Constraint
b -> Version -> Constraint -> Bool
go Version
v Constraint
a Bool -> Bool -> Bool
&& Version -> Constraint -> Bool
go Version
v Constraint
b
COr Constraint
a Constraint
b -> Version -> Constraint -> Bool
go Version
v Constraint
a Bool -> Bool -> Bool
|| Version -> Constraint -> Bool
go Version
v Constraint
b
fromText :: Text -> Either String Constraint
fromText :: Text -> Either String Constraint
fromText = forall a. Parser a -> Text -> Either String a
parseOnly Parser Constraint
parser
parser :: Parser Constraint
parser :: Parser Constraint
parser = Delimiters -> Parser Constraint
parserD Delimiters
DL.semantic
parserD :: Delimiters -> Parser Constraint
parserD :: Delimiters -> Parser Constraint
parserD d :: Delimiters
d@Delimiters {Char
_delimIdent :: Delimiters -> Char
_delimMeta :: Delimiters -> Char
_delimRelease :: Delimiters -> Char
_delimPatch :: Delimiters -> Char
_delimMinor :: Delimiters -> Char
_delimIdent :: Char
_delimMeta :: Char
_delimRelease :: Char
_delimPatch :: Char
_delimMinor :: Char
..} = forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput) forall a b. (a -> b) -> a -> b
$ [Parser Constraint
primP, Parser Constraint
andP, Parser Constraint
orP]
where
primP :: Parser Constraint
primP = forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
[ Char -> Parser Char
char Char
'*' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Constraint
CAny
, Char -> Parser Char
char Char
'<' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Version -> Constraint
CLt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delimiters -> Bool -> Parser Version
DL.parser Delimiters
d Bool
False)
, Text -> Parser Text
string Text
"<=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Version -> Constraint
CLtEq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delimiters -> Bool -> Parser Version
DL.parser Delimiters
d Bool
False)
, Char -> Parser Char
char Char
'>' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Version -> Constraint
CGt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delimiters -> Bool -> Parser Version
DL.parser Delimiters
d Bool
False)
, Text -> Parser Text
string Text
">=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Version -> Constraint
CGtEq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delimiters -> Bool -> Parser Version
DL.parser Delimiters
d Bool
False)
, Version -> Constraint
CEq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Char
'=' forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
'=') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Delimiters -> Bool -> Parser Version
DL.parser Delimiters
d Bool
False)
]
andP :: Parser Constraint
andP = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Constraint -> Constraint -> Constraint
CAnd Parser Constraint
primP (Parser ()
skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Constraint
andP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Constraint
primP))
orP :: Parser Constraint
orP = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Constraint -> Constraint -> Constraint
COr (Parser Constraint
andP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Constraint
primP) (Parser ()
skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
string Text
"||" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Constraint
orP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Constraint
andP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Constraint
primP))