{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}

module Hercules.API.State.StateFile where

import Data.OpenApi qualified as O3
import Hercules.API.Prelude
import Hercules.API.Projects.Project (Project)
import Hercules.API.State.StateVersion (StateVersion)

data StateFile = StateFile
  { StateFile -> Id Project
projectId :: Id Project,
    StateFile -> Text
name :: Text,
    StateFile -> [StateVersion]
versions :: [StateVersion]
  }
  deriving ((forall x. StateFile -> Rep StateFile x)
-> (forall x. Rep StateFile x -> StateFile) -> Generic StateFile
forall x. Rep StateFile x -> StateFile
forall x. StateFile -> Rep StateFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StateFile -> Rep StateFile x
from :: forall x. StateFile -> Rep StateFile x
$cto :: forall x. Rep StateFile x -> StateFile
to :: forall x. Rep StateFile x -> StateFile
Generic, Int -> StateFile -> ShowS
[StateFile] -> ShowS
StateFile -> String
(Int -> StateFile -> ShowS)
-> (StateFile -> String)
-> ([StateFile] -> ShowS)
-> Show StateFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateFile -> ShowS
showsPrec :: Int -> StateFile -> ShowS
$cshow :: StateFile -> String
show :: StateFile -> String
$cshowList :: [StateFile] -> ShowS
showList :: [StateFile] -> ShowS
Show, StateFile -> StateFile -> Bool
(StateFile -> StateFile -> Bool)
-> (StateFile -> StateFile -> Bool) -> Eq StateFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateFile -> StateFile -> Bool
== :: StateFile -> StateFile -> Bool
$c/= :: StateFile -> StateFile -> Bool
/= :: StateFile -> StateFile -> Bool
Eq)
  deriving anyclass (StateFile -> ()
(StateFile -> ()) -> NFData StateFile
forall a. (a -> ()) -> NFData a
$crnf :: StateFile -> ()
rnf :: StateFile -> ()
NFData, [StateFile] -> Value
[StateFile] -> Encoding
StateFile -> Value
StateFile -> Encoding
(StateFile -> Value)
-> (StateFile -> Encoding)
-> ([StateFile] -> Value)
-> ([StateFile] -> Encoding)
-> ToJSON StateFile
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: StateFile -> Value
toJSON :: StateFile -> Value
$ctoEncoding :: StateFile -> Encoding
toEncoding :: StateFile -> Encoding
$ctoJSONList :: [StateFile] -> Value
toJSONList :: [StateFile] -> Value
$ctoEncodingList :: [StateFile] -> Encoding
toEncodingList :: [StateFile] -> Encoding
ToJSON, Value -> Parser [StateFile]
Value -> Parser StateFile
(Value -> Parser StateFile)
-> (Value -> Parser [StateFile]) -> FromJSON StateFile
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser StateFile
parseJSON :: Value -> Parser StateFile
$cparseJSONList :: Value -> Parser [StateFile]
parseJSONList :: Value -> Parser [StateFile]
FromJSON, Proxy StateFile -> Declare (Definitions Schema) NamedSchema
(Proxy StateFile -> Declare (Definitions Schema) NamedSchema)
-> ToSchema StateFile
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy StateFile -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy StateFile -> Declare (Definitions Schema) NamedSchema
ToSchema, Typeable StateFile
Typeable StateFile =>
(Proxy StateFile -> Declare (Definitions Schema) NamedSchema)
-> ToSchema StateFile
Proxy StateFile -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy StateFile -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy StateFile -> Declare (Definitions Schema) NamedSchema
O3.ToSchema)