{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Stack.Types.PvpBounds
  ( PvpBounds (..)
  , PvpBoundsType (..)
  , pvpBoundsText
  , parsePvpBounds
  ) where

import           Data.Aeson.Types ( FromJSON (..), ToJSON (..), withText )
import qualified Data.Map as Map
import qualified Data.Text as T
import           Stack.Prelude

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

data PvpBoundsType
  = PvpBoundsNone
  | PvpBoundsUpper
  | PvpBoundsLower
  | PvpBoundsBoth
  deriving (PvpBoundsType
PvpBoundsType -> PvpBoundsType -> Bounded PvpBoundsType
forall a. a -> a -> Bounded a
$cminBound :: PvpBoundsType
minBound :: PvpBoundsType
$cmaxBound :: PvpBoundsType
maxBound :: PvpBoundsType
Bounded, Int -> PvpBoundsType
PvpBoundsType -> Int
PvpBoundsType -> [PvpBoundsType]
PvpBoundsType -> PvpBoundsType
PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
PvpBoundsType -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
(PvpBoundsType -> PvpBoundsType)
-> (PvpBoundsType -> PvpBoundsType)
-> (Int -> PvpBoundsType)
-> (PvpBoundsType -> Int)
-> (PvpBoundsType -> [PvpBoundsType])
-> (PvpBoundsType -> PvpBoundsType -> [PvpBoundsType])
-> (PvpBoundsType -> PvpBoundsType -> [PvpBoundsType])
-> (PvpBoundsType
    -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType])
-> Enum 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
$csucc :: PvpBoundsType -> PvpBoundsType
succ :: PvpBoundsType -> PvpBoundsType
$cpred :: PvpBoundsType -> PvpBoundsType
pred :: PvpBoundsType -> PvpBoundsType
$ctoEnum :: Int -> PvpBoundsType
toEnum :: Int -> PvpBoundsType
$cfromEnum :: PvpBoundsType -> Int
fromEnum :: PvpBoundsType -> Int
$cenumFrom :: PvpBoundsType -> [PvpBoundsType]
enumFrom :: PvpBoundsType -> [PvpBoundsType]
$cenumFromThen :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
enumFromThen :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
$cenumFromTo :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
enumFromTo :: PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
$cenumFromThenTo :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
enumFromThenTo :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType -> [PvpBoundsType]
Enum, PvpBoundsType -> PvpBoundsType -> Bool
(PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> Bool) -> Eq PvpBoundsType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PvpBoundsType -> PvpBoundsType -> Bool
== :: PvpBoundsType -> PvpBoundsType -> Bool
$c/= :: PvpBoundsType -> PvpBoundsType -> Bool
/= :: PvpBoundsType -> PvpBoundsType -> Bool
Eq, Eq PvpBoundsType
Eq PvpBoundsType
-> (PvpBoundsType -> PvpBoundsType -> Ordering)
-> (PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> Bool)
-> (PvpBoundsType -> PvpBoundsType -> PvpBoundsType)
-> (PvpBoundsType -> PvpBoundsType -> PvpBoundsType)
-> Ord 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
$ccompare :: PvpBoundsType -> PvpBoundsType -> Ordering
compare :: PvpBoundsType -> PvpBoundsType -> Ordering
$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
>= :: PvpBoundsType -> PvpBoundsType -> Bool
$cmax :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
max :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
$cmin :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
min :: PvpBoundsType -> PvpBoundsType -> PvpBoundsType
Ord, ReadPrec [PvpBoundsType]
ReadPrec PvpBoundsType
Int -> ReadS PvpBoundsType
ReadS [PvpBoundsType]
(Int -> ReadS PvpBoundsType)
-> ReadS [PvpBoundsType]
-> ReadPrec PvpBoundsType
-> ReadPrec [PvpBoundsType]
-> Read PvpBoundsType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PvpBoundsType
readsPrec :: Int -> ReadS PvpBoundsType
$creadList :: ReadS [PvpBoundsType]
readList :: ReadS [PvpBoundsType]
$creadPrec :: ReadPrec PvpBoundsType
readPrec :: ReadPrec PvpBoundsType
$creadListPrec :: ReadPrec [PvpBoundsType]
readListPrec :: ReadPrec [PvpBoundsType]
Read, Int -> PvpBoundsType -> ShowS
[PvpBoundsType] -> ShowS
PvpBoundsType -> [Char]
(Int -> PvpBoundsType -> ShowS)
-> (PvpBoundsType -> [Char])
-> ([PvpBoundsType] -> ShowS)
-> Show PvpBoundsType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PvpBoundsType -> ShowS
showsPrec :: Int -> PvpBoundsType -> ShowS
$cshow :: PvpBoundsType -> [Char]
show :: PvpBoundsType -> [Char]
$cshowList :: [PvpBoundsType] -> ShowS
showList :: [PvpBoundsType] -> ShowS
Show, Typeable)

