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

-- | How PVP bounds should be added to .cabal files

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)