{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Types.PvpBounds
( PvpBounds (..)
, PvpBoundsType (..)
, pvpBoundsText
, parsePvpBounds
) where
import qualified Data.Map as Map
import qualified Data.Text as T
import Pantry.Internal.AesonExtended
( FromJSON (..), ToJSON (..), withText
)
import Stack.Prelude
data PvpBoundsType
= PvpBoundsNone
| PvpBoundsUpper
| PvpBoundsLower
| PvpBoundsBoth
deriving (PvpBoundsType
forall a. a -> a -> Bounded a
maxBound :: PvpBoundsType
$cmaxBound :: PvpBoundsType
minBound :: PvpBoundsType
$cminBound :: PvpBoundsType
Bounded, Int -> PvpBoundsType
PvpBoundsType -> Int
PvpBoundsType -> [PvpBoundsType]
PvpBoundsType -> PvpBoundsType
PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
PvpBoundsType -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
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 :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
$cenumFromThenTo :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
enumFromTo :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
$cenumFromTo :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
enumFromThen :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
$cenumFromThen :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
enumFrom :: PvpBoundsType -> [PvpBoundsType]
$cenumFrom :: PvpBoundsType -> [PvpBoundsType]
fromEnum :: PvpBoundsType -> Int
$cfromEnum :: PvpBoundsType -> Int
toEnum :: Int -> PvpBoundsType
$ctoEnum :: Int -> PvpBoundsType
pred :: PvpBoundsType -> PvpBoundsType
$cpred :: PvpBoundsType -> PvpBoundsType
succ :: PvpBoundsType -> PvpBoundsType
$csucc :: PvpBoundsType -> PvpBoundsType
Enum, PvpBoundsType -> PvpBoundsType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PvpBoundsType -> PvpBoundsType -> Bool
$c/= :: PvpBoundsType -> PvpBoundsType -> Bool
== :: PvpBoundsType -> PvpBoundsType -> Bool
$c== :: PvpBoundsType -> PvpBoundsType -> Bool
Eq, Eq PvpBoundsType
PvpBoundsType -> PvpBoundsType -> Bool
PvpBoundsType -> PvpBoundsType -> Ordering
PvpBoundsType -> PvpBoundsType -> PvpBoundsType
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 :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
$cmin :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
max :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
$cmax :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
>= :: PvpBoundsType -> PvpBoundsType -> Bool
$c>= :: PvpBoundsType -> PvpBoundsType -> Bool
> :: PvpBoundsType -> PvpBoundsType -> Bool
$c> :: PvpBoundsType -> PvpBoundsType -> Bool
<= :: PvpBoundsType -> PvpBoundsType -> Bool
$c<= :: PvpBoundsType -> PvpBoundsType -> Bool
< :: PvpBoundsType -> PvpBoundsType -> Bool
$c< :: PvpBoundsType -> PvpBoundsType -> Bool
compare :: PvpBoundsType -> PvpBoundsType -> Ordering
$ccompare :: PvpBoundsType -> PvpBoundsType -> Ordering
Ord, ReadPrec [PvpBoundsType]
ReadPrec PvpBoundsType
Int -> ReadS PvpBoundsType
ReadS [PvpBoundsType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PvpBoundsType]
$creadListPrec :: ReadPrec [PvpBoundsType]
readPrec :: ReadPrec PvpBoundsType
$creadPrec :: ReadPrec PvpBoundsType
readList :: ReadS [PvpBoundsType]
$creadList :: ReadS [PvpBoundsType]
readsPrec :: Int -> ReadS PvpBoundsType
$creadsPrec :: Int -> ReadS PvpBoundsType
Read, Int -> PvpBoundsType -> ShowS
[PvpBoundsType] -> ShowS
PvpBoundsType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PvpBoundsType] -> ShowS
$cshowList :: [PvpBoundsType] -> ShowS
show :: PvpBoundsType -> [Char]
$cshow :: PvpBoundsType -> [Char]
showsPrec :: Int -> PvpBoundsType -> ShowS
$cshowsPrec :: Int -> PvpBoundsType -> ShowS
Show, Typeable)
data PvpBounds = PvpBounds
{ PvpBounds -> PvpBoundsType
pbType :: !PvpBoundsType
, PvpBounds -> Bool
pbAsRevision :: !Bool
}
deriving (PvpBounds -> PvpBounds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PvpBounds -> PvpBounds -> Bool
$c/= :: PvpBounds -> PvpBounds -> Bool
== :: PvpBounds -> PvpBounds -> Bool
$c== :: PvpBounds -> PvpBounds -> Bool
Eq, Eq PvpBounds
PvpBounds -> PvpBounds -> Bool
PvpBounds -> PvpBounds -> Ordering
PvpBounds -> PvpBounds -> PvpBounds
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 :: PvpBounds -> PvpBounds -> PvpBounds
$cmin :: PvpBounds -> PvpBounds -> PvpBounds
max :: PvpBounds -> PvpBounds -> PvpBounds
$cmax :: PvpBounds -> PvpBounds -> PvpBounds
>= :: PvpBounds -> PvpBounds -> Bool
$c>= :: PvpBounds -> PvpBounds -> Bool
> :: PvpBounds -> PvpBounds -> Bool
$c> :: PvpBounds -> PvpBounds -> Bool
<= :: PvpBounds -> PvpBounds -> Bool
$c<= :: PvpBounds -> PvpBounds -> Bool
< :: PvpBounds -> PvpBounds -> Bool
$c< :: PvpBounds -> PvpBounds -> Bool
compare :: PvpBounds -> PvpBounds -> Ordering
$ccompare :: PvpBounds -> PvpBounds -> Ordering
Ord, ReadPrec [PvpBounds]
ReadPrec PvpBounds
Int -> ReadS PvpBounds
ReadS [PvpBounds]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PvpBounds]
$creadListPrec :: ReadPrec [PvpBounds]
readPrec :: ReadPrec PvpBounds
$creadPrec :: ReadPrec PvpBounds
readList :: ReadS [PvpBounds]
$creadList :: ReadS [PvpBounds]
readsPrec :: Int -> ReadS PvpBounds
$creadsPrec :: Int -> ReadS PvpBounds
Read, Int -> PvpBounds -> ShowS
[PvpBounds] -> ShowS
PvpBounds -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PvpBounds] -> ShowS
$cshowList :: [PvpBounds] -> ShowS
show :: PvpBounds -> [Char]
$cshow :: PvpBounds -> [Char]
showsPrec :: Int -> PvpBounds -> ShowS
$cshowsPrec :: Int -> PvpBounds -> ShowS
Show, Typeable)
pvpBoundsText :: PvpBoundsType -> Text
pvpBoundsText :: PvpBoundsType -> Text
pvpBoundsText PvpBoundsType
PvpBoundsNone = Text
"none"
pvpBoundsText PvpBoundsType
PvpBoundsUpper = Text
"upper"
pvpBoundsText PvpBoundsType
PvpBoundsLower = Text
"lower"
pvpBoundsText PvpBoundsType
PvpBoundsBoth = Text
"both"
parsePvpBounds :: Text -> Either String PvpBounds
parsePvpBounds :: Text -> Either [Char] PvpBounds
parsePvpBounds Text
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either [Char] b
err forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ do
(Text
t', Bool
asRevision) <-
case (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'-') Text
t of
(Text
x, Text
"") -> forall a. a -> Maybe a
Just (Text
x, Bool
False)
(Text
x, Text
"-revision") -> forall a. a -> Maybe a
Just (Text
x, Bool
True)
(Text, Text)
_ -> forall a. Maybe a
Nothing
PvpBoundsType
x <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
t' Map Text PvpBoundsType
m
forall a. a -> Maybe a
Just PvpBounds
{ pbType :: PvpBoundsType
pbType = PvpBoundsType
x
, pbAsRevision :: Bool
pbAsRevision = Bool
asRevision
}
where
m :: Map Text PvpBoundsType
m = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PvpBoundsType -> Text
pvpBoundsText forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
err :: Either [Char] b
err = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid PVP bounds: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t
instance ToJSON PvpBounds where
toJSON :: PvpBounds -> Value
toJSON (PvpBounds PvpBoundsType
typ Bool
asRevision) =
forall a. ToJSON a => a -> Value
toJSON (PvpBoundsType -> Text
pvpBoundsText PvpBoundsType
typ forall a. Semigroup a => a -> a -> a
<> (if Bool
asRevision then Text
"-revision" else Text
""))
instance FromJSON PvpBounds where
parseJSON :: Value -> Parser PvpBounds
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"PvpBounds" (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] PvpBounds
parsePvpBounds)