module Cachix.Types.PinCreate where

import Data.Aeson (FromJSON, ToJSON)
import Data.Swagger (ToSchema (..), defaultSchemaOptions, genericDeclareNamedSchemaUnrestricted)
import Protolude

data Keep = Days Int | Revisions Int | Forever
  deriving (Int -> Keep -> ShowS
[Keep] -> ShowS
Keep -> String
(Int -> Keep -> ShowS)
-> (Keep -> String) -> ([Keep] -> ShowS) -> Show Keep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Keep -> ShowS
showsPrec :: Int -> Keep -> ShowS
$cshow :: Keep -> String
show :: Keep -> String
$cshowList :: [Keep] -> ShowS
showList :: [Keep] -> ShowS
Show, Keep -> Keep -> Bool
(Keep -> Keep -> Bool) -> (Keep -> Keep -> Bool) -> Eq Keep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Keep -> Keep -> Bool
== :: Keep -> Keep -> Bool
$c/= :: Keep -> Keep -> Bool
/= :: Keep -> Keep -> Bool
Eq, (forall x. Keep -> Rep Keep x)
-> (forall x. Rep Keep x -> Keep) -> Generic Keep
forall x. Rep Keep x -> Keep
forall x. Keep -> Rep Keep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Keep -> Rep Keep x
from :: forall x. Keep -> Rep Keep x
$cto :: forall x. Rep Keep x -> Keep
to :: forall x. Rep Keep x -> Keep
Generic, [Keep] -> Value
[Keep] -> Encoding
Keep -> Value
Keep -> Encoding
(Keep -> Value)
-> (Keep -> Encoding)
-> ([Keep] -> Value)
-> ([Keep] -> Encoding)
-> ToJSON Keep
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Keep -> Value
toJSON :: Keep -> Value
$ctoEncoding :: Keep -> Encoding
toEncoding :: Keep -> Encoding
$ctoJSONList :: [Keep] -> Value
toJSONList :: [Keep] -> Value
$ctoEncodingList :: [Keep] -> Encoding
toEncodingList :: [Keep] -> Encoding
ToJSON, Value -> Parser [Keep]
Value -> Parser Keep
(Value -> Parser Keep) -> (Value -> Parser [Keep]) -> FromJSON Keep
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Keep
parseJSON :: Value -> Parser Keep
$cparseJSONList :: Value -> Parser [Keep]
parseJSONList :: Value -> Parser [Keep]
FromJSON)

-- to support Keep with data constructor with arguments
instance ToSchema Keep where
  declareNamedSchema :: Proxy Keep -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy Keep -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a)) =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchemaUnrestricted SchemaOptions
defaultSchemaOptions

data PinCreate = PinCreate
  { PinCreate -> Text
name :: Text,
    PinCreate -> Text
storePath :: Text,
    PinCreate -> [Text]
artifacts :: [Text],
    PinCreate -> Maybe Keep
keep :: Maybe Keep
  }
  deriving (Int -> PinCreate -> ShowS
[PinCreate] -> ShowS
PinCreate -> String
(Int -> PinCreate -> ShowS)
-> (PinCreate -> String)
-> ([PinCreate] -> ShowS)
-> Show PinCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PinCreate -> ShowS
showsPrec :: Int -> PinCreate -> ShowS
$cshow :: PinCreate -> String
show :: PinCreate -> String
$cshowList :: [PinCreate] -> ShowS
showList :: [PinCreate] -> ShowS
Show, PinCreate -> PinCreate -> Bool
(PinCreate -> PinCreate -> Bool)
-> (PinCreate -> PinCreate -> Bool) -> Eq PinCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PinCreate -> PinCreate -> Bool
== :: PinCreate -> PinCreate -> Bool
$c/= :: PinCreate -> PinCreate -> Bool
/= :: PinCreate -> PinCreate -> Bool
Eq, (forall x. PinCreate -> Rep PinCreate x)
-> (forall x. Rep PinCreate x -> PinCreate) -> Generic PinCreate
forall x. Rep PinCreate x -> PinCreate
forall x. PinCreate -> Rep PinCreate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PinCreate -> Rep PinCreate x
from :: forall x. PinCreate -> Rep PinCreate x
$cto :: forall x. Rep PinCreate x -> PinCreate
to :: forall x. Rep PinCreate x -> PinCreate
Generic, [PinCreate] -> Value
[PinCreate] -> Encoding
PinCreate -> Value
PinCreate -> Encoding
(PinCreate -> Value)
-> (PinCreate -> Encoding)
-> ([PinCreate] -> Value)
-> ([PinCreate] -> Encoding)
-> ToJSON PinCreate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PinCreate -> Value
toJSON :: PinCreate -> Value
$ctoEncoding :: PinCreate -> Encoding
toEncoding :: PinCreate -> Encoding
$ctoJSONList :: [PinCreate] -> Value
toJSONList :: [PinCreate] -> Value
$ctoEncodingList :: [PinCreate] -> Encoding
toEncodingList :: [PinCreate] -> Encoding
ToJSON, Value -> Parser [PinCreate]
Value -> Parser PinCreate
(Value -> Parser PinCreate)
-> (Value -> Parser [PinCreate]) -> FromJSON PinCreate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PinCreate
parseJSON :: Value -> Parser PinCreate
$cparseJSONList :: Value -> Parser [PinCreate]
parseJSONList :: Value -> Parser [PinCreate]
FromJSON, Proxy PinCreate -> Declare (Definitions Schema) NamedSchema
(Proxy PinCreate -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PinCreate
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PinCreate -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PinCreate -> Declare (Definitions Schema) NamedSchema
ToSchema)