data PvpBounds = PvpBounds
  { PvpBounds -> PvpBoundsType
pbType :: !PvpBoundsType
  , PvpBounds -> Bool
pbAsRevision :: !Bool
  }
  deriving (PvpBounds -> PvpBounds -> Bool
(PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> Bool) -> Eq PvpBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PvpBounds -> PvpBounds -> Bool
== :: PvpBounds -> PvpBounds -> Bool
$c/= :: PvpBounds -> PvpBounds -> Bool
/= :: PvpBounds -> PvpBounds -> Bool
Eq, Eq PvpBounds
Eq PvpBounds
-> (PvpBounds -> PvpBounds -> Ordering)
-> (PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> Bool)
-> (PvpBounds -> PvpBounds -> PvpBounds)
-> (PvpBounds -> PvpBounds -> PvpBounds)
-> Ord 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
$ccompare :: PvpBounds -> PvpBounds -> Ordering
compare :: PvpBounds -> PvpBounds -> Ordering
$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
>= :: PvpBounds -> PvpBounds -> Bool
$cmax :: PvpBounds -> PvpBounds -> PvpBounds
max :: PvpBounds -> PvpBounds -> PvpBounds
$cmin :: PvpBounds -> PvpBounds -> PvpBounds
min :: PvpBounds -> PvpBounds -> PvpBounds
Ord, ReadPrec [PvpBounds]
ReadPrec PvpBounds
Int -> ReadS PvpBounds
ReadS [PvpBounds]
(Int -> ReadS PvpBounds)
-> ReadS [PvpBounds]
-> ReadPrec PvpBounds
-> ReadPrec [PvpBounds]
-> Read PvpBounds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PvpBounds
readsPrec :: Int -> ReadS PvpBounds
$creadList :: ReadS [PvpBounds]
readList :: ReadS [PvpBounds]
$creadPrec :: ReadPrec PvpBounds
readPrec :: ReadPrec PvpBounds
$creadListPrec :: ReadPrec [PvpBounds]
readListPrec :: ReadPrec [PvpBounds]
Read, Int -> PvpBounds -> ShowS
[PvpBounds] -> ShowS
PvpBounds -> [Char]
(Int -> PvpBounds -> ShowS)
-> (PvpBounds -> [Char])
-> ([PvpBounds] -> ShowS)
-> Show PvpBounds
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PvpBounds -> ShowS
showsPrec :: Int -> PvpBounds -> ShowS
$cshow :: PvpBounds -> [Char]
show :: PvpBounds -> [Char]
$cshowList :: [PvpBounds] -> ShowS
showList :: [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 = Either [Char] PvpBounds
-> (PvpBounds -> Either [Char] PvpBounds)
-> Maybe PvpBounds
-> Either [Char] PvpBounds
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either [Char] PvpBounds
forall {b}. Either [Char] b
err PvpBounds -> Either [Char] PvpBounds
forall a b. b -> Either a b
Right (Maybe PvpBounds -> Either [Char] PvpBounds)
-> Maybe PvpBounds -> Either [Char] PvpBounds
forall a b. (a -> b) -> a -> b
$ do
  (Text
t', Bool
asRevision) <-
    case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
t of
      (Text
x, Text
"") -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
x, Bool
False)
      (Text
x, Text
"-revision") -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
x, Bool
True)
      (Text, Text)
_ -> Maybe (Text, Bool)
forall a. Maybe a
Nothing
  PvpBoundsType
x <- Text -> Map Text PvpBoundsType -> Maybe PvpBoundsType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
t' Map Text PvpBoundsType
m
  PvpBounds -> Maybe PvpBounds
forall a. a -> Maybe a
Just PvpBounds
    { pbType :: PvpBoundsType
pbType = PvpBoundsType
x
    , pbAsRevision :: Bool
pbAsRevision = Bool
asRevision
    }
 where
  m :: Map Text PvpBoundsType
m = [(Text, PvpBoundsType)] -> Map Text PvpBoundsType
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, PvpBoundsType)] -> Map Text PvpBoundsType)
-> [(Text, PvpBoundsType)] -> Map Text PvpBoundsType
forall a b. (a -> b) -> a -> b
$ (PvpBoundsType -> (Text, PvpBoundsType))
-> [PvpBoundsType] -> [(Text, PvpBoundsType)]
forall a b. (a -> b) -> [a] -> [b]
map (PvpBoundsType -> Text
pvpBoundsText (PvpBoundsType -> Text)
-> (PvpBoundsType -> PvpBoundsType)
-> PvpBoundsType
-> (Text, PvpBoundsType)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PvpBoundsType -> PvpBoundsType
forall a. a -> a
id) [PvpBoundsType
forall a. Bounded a => a
minBound..PvpBoundsType
forall a. Bounded a => a
maxBound]
  err :: Either [Char] b
err = [Char] -> Either [Char] b
forall a b. a -> Either a b
Left ([Char] -> Either [Char] b) -> [Char] -> Either [Char] b
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid PVP bounds: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t

instance ToJSON PvpBounds where
  toJSON :: PvpBounds -> Value
toJSON (PvpBounds PvpBoundsType
typ Bool
asRevision) =
    Text -> Value
forall a. ToJSON a => a -> Value
toJSON (PvpBoundsType -> Text
pvpBoundsText PvpBoundsType
typ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
asRevision then Text
"-revision" else Text
""))

instance FromJSON PvpBounds where
  parseJSON :: Value -> Parser PvpBounds
parseJSON = [Char] -> (Text -> Parser PvpBounds) -> Value -> Parser PvpBounds
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"PvpBounds" (([Char] -> Parser PvpBounds)
-> (PvpBounds -> Parser PvpBounds)
-> Either [Char] PvpBounds
-> Parser PvpBounds
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Parser PvpBounds
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail PvpBounds -> Parser PvpBounds
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] PvpBounds -> Parser PvpBounds)
-> (Text -> Either [Char] PvpBounds) -> Text -> Parser PvpBounds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] PvpBounds
parsePvpBounds)