{-
   Neptune Backend API

   No description provided (generated by Openapi Generator https://github.com/openapitools/openapi-generator)

   OpenAPI Version: 3.0.1
   Neptune Backend API API version: 2.8
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : Neptune.Backend.Model
-}

{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeFamilies               #-}
{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}

module Neptune.Backend.Model where

import           Neptune.Backend.Core
import           Neptune.Backend.MimeTypes

import           Data.Aeson                ((.:!), (.:), (.:?), (.=))

import qualified Control.Arrow             as P (left)
import qualified Data.Aeson                as A
import qualified Data.ByteString           as B
import qualified Data.ByteString.Base64    as B64
import qualified Data.ByteString.Char8     as BC
import qualified Data.ByteString.Lazy      as BL
import qualified Data.Data                 as P (TypeRep, Typeable, typeOf,
                                                 typeRep)
import qualified Data.Foldable             as P
import qualified Data.HashMap.Lazy         as HM
import qualified Data.Map                  as Map
import qualified Data.Maybe                as P
import qualified Data.Set                  as Set
import qualified Data.Text                 as T
import qualified Data.Text.Encoding        as T
import qualified Data.Time                 as TI
import qualified Lens.Micro                as L
import qualified Web.FormUrlEncoded        as WH
import qualified Web.HttpApiData           as WH

import           Control.Applicative       (Alternative, (<|>))
import           Data.Function             ((&))
import           Data.Monoid               ((<>))
import           Data.Text                 (Text)
import           Prelude                   (Applicative, Bool (..), Char,
                                            Double, FilePath, Float, Functor,
                                            Int, Integer, Maybe (..), Monad,
                                            String, fmap, maybe, mempty, pure,
                                            undefined, ($), (.), (/=), (<$>),
                                            (<*>), (=<<), (>>=))

import qualified Prelude                   as P



-- * Parameter newtypes


-- ** AvatarFile
newtype AvatarFile = AvatarFile { AvatarFile -> FilePath
unAvatarFile :: FilePath } deriving (AvatarFile -> AvatarFile -> Bool
(AvatarFile -> AvatarFile -> Bool)
-> (AvatarFile -> AvatarFile -> Bool) -> Eq AvatarFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AvatarFile -> AvatarFile -> Bool
$c/= :: AvatarFile -> AvatarFile -> Bool
== :: AvatarFile -> AvatarFile -> Bool
$c== :: AvatarFile -> AvatarFile -> Bool
P.Eq, Int -> AvatarFile -> ShowS
[AvatarFile] -> ShowS
AvatarFile -> FilePath
(Int -> AvatarFile -> ShowS)
-> (AvatarFile -> FilePath)
-> ([AvatarFile] -> ShowS)
-> Show AvatarFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AvatarFile] -> ShowS
$cshowList :: [AvatarFile] -> ShowS
show :: AvatarFile -> FilePath
$cshow :: AvatarFile -> FilePath
showsPrec :: Int -> AvatarFile -> ShowS
$cshowsPrec :: Int -> AvatarFile -> ShowS
P.Show)

-- ** BackgroundFile
newtype BackgroundFile = BackgroundFile { BackgroundFile -> FilePath
unBackgroundFile :: FilePath } deriving (BackgroundFile -> BackgroundFile -> Bool
(BackgroundFile -> BackgroundFile -> Bool)
-> (BackgroundFile -> BackgroundFile -> Bool) -> Eq BackgroundFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackgroundFile -> BackgroundFile -> Bool
$c/= :: BackgroundFile -> BackgroundFile -> Bool
== :: BackgroundFile -> BackgroundFile -> Bool
$c== :: BackgroundFile -> BackgroundFile -> Bool
P.Eq, Int -> BackgroundFile -> ShowS
[BackgroundFile] -> ShowS
BackgroundFile -> FilePath
(Int -> BackgroundFile -> ShowS)
-> (BackgroundFile -> FilePath)
-> ([BackgroundFile] -> ShowS)
-> Show BackgroundFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BackgroundFile] -> ShowS
$cshowList :: [BackgroundFile] -> ShowS
show :: BackgroundFile -> FilePath
$cshow :: BackgroundFile -> FilePath
showsPrec :: Int -> BackgroundFile -> ShowS
$cshowsPrec :: Int -> BackgroundFile -> ShowS
P.Show)

-- ** ChannelId
newtype ChannelId = ChannelId { ChannelId -> Text
unChannelId :: Text } deriving (ChannelId -> ChannelId -> Bool
(ChannelId -> ChannelId -> Bool)
-> (ChannelId -> ChannelId -> Bool) -> Eq ChannelId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelId -> ChannelId -> Bool
$c/= :: ChannelId -> ChannelId -> Bool
== :: ChannelId -> ChannelId -> Bool
$c== :: ChannelId -> ChannelId -> Bool
P.Eq, Int -> ChannelId -> ShowS
[ChannelId] -> ShowS
ChannelId -> FilePath
(Int -> ChannelId -> ShowS)
-> (ChannelId -> FilePath)
-> ([ChannelId] -> ShowS)
-> Show ChannelId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChannelId] -> ShowS
$cshowList :: [ChannelId] -> ShowS
show :: ChannelId -> FilePath
$cshow :: ChannelId -> FilePath
showsPrec :: Int -> ChannelId -> ShowS
$cshowsPrec :: Int -> ChannelId -> ShowS
P.Show)

-- ** ChannelsValues
newtype ChannelsValues = ChannelsValues { ChannelsValues -> [InputChannelValues]
unChannelsValues :: [InputChannelValues] } deriving (ChannelsValues -> ChannelsValues -> Bool
(ChannelsValues -> ChannelsValues -> Bool)
-> (ChannelsValues -> ChannelsValues -> Bool) -> Eq ChannelsValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelsValues -> ChannelsValues -> Bool
$c/= :: ChannelsValues -> ChannelsValues -> Bool
== :: ChannelsValues -> ChannelsValues -> Bool
$c== :: ChannelsValues -> ChannelsValues -> Bool
P.Eq, Int -> ChannelsValues -> ShowS
[ChannelsValues] -> ShowS
ChannelsValues -> FilePath
(Int -> ChannelsValues -> ShowS)
-> (ChannelsValues -> FilePath)
-> ([ChannelsValues] -> ShowS)
-> Show ChannelsValues
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChannelsValues] -> ShowS
$cshowList :: [ChannelsValues] -> ShowS
show :: ChannelsValues -> FilePath
$cshow :: ChannelsValues -> FilePath
showsPrec :: Int -> ChannelsValues -> ShowS
$cshowsPrec :: Int -> ChannelsValues -> ShowS
P.Show, [ChannelsValues] -> Encoding
[ChannelsValues] -> Value
ChannelsValues -> Encoding
ChannelsValues -> Value
(ChannelsValues -> Value)
-> (ChannelsValues -> Encoding)
-> ([ChannelsValues] -> Value)
-> ([ChannelsValues] -> Encoding)
-> ToJSON ChannelsValues
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChannelsValues] -> Encoding
$ctoEncodingList :: [ChannelsValues] -> Encoding
toJSONList :: [ChannelsValues] -> Value
$ctoJSONList :: [ChannelsValues] -> Value
toEncoding :: ChannelsValues -> Encoding
$ctoEncoding :: ChannelsValues -> Encoding
toJSON :: ChannelsValues -> Value
$ctoJSON :: ChannelsValues -> Value
A.ToJSON)

-- ** ChartId
newtype ChartId = ChartId { ChartId -> Text
unChartId :: Text } deriving (ChartId -> ChartId -> Bool
(ChartId -> ChartId -> Bool)
-> (ChartId -> ChartId -> Bool) -> Eq ChartId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartId -> ChartId -> Bool
$c/= :: ChartId -> ChartId -> Bool
== :: ChartId -> ChartId -> Bool
$c== :: ChartId -> ChartId -> Bool
P.Eq, Int -> ChartId -> ShowS
[ChartId] -> ShowS
ChartId -> FilePath
(Int -> ChartId -> ShowS)
-> (ChartId -> FilePath) -> ([ChartId] -> ShowS) -> Show ChartId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChartId] -> ShowS
$cshowList :: [ChartId] -> ShowS
show :: ChartId -> FilePath
$cshow :: ChartId -> FilePath
showsPrec :: Int -> ChartId -> ShowS
$cshowsPrec :: Int -> ChartId -> ShowS
P.Show)

-- ** ChartSetId
newtype ChartSetId = ChartSetId { ChartSetId -> Text
unChartSetId :: Text } deriving (ChartSetId -> ChartSetId -> Bool
(ChartSetId -> ChartSetId -> Bool)
-> (ChartSetId -> ChartSetId -> Bool) -> Eq ChartSetId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartSetId -> ChartSetId -> Bool
$c/= :: ChartSetId -> ChartSetId -> Bool
== :: ChartSetId -> ChartSetId -> Bool
$c== :: ChartSetId -> ChartSetId -> Bool
P.Eq, Int -> ChartSetId -> ShowS
[ChartSetId] -> ShowS
ChartSetId -> FilePath
(Int -> ChartSetId -> ShowS)
-> (ChartSetId -> FilePath)
-> ([ChartSetId] -> ShowS)
-> Show ChartSetId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChartSetId] -> ShowS
$cshowList :: [ChartSetId] -> ShowS
show :: ChartSetId -> FilePath
$cshow :: ChartSetId -> FilePath
showsPrec :: Int -> ChartSetId -> ShowS
$cshowsPrec :: Int -> ChartSetId -> ShowS
P.Show)

-- ** EndPoint
newtype EndPoint = EndPoint { EndPoint -> Integer
unEndPoint :: Integer } deriving (EndPoint -> EndPoint -> Bool
(EndPoint -> EndPoint -> Bool)
-> (EndPoint -> EndPoint -> Bool) -> Eq EndPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndPoint -> EndPoint -> Bool
$c/= :: EndPoint -> EndPoint -> Bool
== :: EndPoint -> EndPoint -> Bool
$c== :: EndPoint -> EndPoint -> Bool
P.Eq, Int -> EndPoint -> ShowS
[EndPoint] -> ShowS
EndPoint -> FilePath
(Int -> EndPoint -> ShowS)
-> (EndPoint -> FilePath) -> ([EndPoint] -> ShowS) -> Show EndPoint
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EndPoint] -> ShowS
$cshowList :: [EndPoint] -> ShowS
show :: EndPoint -> FilePath
$cshow :: EndPoint -> FilePath
showsPrec :: Int -> EndPoint -> ShowS
$cshowsPrec :: Int -> EndPoint -> ShowS
P.Show)

-- ** ExperimentId
newtype ExperimentId = ExperimentId { ExperimentId -> Text
unExperimentId :: Text } deriving (ExperimentId -> ExperimentId -> Bool
(ExperimentId -> ExperimentId -> Bool)
-> (ExperimentId -> ExperimentId -> Bool) -> Eq ExperimentId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExperimentId -> ExperimentId -> Bool
$c/= :: ExperimentId -> ExperimentId -> Bool
== :: ExperimentId -> ExperimentId -> Bool
$c== :: ExperimentId -> ExperimentId -> Bool
P.Eq, Int -> ExperimentId -> ShowS
[ExperimentId] -> ShowS
ExperimentId -> FilePath
(Int -> ExperimentId -> ShowS)
-> (ExperimentId -> FilePath)
-> ([ExperimentId] -> ShowS)
-> Show ExperimentId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExperimentId] -> ShowS
$cshowList :: [ExperimentId] -> ShowS
show :: ExperimentId -> FilePath
$cshow :: ExperimentId -> FilePath
showsPrec :: Int -> ExperimentId -> ShowS
$cshowsPrec :: Int -> ExperimentId -> ShowS
P.Show)

-- ** ExperimentIdentifier
newtype ExperimentIdentifier = ExperimentIdentifier { ExperimentIdentifier -> Text
unExperimentIdentifier :: Text } deriving (ExperimentIdentifier -> ExperimentIdentifier -> Bool
(ExperimentIdentifier -> ExperimentIdentifier -> Bool)
-> (ExperimentIdentifier -> ExperimentIdentifier -> Bool)
-> Eq ExperimentIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExperimentIdentifier -> ExperimentIdentifier -> Bool
$c/= :: ExperimentIdentifier -> ExperimentIdentifier -> Bool
== :: ExperimentIdentifier -> ExperimentIdentifier -> Bool
$c== :: ExperimentIdentifier -> ExperimentIdentifier -> Bool
P.Eq, Int -> ExperimentIdentifier -> ShowS
[ExperimentIdentifier] -> ShowS
ExperimentIdentifier -> FilePath
(Int -> ExperimentIdentifier -> ShowS)
-> (ExperimentIdentifier -> FilePath)
-> ([ExperimentIdentifier] -> ShowS)
-> Show ExperimentIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExperimentIdentifier] -> ShowS
$cshowList :: [ExperimentIdentifier] -> ShowS
show :: ExperimentIdentifier -> FilePath
$cshow :: ExperimentIdentifier -> FilePath
showsPrec :: Int -> ExperimentIdentifier -> ShowS
$cshowsPrec :: Int -> ExperimentIdentifier -> ShowS
P.Show)

-- ** ExperimentIdentity
newtype ExperimentIdentity = ExperimentIdentity { ExperimentIdentity -> Text
unExperimentIdentity :: Text } deriving (ExperimentIdentity -> ExperimentIdentity -> Bool
(ExperimentIdentity -> ExperimentIdentity -> Bool)
-> (ExperimentIdentity -> ExperimentIdentity -> Bool)
-> Eq ExperimentIdentity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExperimentIdentity -> ExperimentIdentity -> Bool
$c/= :: ExperimentIdentity -> ExperimentIdentity -> Bool
== :: ExperimentIdentity -> ExperimentIdentity -> Bool
$c== :: ExperimentIdentity -> ExperimentIdentity -> Bool
P.Eq, Int -> ExperimentIdentity -> ShowS
[ExperimentIdentity] -> ShowS
ExperimentIdentity -> FilePath
(Int -> ExperimentIdentity -> ShowS)
-> (ExperimentIdentity -> FilePath)
-> ([ExperimentIdentity] -> ShowS)
-> Show ExperimentIdentity
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExperimentIdentity] -> ShowS
$cshowList :: [ExperimentIdentity] -> ShowS
show :: ExperimentIdentity -> FilePath
$cshow :: ExperimentIdentity -> FilePath
showsPrec :: Int -> ExperimentIdentity -> ShowS
$cshowsPrec :: Int -> ExperimentIdentity -> ShowS
P.Show)

-- ** ExperimentIds
newtype ExperimentIds = ExperimentIds { ExperimentIds -> [Text]
unExperimentIds :: [Text] } deriving (ExperimentIds -> ExperimentIds -> Bool
(ExperimentIds -> ExperimentIds -> Bool)
-> (ExperimentIds -> ExperimentIds -> Bool) -> Eq ExperimentIds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExperimentIds -> ExperimentIds -> Bool
$c/= :: ExperimentIds -> ExperimentIds -> Bool
== :: ExperimentIds -> ExperimentIds -> Bool
$c== :: ExperimentIds -> ExperimentIds -> Bool
P.Eq, Int -> ExperimentIds -> ShowS
[ExperimentIds] -> ShowS
ExperimentIds -> FilePath
(Int -> ExperimentIds -> ShowS)
-> (ExperimentIds -> FilePath)
-> ([ExperimentIds] -> ShowS)
-> Show ExperimentIds
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExperimentIds] -> ShowS
$cshowList :: [ExperimentIds] -> ShowS
show :: ExperimentIds -> FilePath
$cshow :: ExperimentIds -> FilePath
showsPrec :: Int -> ExperimentIds -> ShowS
$cshowsPrec :: Int -> ExperimentIds -> ShowS
P.Show, [ExperimentIds] -> Encoding
[ExperimentIds] -> Value
ExperimentIds -> Encoding
ExperimentIds -> Value
(ExperimentIds -> Value)
-> (ExperimentIds -> Encoding)
-> ([ExperimentIds] -> Value)
-> ([ExperimentIds] -> Encoding)
-> ToJSON ExperimentIds
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExperimentIds] -> Encoding
$ctoEncodingList :: [ExperimentIds] -> Encoding
toJSONList :: [ExperimentIds] -> Value
$ctoJSONList :: [ExperimentIds] -> Value
toEncoding :: ExperimentIds -> Encoding
$ctoEncoding :: ExperimentIds -> Encoding
toJSON :: ExperimentIds -> Value
$ctoJSON :: ExperimentIds -> Value
A.ToJSON)

-- ** Gzipped
newtype Gzipped = Gzipped { Gzipped -> Bool
unGzipped :: Bool } deriving (Gzipped -> Gzipped -> Bool
(Gzipped -> Gzipped -> Bool)
-> (Gzipped -> Gzipped -> Bool) -> Eq Gzipped
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gzipped -> Gzipped -> Bool
$c/= :: Gzipped -> Gzipped -> Bool
== :: Gzipped -> Gzipped -> Bool
$c== :: Gzipped -> Gzipped -> Bool
P.Eq, Int -> Gzipped -> ShowS
[Gzipped] -> ShowS
Gzipped -> FilePath
(Int -> Gzipped -> ShowS)
-> (Gzipped -> FilePath) -> ([Gzipped] -> ShowS) -> Show Gzipped
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Gzipped] -> ShowS
$cshowList :: [Gzipped] -> ShowS
show :: Gzipped -> FilePath
$cshow :: Gzipped -> FilePath
showsPrec :: Int -> Gzipped -> ShowS
$cshowsPrec :: Int -> Gzipped -> ShowS
P.Show)

-- ** Id
newtype Id = Id { Id -> Text
unId :: Text } deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
P.Eq, Int -> Id -> ShowS
[Id] -> ShowS
Id -> FilePath
(Int -> Id -> ShowS)
-> (Id -> FilePath) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> FilePath
$cshow :: Id -> FilePath
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
P.Show)

-- ** Ids
newtype Ids = Ids { Ids -> [Text]
unIds :: [Text] } deriving (Ids -> Ids -> Bool
(Ids -> Ids -> Bool) -> (Ids -> Ids -> Bool) -> Eq Ids
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ids -> Ids -> Bool
$c/= :: Ids -> Ids -> Bool
== :: Ids -> Ids -> Bool
$c== :: Ids -> Ids -> Bool
P.Eq, Int -> Ids -> ShowS
[Ids] -> ShowS
Ids -> FilePath
(Int -> Ids -> ShowS)
-> (Ids -> FilePath) -> ([Ids] -> ShowS) -> Show Ids
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Ids] -> ShowS
$cshowList :: [Ids] -> ShowS
show :: Ids -> FilePath
$cshow :: Ids -> FilePath
showsPrec :: Int -> Ids -> ShowS
$cshowsPrec :: Int -> Ids -> ShowS
P.Show)

-- ** IncludeInvitations
newtype IncludeInvitations = IncludeInvitations { IncludeInvitations -> Bool
unIncludeInvitations :: Bool } deriving (IncludeInvitations -> IncludeInvitations -> Bool
(IncludeInvitations -> IncludeInvitations -> Bool)
-> (IncludeInvitations -> IncludeInvitations -> Bool)
-> Eq IncludeInvitations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncludeInvitations -> IncludeInvitations -> Bool
$c/= :: IncludeInvitations -> IncludeInvitations -> Bool
== :: IncludeInvitations -> IncludeInvitations -> Bool
$c== :: IncludeInvitations -> IncludeInvitations -> Bool
P.Eq, Int -> IncludeInvitations -> ShowS
[IncludeInvitations] -> ShowS
IncludeInvitations -> FilePath
(Int -> IncludeInvitations -> ShowS)
-> (IncludeInvitations -> FilePath)
-> ([IncludeInvitations] -> ShowS)
-> Show IncludeInvitations
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [IncludeInvitations] -> ShowS
$cshowList :: [IncludeInvitations] -> ShowS
show :: IncludeInvitations -> FilePath
$cshow :: IncludeInvitations -> FilePath
showsPrec :: Int -> IncludeInvitations -> ShowS
$cshowsPrec :: Int -> IncludeInvitations -> ShowS
P.Show)

-- ** InvitationId
newtype InvitationId = InvitationId { InvitationId -> Text
unInvitationId :: Text } deriving (InvitationId -> InvitationId -> Bool
(InvitationId -> InvitationId -> Bool)
-> (InvitationId -> InvitationId -> Bool) -> Eq InvitationId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvitationId -> InvitationId -> Bool
$c/= :: InvitationId -> InvitationId -> Bool
== :: InvitationId -> InvitationId -> Bool
$c== :: InvitationId -> InvitationId -> Bool
P.Eq, Int -> InvitationId -> ShowS
[InvitationId] -> ShowS
InvitationId -> FilePath
(Int -> InvitationId -> ShowS)
-> (InvitationId -> FilePath)
-> ([InvitationId] -> ShowS)
-> Show InvitationId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InvitationId] -> ShowS
$cshowList :: [InvitationId] -> ShowS
show :: InvitationId -> FilePath
$cshow :: InvitationId -> FilePath
showsPrec :: Int -> InvitationId -> ShowS
$cshowsPrec :: Int -> InvitationId -> ShowS
P.Show)

-- ** ItemCount
newtype ItemCount = ItemCount { ItemCount -> Int
unItemCount :: Int } deriving (ItemCount -> ItemCount -> Bool
(ItemCount -> ItemCount -> Bool)
-> (ItemCount -> ItemCount -> Bool) -> Eq ItemCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemCount -> ItemCount -> Bool
$c/= :: ItemCount -> ItemCount -> Bool
== :: ItemCount -> ItemCount -> Bool
$c== :: ItemCount -> ItemCount -> Bool
P.Eq, Int -> ItemCount -> ShowS
[ItemCount] -> ShowS
ItemCount -> FilePath
(Int -> ItemCount -> ShowS)
-> (ItemCount -> FilePath)
-> ([ItemCount] -> ShowS)
-> Show ItemCount
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ItemCount] -> ShowS
$cshowList :: [ItemCount] -> ShowS
show :: ItemCount -> FilePath
$cshow :: ItemCount -> FilePath
showsPrec :: Int -> ItemCount -> ShowS
$cshowsPrec :: Int -> ItemCount -> ShowS
P.Show)

-- ** Limit
newtype Limit = Limit { Limit -> Int
unLimit :: Int } deriving (Limit -> Limit -> Bool
(Limit -> Limit -> Bool) -> (Limit -> Limit -> Bool) -> Eq Limit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c== :: Limit -> Limit -> Bool
P.Eq, Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> FilePath
(Int -> Limit -> ShowS)
-> (Limit -> FilePath) -> ([Limit] -> ShowS) -> Show Limit
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Limit] -> ShowS
$cshowList :: [Limit] -> ShowS
show :: Limit -> FilePath
$cshow :: Limit -> FilePath
showsPrec :: Int -> Limit -> ShowS
$cshowsPrec :: Int -> Limit -> ShowS
P.Show)

-- ** MarkOnly
newtype MarkOnly = MarkOnly { MarkOnly -> Bool
unMarkOnly :: Bool } deriving (MarkOnly -> MarkOnly -> Bool
(MarkOnly -> MarkOnly -> Bool)
-> (MarkOnly -> MarkOnly -> Bool) -> Eq MarkOnly
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkOnly -> MarkOnly -> Bool
$c/= :: MarkOnly -> MarkOnly -> Bool
== :: MarkOnly -> MarkOnly -> Bool
$c== :: MarkOnly -> MarkOnly -> Bool
P.Eq, Int -> MarkOnly -> ShowS
[MarkOnly] -> ShowS
MarkOnly -> FilePath
(Int -> MarkOnly -> ShowS)
-> (MarkOnly -> FilePath) -> ([MarkOnly] -> ShowS) -> Show MarkOnly
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MarkOnly] -> ShowS
$cshowList :: [MarkOnly] -> ShowS
show :: MarkOnly -> FilePath
$cshow :: MarkOnly -> FilePath
showsPrec :: Int -> MarkOnly -> ShowS
$cshowsPrec :: Int -> MarkOnly -> ShowS
P.Show)

-- ** MetricId
newtype MetricId = MetricId { MetricId -> Text
unMetricId :: Text } deriving (MetricId -> MetricId -> Bool
(MetricId -> MetricId -> Bool)
-> (MetricId -> MetricId -> Bool) -> Eq MetricId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetricId -> MetricId -> Bool
$c/= :: MetricId -> MetricId -> Bool
== :: MetricId -> MetricId -> Bool
$c== :: MetricId -> MetricId -> Bool
P.Eq, Int -> MetricId -> ShowS
[MetricId] -> ShowS
MetricId -> FilePath
(Int -> MetricId -> ShowS)
-> (MetricId -> FilePath) -> ([MetricId] -> ShowS) -> Show MetricId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MetricId] -> ShowS
$cshowList :: [MetricId] -> ShowS
show :: MetricId -> FilePath
$cshow :: MetricId -> FilePath
showsPrec :: Int -> MetricId -> ShowS
$cshowsPrec :: Int -> MetricId -> ShowS
P.Show)

-- ** MetricValues
newtype MetricValues = MetricValues { MetricValues -> [SystemMetricValues]
unMetricValues :: [SystemMetricValues] } deriving (MetricValues -> MetricValues -> Bool
(MetricValues -> MetricValues -> Bool)
-> (MetricValues -> MetricValues -> Bool) -> Eq MetricValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetricValues -> MetricValues -> Bool
$c/= :: MetricValues -> MetricValues -> Bool
== :: MetricValues -> MetricValues -> Bool
$c== :: MetricValues -> MetricValues -> Bool
P.Eq, Int -> MetricValues -> ShowS
[MetricValues] -> ShowS
MetricValues -> FilePath
(Int -> MetricValues -> ShowS)
-> (MetricValues -> FilePath)
-> ([MetricValues] -> ShowS)
-> Show MetricValues
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MetricValues] -> ShowS
$cshowList :: [MetricValues] -> ShowS
show :: MetricValues -> FilePath
$cshow :: MetricValues -> FilePath
showsPrec :: Int -> MetricValues -> ShowS
$cshowsPrec :: Int -> MetricValues -> ShowS
P.Show, [MetricValues] -> Encoding
[MetricValues] -> Value
MetricValues -> Encoding
MetricValues -> Value
(MetricValues -> Value)
-> (MetricValues -> Encoding)
-> ([MetricValues] -> Value)
-> ([MetricValues] -> Encoding)
-> ToJSON MetricValues
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MetricValues] -> Encoding
$ctoEncodingList :: [MetricValues] -> Encoding
toJSONList :: [MetricValues] -> Value
$ctoJSONList :: [MetricValues] -> Value
toEncoding :: MetricValues -> Encoding
$ctoEncoding :: MetricValues -> Encoding
toJSON :: MetricValues -> Value
$ctoJSON :: MetricValues -> Value
A.ToJSON)

-- ** Offset
newtype Offset = Offset { Offset -> Int
unOffset :: Int } deriving (Offset -> Offset -> Bool
(Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool) -> Eq Offset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c== :: Offset -> Offset -> Bool
P.Eq, Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> FilePath
(Int -> Offset -> ShowS)
-> (Offset -> FilePath) -> ([Offset] -> ShowS) -> Show Offset
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Offset] -> ShowS
$cshowList :: [Offset] -> ShowS
show :: Offset -> FilePath
$cshow :: Offset -> FilePath
showsPrec :: Int -> Offset -> ShowS
$cshowsPrec :: Int -> Offset -> ShowS
P.Show)

-- ** OrgRelation
newtype OrgRelation = OrgRelation { OrgRelation -> [Text]
unOrgRelation :: [Text] } deriving (OrgRelation -> OrgRelation -> Bool
(OrgRelation -> OrgRelation -> Bool)
-> (OrgRelation -> OrgRelation -> Bool) -> Eq OrgRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgRelation -> OrgRelation -> Bool
$c/= :: OrgRelation -> OrgRelation -> Bool
== :: OrgRelation -> OrgRelation -> Bool
$c== :: OrgRelation -> OrgRelation -> Bool
P.Eq, Int -> OrgRelation -> ShowS
[OrgRelation] -> ShowS
OrgRelation -> FilePath
(Int -> OrgRelation -> ShowS)
-> (OrgRelation -> FilePath)
-> ([OrgRelation] -> ShowS)
-> Show OrgRelation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrgRelation] -> ShowS
$cshowList :: [OrgRelation] -> ShowS
show :: OrgRelation -> FilePath
$cshow :: OrgRelation -> FilePath
showsPrec :: Int -> OrgRelation -> ShowS
$cshowsPrec :: Int -> OrgRelation -> ShowS
P.Show)

-- ** Organization
newtype Organization = Organization { Organization -> Text
unOrganization :: Text } deriving (Organization -> Organization -> Bool
(Organization -> Organization -> Bool)
-> (Organization -> Organization -> Bool) -> Eq Organization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Organization -> Organization -> Bool
$c/= :: Organization -> Organization -> Bool
== :: Organization -> Organization -> Bool
$c== :: Organization -> Organization -> Bool
P.Eq, Int -> Organization -> ShowS
[Organization] -> ShowS
Organization -> FilePath
(Int -> Organization -> ShowS)
-> (Organization -> FilePath)
-> ([Organization] -> ShowS)
-> Show Organization
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Organization] -> ShowS
$cshowList :: [Organization] -> ShowS
show :: Organization -> FilePath
$cshow :: Organization -> FilePath
showsPrec :: Int -> Organization -> ShowS
$cshowsPrec :: Int -> Organization -> ShowS
P.Show)

-- ** OrganizationId
newtype OrganizationId = OrganizationId { OrganizationId -> Text
unOrganizationId :: Text } deriving (OrganizationId -> OrganizationId -> Bool
(OrganizationId -> OrganizationId -> Bool)
-> (OrganizationId -> OrganizationId -> Bool) -> Eq OrganizationId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationId -> OrganizationId -> Bool
$c/= :: OrganizationId -> OrganizationId -> Bool
== :: OrganizationId -> OrganizationId -> Bool
$c== :: OrganizationId -> OrganizationId -> Bool
P.Eq, Int -> OrganizationId -> ShowS
[OrganizationId] -> ShowS
OrganizationId -> FilePath
(Int -> OrganizationId -> ShowS)
-> (OrganizationId -> FilePath)
-> ([OrganizationId] -> ShowS)
-> Show OrganizationId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationId] -> ShowS
$cshowList :: [OrganizationId] -> ShowS
show :: OrganizationId -> FilePath
$cshow :: OrganizationId -> FilePath
showsPrec :: Int -> OrganizationId -> ShowS
$cshowsPrec :: Int -> OrganizationId -> ShowS
P.Show)

-- ** OrganizationIdentifier
newtype OrganizationIdentifier = OrganizationIdentifier { OrganizationIdentifier -> Text
unOrganizationIdentifier :: Text } deriving (OrganizationIdentifier -> OrganizationIdentifier -> Bool
(OrganizationIdentifier -> OrganizationIdentifier -> Bool)
-> (OrganizationIdentifier -> OrganizationIdentifier -> Bool)
-> Eq OrganizationIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationIdentifier -> OrganizationIdentifier -> Bool
$c/= :: OrganizationIdentifier -> OrganizationIdentifier -> Bool
== :: OrganizationIdentifier -> OrganizationIdentifier -> Bool
$c== :: OrganizationIdentifier -> OrganizationIdentifier -> Bool
P.Eq, Int -> OrganizationIdentifier -> ShowS
[OrganizationIdentifier] -> ShowS
OrganizationIdentifier -> FilePath
(Int -> OrganizationIdentifier -> ShowS)
-> (OrganizationIdentifier -> FilePath)
-> ([OrganizationIdentifier] -> ShowS)
-> Show OrganizationIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationIdentifier] -> ShowS
$cshowList :: [OrganizationIdentifier] -> ShowS
show :: OrganizationIdentifier -> FilePath
$cshow :: OrganizationIdentifier -> FilePath
showsPrec :: Int -> OrganizationIdentifier -> ShowS
$cshowsPrec :: Int -> OrganizationIdentifier -> ShowS
P.Show)

-- ** OrganizationName
newtype OrganizationName = OrganizationName { OrganizationName -> Text
unOrganizationName :: Text } deriving (OrganizationName -> OrganizationName -> Bool
(OrganizationName -> OrganizationName -> Bool)
-> (OrganizationName -> OrganizationName -> Bool)
-> Eq OrganizationName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationName -> OrganizationName -> Bool
$c/= :: OrganizationName -> OrganizationName -> Bool
== :: OrganizationName -> OrganizationName -> Bool
$c== :: OrganizationName -> OrganizationName -> Bool
P.Eq, Int -> OrganizationName -> ShowS
[OrganizationName] -> ShowS
OrganizationName -> FilePath
(Int -> OrganizationName -> ShowS)
-> (OrganizationName -> FilePath)
-> ([OrganizationName] -> ShowS)
-> Show OrganizationName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationName] -> ShowS
$cshowList :: [OrganizationName] -> ShowS
show :: OrganizationName -> FilePath
$cshow :: OrganizationName -> FilePath
showsPrec :: Int -> OrganizationName -> ShowS
$cshowsPrec :: Int -> OrganizationName -> ShowS
P.Show)

-- ** Path
newtype Path = Path { Path -> Text
unPath :: Text } deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
P.Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> FilePath
(Int -> Path -> ShowS)
-> (Path -> FilePath) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> FilePath
$cshow :: Path -> FilePath
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
P.Show)

-- ** ProjectId
newtype ProjectId = ProjectId { ProjectId -> Text
unProjectId :: Text } deriving (ProjectId -> ProjectId -> Bool
(ProjectId -> ProjectId -> Bool)
-> (ProjectId -> ProjectId -> Bool) -> Eq ProjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectId -> ProjectId -> Bool
$c/= :: ProjectId -> ProjectId -> Bool
== :: ProjectId -> ProjectId -> Bool
$c== :: ProjectId -> ProjectId -> Bool
P.Eq, Int -> ProjectId -> ShowS
[ProjectId] -> ShowS
ProjectId -> FilePath
(Int -> ProjectId -> ShowS)
-> (ProjectId -> FilePath)
-> ([ProjectId] -> ShowS)
-> Show ProjectId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectId] -> ShowS
$cshowList :: [ProjectId] -> ShowS
show :: ProjectId -> FilePath
$cshow :: ProjectId -> FilePath
showsPrec :: Int -> ProjectId -> ShowS
$cshowsPrec :: Int -> ProjectId -> ShowS
P.Show)

-- ** ProjectIdentifier
newtype ProjectIdentifier = ProjectIdentifier { ProjectIdentifier -> Text
unProjectIdentifier :: Text } deriving (ProjectIdentifier -> ProjectIdentifier -> Bool
(ProjectIdentifier -> ProjectIdentifier -> Bool)
-> (ProjectIdentifier -> ProjectIdentifier -> Bool)
-> Eq ProjectIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectIdentifier -> ProjectIdentifier -> Bool
$c/= :: ProjectIdentifier -> ProjectIdentifier -> Bool
== :: ProjectIdentifier -> ProjectIdentifier -> Bool
$c== :: ProjectIdentifier -> ProjectIdentifier -> Bool
P.Eq, Int -> ProjectIdentifier -> ShowS
[ProjectIdentifier] -> ShowS
ProjectIdentifier -> FilePath
(Int -> ProjectIdentifier -> ShowS)
-> (ProjectIdentifier -> FilePath)
-> ([ProjectIdentifier] -> ShowS)
-> Show ProjectIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectIdentifier] -> ShowS
$cshowList :: [ProjectIdentifier] -> ShowS
show :: ProjectIdentifier -> FilePath
$cshow :: ProjectIdentifier -> FilePath
showsPrec :: Int -> ProjectIdentifier -> ShowS
$cshowsPrec :: Int -> ProjectIdentifier -> ShowS
P.Show)

-- ** ProjectIdentifierText
newtype ProjectIdentifierText = ProjectIdentifierText { ProjectIdentifierText -> [Text]
unProjectIdentifierText :: [Text] } deriving (ProjectIdentifierText -> ProjectIdentifierText -> Bool
(ProjectIdentifierText -> ProjectIdentifierText -> Bool)
-> (ProjectIdentifierText -> ProjectIdentifierText -> Bool)
-> Eq ProjectIdentifierText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectIdentifierText -> ProjectIdentifierText -> Bool
$c/= :: ProjectIdentifierText -> ProjectIdentifierText -> Bool
== :: ProjectIdentifierText -> ProjectIdentifierText -> Bool
$c== :: ProjectIdentifierText -> ProjectIdentifierText -> Bool
P.Eq, Int -> ProjectIdentifierText -> ShowS
[ProjectIdentifierText] -> ShowS
ProjectIdentifierText -> FilePath
(Int -> ProjectIdentifierText -> ShowS)
-> (ProjectIdentifierText -> FilePath)
-> ([ProjectIdentifierText] -> ShowS)
-> Show ProjectIdentifierText
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectIdentifierText] -> ShowS
$cshowList :: [ProjectIdentifierText] -> ShowS
show :: ProjectIdentifierText -> FilePath
$cshow :: ProjectIdentifierText -> FilePath
showsPrec :: Int -> ProjectIdentifierText -> ShowS
$cshowsPrec :: Int -> ProjectIdentifierText -> ShowS
P.Show)

-- ** ProjectKey
newtype ProjectKey = ProjectKey { ProjectKey -> Text
unProjectKey :: Text } deriving (ProjectKey -> ProjectKey -> Bool
(ProjectKey -> ProjectKey -> Bool)
-> (ProjectKey -> ProjectKey -> Bool) -> Eq ProjectKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectKey -> ProjectKey -> Bool
$c/= :: ProjectKey -> ProjectKey -> Bool
== :: ProjectKey -> ProjectKey -> Bool
$c== :: ProjectKey -> ProjectKey -> Bool
P.Eq, Int -> ProjectKey -> ShowS
[ProjectKey] -> ShowS
ProjectKey -> FilePath
(Int -> ProjectKey -> ShowS)
-> (ProjectKey -> FilePath)
-> ([ProjectKey] -> ShowS)
-> Show ProjectKey
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectKey] -> ShowS
$cshowList :: [ProjectKey] -> ShowS
show :: ProjectKey -> FilePath
$cshow :: ProjectKey -> FilePath
showsPrec :: Int -> ProjectKey -> ShowS
$cshowsPrec :: Int -> ProjectKey -> ShowS
P.Show)

-- ** ProjectName
newtype ProjectName = ProjectName { ProjectName -> Text
unProjectName :: Text } deriving (ProjectName -> ProjectName -> Bool
(ProjectName -> ProjectName -> Bool)
-> (ProjectName -> ProjectName -> Bool) -> Eq ProjectName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectName -> ProjectName -> Bool
$c/= :: ProjectName -> ProjectName -> Bool
== :: ProjectName -> ProjectName -> Bool
$c== :: ProjectName -> ProjectName -> Bool
P.Eq, Int -> ProjectName -> ShowS
[ProjectName] -> ShowS
ProjectName -> FilePath
(Int -> ProjectName -> ShowS)
-> (ProjectName -> FilePath)
-> ([ProjectName] -> ShowS)
-> Show ProjectName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectName] -> ShowS
$cshowList :: [ProjectName] -> ShowS
show :: ProjectName -> FilePath
$cshow :: ProjectName -> FilePath
showsPrec :: Int -> ProjectName -> ShowS
$cshowsPrec :: Int -> ProjectName -> ShowS
P.Show)

-- ** Resource
newtype Resource = Resource { Resource -> Text
unResource :: Text } deriving (Resource -> Resource -> Bool
(Resource -> Resource -> Bool)
-> (Resource -> Resource -> Bool) -> Eq Resource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Resource -> Resource -> Bool
$c/= :: Resource -> Resource -> Bool
== :: Resource -> Resource -> Bool
$c== :: Resource -> Resource -> Bool
P.Eq, Int -> Resource -> ShowS
[Resource] -> ShowS
Resource -> FilePath
(Int -> Resource -> ShowS)
-> (Resource -> FilePath) -> ([Resource] -> ShowS) -> Show Resource
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Resource] -> ShowS
$cshowList :: [Resource] -> ShowS
show :: Resource -> FilePath
$cshow :: Resource -> FilePath
showsPrec :: Int -> Resource -> ShowS
$cshowsPrec :: Int -> Resource -> ShowS
P.Show)

-- ** SearchTerm
newtype SearchTerm = SearchTerm { SearchTerm -> Text
unSearchTerm :: Text } deriving (SearchTerm -> SearchTerm -> Bool
(SearchTerm -> SearchTerm -> Bool)
-> (SearchTerm -> SearchTerm -> Bool) -> Eq SearchTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchTerm -> SearchTerm -> Bool
$c/= :: SearchTerm -> SearchTerm -> Bool
== :: SearchTerm -> SearchTerm -> Bool
$c== :: SearchTerm -> SearchTerm -> Bool
P.Eq, Int -> SearchTerm -> ShowS
[SearchTerm] -> ShowS
SearchTerm -> FilePath
(Int -> SearchTerm -> ShowS)
-> (SearchTerm -> FilePath)
-> ([SearchTerm] -> ShowS)
-> Show SearchTerm
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SearchTerm] -> ShowS
$cshowList :: [SearchTerm] -> ShowS
show :: SearchTerm -> FilePath
$cshow :: SearchTerm -> FilePath
showsPrec :: Int -> SearchTerm -> ShowS
$cshowsPrec :: Int -> SearchTerm -> ShowS
P.Show)

-- ** SortBy
newtype SortBy = SortBy { SortBy -> [Text]
unSortBy :: [Text] } deriving (SortBy -> SortBy -> Bool
(SortBy -> SortBy -> Bool)
-> (SortBy -> SortBy -> Bool) -> Eq SortBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortBy -> SortBy -> Bool
$c/= :: SortBy -> SortBy -> Bool
== :: SortBy -> SortBy -> Bool
$c== :: SortBy -> SortBy -> Bool
P.Eq, Int -> SortBy -> ShowS
[SortBy] -> ShowS
SortBy -> FilePath
(Int -> SortBy -> ShowS)
-> (SortBy -> FilePath) -> ([SortBy] -> ShowS) -> Show SortBy
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SortBy] -> ShowS
$cshowList :: [SortBy] -> ShowS
show :: SortBy -> FilePath
$cshow :: SortBy -> FilePath
showsPrec :: Int -> SortBy -> ShowS
$cshowsPrec :: Int -> SortBy -> ShowS
P.Show)

-- ** SortDirection
newtype SortDirection = SortDirection { SortDirection -> [Text]
unSortDirection :: [Text] } deriving (SortDirection -> SortDirection -> Bool
(SortDirection -> SortDirection -> Bool)
-> (SortDirection -> SortDirection -> Bool) -> Eq SortDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortDirection -> SortDirection -> Bool
$c/= :: SortDirection -> SortDirection -> Bool
== :: SortDirection -> SortDirection -> Bool
$c== :: SortDirection -> SortDirection -> Bool
P.Eq, Int -> SortDirection -> ShowS
[SortDirection] -> ShowS
SortDirection -> FilePath
(Int -> SortDirection -> ShowS)
-> (SortDirection -> FilePath)
-> ([SortDirection] -> ShowS)
-> Show SortDirection
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SortDirection] -> ShowS
$cshowList :: [SortDirection] -> ShowS
show :: SortDirection -> FilePath
$cshow :: SortDirection -> FilePath
showsPrec :: Int -> SortDirection -> ShowS
$cshowsPrec :: Int -> SortDirection -> ShowS
P.Show)

-- ** StartPoint
newtype StartPoint = StartPoint { StartPoint -> Integer
unStartPoint :: Integer } deriving (StartPoint -> StartPoint -> Bool
(StartPoint -> StartPoint -> Bool)
-> (StartPoint -> StartPoint -> Bool) -> Eq StartPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartPoint -> StartPoint -> Bool
$c/= :: StartPoint -> StartPoint -> Bool
== :: StartPoint -> StartPoint -> Bool
$c== :: StartPoint -> StartPoint -> Bool
P.Eq, Int -> StartPoint -> ShowS
[StartPoint] -> ShowS
StartPoint -> FilePath
(Int -> StartPoint -> ShowS)
-> (StartPoint -> FilePath)
-> ([StartPoint] -> ShowS)
-> Show StartPoint
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StartPoint] -> ShowS
$cshowList :: [StartPoint] -> ShowS
show :: StartPoint -> FilePath
$cshow :: StartPoint -> FilePath
showsPrec :: Int -> StartPoint -> ShowS
$cshowsPrec :: Int -> StartPoint -> ShowS
P.Show)

-- ** UserId
newtype UserId = UserId { UserId -> Text
unUserId :: Text } deriving (UserId -> UserId -> Bool
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c== :: UserId -> UserId -> Bool
P.Eq, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> FilePath
(Int -> UserId -> ShowS)
-> (UserId -> FilePath) -> ([UserId] -> ShowS) -> Show UserId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserId] -> ShowS
$cshowList :: [UserId] -> ShowS
show :: UserId -> FilePath
$cshow :: UserId -> FilePath
showsPrec :: Int -> UserId -> ShowS
$cshowsPrec :: Int -> UserId -> ShowS
P.Show)

-- ** UserRelation
newtype UserRelation = UserRelation { UserRelation -> Text
unUserRelation :: Text } deriving (UserRelation -> UserRelation -> Bool
(UserRelation -> UserRelation -> Bool)
-> (UserRelation -> UserRelation -> Bool) -> Eq UserRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserRelation -> UserRelation -> Bool
$c/= :: UserRelation -> UserRelation -> Bool
== :: UserRelation -> UserRelation -> Bool
$c== :: UserRelation -> UserRelation -> Bool
P.Eq, Int -> UserRelation -> ShowS
[UserRelation] -> ShowS
UserRelation -> FilePath
(Int -> UserRelation -> ShowS)
-> (UserRelation -> FilePath)
-> ([UserRelation] -> ShowS)
-> Show UserRelation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserRelation] -> ShowS
$cshowList :: [UserRelation] -> ShowS
show :: UserRelation -> FilePath
$cshow :: UserRelation -> FilePath
showsPrec :: Int -> UserRelation -> ShowS
$cshowsPrec :: Int -> UserRelation -> ShowS
P.Show)

-- ** Username
newtype Username = Username { Username -> [Text]
unUsername :: [Text] } deriving (Username -> Username -> Bool
(Username -> Username -> Bool)
-> (Username -> Username -> Bool) -> Eq Username
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Username -> Username -> Bool
$c/= :: Username -> Username -> Bool
== :: Username -> Username -> Bool
$c== :: Username -> Username -> Bool
P.Eq, Int -> Username -> ShowS
[Username] -> ShowS
Username -> FilePath
(Int -> Username -> ShowS)
-> (Username -> FilePath) -> ([Username] -> ShowS) -> Show Username
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Username] -> ShowS
$cshowList :: [Username] -> ShowS
show :: Username -> FilePath
$cshow :: Username -> FilePath
showsPrec :: Int -> Username -> ShowS
$cshowsPrec :: Int -> Username -> ShowS
P.Show)

-- ** UsernamePrefix
newtype UsernamePrefix = UsernamePrefix { UsernamePrefix -> Text
unUsernamePrefix :: Text } deriving (UsernamePrefix -> UsernamePrefix -> Bool
(UsernamePrefix -> UsernamePrefix -> Bool)
-> (UsernamePrefix -> UsernamePrefix -> Bool) -> Eq UsernamePrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsernamePrefix -> UsernamePrefix -> Bool
$c/= :: UsernamePrefix -> UsernamePrefix -> Bool
== :: UsernamePrefix -> UsernamePrefix -> Bool
$c== :: UsernamePrefix -> UsernamePrefix -> Bool
P.Eq, Int -> UsernamePrefix -> ShowS
[UsernamePrefix] -> ShowS
UsernamePrefix -> FilePath
(Int -> UsernamePrefix -> ShowS)
-> (UsernamePrefix -> FilePath)
-> ([UsernamePrefix] -> ShowS)
-> Show UsernamePrefix
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UsernamePrefix] -> ShowS
$cshowList :: [UsernamePrefix] -> ShowS
show :: UsernamePrefix -> FilePath
$cshow :: UsernamePrefix -> FilePath
showsPrec :: Int -> UsernamePrefix -> ShowS
$cshowsPrec :: Int -> UsernamePrefix -> ShowS
P.Show)

-- ** UsernameText
newtype UsernameText = UsernameText { UsernameText -> Text
unUsernameText :: Text } deriving (UsernameText -> UsernameText -> Bool
(UsernameText -> UsernameText -> Bool)
-> (UsernameText -> UsernameText -> Bool) -> Eq UsernameText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsernameText -> UsernameText -> Bool
$c/= :: UsernameText -> UsernameText -> Bool
== :: UsernameText -> UsernameText -> Bool
$c== :: UsernameText -> UsernameText -> Bool
P.Eq, Int -> UsernameText -> ShowS
[UsernameText] -> ShowS
UsernameText -> FilePath
(Int -> UsernameText -> ShowS)
-> (UsernameText -> FilePath)
-> ([UsernameText] -> ShowS)
-> Show UsernameText
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UsernameText] -> ShowS
$cshowList :: [UsernameText] -> ShowS
show :: UsernameText -> FilePath
$cshow :: UsernameText -> FilePath
showsPrec :: Int -> UsernameText -> ShowS
$cshowsPrec :: Int -> UsernameText -> ShowS
P.Show)

-- ** ViewedUsername
newtype ViewedUsername = ViewedUsername { ViewedUsername -> Text
unViewedUsername :: Text } deriving (ViewedUsername -> ViewedUsername -> Bool
(ViewedUsername -> ViewedUsername -> Bool)
-> (ViewedUsername -> ViewedUsername -> Bool) -> Eq ViewedUsername
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewedUsername -> ViewedUsername -> Bool
$c/= :: ViewedUsername -> ViewedUsername -> Bool
== :: ViewedUsername -> ViewedUsername -> Bool
$c== :: ViewedUsername -> ViewedUsername -> Bool
P.Eq, Int -> ViewedUsername -> ShowS
[ViewedUsername] -> ShowS
ViewedUsername -> FilePath
(Int -> ViewedUsername -> ShowS)
-> (ViewedUsername -> FilePath)
-> ([ViewedUsername] -> ShowS)
-> Show ViewedUsername
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ViewedUsername] -> ShowS
$cshowList :: [ViewedUsername] -> ShowS
show :: ViewedUsername -> FilePath
$cshow :: ViewedUsername -> FilePath
showsPrec :: Int -> ViewedUsername -> ShowS
$cshowsPrec :: Int -> ViewedUsername -> ShowS
P.Show)

-- ** Visibility
newtype Visibility = Visibility { Visibility -> Text
unVisibility :: Text } deriving (Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
P.Eq, Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> FilePath
(Int -> Visibility -> ShowS)
-> (Visibility -> FilePath)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> FilePath
$cshow :: Visibility -> FilePath
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
P.Show)

-- ** WorkspaceName
newtype WorkspaceName = WorkspaceName { WorkspaceName -> Text
unWorkspaceName :: Text } deriving (WorkspaceName -> WorkspaceName -> Bool
(WorkspaceName -> WorkspaceName -> Bool)
-> (WorkspaceName -> WorkspaceName -> Bool) -> Eq WorkspaceName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceName -> WorkspaceName -> Bool
$c/= :: WorkspaceName -> WorkspaceName -> Bool
== :: WorkspaceName -> WorkspaceName -> Bool
$c== :: WorkspaceName -> WorkspaceName -> Bool
P.Eq, Int -> WorkspaceName -> ShowS
[WorkspaceName] -> ShowS
WorkspaceName -> FilePath
(Int -> WorkspaceName -> ShowS)
-> (WorkspaceName -> FilePath)
-> ([WorkspaceName] -> ShowS)
-> Show WorkspaceName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceName] -> ShowS
$cshowList :: [WorkspaceName] -> ShowS
show :: WorkspaceName -> FilePath
$cshow :: WorkspaceName -> FilePath
showsPrec :: Int -> WorkspaceName -> ShowS
$cshowsPrec :: Int -> WorkspaceName -> ShowS
P.Show)

-- ** XNeptuneApiToken
newtype XNeptuneApiToken = XNeptuneApiToken { XNeptuneApiToken -> Text
unXNeptuneApiToken :: Text } deriving (XNeptuneApiToken -> XNeptuneApiToken -> Bool
(XNeptuneApiToken -> XNeptuneApiToken -> Bool)
-> (XNeptuneApiToken -> XNeptuneApiToken -> Bool)
-> Eq XNeptuneApiToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XNeptuneApiToken -> XNeptuneApiToken -> Bool
$c/= :: XNeptuneApiToken -> XNeptuneApiToken -> Bool
== :: XNeptuneApiToken -> XNeptuneApiToken -> Bool
$c== :: XNeptuneApiToken -> XNeptuneApiToken -> Bool
P.Eq, Int -> XNeptuneApiToken -> ShowS
[XNeptuneApiToken] -> ShowS
XNeptuneApiToken -> FilePath
(Int -> XNeptuneApiToken -> ShowS)
-> (XNeptuneApiToken -> FilePath)
-> ([XNeptuneApiToken] -> ShowS)
-> Show XNeptuneApiToken
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [XNeptuneApiToken] -> ShowS
$cshowList :: [XNeptuneApiToken] -> ShowS
show :: XNeptuneApiToken -> FilePath
$cshow :: XNeptuneApiToken -> FilePath
showsPrec :: Int -> XNeptuneApiToken -> ShowS
$cshowsPrec :: Int -> XNeptuneApiToken -> ShowS
P.Show)

-- ** XNeptuneCliVersion
newtype XNeptuneCliVersion = XNeptuneCliVersion { XNeptuneCliVersion -> Text
unXNeptuneCliVersion :: Text } deriving (XNeptuneCliVersion -> XNeptuneCliVersion -> Bool
(XNeptuneCliVersion -> XNeptuneCliVersion -> Bool)
-> (XNeptuneCliVersion -> XNeptuneCliVersion -> Bool)
-> Eq XNeptuneCliVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XNeptuneCliVersion -> XNeptuneCliVersion -> Bool
$c/= :: XNeptuneCliVersion -> XNeptuneCliVersion -> Bool
== :: XNeptuneCliVersion -> XNeptuneCliVersion -> Bool
$c== :: XNeptuneCliVersion -> XNeptuneCliVersion -> Bool
P.Eq, Int -> XNeptuneCliVersion -> ShowS
[XNeptuneCliVersion] -> ShowS
XNeptuneCliVersion -> FilePath
(Int -> XNeptuneCliVersion -> ShowS)
-> (XNeptuneCliVersion -> FilePath)
-> ([XNeptuneCliVersion] -> ShowS)
-> Show XNeptuneCliVersion
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [XNeptuneCliVersion] -> ShowS
$cshowList :: [XNeptuneCliVersion] -> ShowS
show :: XNeptuneCliVersion -> FilePath
$cshow :: XNeptuneCliVersion -> FilePath
showsPrec :: Int -> XNeptuneCliVersion -> ShowS
$cshowsPrec :: Int -> XNeptuneCliVersion -> ShowS
P.Show)

-- * Models


-- ** AchievementsDTO
-- | AchievementsDTO
data AchievementsDTO = AchievementsDTO
    { AchievementsDTO -> [AchievementTypeDTO]
achievementsDTOEarned :: !([AchievementTypeDTO]) -- ^ /Required/ "earned"
    }
    deriving (Int -> AchievementsDTO -> ShowS
[AchievementsDTO] -> ShowS
AchievementsDTO -> FilePath
(Int -> AchievementsDTO -> ShowS)
-> (AchievementsDTO -> FilePath)
-> ([AchievementsDTO] -> ShowS)
-> Show AchievementsDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AchievementsDTO] -> ShowS
$cshowList :: [AchievementsDTO] -> ShowS
show :: AchievementsDTO -> FilePath
$cshow :: AchievementsDTO -> FilePath
showsPrec :: Int -> AchievementsDTO -> ShowS
$cshowsPrec :: Int -> AchievementsDTO -> ShowS
P.Show, AchievementsDTO -> AchievementsDTO -> Bool
(AchievementsDTO -> AchievementsDTO -> Bool)
-> (AchievementsDTO -> AchievementsDTO -> Bool)
-> Eq AchievementsDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AchievementsDTO -> AchievementsDTO -> Bool
$c/= :: AchievementsDTO -> AchievementsDTO -> Bool
== :: AchievementsDTO -> AchievementsDTO -> Bool
$c== :: AchievementsDTO -> AchievementsDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON AchievementsDTO
instance A.FromJSON AchievementsDTO where
  parseJSON :: Value -> Parser AchievementsDTO
parseJSON = FilePath
-> (Object -> Parser AchievementsDTO)
-> Value
-> Parser AchievementsDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"AchievementsDTO" ((Object -> Parser AchievementsDTO)
 -> Value -> Parser AchievementsDTO)
-> (Object -> Parser AchievementsDTO)
-> Value
-> Parser AchievementsDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [AchievementTypeDTO] -> AchievementsDTO
AchievementsDTO
      ([AchievementTypeDTO] -> AchievementsDTO)
-> Parser [AchievementTypeDTO] -> Parser AchievementsDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [AchievementTypeDTO]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"earned")

-- | ToJSON AchievementsDTO
instance A.ToJSON AchievementsDTO where
  toJSON :: AchievementsDTO -> Value
toJSON AchievementsDTO {[AchievementTypeDTO]
achievementsDTOEarned :: [AchievementTypeDTO]
achievementsDTOEarned :: AchievementsDTO -> [AchievementTypeDTO]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"earned" Text -> [AchievementTypeDTO] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [AchievementTypeDTO]
achievementsDTOEarned
      ]


-- | Construct a value of type 'AchievementsDTO' (by applying it's required fields, if any)
mkAchievementsDTO
  :: [AchievementTypeDTO] -- ^ 'achievementsDTOEarned'
  -> AchievementsDTO
mkAchievementsDTO :: [AchievementTypeDTO] -> AchievementsDTO
mkAchievementsDTO [AchievementTypeDTO]
achievementsDTOEarned =
  AchievementsDTO :: [AchievementTypeDTO] -> AchievementsDTO
AchievementsDTO
  { [AchievementTypeDTO]
achievementsDTOEarned :: [AchievementTypeDTO]
achievementsDTOEarned :: [AchievementTypeDTO]
achievementsDTOEarned
  }

-- ** AuthorizedUserDTO
-- | AuthorizedUserDTO
data AuthorizedUserDTO = AuthorizedUserDTO
    { AuthorizedUserDTO -> Text
authorizedUserDTOUsername :: !(Text) -- ^ /Required/ "username"
    }
    deriving (Int -> AuthorizedUserDTO -> ShowS
[AuthorizedUserDTO] -> ShowS
AuthorizedUserDTO -> FilePath
(Int -> AuthorizedUserDTO -> ShowS)
-> (AuthorizedUserDTO -> FilePath)
-> ([AuthorizedUserDTO] -> ShowS)
-> Show AuthorizedUserDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizedUserDTO] -> ShowS
$cshowList :: [AuthorizedUserDTO] -> ShowS
show :: AuthorizedUserDTO -> FilePath
$cshow :: AuthorizedUserDTO -> FilePath
showsPrec :: Int -> AuthorizedUserDTO -> ShowS
$cshowsPrec :: Int -> AuthorizedUserDTO -> ShowS
P.Show, AuthorizedUserDTO -> AuthorizedUserDTO -> Bool
(AuthorizedUserDTO -> AuthorizedUserDTO -> Bool)
-> (AuthorizedUserDTO -> AuthorizedUserDTO -> Bool)
-> Eq AuthorizedUserDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizedUserDTO -> AuthorizedUserDTO -> Bool
$c/= :: AuthorizedUserDTO -> AuthorizedUserDTO -> Bool
== :: AuthorizedUserDTO -> AuthorizedUserDTO -> Bool
$c== :: AuthorizedUserDTO -> AuthorizedUserDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON AuthorizedUserDTO
instance A.FromJSON AuthorizedUserDTO where
  parseJSON :: Value -> Parser AuthorizedUserDTO
parseJSON = FilePath
-> (Object -> Parser AuthorizedUserDTO)
-> Value
-> Parser AuthorizedUserDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"AuthorizedUserDTO" ((Object -> Parser AuthorizedUserDTO)
 -> Value -> Parser AuthorizedUserDTO)
-> (Object -> Parser AuthorizedUserDTO)
-> Value
-> Parser AuthorizedUserDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> AuthorizedUserDTO
AuthorizedUserDTO
      (Text -> AuthorizedUserDTO)
-> Parser Text -> Parser AuthorizedUserDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"username")

-- | ToJSON AuthorizedUserDTO
instance A.ToJSON AuthorizedUserDTO where
  toJSON :: AuthorizedUserDTO -> Value
toJSON AuthorizedUserDTO {Text
authorizedUserDTOUsername :: Text
authorizedUserDTOUsername :: AuthorizedUserDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"username" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
authorizedUserDTOUsername
      ]


-- | Construct a value of type 'AuthorizedUserDTO' (by applying it's required fields, if any)
mkAuthorizedUserDTO
  :: Text -- ^ 'authorizedUserDTOUsername'
  -> AuthorizedUserDTO
mkAuthorizedUserDTO :: Text -> AuthorizedUserDTO
mkAuthorizedUserDTO Text
authorizedUserDTOUsername =
  AuthorizedUserDTO :: Text -> AuthorizedUserDTO
AuthorizedUserDTO
  { Text
authorizedUserDTOUsername :: Text
authorizedUserDTOUsername :: Text
authorizedUserDTOUsername
  }

-- ** BatchChannelValueErrorDTO
-- | BatchChannelValueErrorDTO
data BatchChannelValueErrorDTO = BatchChannelValueErrorDTO
    { BatchChannelValueErrorDTO -> Text
batchChannelValueErrorDTOChannelId :: !(Text) -- ^ /Required/ "channelId"
    -- ^ /Required/ "x"
    , BatchChannelValueErrorDTO -> Double
batchChannelValueErrorDTOX         :: !(Double) -- ^ /Required/ "x"
    -- ^ /Required/ "error"
    , BatchChannelValueErrorDTO -> Error
batchChannelValueErrorDTOError     :: !(Error) -- ^ /Required/ "error"
    }
    deriving (Int -> BatchChannelValueErrorDTO -> ShowS
[BatchChannelValueErrorDTO] -> ShowS
BatchChannelValueErrorDTO -> FilePath
(Int -> BatchChannelValueErrorDTO -> ShowS)
-> (BatchChannelValueErrorDTO -> FilePath)
-> ([BatchChannelValueErrorDTO] -> ShowS)
-> Show BatchChannelValueErrorDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BatchChannelValueErrorDTO] -> ShowS
$cshowList :: [BatchChannelValueErrorDTO] -> ShowS
show :: BatchChannelValueErrorDTO -> FilePath
$cshow :: BatchChannelValueErrorDTO -> FilePath
showsPrec :: Int -> BatchChannelValueErrorDTO -> ShowS
$cshowsPrec :: Int -> BatchChannelValueErrorDTO -> ShowS
P.Show, BatchChannelValueErrorDTO -> BatchChannelValueErrorDTO -> Bool
(BatchChannelValueErrorDTO -> BatchChannelValueErrorDTO -> Bool)
-> (BatchChannelValueErrorDTO -> BatchChannelValueErrorDTO -> Bool)
-> Eq BatchChannelValueErrorDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchChannelValueErrorDTO -> BatchChannelValueErrorDTO -> Bool
$c/= :: BatchChannelValueErrorDTO -> BatchChannelValueErrorDTO -> Bool
== :: BatchChannelValueErrorDTO -> BatchChannelValueErrorDTO -> Bool
$c== :: BatchChannelValueErrorDTO -> BatchChannelValueErrorDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON BatchChannelValueErrorDTO
instance A.FromJSON BatchChannelValueErrorDTO where
  parseJSON :: Value -> Parser BatchChannelValueErrorDTO
parseJSON = FilePath
-> (Object -> Parser BatchChannelValueErrorDTO)
-> Value
-> Parser BatchChannelValueErrorDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"BatchChannelValueErrorDTO" ((Object -> Parser BatchChannelValueErrorDTO)
 -> Value -> Parser BatchChannelValueErrorDTO)
-> (Object -> Parser BatchChannelValueErrorDTO)
-> Value
-> Parser BatchChannelValueErrorDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Double -> Error -> BatchChannelValueErrorDTO
BatchChannelValueErrorDTO
      (Text -> Double -> Error -> BatchChannelValueErrorDTO)
-> Parser Text
-> Parser (Double -> Error -> BatchChannelValueErrorDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelId")
      Parser (Double -> Error -> BatchChannelValueErrorDTO)
-> Parser Double -> Parser (Error -> BatchChannelValueErrorDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"x")
      Parser (Error -> BatchChannelValueErrorDTO)
-> Parser Error -> Parser BatchChannelValueErrorDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Error
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"error")

-- | ToJSON BatchChannelValueErrorDTO
instance A.ToJSON BatchChannelValueErrorDTO where
  toJSON :: BatchChannelValueErrorDTO -> Value
toJSON BatchChannelValueErrorDTO {Double
Text
Error
batchChannelValueErrorDTOError :: Error
batchChannelValueErrorDTOX :: Double
batchChannelValueErrorDTOChannelId :: Text
batchChannelValueErrorDTOError :: BatchChannelValueErrorDTO -> Error
batchChannelValueErrorDTOX :: BatchChannelValueErrorDTO -> Double
batchChannelValueErrorDTOChannelId :: BatchChannelValueErrorDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"channelId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
batchChannelValueErrorDTOChannelId
      , Text
"x" Text -> Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
batchChannelValueErrorDTOX
      , Text
"error" Text -> Error -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Error
batchChannelValueErrorDTOError
      ]


-- | Construct a value of type 'BatchChannelValueErrorDTO' (by applying it's required fields, if any)
mkBatchChannelValueErrorDTO
  :: Text -- ^ 'batchChannelValueErrorDTOChannelId'
  -> Double -- ^ 'batchChannelValueErrorDTOX'
  -> Error -- ^ 'batchChannelValueErrorDTOError'
  -> BatchChannelValueErrorDTO
mkBatchChannelValueErrorDTO :: Text -> Double -> Error -> BatchChannelValueErrorDTO
mkBatchChannelValueErrorDTO Text
batchChannelValueErrorDTOChannelId Double
batchChannelValueErrorDTOX Error
batchChannelValueErrorDTOError =
  BatchChannelValueErrorDTO :: Text -> Double -> Error -> BatchChannelValueErrorDTO
BatchChannelValueErrorDTO
  { Text
batchChannelValueErrorDTOChannelId :: Text
batchChannelValueErrorDTOChannelId :: Text
batchChannelValueErrorDTOChannelId
  , Double
batchChannelValueErrorDTOX :: Double
batchChannelValueErrorDTOX :: Double
batchChannelValueErrorDTOX
  , Error
batchChannelValueErrorDTOError :: Error
batchChannelValueErrorDTOError :: Error
batchChannelValueErrorDTOError
  }

-- ** BatchExperimentUpdateResult
-- | BatchExperimentUpdateResult
data BatchExperimentUpdateResult = BatchExperimentUpdateResult
    { BatchExperimentUpdateResult -> Text
batchExperimentUpdateResultExperimentId :: !(Text) -- ^ /Required/ "experimentId"
    -- ^ "error"
    , BatchExperimentUpdateResult -> Maybe Error
batchExperimentUpdateResultError        :: !(Maybe Error) -- ^ "error"
    }
    deriving (Int -> BatchExperimentUpdateResult -> ShowS
[BatchExperimentUpdateResult] -> ShowS
BatchExperimentUpdateResult -> FilePath
(Int -> BatchExperimentUpdateResult -> ShowS)
-> (BatchExperimentUpdateResult -> FilePath)
-> ([BatchExperimentUpdateResult] -> ShowS)
-> Show BatchExperimentUpdateResult
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BatchExperimentUpdateResult] -> ShowS
$cshowList :: [BatchExperimentUpdateResult] -> ShowS
show :: BatchExperimentUpdateResult -> FilePath
$cshow :: BatchExperimentUpdateResult -> FilePath
showsPrec :: Int -> BatchExperimentUpdateResult -> ShowS
$cshowsPrec :: Int -> BatchExperimentUpdateResult -> ShowS
P.Show, BatchExperimentUpdateResult -> BatchExperimentUpdateResult -> Bool
(BatchExperimentUpdateResult
 -> BatchExperimentUpdateResult -> Bool)
-> (BatchExperimentUpdateResult
    -> BatchExperimentUpdateResult -> Bool)
-> Eq BatchExperimentUpdateResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchExperimentUpdateResult -> BatchExperimentUpdateResult -> Bool
$c/= :: BatchExperimentUpdateResult -> BatchExperimentUpdateResult -> Bool
== :: BatchExperimentUpdateResult -> BatchExperimentUpdateResult -> Bool
$c== :: BatchExperimentUpdateResult -> BatchExperimentUpdateResult -> Bool
P.Eq, P.Typeable)

-- | FromJSON BatchExperimentUpdateResult
instance A.FromJSON BatchExperimentUpdateResult where
  parseJSON :: Value -> Parser BatchExperimentUpdateResult
parseJSON = FilePath
-> (Object -> Parser BatchExperimentUpdateResult)
-> Value
-> Parser BatchExperimentUpdateResult
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"BatchExperimentUpdateResult" ((Object -> Parser BatchExperimentUpdateResult)
 -> Value -> Parser BatchExperimentUpdateResult)
-> (Object -> Parser BatchExperimentUpdateResult)
-> Value
-> Parser BatchExperimentUpdateResult
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe Error -> BatchExperimentUpdateResult
BatchExperimentUpdateResult
      (Text -> Maybe Error -> BatchExperimentUpdateResult)
-> Parser Text
-> Parser (Maybe Error -> BatchExperimentUpdateResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"experimentId")
      Parser (Maybe Error -> BatchExperimentUpdateResult)
-> Parser (Maybe Error) -> Parser BatchExperimentUpdateResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Error)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"error")

-- | ToJSON BatchExperimentUpdateResult
instance A.ToJSON BatchExperimentUpdateResult where
  toJSON :: BatchExperimentUpdateResult -> Value
toJSON BatchExperimentUpdateResult {Maybe Error
Text
batchExperimentUpdateResultError :: Maybe Error
batchExperimentUpdateResultExperimentId :: Text
batchExperimentUpdateResultError :: BatchExperimentUpdateResult -> Maybe Error
batchExperimentUpdateResultExperimentId :: BatchExperimentUpdateResult -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"experimentId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
batchExperimentUpdateResultExperimentId
      , Text
"error" Text -> Maybe Error -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Error
batchExperimentUpdateResultError
      ]


-- | Construct a value of type 'BatchExperimentUpdateResult' (by applying it's required fields, if any)
mkBatchExperimentUpdateResult
  :: Text -- ^ 'batchExperimentUpdateResultExperimentId'
  -> BatchExperimentUpdateResult
mkBatchExperimentUpdateResult :: Text -> BatchExperimentUpdateResult
mkBatchExperimentUpdateResult Text
batchExperimentUpdateResultExperimentId =
  BatchExperimentUpdateResult :: Text -> Maybe Error -> BatchExperimentUpdateResult
BatchExperimentUpdateResult
  { Text
batchExperimentUpdateResultExperimentId :: Text
batchExperimentUpdateResultExperimentId :: Text
batchExperimentUpdateResultExperimentId
  , batchExperimentUpdateResultError :: Maybe Error
batchExperimentUpdateResultError = Maybe Error
forall a. Maybe a
Nothing
  }

-- ** Channel
-- | Channel
data Channel = Channel
    { Channel -> Text
channelId          :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "name"
    , Channel -> Text
channelName        :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "channelType"
    , Channel -> ChannelType
channelChannelType :: !(ChannelType) -- ^ /Required/ "channelType"
    -- ^ "lastX"
    , Channel -> Maybe Double
channelLastX       :: !(Maybe Double) -- ^ "lastX"
    }
    deriving (Int -> Channel -> ShowS
[Channel] -> ShowS
Channel -> FilePath
(Int -> Channel -> ShowS)
-> (Channel -> FilePath) -> ([Channel] -> ShowS) -> Show Channel
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Channel] -> ShowS
$cshowList :: [Channel] -> ShowS
show :: Channel -> FilePath
$cshow :: Channel -> FilePath
showsPrec :: Int -> Channel -> ShowS
$cshowsPrec :: Int -> Channel -> ShowS
P.Show, Channel -> Channel -> Bool
(Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool) -> Eq Channel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c== :: Channel -> Channel -> Bool
P.Eq, P.Typeable)

-- | FromJSON Channel
instance A.FromJSON Channel where
  parseJSON :: Value -> Parser Channel
parseJSON = FilePath -> (Object -> Parser Channel) -> Value -> Parser Channel
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Channel" ((Object -> Parser Channel) -> Value -> Parser Channel)
-> (Object -> Parser Channel) -> Value -> Parser Channel
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> ChannelType -> Maybe Double -> Channel
Channel
      (Text -> Text -> ChannelType -> Maybe Double -> Channel)
-> Parser Text
-> Parser (Text -> ChannelType -> Maybe Double -> Channel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser (Text -> ChannelType -> Maybe Double -> Channel)
-> Parser Text -> Parser (ChannelType -> Maybe Double -> Channel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser (ChannelType -> Maybe Double -> Channel)
-> Parser ChannelType -> Parser (Maybe Double -> Channel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ChannelType
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelType")
      Parser (Maybe Double -> Channel)
-> Parser (Maybe Double) -> Parser Channel
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"lastX")

-- | ToJSON Channel
instance A.ToJSON Channel where
  toJSON :: Channel -> Value
toJSON Channel {Maybe Double
Text
ChannelType
channelLastX :: Maybe Double
channelChannelType :: ChannelType
channelName :: Text
channelId :: Text
channelLastX :: Channel -> Maybe Double
channelChannelType :: Channel -> ChannelType
channelName :: Channel -> Text
channelId :: Channel -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelId
      , Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelName
      , Text
"channelType" Text -> ChannelType -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChannelType
channelChannelType
      , Text
"lastX" Text -> Maybe Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Double
channelLastX
      ]


-- | Construct a value of type 'Channel' (by applying it's required fields, if any)
mkChannel
  :: Text -- ^ 'channelId'
  -> Text -- ^ 'channelName'
  -> ChannelType -- ^ 'channelChannelType'
  -> Channel
mkChannel :: Text -> Text -> ChannelType -> Channel
mkChannel Text
channelId Text
channelName ChannelType
channelChannelType =
  Channel :: Text -> Text -> ChannelType -> Maybe Double -> Channel
Channel
  { Text
channelId :: Text
channelId :: Text
channelId
  , Text
channelName :: Text
channelName :: Text
channelName
  , ChannelType
channelChannelType :: ChannelType
channelChannelType :: ChannelType
channelChannelType
  , channelLastX :: Maybe Double
channelLastX = Maybe Double
forall a. Maybe a
Nothing
  }

-- ** ChannelDTO
-- | ChannelDTO
data ChannelDTO = ChannelDTO
    { ChannelDTO -> Text
channelDTOId          :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "name"
    , ChannelDTO -> Text
channelDTOName        :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "channelType"
    , ChannelDTO -> ChannelTypeEnum
channelDTOChannelType :: !(ChannelTypeEnum) -- ^ /Required/ "channelType"
    -- ^ "lastX"
    , ChannelDTO -> Maybe Double
channelDTOLastX       :: !(Maybe Double) -- ^ "lastX"
    }
    deriving (Int -> ChannelDTO -> ShowS
[ChannelDTO] -> ShowS
ChannelDTO -> FilePath
(Int -> ChannelDTO -> ShowS)
-> (ChannelDTO -> FilePath)
-> ([ChannelDTO] -> ShowS)
-> Show ChannelDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChannelDTO] -> ShowS
$cshowList :: [ChannelDTO] -> ShowS
show :: ChannelDTO -> FilePath
$cshow :: ChannelDTO -> FilePath
showsPrec :: Int -> ChannelDTO -> ShowS
$cshowsPrec :: Int -> ChannelDTO -> ShowS
P.Show, ChannelDTO -> ChannelDTO -> Bool
(ChannelDTO -> ChannelDTO -> Bool)
-> (ChannelDTO -> ChannelDTO -> Bool) -> Eq ChannelDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelDTO -> ChannelDTO -> Bool
$c/= :: ChannelDTO -> ChannelDTO -> Bool
== :: ChannelDTO -> ChannelDTO -> Bool
$c== :: ChannelDTO -> ChannelDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChannelDTO
instance A.FromJSON ChannelDTO where
  parseJSON :: Value -> Parser ChannelDTO
parseJSON = FilePath
-> (Object -> Parser ChannelDTO) -> Value -> Parser ChannelDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ChannelDTO" ((Object -> Parser ChannelDTO) -> Value -> Parser ChannelDTO)
-> (Object -> Parser ChannelDTO) -> Value -> Parser ChannelDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> ChannelTypeEnum -> Maybe Double -> ChannelDTO
ChannelDTO
      (Text -> Text -> ChannelTypeEnum -> Maybe Double -> ChannelDTO)
-> Parser Text
-> Parser (Text -> ChannelTypeEnum -> Maybe Double -> ChannelDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser (Text -> ChannelTypeEnum -> Maybe Double -> ChannelDTO)
-> Parser Text
-> Parser (ChannelTypeEnum -> Maybe Double -> ChannelDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser (ChannelTypeEnum -> Maybe Double -> ChannelDTO)
-> Parser ChannelTypeEnum -> Parser (Maybe Double -> ChannelDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ChannelTypeEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelType")
      Parser (Maybe Double -> ChannelDTO)
-> Parser (Maybe Double) -> Parser ChannelDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"lastX")

-- | ToJSON ChannelDTO
instance A.ToJSON ChannelDTO where
  toJSON :: ChannelDTO -> Value
toJSON ChannelDTO {Maybe Double
Text
ChannelTypeEnum
channelDTOLastX :: Maybe Double
channelDTOChannelType :: ChannelTypeEnum
channelDTOName :: Text
channelDTOId :: Text
channelDTOLastX :: ChannelDTO -> Maybe Double
channelDTOChannelType :: ChannelDTO -> ChannelTypeEnum
channelDTOName :: ChannelDTO -> Text
channelDTOId :: ChannelDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelDTOId
      , Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelDTOName
      , Text
"channelType" Text -> ChannelTypeEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChannelTypeEnum
channelDTOChannelType
      , Text
"lastX" Text -> Maybe Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Double
channelDTOLastX
      ]


-- | Construct a value of type 'ChannelDTO' (by applying it's required fields, if any)
mkChannelDTO
  :: Text -- ^ 'channelDTOId'
  -> Text -- ^ 'channelDTOName'
  -> ChannelTypeEnum -- ^ 'channelDTOChannelType'
  -> ChannelDTO
mkChannelDTO :: Text -> Text -> ChannelTypeEnum -> ChannelDTO
mkChannelDTO Text
channelDTOId Text
channelDTOName ChannelTypeEnum
channelDTOChannelType =
  ChannelDTO :: Text -> Text -> ChannelTypeEnum -> Maybe Double -> ChannelDTO
ChannelDTO
  { Text
channelDTOId :: Text
channelDTOId :: Text
channelDTOId
  , Text
channelDTOName :: Text
channelDTOName :: Text
channelDTOName
  , ChannelTypeEnum
channelDTOChannelType :: ChannelTypeEnum
channelDTOChannelType :: ChannelTypeEnum
channelDTOChannelType
  , channelDTOLastX :: Maybe Double
channelDTOLastX = Maybe Double
forall a. Maybe a
Nothing
  }

-- ** ChannelParams
-- | ChannelParams
data ChannelParams = ChannelParams
    { ChannelParams -> Text
channelParamsName        :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "channelType"
    , ChannelParams -> ChannelTypeEnum
channelParamsChannelType :: !(ChannelTypeEnum) -- ^ /Required/ "channelType"
    }
    deriving (Int -> ChannelParams -> ShowS
[ChannelParams] -> ShowS
ChannelParams -> FilePath
(Int -> ChannelParams -> ShowS)
-> (ChannelParams -> FilePath)
-> ([ChannelParams] -> ShowS)
-> Show ChannelParams
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChannelParams] -> ShowS
$cshowList :: [ChannelParams] -> ShowS
show :: ChannelParams -> FilePath
$cshow :: ChannelParams -> FilePath
showsPrec :: Int -> ChannelParams -> ShowS
$cshowsPrec :: Int -> ChannelParams -> ShowS
P.Show, ChannelParams -> ChannelParams -> Bool
(ChannelParams -> ChannelParams -> Bool)
-> (ChannelParams -> ChannelParams -> Bool) -> Eq ChannelParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelParams -> ChannelParams -> Bool
$c/= :: ChannelParams -> ChannelParams -> Bool
== :: ChannelParams -> ChannelParams -> Bool
$c== :: ChannelParams -> ChannelParams -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChannelParams
instance A.FromJSON ChannelParams where
  parseJSON :: Value -> Parser ChannelParams
parseJSON = FilePath
-> (Object -> Parser ChannelParams)
-> Value
-> Parser ChannelParams
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ChannelParams" ((Object -> Parser ChannelParams) -> Value -> Parser ChannelParams)
-> (Object -> Parser ChannelParams)
-> Value
-> Parser ChannelParams
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> ChannelTypeEnum -> ChannelParams
ChannelParams
      (Text -> ChannelTypeEnum -> ChannelParams)
-> Parser Text -> Parser (ChannelTypeEnum -> ChannelParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser (ChannelTypeEnum -> ChannelParams)
-> Parser ChannelTypeEnum -> Parser ChannelParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ChannelTypeEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelType")

-- | ToJSON ChannelParams
instance A.ToJSON ChannelParams where
  toJSON :: ChannelParams -> Value
toJSON ChannelParams {Text
ChannelTypeEnum
channelParamsChannelType :: ChannelTypeEnum
channelParamsName :: Text
channelParamsChannelType :: ChannelParams -> ChannelTypeEnum
channelParamsName :: ChannelParams -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelParamsName
      , Text
"channelType" Text -> ChannelTypeEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChannelTypeEnum
channelParamsChannelType
      ]


-- | Construct a value of type 'ChannelParams' (by applying it's required fields, if any)
mkChannelParams
  :: Text -- ^ 'channelParamsName'
  -> ChannelTypeEnum -- ^ 'channelParamsChannelType'
  -> ChannelParams
mkChannelParams :: Text -> ChannelTypeEnum -> ChannelParams
mkChannelParams Text
channelParamsName ChannelTypeEnum
channelParamsChannelType =
  ChannelParams :: Text -> ChannelTypeEnum -> ChannelParams
ChannelParams
  { Text
channelParamsName :: Text
channelParamsName :: Text
channelParamsName
  , ChannelTypeEnum
channelParamsChannelType :: ChannelTypeEnum
channelParamsChannelType :: ChannelTypeEnum
channelParamsChannelType
  }

-- ** ChannelWithValue
-- | ChannelWithValue
data ChannelWithValue = ChannelWithValue
    { ChannelWithValue -> Double
channelWithValueX           :: !(Double) -- ^ /Required/ "x"
    -- ^ /Required/ "y"
    , ChannelWithValue -> Text
channelWithValueY           :: !(Text) -- ^ /Required/ "y"
    -- ^ /Required/ "channelType"
    , ChannelWithValue -> ChannelType
channelWithValueChannelType :: !(ChannelType) -- ^ /Required/ "channelType"
    -- ^ /Required/ "channelName"
    , ChannelWithValue -> Text
channelWithValueChannelName :: !(Text) -- ^ /Required/ "channelName"
    -- ^ /Required/ "channelId"
    , ChannelWithValue -> Text
channelWithValueChannelId   :: !(Text) -- ^ /Required/ "channelId"
    }
    deriving (Int -> ChannelWithValue -> ShowS
[ChannelWithValue] -> ShowS
ChannelWithValue -> FilePath
(Int -> ChannelWithValue -> ShowS)
-> (ChannelWithValue -> FilePath)
-> ([ChannelWithValue] -> ShowS)
-> Show ChannelWithValue
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChannelWithValue] -> ShowS
$cshowList :: [ChannelWithValue] -> ShowS
show :: ChannelWithValue -> FilePath
$cshow :: ChannelWithValue -> FilePath
showsPrec :: Int -> ChannelWithValue -> ShowS
$cshowsPrec :: Int -> ChannelWithValue -> ShowS
P.Show, ChannelWithValue -> ChannelWithValue -> Bool
(ChannelWithValue -> ChannelWithValue -> Bool)
-> (ChannelWithValue -> ChannelWithValue -> Bool)
-> Eq ChannelWithValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelWithValue -> ChannelWithValue -> Bool
$c/= :: ChannelWithValue -> ChannelWithValue -> Bool
== :: ChannelWithValue -> ChannelWithValue -> Bool
$c== :: ChannelWithValue -> ChannelWithValue -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChannelWithValue
instance A.FromJSON ChannelWithValue where
  parseJSON :: Value -> Parser ChannelWithValue
parseJSON = FilePath
-> (Object -> Parser ChannelWithValue)
-> Value
-> Parser ChannelWithValue
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ChannelWithValue" ((Object -> Parser ChannelWithValue)
 -> Value -> Parser ChannelWithValue)
-> (Object -> Parser ChannelWithValue)
-> Value
-> Parser ChannelWithValue
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Double -> Text -> ChannelType -> Text -> Text -> ChannelWithValue
ChannelWithValue
      (Double -> Text -> ChannelType -> Text -> Text -> ChannelWithValue)
-> Parser Double
-> Parser (Text -> ChannelType -> Text -> Text -> ChannelWithValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"x")
      Parser (Text -> ChannelType -> Text -> Text -> ChannelWithValue)
-> Parser Text
-> Parser (ChannelType -> Text -> Text -> ChannelWithValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"y")
      Parser (ChannelType -> Text -> Text -> ChannelWithValue)
-> Parser ChannelType -> Parser (Text -> Text -> ChannelWithValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ChannelType
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelType")
      Parser (Text -> Text -> ChannelWithValue)
-> Parser Text -> Parser (Text -> ChannelWithValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelName")
      Parser (Text -> ChannelWithValue)
-> Parser Text -> Parser ChannelWithValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelId")

-- | ToJSON ChannelWithValue
instance A.ToJSON ChannelWithValue where
  toJSON :: ChannelWithValue -> Value
toJSON ChannelWithValue {Double
Text
ChannelType
channelWithValueChannelId :: Text
channelWithValueChannelName :: Text
channelWithValueChannelType :: ChannelType
channelWithValueY :: Text
channelWithValueX :: Double
channelWithValueChannelId :: ChannelWithValue -> Text
channelWithValueChannelName :: ChannelWithValue -> Text
channelWithValueChannelType :: ChannelWithValue -> ChannelType
channelWithValueY :: ChannelWithValue -> Text
channelWithValueX :: ChannelWithValue -> Double
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"x" Text -> Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
channelWithValueX
      , Text
"y" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelWithValueY
      , Text
"channelType" Text -> ChannelType -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChannelType
channelWithValueChannelType
      , Text
"channelName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelWithValueChannelName
      , Text
"channelId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelWithValueChannelId
      ]


-- | Construct a value of type 'ChannelWithValue' (by applying it's required fields, if any)
mkChannelWithValue
  :: Double -- ^ 'channelWithValueX'
  -> Text -- ^ 'channelWithValueY'
  -> ChannelType -- ^ 'channelWithValueChannelType'
  -> Text -- ^ 'channelWithValueChannelName'
  -> Text -- ^ 'channelWithValueChannelId'
  -> ChannelWithValue
mkChannelWithValue :: Double -> Text -> ChannelType -> Text -> Text -> ChannelWithValue
mkChannelWithValue Double
channelWithValueX Text
channelWithValueY ChannelType
channelWithValueChannelType Text
channelWithValueChannelName Text
channelWithValueChannelId =
  ChannelWithValue :: Double -> Text -> ChannelType -> Text -> Text -> ChannelWithValue
ChannelWithValue
  { Double
channelWithValueX :: Double
channelWithValueX :: Double
channelWithValueX
  , Text
channelWithValueY :: Text
channelWithValueY :: Text
channelWithValueY
  , ChannelType
channelWithValueChannelType :: ChannelType
channelWithValueChannelType :: ChannelType
channelWithValueChannelType
  , Text
channelWithValueChannelName :: Text
channelWithValueChannelName :: Text
channelWithValueChannelName
  , Text
channelWithValueChannelId :: Text
channelWithValueChannelId :: Text
channelWithValueChannelId
  }

-- ** ChannelWithValueDTO
-- | ChannelWithValueDTO
data ChannelWithValueDTO = ChannelWithValueDTO
    { ChannelWithValueDTO -> Double
channelWithValueDTOX           :: !(Double) -- ^ /Required/ "x"
    -- ^ /Required/ "y"
    , ChannelWithValueDTO -> Text
channelWithValueDTOY           :: !(Text) -- ^ /Required/ "y"
    -- ^ /Required/ "channelType"
    , ChannelWithValueDTO -> ChannelTypeEnum
channelWithValueDTOChannelType :: !(ChannelTypeEnum) -- ^ /Required/ "channelType"
    -- ^ /Required/ "channelName"
    , ChannelWithValueDTO -> Text
channelWithValueDTOChannelName :: !(Text) -- ^ /Required/ "channelName"
    -- ^ /Required/ "channelId"
    , ChannelWithValueDTO -> Text
channelWithValueDTOChannelId   :: !(Text) -- ^ /Required/ "channelId"
    }
    deriving (Int -> ChannelWithValueDTO -> ShowS
[ChannelWithValueDTO] -> ShowS
ChannelWithValueDTO -> FilePath
(Int -> ChannelWithValueDTO -> ShowS)
-> (ChannelWithValueDTO -> FilePath)
-> ([ChannelWithValueDTO] -> ShowS)
-> Show ChannelWithValueDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChannelWithValueDTO] -> ShowS
$cshowList :: [ChannelWithValueDTO] -> ShowS
show :: ChannelWithValueDTO -> FilePath
$cshow :: ChannelWithValueDTO -> FilePath
showsPrec :: Int -> ChannelWithValueDTO -> ShowS
$cshowsPrec :: Int -> ChannelWithValueDTO -> ShowS
P.Show, ChannelWithValueDTO -> ChannelWithValueDTO -> Bool
(ChannelWithValueDTO -> ChannelWithValueDTO -> Bool)
-> (ChannelWithValueDTO -> ChannelWithValueDTO -> Bool)
-> Eq ChannelWithValueDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelWithValueDTO -> ChannelWithValueDTO -> Bool
$c/= :: ChannelWithValueDTO -> ChannelWithValueDTO -> Bool
== :: ChannelWithValueDTO -> ChannelWithValueDTO -> Bool
$c== :: ChannelWithValueDTO -> ChannelWithValueDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChannelWithValueDTO
instance A.FromJSON ChannelWithValueDTO where
  parseJSON :: Value -> Parser ChannelWithValueDTO
parseJSON = FilePath
-> (Object -> Parser ChannelWithValueDTO)
-> Value
-> Parser ChannelWithValueDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ChannelWithValueDTO" ((Object -> Parser ChannelWithValueDTO)
 -> Value -> Parser ChannelWithValueDTO)
-> (Object -> Parser ChannelWithValueDTO)
-> Value
-> Parser ChannelWithValueDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Double
-> Text -> ChannelTypeEnum -> Text -> Text -> ChannelWithValueDTO
ChannelWithValueDTO
      (Double
 -> Text -> ChannelTypeEnum -> Text -> Text -> ChannelWithValueDTO)
-> Parser Double
-> Parser
     (Text -> ChannelTypeEnum -> Text -> Text -> ChannelWithValueDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"x")
      Parser
  (Text -> ChannelTypeEnum -> Text -> Text -> ChannelWithValueDTO)
-> Parser Text
-> Parser (ChannelTypeEnum -> Text -> Text -> ChannelWithValueDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"y")
      Parser (ChannelTypeEnum -> Text -> Text -> ChannelWithValueDTO)
-> Parser ChannelTypeEnum
-> Parser (Text -> Text -> ChannelWithValueDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ChannelTypeEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelType")
      Parser (Text -> Text -> ChannelWithValueDTO)
-> Parser Text -> Parser (Text -> ChannelWithValueDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelName")
      Parser (Text -> ChannelWithValueDTO)
-> Parser Text -> Parser ChannelWithValueDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelId")

-- | ToJSON ChannelWithValueDTO
instance A.ToJSON ChannelWithValueDTO where
  toJSON :: ChannelWithValueDTO -> Value
toJSON ChannelWithValueDTO {Double
Text
ChannelTypeEnum
channelWithValueDTOChannelId :: Text
channelWithValueDTOChannelName :: Text
channelWithValueDTOChannelType :: ChannelTypeEnum
channelWithValueDTOY :: Text
channelWithValueDTOX :: Double
channelWithValueDTOChannelId :: ChannelWithValueDTO -> Text
channelWithValueDTOChannelName :: ChannelWithValueDTO -> Text
channelWithValueDTOChannelType :: ChannelWithValueDTO -> ChannelTypeEnum
channelWithValueDTOY :: ChannelWithValueDTO -> Text
channelWithValueDTOX :: ChannelWithValueDTO -> Double
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"x" Text -> Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
channelWithValueDTOX
      , Text
"y" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelWithValueDTOY
      , Text
"channelType" Text -> ChannelTypeEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChannelTypeEnum
channelWithValueDTOChannelType
      , Text
"channelName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelWithValueDTOChannelName
      , Text
"channelId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
channelWithValueDTOChannelId
      ]


-- | Construct a value of type 'ChannelWithValueDTO' (by applying it's required fields, if any)
mkChannelWithValueDTO
  :: Double -- ^ 'channelWithValueDTOX'
  -> Text -- ^ 'channelWithValueDTOY'
  -> ChannelTypeEnum -- ^ 'channelWithValueDTOChannelType'
  -> Text -- ^ 'channelWithValueDTOChannelName'
  -> Text -- ^ 'channelWithValueDTOChannelId'
  -> ChannelWithValueDTO
mkChannelWithValueDTO :: Double
-> Text -> ChannelTypeEnum -> Text -> Text -> ChannelWithValueDTO
mkChannelWithValueDTO Double
channelWithValueDTOX Text
channelWithValueDTOY ChannelTypeEnum
channelWithValueDTOChannelType Text
channelWithValueDTOChannelName Text
channelWithValueDTOChannelId =
  ChannelWithValueDTO :: Double
-> Text -> ChannelTypeEnum -> Text -> Text -> ChannelWithValueDTO
ChannelWithValueDTO
  { Double
channelWithValueDTOX :: Double
channelWithValueDTOX :: Double
channelWithValueDTOX
  , Text
channelWithValueDTOY :: Text
channelWithValueDTOY :: Text
channelWithValueDTOY
  , ChannelTypeEnum
channelWithValueDTOChannelType :: ChannelTypeEnum
channelWithValueDTOChannelType :: ChannelTypeEnum
channelWithValueDTOChannelType
  , Text
channelWithValueDTOChannelName :: Text
channelWithValueDTOChannelName :: Text
channelWithValueDTOChannelName
  , Text
channelWithValueDTOChannelId :: Text
channelWithValueDTOChannelId :: Text
channelWithValueDTOChannelId
  }

-- ** Chart
-- | Chart
data Chart = Chart
    { Chart -> Text
chartId     :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "name"
    , Chart -> Text
chartName   :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "series"
    , Chart -> [Series]
chartSeries :: !([Series]) -- ^ /Required/ "series"
    }
    deriving (Int -> Chart -> ShowS
[Chart] -> ShowS
Chart -> FilePath
(Int -> Chart -> ShowS)
-> (Chart -> FilePath) -> ([Chart] -> ShowS) -> Show Chart
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Chart] -> ShowS
$cshowList :: [Chart] -> ShowS
show :: Chart -> FilePath
$cshow :: Chart -> FilePath
showsPrec :: Int -> Chart -> ShowS
$cshowsPrec :: Int -> Chart -> ShowS
P.Show, Chart -> Chart -> Bool
(Chart -> Chart -> Bool) -> (Chart -> Chart -> Bool) -> Eq Chart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chart -> Chart -> Bool
$c/= :: Chart -> Chart -> Bool
== :: Chart -> Chart -> Bool
$c== :: Chart -> Chart -> Bool
P.Eq, P.Typeable)

-- | FromJSON Chart
instance A.FromJSON Chart where
  parseJSON :: Value -> Parser Chart
parseJSON = FilePath -> (Object -> Parser Chart) -> Value -> Parser Chart
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Chart" ((Object -> Parser Chart) -> Value -> Parser Chart)
-> (Object -> Parser Chart) -> Value -> Parser Chart
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> [Series] -> Chart
Chart
      (Text -> Text -> [Series] -> Chart)
-> Parser Text -> Parser (Text -> [Series] -> Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser (Text -> [Series] -> Chart)
-> Parser Text -> Parser ([Series] -> Chart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser ([Series] -> Chart) -> Parser [Series] -> Parser Chart
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Series]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"series")

-- | ToJSON Chart
instance A.ToJSON Chart where
  toJSON :: Chart -> Value
toJSON Chart {[Series]
Text
chartSeries :: [Series]
chartName :: Text
chartId :: Text
chartSeries :: Chart -> [Series]
chartName :: Chart -> Text
chartId :: Chart -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
chartId
      , Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
chartName
      , Text
"series" Text -> [Series] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Series]
chartSeries
      ]


-- | Construct a value of type 'Chart' (by applying it's required fields, if any)
mkChart
  :: Text -- ^ 'chartId'
  -> Text -- ^ 'chartName'
  -> [Series] -- ^ 'chartSeries'
  -> Chart
mkChart :: Text -> Text -> [Series] -> Chart
mkChart Text
chartId Text
chartName [Series]
chartSeries =
  Chart :: Text -> Text -> [Series] -> Chart
Chart
  { Text
chartId :: Text
chartId :: Text
chartId
  , Text
chartName :: Text
chartName :: Text
chartName
  , [Series]
chartSeries :: [Series]
chartSeries :: [Series]
chartSeries
  }

-- ** ChartDefinition
-- | ChartDefinition
data ChartDefinition = ChartDefinition
    { ChartDefinition -> Text
chartDefinitionName   :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "series"
    , ChartDefinition -> [SeriesDefinition]
chartDefinitionSeries :: !([SeriesDefinition]) -- ^ /Required/ "series"
    }
    deriving (Int -> ChartDefinition -> ShowS
[ChartDefinition] -> ShowS
ChartDefinition -> FilePath
(Int -> ChartDefinition -> ShowS)
-> (ChartDefinition -> FilePath)
-> ([ChartDefinition] -> ShowS)
-> Show ChartDefinition
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChartDefinition] -> ShowS
$cshowList :: [ChartDefinition] -> ShowS
show :: ChartDefinition -> FilePath
$cshow :: ChartDefinition -> FilePath
showsPrec :: Int -> ChartDefinition -> ShowS
$cshowsPrec :: Int -> ChartDefinition -> ShowS
P.Show, ChartDefinition -> ChartDefinition -> Bool
(ChartDefinition -> ChartDefinition -> Bool)
-> (ChartDefinition -> ChartDefinition -> Bool)
-> Eq ChartDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartDefinition -> ChartDefinition -> Bool
$c/= :: ChartDefinition -> ChartDefinition -> Bool
== :: ChartDefinition -> ChartDefinition -> Bool
$c== :: ChartDefinition -> ChartDefinition -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChartDefinition
instance A.FromJSON ChartDefinition where
  parseJSON :: Value -> Parser ChartDefinition
parseJSON = FilePath
-> (Object -> Parser ChartDefinition)
-> Value
-> Parser ChartDefinition
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ChartDefinition" ((Object -> Parser ChartDefinition)
 -> Value -> Parser ChartDefinition)
-> (Object -> Parser ChartDefinition)
-> Value
-> Parser ChartDefinition
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> [SeriesDefinition] -> ChartDefinition
ChartDefinition
      (Text -> [SeriesDefinition] -> ChartDefinition)
-> Parser Text -> Parser ([SeriesDefinition] -> ChartDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser ([SeriesDefinition] -> ChartDefinition)
-> Parser [SeriesDefinition] -> Parser ChartDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [SeriesDefinition]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"series")

-- | ToJSON ChartDefinition
instance A.ToJSON ChartDefinition where
  toJSON :: ChartDefinition -> Value
toJSON ChartDefinition {[SeriesDefinition]
Text
chartDefinitionSeries :: [SeriesDefinition]
chartDefinitionName :: Text
chartDefinitionSeries :: ChartDefinition -> [SeriesDefinition]
chartDefinitionName :: ChartDefinition -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
chartDefinitionName
      , Text
"series" Text -> [SeriesDefinition] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [SeriesDefinition]
chartDefinitionSeries
      ]


-- | Construct a value of type 'ChartDefinition' (by applying it's required fields, if any)
mkChartDefinition
  :: Text -- ^ 'chartDefinitionName'
  -> [SeriesDefinition] -- ^ 'chartDefinitionSeries'
  -> ChartDefinition
mkChartDefinition :: Text -> [SeriesDefinition] -> ChartDefinition
mkChartDefinition Text
chartDefinitionName [SeriesDefinition]
chartDefinitionSeries =
  ChartDefinition :: Text -> [SeriesDefinition] -> ChartDefinition
ChartDefinition
  { Text
chartDefinitionName :: Text
chartDefinitionName :: Text
chartDefinitionName
  , [SeriesDefinition]
chartDefinitionSeries :: [SeriesDefinition]
chartDefinitionSeries :: [SeriesDefinition]
chartDefinitionSeries
  }

-- ** ChartSet
-- | ChartSet
data ChartSet = ChartSet
    { ChartSet -> Maybe Bool
chartSetIsEditable           :: !(Maybe Bool) -- ^ "isEditable"
    -- ^ "defaultChartsEnabled"
    , ChartSet -> Maybe Bool
chartSetDefaultChartsEnabled :: !(Maybe Bool) -- ^ "defaultChartsEnabled"
    -- ^ /Required/ "projectId"
    , ChartSet -> Text
chartSetProjectId            :: !(Text) -- ^ /Required/ "projectId"
    -- ^ /Required/ "id"
    , ChartSet -> Text
chartSetId                   :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "name"
    , ChartSet -> Text
chartSetName                 :: !(Text) -- ^ /Required/ "name"
    -- ^ "charts"
    , ChartSet -> Maybe [Chart]
chartSetCharts               :: !(Maybe [Chart]) -- ^ "charts"
    }
    deriving (Int -> ChartSet -> ShowS
[ChartSet] -> ShowS
ChartSet -> FilePath
(Int -> ChartSet -> ShowS)
-> (ChartSet -> FilePath) -> ([ChartSet] -> ShowS) -> Show ChartSet
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChartSet] -> ShowS
$cshowList :: [ChartSet] -> ShowS
show :: ChartSet -> FilePath
$cshow :: ChartSet -> FilePath
showsPrec :: Int -> ChartSet -> ShowS
$cshowsPrec :: Int -> ChartSet -> ShowS
P.Show, ChartSet -> ChartSet -> Bool
(ChartSet -> ChartSet -> Bool)
-> (ChartSet -> ChartSet -> Bool) -> Eq ChartSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartSet -> ChartSet -> Bool
$c/= :: ChartSet -> ChartSet -> Bool
== :: ChartSet -> ChartSet -> Bool
$c== :: ChartSet -> ChartSet -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChartSet
instance A.FromJSON ChartSet where
  parseJSON :: Value -> Parser ChartSet
parseJSON = FilePath -> (Object -> Parser ChartSet) -> Value -> Parser ChartSet
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ChartSet" ((Object -> Parser ChartSet) -> Value -> Parser ChartSet)
-> (Object -> Parser ChartSet) -> Value -> Parser ChartSet
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Bool -> Text -> Text -> Text -> Maybe [Chart] -> ChartSet
ChartSet
      (Maybe Bool
 -> Maybe Bool -> Text -> Text -> Text -> Maybe [Chart] -> ChartSet)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Text -> Text -> Text -> Maybe [Chart] -> ChartSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"isEditable")
      Parser
  (Maybe Bool -> Text -> Text -> Text -> Maybe [Chart] -> ChartSet)
-> Parser (Maybe Bool)
-> Parser (Text -> Text -> Text -> Maybe [Chart] -> ChartSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"defaultChartsEnabled")
      Parser (Text -> Text -> Text -> Maybe [Chart] -> ChartSet)
-> Parser Text
-> Parser (Text -> Text -> Maybe [Chart] -> ChartSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"projectId")
      Parser (Text -> Text -> Maybe [Chart] -> ChartSet)
-> Parser Text -> Parser (Text -> Maybe [Chart] -> ChartSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser (Text -> Maybe [Chart] -> ChartSet)
-> Parser Text -> Parser (Maybe [Chart] -> ChartSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser (Maybe [Chart] -> ChartSet)
-> Parser (Maybe [Chart]) -> Parser ChartSet
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [Chart])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"charts")

-- | ToJSON ChartSet
instance A.ToJSON ChartSet where
  toJSON :: ChartSet -> Value
toJSON ChartSet {Maybe Bool
Maybe [Chart]
Text
chartSetCharts :: Maybe [Chart]
chartSetName :: Text
chartSetId :: Text
chartSetProjectId :: Text
chartSetDefaultChartsEnabled :: Maybe Bool
chartSetIsEditable :: Maybe Bool
chartSetCharts :: ChartSet -> Maybe [Chart]
chartSetName :: ChartSet -> Text
chartSetId :: ChartSet -> Text
chartSetProjectId :: ChartSet -> Text
chartSetDefaultChartsEnabled :: ChartSet -> Maybe Bool
chartSetIsEditable :: ChartSet -> Maybe Bool
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"isEditable" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
chartSetIsEditable
      , Text
"defaultChartsEnabled" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
chartSetDefaultChartsEnabled
      , Text
"projectId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
chartSetProjectId
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
chartSetId
      , Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
chartSetName
      , Text
"charts" Text -> Maybe [Chart] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Chart]
chartSetCharts
      ]


-- | Construct a value of type 'ChartSet' (by applying it's required fields, if any)
mkChartSet
  :: Text -- ^ 'chartSetProjectId'
  -> Text -- ^ 'chartSetId'
  -> Text -- ^ 'chartSetName'
  -> ChartSet
mkChartSet :: Text -> Text -> Text -> ChartSet
mkChartSet Text
chartSetProjectId Text
chartSetId Text
chartSetName =
  ChartSet :: Maybe Bool
-> Maybe Bool -> Text -> Text -> Text -> Maybe [Chart] -> ChartSet
ChartSet
  { chartSetIsEditable :: Maybe Bool
chartSetIsEditable = Maybe Bool
forall a. Maybe a
Nothing
  , chartSetDefaultChartsEnabled :: Maybe Bool
chartSetDefaultChartsEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , Text
chartSetProjectId :: Text
chartSetProjectId :: Text
chartSetProjectId
  , Text
chartSetId :: Text
chartSetId :: Text
chartSetId
  , Text
chartSetName :: Text
chartSetName :: Text
chartSetName
  , chartSetCharts :: Maybe [Chart]
chartSetCharts = Maybe [Chart]
forall a. Maybe a
Nothing
  }

-- ** ChartSetParams
-- | ChartSetParams
data ChartSetParams = ChartSetParams
    { ChartSetParams -> Text
chartSetParamsName                 :: !(Text) -- ^ /Required/ "name"
    -- ^ "charts"
    , ChartSetParams -> Maybe [ChartDefinition]
chartSetParamsCharts               :: !(Maybe [ChartDefinition]) -- ^ "charts"
    -- ^ "defaultChartsEnabled"
    , ChartSetParams -> Maybe Bool
chartSetParamsDefaultChartsEnabled :: !(Maybe Bool) -- ^ "defaultChartsEnabled"
    -- ^ "isEditable"
    , ChartSetParams -> Maybe Bool
chartSetParamsIsEditable           :: !(Maybe Bool) -- ^ "isEditable"
    }
    deriving (Int -> ChartSetParams -> ShowS
[ChartSetParams] -> ShowS
ChartSetParams -> FilePath
(Int -> ChartSetParams -> ShowS)
-> (ChartSetParams -> FilePath)
-> ([ChartSetParams] -> ShowS)
-> Show ChartSetParams
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChartSetParams] -> ShowS
$cshowList :: [ChartSetParams] -> ShowS
show :: ChartSetParams -> FilePath
$cshow :: ChartSetParams -> FilePath
showsPrec :: Int -> ChartSetParams -> ShowS
$cshowsPrec :: Int -> ChartSetParams -> ShowS
P.Show, ChartSetParams -> ChartSetParams -> Bool
(ChartSetParams -> ChartSetParams -> Bool)
-> (ChartSetParams -> ChartSetParams -> Bool) -> Eq ChartSetParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartSetParams -> ChartSetParams -> Bool
$c/= :: ChartSetParams -> ChartSetParams -> Bool
== :: ChartSetParams -> ChartSetParams -> Bool
$c== :: ChartSetParams -> ChartSetParams -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChartSetParams
instance A.FromJSON ChartSetParams where
  parseJSON :: Value -> Parser ChartSetParams
parseJSON = FilePath
-> (Object -> Parser ChartSetParams)
-> Value
-> Parser ChartSetParams
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ChartSetParams" ((Object -> Parser ChartSetParams)
 -> Value -> Parser ChartSetParams)
-> (Object -> Parser ChartSetParams)
-> Value
-> Parser ChartSetParams
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe [ChartDefinition]
-> Maybe Bool
-> Maybe Bool
-> ChartSetParams
ChartSetParams
      (Text
 -> Maybe [ChartDefinition]
 -> Maybe Bool
 -> Maybe Bool
 -> ChartSetParams)
-> Parser Text
-> Parser
     (Maybe [ChartDefinition]
      -> Maybe Bool -> Maybe Bool -> ChartSetParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (Maybe [ChartDefinition]
   -> Maybe Bool -> Maybe Bool -> ChartSetParams)
-> Parser (Maybe [ChartDefinition])
-> Parser (Maybe Bool -> Maybe Bool -> ChartSetParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [ChartDefinition])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"charts")
      Parser (Maybe Bool -> Maybe Bool -> ChartSetParams)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> ChartSetParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"defaultChartsEnabled")
      Parser (Maybe Bool -> ChartSetParams)
-> Parser (Maybe Bool) -> Parser ChartSetParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"isEditable")

-- | ToJSON ChartSetParams
instance A.ToJSON ChartSetParams where
  toJSON :: ChartSetParams -> Value
toJSON ChartSetParams {Maybe Bool
Maybe [ChartDefinition]
Text
chartSetParamsIsEditable :: Maybe Bool
chartSetParamsDefaultChartsEnabled :: Maybe Bool
chartSetParamsCharts :: Maybe [ChartDefinition]
chartSetParamsName :: Text
chartSetParamsIsEditable :: ChartSetParams -> Maybe Bool
chartSetParamsDefaultChartsEnabled :: ChartSetParams -> Maybe Bool
chartSetParamsCharts :: ChartSetParams -> Maybe [ChartDefinition]
chartSetParamsName :: ChartSetParams -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
chartSetParamsName
      , Text
"charts" Text -> Maybe [ChartDefinition] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [ChartDefinition]
chartSetParamsCharts
      , Text
"defaultChartsEnabled" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
chartSetParamsDefaultChartsEnabled
      , Text
"isEditable" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
chartSetParamsIsEditable
      ]


-- | Construct a value of type 'ChartSetParams' (by applying it's required fields, if any)
mkChartSetParams
  :: Text -- ^ 'chartSetParamsName'
  -> ChartSetParams
mkChartSetParams :: Text -> ChartSetParams
mkChartSetParams Text
chartSetParamsName =
  ChartSetParams :: Text
-> Maybe [ChartDefinition]
-> Maybe Bool
-> Maybe Bool
-> ChartSetParams
ChartSetParams
  { Text
chartSetParamsName :: Text
chartSetParamsName :: Text
chartSetParamsName
  , chartSetParamsCharts :: Maybe [ChartDefinition]
chartSetParamsCharts = Maybe [ChartDefinition]
forall a. Maybe a
Nothing
  , chartSetParamsDefaultChartsEnabled :: Maybe Bool
chartSetParamsDefaultChartsEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , chartSetParamsIsEditable :: Maybe Bool
chartSetParamsIsEditable = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** Charts
-- | Charts
data Charts = Charts
    { Charts -> [Chart]
chartsManualCharts  :: !([Chart]) -- ^ /Required/ "manualCharts"
    -- ^ /Required/ "defaultCharts"
    , Charts -> [Chart]
chartsDefaultCharts :: !([Chart]) -- ^ /Required/ "defaultCharts"
    }
    deriving (Int -> Charts -> ShowS
[Charts] -> ShowS
Charts -> FilePath
(Int -> Charts -> ShowS)
-> (Charts -> FilePath) -> ([Charts] -> ShowS) -> Show Charts
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Charts] -> ShowS
$cshowList :: [Charts] -> ShowS
show :: Charts -> FilePath
$cshow :: Charts -> FilePath
showsPrec :: Int -> Charts -> ShowS
$cshowsPrec :: Int -> Charts -> ShowS
P.Show, Charts -> Charts -> Bool
(Charts -> Charts -> Bool)
-> (Charts -> Charts -> Bool) -> Eq Charts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Charts -> Charts -> Bool
$c/= :: Charts -> Charts -> Bool
== :: Charts -> Charts -> Bool
$c== :: Charts -> Charts -> Bool
P.Eq, P.Typeable)

-- | FromJSON Charts
instance A.FromJSON Charts where
  parseJSON :: Value -> Parser Charts
parseJSON = FilePath -> (Object -> Parser Charts) -> Value -> Parser Charts
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Charts" ((Object -> Parser Charts) -> Value -> Parser Charts)
-> (Object -> Parser Charts) -> Value -> Parser Charts
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Chart] -> [Chart] -> Charts
Charts
      ([Chart] -> [Chart] -> Charts)
-> Parser [Chart] -> Parser ([Chart] -> Charts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [Chart]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"manualCharts")
      Parser ([Chart] -> Charts) -> Parser [Chart] -> Parser Charts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Chart]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"defaultCharts")

-- | ToJSON Charts
instance A.ToJSON Charts where
  toJSON :: Charts -> Value
toJSON Charts {[Chart]
chartsDefaultCharts :: [Chart]
chartsManualCharts :: [Chart]
chartsDefaultCharts :: Charts -> [Chart]
chartsManualCharts :: Charts -> [Chart]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"manualCharts" Text -> [Chart] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Chart]
chartsManualCharts
      , Text
"defaultCharts" Text -> [Chart] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Chart]
chartsDefaultCharts
      ]


-- | Construct a value of type 'Charts' (by applying it's required fields, if any)
mkCharts
  :: [Chart] -- ^ 'chartsManualCharts'
  -> [Chart] -- ^ 'chartsDefaultCharts'
  -> Charts
mkCharts :: [Chart] -> [Chart] -> Charts
mkCharts [Chart]
chartsManualCharts [Chart]
chartsDefaultCharts =
  Charts :: [Chart] -> [Chart] -> Charts
Charts
  { [Chart]
chartsManualCharts :: [Chart]
chartsManualCharts :: [Chart]
chartsManualCharts
  , [Chart]
chartsDefaultCharts :: [Chart]
chartsDefaultCharts :: [Chart]
chartsDefaultCharts
  }

-- ** ClientConfig
-- | ClientConfig
data ClientConfig = ClientConfig
    { ClientConfig -> Text
clientConfigApiUrl         :: !(Text) -- ^ /Required/ "apiUrl"
    -- ^ /Required/ "applicationUrl"
    , ClientConfig -> Text
clientConfigApplicationUrl :: !(Text) -- ^ /Required/ "applicationUrl"
    -- ^ /Required/ "pyLibVersions"
    , ClientConfig -> ClientVersionsConfigDTO
clientConfigPyLibVersions  :: !(ClientVersionsConfigDTO) -- ^ /Required/ "pyLibVersions"
    }
    deriving (Int -> ClientConfig -> ShowS
[ClientConfig] -> ShowS
ClientConfig -> FilePath
(Int -> ClientConfig -> ShowS)
-> (ClientConfig -> FilePath)
-> ([ClientConfig] -> ShowS)
-> Show ClientConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ClientConfig] -> ShowS
$cshowList :: [ClientConfig] -> ShowS
show :: ClientConfig -> FilePath
$cshow :: ClientConfig -> FilePath
showsPrec :: Int -> ClientConfig -> ShowS
$cshowsPrec :: Int -> ClientConfig -> ShowS
P.Show, ClientConfig -> ClientConfig -> Bool
(ClientConfig -> ClientConfig -> Bool)
-> (ClientConfig -> ClientConfig -> Bool) -> Eq ClientConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientConfig -> ClientConfig -> Bool
$c/= :: ClientConfig -> ClientConfig -> Bool
== :: ClientConfig -> ClientConfig -> Bool
$c== :: ClientConfig -> ClientConfig -> Bool
P.Eq, P.Typeable)

-- | FromJSON ClientConfig
instance A.FromJSON ClientConfig where
  parseJSON :: Value -> Parser ClientConfig
parseJSON = FilePath
-> (Object -> Parser ClientConfig) -> Value -> Parser ClientConfig
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ClientConfig" ((Object -> Parser ClientConfig) -> Value -> Parser ClientConfig)
-> (Object -> Parser ClientConfig) -> Value -> Parser ClientConfig
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> ClientVersionsConfigDTO -> ClientConfig
ClientConfig
      (Text -> Text -> ClientVersionsConfigDTO -> ClientConfig)
-> Parser Text
-> Parser (Text -> ClientVersionsConfigDTO -> ClientConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"apiUrl")
      Parser (Text -> ClientVersionsConfigDTO -> ClientConfig)
-> Parser Text -> Parser (ClientVersionsConfigDTO -> ClientConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"applicationUrl")
      Parser (ClientVersionsConfigDTO -> ClientConfig)
-> Parser ClientVersionsConfigDTO -> Parser ClientConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ClientVersionsConfigDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"pyLibVersions")

-- | ToJSON ClientConfig
instance A.ToJSON ClientConfig where
  toJSON :: ClientConfig -> Value
toJSON ClientConfig {Text
ClientVersionsConfigDTO
clientConfigPyLibVersions :: ClientVersionsConfigDTO
clientConfigApplicationUrl :: Text
clientConfigApiUrl :: Text
clientConfigPyLibVersions :: ClientConfig -> ClientVersionsConfigDTO
clientConfigApplicationUrl :: ClientConfig -> Text
clientConfigApiUrl :: ClientConfig -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"apiUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
clientConfigApiUrl
      , Text
"applicationUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
clientConfigApplicationUrl
      , Text
"pyLibVersions" Text -> ClientVersionsConfigDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ClientVersionsConfigDTO
clientConfigPyLibVersions
      ]


-- | Construct a value of type 'ClientConfig' (by applying it's required fields, if any)
mkClientConfig
  :: Text -- ^ 'clientConfigApiUrl'
  -> Text -- ^ 'clientConfigApplicationUrl'
  -> ClientVersionsConfigDTO -- ^ 'clientConfigPyLibVersions'
  -> ClientConfig
mkClientConfig :: Text -> Text -> ClientVersionsConfigDTO -> ClientConfig
mkClientConfig Text
clientConfigApiUrl Text
clientConfigApplicationUrl ClientVersionsConfigDTO
clientConfigPyLibVersions =
  ClientConfig :: Text -> Text -> ClientVersionsConfigDTO -> ClientConfig
ClientConfig
  { Text
clientConfigApiUrl :: Text
clientConfigApiUrl :: Text
clientConfigApiUrl
  , Text
clientConfigApplicationUrl :: Text
clientConfigApplicationUrl :: Text
clientConfigApplicationUrl
  , ClientVersionsConfigDTO
clientConfigPyLibVersions :: ClientVersionsConfigDTO
clientConfigPyLibVersions :: ClientVersionsConfigDTO
clientConfigPyLibVersions
  }

-- ** ClientVersionsConfigDTO
-- | ClientVersionsConfigDTO
data ClientVersionsConfigDTO = ClientVersionsConfigDTO
    { ClientVersionsConfigDTO -> Maybe Text
clientVersionsConfigDTOMinRecommendedVersion :: !(Maybe Text) -- ^ "minRecommendedVersion"
    -- ^ "minCompatibleVersion"
    , ClientVersionsConfigDTO -> Maybe Text
clientVersionsConfigDTOMinCompatibleVersion  :: !(Maybe Text) -- ^ "minCompatibleVersion"
    -- ^ "maxCompatibleVersion"
    , ClientVersionsConfigDTO -> Maybe Text
clientVersionsConfigDTOMaxCompatibleVersion  :: !(Maybe Text) -- ^ "maxCompatibleVersion"
    }
    deriving (Int -> ClientVersionsConfigDTO -> ShowS
[ClientVersionsConfigDTO] -> ShowS
ClientVersionsConfigDTO -> FilePath
(Int -> ClientVersionsConfigDTO -> ShowS)
-> (ClientVersionsConfigDTO -> FilePath)
-> ([ClientVersionsConfigDTO] -> ShowS)
-> Show ClientVersionsConfigDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ClientVersionsConfigDTO] -> ShowS
$cshowList :: [ClientVersionsConfigDTO] -> ShowS
show :: ClientVersionsConfigDTO -> FilePath
$cshow :: ClientVersionsConfigDTO -> FilePath
showsPrec :: Int -> ClientVersionsConfigDTO -> ShowS
$cshowsPrec :: Int -> ClientVersionsConfigDTO -> ShowS
P.Show, ClientVersionsConfigDTO -> ClientVersionsConfigDTO -> Bool
(ClientVersionsConfigDTO -> ClientVersionsConfigDTO -> Bool)
-> (ClientVersionsConfigDTO -> ClientVersionsConfigDTO -> Bool)
-> Eq ClientVersionsConfigDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientVersionsConfigDTO -> ClientVersionsConfigDTO -> Bool
$c/= :: ClientVersionsConfigDTO -> ClientVersionsConfigDTO -> Bool
== :: ClientVersionsConfigDTO -> ClientVersionsConfigDTO -> Bool
$c== :: ClientVersionsConfigDTO -> ClientVersionsConfigDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ClientVersionsConfigDTO
instance A.FromJSON ClientVersionsConfigDTO where
  parseJSON :: Value -> Parser ClientVersionsConfigDTO
parseJSON = FilePath
-> (Object -> Parser ClientVersionsConfigDTO)
-> Value
-> Parser ClientVersionsConfigDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ClientVersionsConfigDTO" ((Object -> Parser ClientVersionsConfigDTO)
 -> Value -> Parser ClientVersionsConfigDTO)
-> (Object -> Parser ClientVersionsConfigDTO)
-> Value
-> Parser ClientVersionsConfigDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> Maybe Text -> ClientVersionsConfigDTO
ClientVersionsConfigDTO
      (Maybe Text -> Maybe Text -> Maybe Text -> ClientVersionsConfigDTO)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> ClientVersionsConfigDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"minRecommendedVersion")
      Parser (Maybe Text -> Maybe Text -> ClientVersionsConfigDTO)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> ClientVersionsConfigDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"minCompatibleVersion")
      Parser (Maybe Text -> ClientVersionsConfigDTO)
-> Parser (Maybe Text) -> Parser ClientVersionsConfigDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"maxCompatibleVersion")

-- | ToJSON ClientVersionsConfigDTO
instance A.ToJSON ClientVersionsConfigDTO where
  toJSON :: ClientVersionsConfigDTO -> Value
toJSON ClientVersionsConfigDTO {Maybe Text
clientVersionsConfigDTOMaxCompatibleVersion :: Maybe Text
clientVersionsConfigDTOMinCompatibleVersion :: Maybe Text
clientVersionsConfigDTOMinRecommendedVersion :: Maybe Text
clientVersionsConfigDTOMaxCompatibleVersion :: ClientVersionsConfigDTO -> Maybe Text
clientVersionsConfigDTOMinCompatibleVersion :: ClientVersionsConfigDTO -> Maybe Text
clientVersionsConfigDTOMinRecommendedVersion :: ClientVersionsConfigDTO -> Maybe Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"minRecommendedVersion" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
clientVersionsConfigDTOMinRecommendedVersion
      , Text
"minCompatibleVersion" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
clientVersionsConfigDTOMinCompatibleVersion
      , Text
"maxCompatibleVersion" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
clientVersionsConfigDTOMaxCompatibleVersion
      ]


-- | Construct a value of type 'ClientVersionsConfigDTO' (by applying it's required fields, if any)
mkClientVersionsConfigDTO
  :: ClientVersionsConfigDTO
mkClientVersionsConfigDTO :: ClientVersionsConfigDTO
mkClientVersionsConfigDTO =
  ClientVersionsConfigDTO :: Maybe Text -> Maybe Text -> Maybe Text -> ClientVersionsConfigDTO
ClientVersionsConfigDTO
  { clientVersionsConfigDTOMinRecommendedVersion :: Maybe Text
clientVersionsConfigDTOMinRecommendedVersion = Maybe Text
forall a. Maybe a
Nothing
  , clientVersionsConfigDTOMinCompatibleVersion :: Maybe Text
clientVersionsConfigDTOMinCompatibleVersion = Maybe Text
forall a. Maybe a
Nothing
  , clientVersionsConfigDTOMaxCompatibleVersion :: Maybe Text
clientVersionsConfigDTOMaxCompatibleVersion = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CompletedExperimentParams
-- | CompletedExperimentParams
data CompletedExperimentParams = CompletedExperimentParams
    { CompletedExperimentParams -> ExperimentState
completedExperimentParamsState     :: !(ExperimentState) -- ^ /Required/ "state"
    -- ^ /Required/ "traceback"
    , CompletedExperimentParams -> Text
completedExperimentParamsTraceback :: !(Text) -- ^ /Required/ "traceback"
    }
    deriving (Int -> CompletedExperimentParams -> ShowS
[CompletedExperimentParams] -> ShowS
CompletedExperimentParams -> FilePath
(Int -> CompletedExperimentParams -> ShowS)
-> (CompletedExperimentParams -> FilePath)
-> ([CompletedExperimentParams] -> ShowS)
-> Show CompletedExperimentParams
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompletedExperimentParams] -> ShowS
$cshowList :: [CompletedExperimentParams] -> ShowS
show :: CompletedExperimentParams -> FilePath
$cshow :: CompletedExperimentParams -> FilePath
showsPrec :: Int -> CompletedExperimentParams -> ShowS
$cshowsPrec :: Int -> CompletedExperimentParams -> ShowS
P.Show, CompletedExperimentParams -> CompletedExperimentParams -> Bool
(CompletedExperimentParams -> CompletedExperimentParams -> Bool)
-> (CompletedExperimentParams -> CompletedExperimentParams -> Bool)
-> Eq CompletedExperimentParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletedExperimentParams -> CompletedExperimentParams -> Bool
$c/= :: CompletedExperimentParams -> CompletedExperimentParams -> Bool
== :: CompletedExperimentParams -> CompletedExperimentParams -> Bool
$c== :: CompletedExperimentParams -> CompletedExperimentParams -> Bool
P.Eq, P.Typeable)

-- | FromJSON CompletedExperimentParams
instance A.FromJSON CompletedExperimentParams where
  parseJSON :: Value -> Parser CompletedExperimentParams
parseJSON = FilePath
-> (Object -> Parser CompletedExperimentParams)
-> Value
-> Parser CompletedExperimentParams
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"CompletedExperimentParams" ((Object -> Parser CompletedExperimentParams)
 -> Value -> Parser CompletedExperimentParams)
-> (Object -> Parser CompletedExperimentParams)
-> Value
-> Parser CompletedExperimentParams
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ExperimentState -> Text -> CompletedExperimentParams
CompletedExperimentParams
      (ExperimentState -> Text -> CompletedExperimentParams)
-> Parser ExperimentState
-> Parser (Text -> CompletedExperimentParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser ExperimentState
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"state")
      Parser (Text -> CompletedExperimentParams)
-> Parser Text -> Parser CompletedExperimentParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"traceback")

-- | ToJSON CompletedExperimentParams
instance A.ToJSON CompletedExperimentParams where
  toJSON :: CompletedExperimentParams -> Value
toJSON CompletedExperimentParams {Text
ExperimentState
completedExperimentParamsTraceback :: Text
completedExperimentParamsState :: ExperimentState
completedExperimentParamsTraceback :: CompletedExperimentParams -> Text
completedExperimentParamsState :: CompletedExperimentParams -> ExperimentState
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"state" Text -> ExperimentState -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ExperimentState
completedExperimentParamsState
      , Text
"traceback" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
completedExperimentParamsTraceback
      ]


-- | Construct a value of type 'CompletedExperimentParams' (by applying it's required fields, if any)
mkCompletedExperimentParams
  :: ExperimentState -- ^ 'completedExperimentParamsState'
  -> Text -- ^ 'completedExperimentParamsTraceback'
  -> CompletedExperimentParams
mkCompletedExperimentParams :: ExperimentState -> Text -> CompletedExperimentParams
mkCompletedExperimentParams ExperimentState
completedExperimentParamsState Text
completedExperimentParamsTraceback =
  CompletedExperimentParams :: ExperimentState -> Text -> CompletedExperimentParams
CompletedExperimentParams
  { ExperimentState
completedExperimentParamsState :: ExperimentState
completedExperimentParamsState :: ExperimentState
completedExperimentParamsState
  , Text
completedExperimentParamsTraceback :: Text
completedExperimentParamsTraceback :: Text
completedExperimentParamsTraceback
  }

-- ** ComponentStatus
-- | ComponentStatus
data ComponentStatus = ComponentStatus
    { ComponentStatus -> Text
componentStatusName   :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "status"
    , ComponentStatus -> Text
componentStatusStatus :: !(Text) -- ^ /Required/ "status"
    }
    deriving (Int -> ComponentStatus -> ShowS
[ComponentStatus] -> ShowS
ComponentStatus -> FilePath
(Int -> ComponentStatus -> ShowS)
-> (ComponentStatus -> FilePath)
-> ([ComponentStatus] -> ShowS)
-> Show ComponentStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ComponentStatus] -> ShowS
$cshowList :: [ComponentStatus] -> ShowS
show :: ComponentStatus -> FilePath
$cshow :: ComponentStatus -> FilePath
showsPrec :: Int -> ComponentStatus -> ShowS
$cshowsPrec :: Int -> ComponentStatus -> ShowS
P.Show, ComponentStatus -> ComponentStatus -> Bool
(ComponentStatus -> ComponentStatus -> Bool)
-> (ComponentStatus -> ComponentStatus -> Bool)
-> Eq ComponentStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentStatus -> ComponentStatus -> Bool
$c/= :: ComponentStatus -> ComponentStatus -> Bool
== :: ComponentStatus -> ComponentStatus -> Bool
$c== :: ComponentStatus -> ComponentStatus -> Bool
P.Eq, P.Typeable)

-- | FromJSON ComponentStatus
instance A.FromJSON ComponentStatus where
  parseJSON :: Value -> Parser ComponentStatus
parseJSON = FilePath
-> (Object -> Parser ComponentStatus)
-> Value
-> Parser ComponentStatus
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ComponentStatus" ((Object -> Parser ComponentStatus)
 -> Value -> Parser ComponentStatus)
-> (Object -> Parser ComponentStatus)
-> Value
-> Parser ComponentStatus
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> ComponentStatus
ComponentStatus
      (Text -> Text -> ComponentStatus)
-> Parser Text -> Parser (Text -> ComponentStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser (Text -> ComponentStatus)
-> Parser Text -> Parser ComponentStatus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"status")

-- | ToJSON ComponentStatus
instance A.ToJSON ComponentStatus where
  toJSON :: ComponentStatus -> Value
toJSON ComponentStatus {Text
componentStatusStatus :: Text
componentStatusName :: Text
componentStatusStatus :: ComponentStatus -> Text
componentStatusName :: ComponentStatus -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
componentStatusName
      , Text
"status" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
componentStatusStatus
      ]


-- | Construct a value of type 'ComponentStatus' (by applying it's required fields, if any)
mkComponentStatus
  :: Text -- ^ 'componentStatusName'
  -> Text -- ^ 'componentStatusStatus'
  -> ComponentStatus
mkComponentStatus :: Text -> Text -> ComponentStatus
mkComponentStatus Text
componentStatusName Text
componentStatusStatus =
  ComponentStatus :: Text -> Text -> ComponentStatus
ComponentStatus
  { Text
componentStatusName :: Text
componentStatusName :: Text
componentStatusName
  , Text
componentStatusStatus :: Text
componentStatusStatus :: Text
componentStatusStatus
  }

-- ** ComponentVersion
-- | ComponentVersion
data ComponentVersion = ComponentVersion
    { ComponentVersion -> NameEnum
componentVersionName    :: !(NameEnum) -- ^ /Required/ "name"
    -- ^ /Required/ "version"
    , ComponentVersion -> Text
componentVersionVersion :: !(Text) -- ^ /Required/ "version"
    }
    deriving (Int -> ComponentVersion -> ShowS
[ComponentVersion] -> ShowS
ComponentVersion -> FilePath
(Int -> ComponentVersion -> ShowS)
-> (ComponentVersion -> FilePath)
-> ([ComponentVersion] -> ShowS)
-> Show ComponentVersion
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ComponentVersion] -> ShowS
$cshowList :: [ComponentVersion] -> ShowS
show :: ComponentVersion -> FilePath
$cshow :: ComponentVersion -> FilePath
showsPrec :: Int -> ComponentVersion -> ShowS
$cshowsPrec :: Int -> ComponentVersion -> ShowS
P.Show, ComponentVersion -> ComponentVersion -> Bool
(ComponentVersion -> ComponentVersion -> Bool)
-> (ComponentVersion -> ComponentVersion -> Bool)
-> Eq ComponentVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentVersion -> ComponentVersion -> Bool
$c/= :: ComponentVersion -> ComponentVersion -> Bool
== :: ComponentVersion -> ComponentVersion -> Bool
$c== :: ComponentVersion -> ComponentVersion -> Bool
P.Eq, P.Typeable)

-- | FromJSON ComponentVersion
instance A.FromJSON ComponentVersion where
  parseJSON :: Value -> Parser ComponentVersion
parseJSON = FilePath
-> (Object -> Parser ComponentVersion)
-> Value
-> Parser ComponentVersion
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ComponentVersion" ((Object -> Parser ComponentVersion)
 -> Value -> Parser ComponentVersion)
-> (Object -> Parser ComponentVersion)
-> Value
-> Parser ComponentVersion
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    NameEnum -> Text -> ComponentVersion
ComponentVersion
      (NameEnum -> Text -> ComponentVersion)
-> Parser NameEnum -> Parser (Text -> ComponentVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser NameEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser (Text -> ComponentVersion)
-> Parser Text -> Parser ComponentVersion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"version")

-- | ToJSON ComponentVersion
instance A.ToJSON ComponentVersion where
  toJSON :: ComponentVersion -> Value
toJSON ComponentVersion {Text
NameEnum
componentVersionVersion :: Text
componentVersionName :: NameEnum
componentVersionVersion :: ComponentVersion -> Text
componentVersionName :: ComponentVersion -> NameEnum
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> NameEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NameEnum
componentVersionName
      , Text
"version" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
componentVersionVersion
      ]


-- | Construct a value of type 'ComponentVersion' (by applying it's required fields, if any)
mkComponentVersion
  :: NameEnum -- ^ 'componentVersionName'
  -> Text -- ^ 'componentVersionVersion'
  -> ComponentVersion
mkComponentVersion :: NameEnum -> Text -> ComponentVersion
mkComponentVersion NameEnum
componentVersionName Text
componentVersionVersion =
  ComponentVersion :: NameEnum -> Text -> ComponentVersion
ComponentVersion
  { NameEnum
componentVersionName :: NameEnum
componentVersionName :: NameEnum
componentVersionName
  , Text
componentVersionVersion :: Text
componentVersionVersion :: Text
componentVersionVersion
  }

-- ** ConfigInfo
-- | ConfigInfo
data ConfigInfo = ConfigInfo
    { ConfigInfo -> Int
configInfoMaxFormContentSize :: !(Int) -- ^ /Required/ "maxFormContentSize"
    }
    deriving (Int -> ConfigInfo -> ShowS
[ConfigInfo] -> ShowS
ConfigInfo -> FilePath
(Int -> ConfigInfo -> ShowS)
-> (ConfigInfo -> FilePath)
-> ([ConfigInfo] -> ShowS)
-> Show ConfigInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigInfo] -> ShowS
$cshowList :: [ConfigInfo] -> ShowS
show :: ConfigInfo -> FilePath
$cshow :: ConfigInfo -> FilePath
showsPrec :: Int -> ConfigInfo -> ShowS
$cshowsPrec :: Int -> ConfigInfo -> ShowS
P.Show, ConfigInfo -> ConfigInfo -> Bool
(ConfigInfo -> ConfigInfo -> Bool)
-> (ConfigInfo -> ConfigInfo -> Bool) -> Eq ConfigInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigInfo -> ConfigInfo -> Bool
$c/= :: ConfigInfo -> ConfigInfo -> Bool
== :: ConfigInfo -> ConfigInfo -> Bool
$c== :: ConfigInfo -> ConfigInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON ConfigInfo
instance A.FromJSON ConfigInfo where
  parseJSON :: Value -> Parser ConfigInfo
parseJSON = FilePath
-> (Object -> Parser ConfigInfo) -> Value -> Parser ConfigInfo
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ConfigInfo" ((Object -> Parser ConfigInfo) -> Value -> Parser ConfigInfo)
-> (Object -> Parser ConfigInfo) -> Value -> Parser ConfigInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Int -> ConfigInfo
ConfigInfo
      (Int -> ConfigInfo) -> Parser Int -> Parser ConfigInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"maxFormContentSize")

-- | ToJSON ConfigInfo
instance A.ToJSON ConfigInfo where
  toJSON :: ConfigInfo -> Value
toJSON ConfigInfo {Int
configInfoMaxFormContentSize :: Int
configInfoMaxFormContentSize :: ConfigInfo -> Int
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"maxFormContentSize" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
configInfoMaxFormContentSize
      ]


-- | Construct a value of type 'ConfigInfo' (by applying it's required fields, if any)
mkConfigInfo
  :: Int -- ^ 'configInfoMaxFormContentSize'
  -> ConfigInfo
mkConfigInfo :: Int -> ConfigInfo
mkConfigInfo Int
configInfoMaxFormContentSize =
  ConfigInfo :: Int -> ConfigInfo
ConfigInfo
  { Int
configInfoMaxFormContentSize :: Int
configInfoMaxFormContentSize :: Int
configInfoMaxFormContentSize
  }

-- ** CreateSessionParamsDTO
-- | CreateSessionParamsDTO
-- Stripe Checkout Session details
data CreateSessionParamsDTO = CreateSessionParamsDTO
    { CreateSessionParamsDTO -> Text
createSessionParamsDTOSuccessUrl :: !(Text) -- ^ /Required/ "successUrl"
    -- ^ /Required/ "failureUrl"
    , CreateSessionParamsDTO -> Text
createSessionParamsDTOFailureUrl :: !(Text) -- ^ /Required/ "failureUrl"
    }
    deriving (Int -> CreateSessionParamsDTO -> ShowS
[CreateSessionParamsDTO] -> ShowS
CreateSessionParamsDTO -> FilePath
(Int -> CreateSessionParamsDTO -> ShowS)
-> (CreateSessionParamsDTO -> FilePath)
-> ([CreateSessionParamsDTO] -> ShowS)
-> Show CreateSessionParamsDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CreateSessionParamsDTO] -> ShowS
$cshowList :: [CreateSessionParamsDTO] -> ShowS
show :: CreateSessionParamsDTO -> FilePath
$cshow :: CreateSessionParamsDTO -> FilePath
showsPrec :: Int -> CreateSessionParamsDTO -> ShowS
$cshowsPrec :: Int -> CreateSessionParamsDTO -> ShowS
P.Show, CreateSessionParamsDTO -> CreateSessionParamsDTO -> Bool
(CreateSessionParamsDTO -> CreateSessionParamsDTO -> Bool)
-> (CreateSessionParamsDTO -> CreateSessionParamsDTO -> Bool)
-> Eq CreateSessionParamsDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSessionParamsDTO -> CreateSessionParamsDTO -> Bool
$c/= :: CreateSessionParamsDTO -> CreateSessionParamsDTO -> Bool
== :: CreateSessionParamsDTO -> CreateSessionParamsDTO -> Bool
$c== :: CreateSessionParamsDTO -> CreateSessionParamsDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateSessionParamsDTO
instance A.FromJSON CreateSessionParamsDTO where
  parseJSON :: Value -> Parser CreateSessionParamsDTO
parseJSON = FilePath
-> (Object -> Parser CreateSessionParamsDTO)
-> Value
-> Parser CreateSessionParamsDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"CreateSessionParamsDTO" ((Object -> Parser CreateSessionParamsDTO)
 -> Value -> Parser CreateSessionParamsDTO)
-> (Object -> Parser CreateSessionParamsDTO)
-> Value
-> Parser CreateSessionParamsDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> CreateSessionParamsDTO
CreateSessionParamsDTO
      (Text -> Text -> CreateSessionParamsDTO)
-> Parser Text -> Parser (Text -> CreateSessionParamsDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"successUrl")
      Parser (Text -> CreateSessionParamsDTO)
-> Parser Text -> Parser CreateSessionParamsDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"failureUrl")

-- | ToJSON CreateSessionParamsDTO
instance A.ToJSON CreateSessionParamsDTO where
  toJSON :: CreateSessionParamsDTO -> Value
toJSON CreateSessionParamsDTO {Text
createSessionParamsDTOFailureUrl :: Text
createSessionParamsDTOSuccessUrl :: Text
createSessionParamsDTOFailureUrl :: CreateSessionParamsDTO -> Text
createSessionParamsDTOSuccessUrl :: CreateSessionParamsDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"successUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
createSessionParamsDTOSuccessUrl
      , Text
"failureUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
createSessionParamsDTOFailureUrl
      ]


-- | Construct a value of type 'CreateSessionParamsDTO' (by applying it's required fields, if any)
mkCreateSessionParamsDTO
  :: Text -- ^ 'createSessionParamsDTOSuccessUrl'
  -> Text -- ^ 'createSessionParamsDTOFailureUrl'
  -> CreateSessionParamsDTO
mkCreateSessionParamsDTO :: Text -> Text -> CreateSessionParamsDTO
mkCreateSessionParamsDTO Text
createSessionParamsDTOSuccessUrl Text
createSessionParamsDTOFailureUrl =
  CreateSessionParamsDTO :: Text -> Text -> CreateSessionParamsDTO
CreateSessionParamsDTO
  { Text
createSessionParamsDTOSuccessUrl :: Text
createSessionParamsDTOSuccessUrl :: Text
createSessionParamsDTOSuccessUrl
  , Text
createSessionParamsDTOFailureUrl :: Text
createSessionParamsDTOFailureUrl :: Text
createSessionParamsDTOFailureUrl
  }

-- ** CustomerDTO
-- | CustomerDTO
data CustomerDTO = CustomerDTO
    { CustomerDTO -> Maybe Integer
customerDTONumberOfUsers    :: !(Maybe Integer) -- ^ "numberOfUsers"
    -- ^ /Required/ "userPriceInCents"
    , CustomerDTO -> Integer
customerDTOUserPriceInCents :: !(Integer) -- ^ /Required/ "userPriceInCents"
    -- ^ /Required/ "pricingPlan"
    , CustomerDTO -> PricingPlanDTO
customerDTOPricingPlan      :: !(PricingPlanDTO) -- ^ /Required/ "pricingPlan"
    -- ^ "discount"
    , CustomerDTO -> Maybe DiscountDTO
customerDTODiscount         :: !(Maybe DiscountDTO) -- ^ "discount"
    }
    deriving (Int -> CustomerDTO -> ShowS
[CustomerDTO] -> ShowS
CustomerDTO -> FilePath
(Int -> CustomerDTO -> ShowS)
-> (CustomerDTO -> FilePath)
-> ([CustomerDTO] -> ShowS)
-> Show CustomerDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CustomerDTO] -> ShowS
$cshowList :: [CustomerDTO] -> ShowS
show :: CustomerDTO -> FilePath
$cshow :: CustomerDTO -> FilePath
showsPrec :: Int -> CustomerDTO -> ShowS
$cshowsPrec :: Int -> CustomerDTO -> ShowS
P.Show, CustomerDTO -> CustomerDTO -> Bool
(CustomerDTO -> CustomerDTO -> Bool)
-> (CustomerDTO -> CustomerDTO -> Bool) -> Eq CustomerDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomerDTO -> CustomerDTO -> Bool
$c/= :: CustomerDTO -> CustomerDTO -> Bool
== :: CustomerDTO -> CustomerDTO -> Bool
$c== :: CustomerDTO -> CustomerDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON CustomerDTO
instance A.FromJSON CustomerDTO where
  parseJSON :: Value -> Parser CustomerDTO
parseJSON = FilePath
-> (Object -> Parser CustomerDTO) -> Value -> Parser CustomerDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"CustomerDTO" ((Object -> Parser CustomerDTO) -> Value -> Parser CustomerDTO)
-> (Object -> Parser CustomerDTO) -> Value -> Parser CustomerDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Integer -> PricingPlanDTO -> Maybe DiscountDTO -> CustomerDTO
CustomerDTO
      (Maybe Integer
 -> Integer -> PricingPlanDTO -> Maybe DiscountDTO -> CustomerDTO)
-> Parser (Maybe Integer)
-> Parser
     (Integer -> PricingPlanDTO -> Maybe DiscountDTO -> CustomerDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"numberOfUsers")
      Parser
  (Integer -> PricingPlanDTO -> Maybe DiscountDTO -> CustomerDTO)
-> Parser Integer
-> Parser (PricingPlanDTO -> Maybe DiscountDTO -> CustomerDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"userPriceInCents")
      Parser (PricingPlanDTO -> Maybe DiscountDTO -> CustomerDTO)
-> Parser PricingPlanDTO
-> Parser (Maybe DiscountDTO -> CustomerDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser PricingPlanDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"pricingPlan")
      Parser (Maybe DiscountDTO -> CustomerDTO)
-> Parser (Maybe DiscountDTO) -> Parser CustomerDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe DiscountDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"discount")

-- | ToJSON CustomerDTO
instance A.ToJSON CustomerDTO where
  toJSON :: CustomerDTO -> Value
toJSON CustomerDTO {Integer
Maybe Integer
Maybe DiscountDTO
PricingPlanDTO
customerDTODiscount :: Maybe DiscountDTO
customerDTOPricingPlan :: PricingPlanDTO
customerDTOUserPriceInCents :: Integer
customerDTONumberOfUsers :: Maybe Integer
customerDTODiscount :: CustomerDTO -> Maybe DiscountDTO
customerDTOPricingPlan :: CustomerDTO -> PricingPlanDTO
customerDTOUserPriceInCents :: CustomerDTO -> Integer
customerDTONumberOfUsers :: CustomerDTO -> Maybe Integer
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"numberOfUsers" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
customerDTONumberOfUsers
      , Text
"userPriceInCents" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
customerDTOUserPriceInCents
      , Text
"pricingPlan" Text -> PricingPlanDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PricingPlanDTO
customerDTOPricingPlan
      , Text
"discount" Text -> Maybe DiscountDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe DiscountDTO
customerDTODiscount
      ]


-- | Construct a value of type 'CustomerDTO' (by applying it's required fields, if any)
mkCustomerDTO
  :: Integer -- ^ 'customerDTOUserPriceInCents'
  -> PricingPlanDTO -- ^ 'customerDTOPricingPlan'
  -> CustomerDTO
mkCustomerDTO :: Integer -> PricingPlanDTO -> CustomerDTO
mkCustomerDTO Integer
customerDTOUserPriceInCents PricingPlanDTO
customerDTOPricingPlan =
  CustomerDTO :: Maybe Integer
-> Integer -> PricingPlanDTO -> Maybe DiscountDTO -> CustomerDTO
CustomerDTO
  { customerDTONumberOfUsers :: Maybe Integer
customerDTONumberOfUsers = Maybe Integer
forall a. Maybe a
Nothing
  , Integer
customerDTOUserPriceInCents :: Integer
customerDTOUserPriceInCents :: Integer
customerDTOUserPriceInCents
  , PricingPlanDTO
customerDTOPricingPlan :: PricingPlanDTO
customerDTOPricingPlan :: PricingPlanDTO
customerDTOPricingPlan
  , customerDTODiscount :: Maybe DiscountDTO
customerDTODiscount = Maybe DiscountDTO
forall a. Maybe a
Nothing
  }

-- ** DiscountCodeDTO
-- | DiscountCodeDTO
data DiscountCodeDTO = DiscountCodeDTO
    { DiscountCodeDTO -> Text
discountCodeDTOCode :: !(Text) -- ^ /Required/ "code"
    }
    deriving (Int -> DiscountCodeDTO -> ShowS
[DiscountCodeDTO] -> ShowS
DiscountCodeDTO -> FilePath
(Int -> DiscountCodeDTO -> ShowS)
-> (DiscountCodeDTO -> FilePath)
-> ([DiscountCodeDTO] -> ShowS)
-> Show DiscountCodeDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DiscountCodeDTO] -> ShowS
$cshowList :: [DiscountCodeDTO] -> ShowS
show :: DiscountCodeDTO -> FilePath
$cshow :: DiscountCodeDTO -> FilePath
showsPrec :: Int -> DiscountCodeDTO -> ShowS
$cshowsPrec :: Int -> DiscountCodeDTO -> ShowS
P.Show, DiscountCodeDTO -> DiscountCodeDTO -> Bool
(DiscountCodeDTO -> DiscountCodeDTO -> Bool)
-> (DiscountCodeDTO -> DiscountCodeDTO -> Bool)
-> Eq DiscountCodeDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiscountCodeDTO -> DiscountCodeDTO -> Bool
$c/= :: DiscountCodeDTO -> DiscountCodeDTO -> Bool
== :: DiscountCodeDTO -> DiscountCodeDTO -> Bool
$c== :: DiscountCodeDTO -> DiscountCodeDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON DiscountCodeDTO
instance A.FromJSON DiscountCodeDTO where
  parseJSON :: Value -> Parser DiscountCodeDTO
parseJSON = FilePath
-> (Object -> Parser DiscountCodeDTO)
-> Value
-> Parser DiscountCodeDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"DiscountCodeDTO" ((Object -> Parser DiscountCodeDTO)
 -> Value -> Parser DiscountCodeDTO)
-> (Object -> Parser DiscountCodeDTO)
-> Value
-> Parser DiscountCodeDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> DiscountCodeDTO
DiscountCodeDTO
      (Text -> DiscountCodeDTO) -> Parser Text -> Parser DiscountCodeDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"code")

-- | ToJSON DiscountCodeDTO
instance A.ToJSON DiscountCodeDTO where
  toJSON :: DiscountCodeDTO -> Value
toJSON DiscountCodeDTO {Text
discountCodeDTOCode :: Text
discountCodeDTOCode :: DiscountCodeDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"code" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
discountCodeDTOCode
      ]


-- | Construct a value of type 'DiscountCodeDTO' (by applying it's required fields, if any)
mkDiscountCodeDTO
  :: Text -- ^ 'discountCodeDTOCode'
  -> DiscountCodeDTO
mkDiscountCodeDTO :: Text -> DiscountCodeDTO
mkDiscountCodeDTO Text
discountCodeDTOCode =
  DiscountCodeDTO :: Text -> DiscountCodeDTO
DiscountCodeDTO
  { Text
discountCodeDTOCode :: Text
discountCodeDTOCode :: Text
discountCodeDTOCode
  }

-- ** DiscountDTO
-- | DiscountDTO
data DiscountDTO = DiscountDTO
    { DiscountDTO -> Maybe Integer
discountDTOAmountOffPercentage :: !(Maybe Integer) -- ^ "amountOffPercentage"
    -- ^ "amountOffInCents"
    , DiscountDTO -> Maybe Integer
discountDTOAmountOffInCents    :: !(Maybe Integer) -- ^ "amountOffInCents"
    -- ^ "end"
    , DiscountDTO -> Maybe DateTime
discountDTOEnd                 :: !(Maybe DateTime) -- ^ "end"
    }
    deriving (Int -> DiscountDTO -> ShowS
[DiscountDTO] -> ShowS
DiscountDTO -> FilePath
(Int -> DiscountDTO -> ShowS)
-> (DiscountDTO -> FilePath)
-> ([DiscountDTO] -> ShowS)
-> Show DiscountDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DiscountDTO] -> ShowS
$cshowList :: [DiscountDTO] -> ShowS
show :: DiscountDTO -> FilePath
$cshow :: DiscountDTO -> FilePath
showsPrec :: Int -> DiscountDTO -> ShowS
$cshowsPrec :: Int -> DiscountDTO -> ShowS
P.Show, DiscountDTO -> DiscountDTO -> Bool
(DiscountDTO -> DiscountDTO -> Bool)
-> (DiscountDTO -> DiscountDTO -> Bool) -> Eq DiscountDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiscountDTO -> DiscountDTO -> Bool
$c/= :: DiscountDTO -> DiscountDTO -> Bool
== :: DiscountDTO -> DiscountDTO -> Bool
$c== :: DiscountDTO -> DiscountDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON DiscountDTO
instance A.FromJSON DiscountDTO where
  parseJSON :: Value -> Parser DiscountDTO
parseJSON = FilePath
-> (Object -> Parser DiscountDTO) -> Value -> Parser DiscountDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"DiscountDTO" ((Object -> Parser DiscountDTO) -> Value -> Parser DiscountDTO)
-> (Object -> Parser DiscountDTO) -> Value -> Parser DiscountDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> Maybe Integer -> Maybe DateTime -> DiscountDTO
DiscountDTO
      (Maybe Integer -> Maybe Integer -> Maybe DateTime -> DiscountDTO)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Maybe DateTime -> DiscountDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"amountOffPercentage")
      Parser (Maybe Integer -> Maybe DateTime -> DiscountDTO)
-> Parser (Maybe Integer) -> Parser (Maybe DateTime -> DiscountDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"amountOffInCents")
      Parser (Maybe DateTime -> DiscountDTO)
-> Parser (Maybe DateTime) -> Parser DiscountDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"end")

-- | ToJSON DiscountDTO
instance A.ToJSON DiscountDTO where
  toJSON :: DiscountDTO -> Value
toJSON DiscountDTO {Maybe Integer
Maybe DateTime
discountDTOEnd :: Maybe DateTime
discountDTOAmountOffInCents :: Maybe Integer
discountDTOAmountOffPercentage :: Maybe Integer
discountDTOEnd :: DiscountDTO -> Maybe DateTime
discountDTOAmountOffInCents :: DiscountDTO -> Maybe Integer
discountDTOAmountOffPercentage :: DiscountDTO -> Maybe Integer
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"amountOffPercentage" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
discountDTOAmountOffPercentage
      , Text
"amountOffInCents" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
discountDTOAmountOffInCents
      , Text
"end" Text -> Maybe DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe DateTime
discountDTOEnd
      ]


-- | Construct a value of type 'DiscountDTO' (by applying it's required fields, if any)
mkDiscountDTO
  :: DiscountDTO
mkDiscountDTO :: DiscountDTO
mkDiscountDTO =
  DiscountDTO :: Maybe Integer -> Maybe Integer -> Maybe DateTime -> DiscountDTO
DiscountDTO
  { discountDTOAmountOffPercentage :: Maybe Integer
discountDTOAmountOffPercentage = Maybe Integer
forall a. Maybe a
Nothing
  , discountDTOAmountOffInCents :: Maybe Integer
discountDTOAmountOffInCents = Maybe Integer
forall a. Maybe a
Nothing
  , discountDTOEnd :: Maybe DateTime
discountDTOEnd = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** DownloadPrepareRequestDTO
-- | DownloadPrepareRequestDTO
data DownloadPrepareRequestDTO = DownloadPrepareRequestDTO
    { DownloadPrepareRequestDTO -> Text
downloadPrepareRequestDTOId          :: !(Text) -- ^ /Required/ "id"
    -- ^ "downloadUrl"
    , DownloadPrepareRequestDTO -> Maybe Text
downloadPrepareRequestDTODownloadUrl :: !(Maybe Text) -- ^ "downloadUrl"
    }
    deriving (Int -> DownloadPrepareRequestDTO -> ShowS
[DownloadPrepareRequestDTO] -> ShowS
DownloadPrepareRequestDTO -> FilePath
(Int -> DownloadPrepareRequestDTO -> ShowS)
-> (DownloadPrepareRequestDTO -> FilePath)
-> ([DownloadPrepareRequestDTO] -> ShowS)
-> Show DownloadPrepareRequestDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DownloadPrepareRequestDTO] -> ShowS
$cshowList :: [DownloadPrepareRequestDTO] -> ShowS
show :: DownloadPrepareRequestDTO -> FilePath
$cshow :: DownloadPrepareRequestDTO -> FilePath
showsPrec :: Int -> DownloadPrepareRequestDTO -> ShowS
$cshowsPrec :: Int -> DownloadPrepareRequestDTO -> ShowS
P.Show, DownloadPrepareRequestDTO -> DownloadPrepareRequestDTO -> Bool
(DownloadPrepareRequestDTO -> DownloadPrepareRequestDTO -> Bool)
-> (DownloadPrepareRequestDTO -> DownloadPrepareRequestDTO -> Bool)
-> Eq DownloadPrepareRequestDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DownloadPrepareRequestDTO -> DownloadPrepareRequestDTO -> Bool
$c/= :: DownloadPrepareRequestDTO -> DownloadPrepareRequestDTO -> Bool
== :: DownloadPrepareRequestDTO -> DownloadPrepareRequestDTO -> Bool
$c== :: DownloadPrepareRequestDTO -> DownloadPrepareRequestDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON DownloadPrepareRequestDTO
instance A.FromJSON DownloadPrepareRequestDTO where
  parseJSON :: Value -> Parser DownloadPrepareRequestDTO
parseJSON = FilePath
-> (Object -> Parser DownloadPrepareRequestDTO)
-> Value
-> Parser DownloadPrepareRequestDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"DownloadPrepareRequestDTO" ((Object -> Parser DownloadPrepareRequestDTO)
 -> Value -> Parser DownloadPrepareRequestDTO)
-> (Object -> Parser DownloadPrepareRequestDTO)
-> Value
-> Parser DownloadPrepareRequestDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe Text -> DownloadPrepareRequestDTO
DownloadPrepareRequestDTO
      (Text -> Maybe Text -> DownloadPrepareRequestDTO)
-> Parser Text -> Parser (Maybe Text -> DownloadPrepareRequestDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser (Maybe Text -> DownloadPrepareRequestDTO)
-> Parser (Maybe Text) -> Parser DownloadPrepareRequestDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"downloadUrl")

-- | ToJSON DownloadPrepareRequestDTO
instance A.ToJSON DownloadPrepareRequestDTO where
  toJSON :: DownloadPrepareRequestDTO -> Value
toJSON DownloadPrepareRequestDTO {Maybe Text
Text
downloadPrepareRequestDTODownloadUrl :: Maybe Text
downloadPrepareRequestDTOId :: Text
downloadPrepareRequestDTODownloadUrl :: DownloadPrepareRequestDTO -> Maybe Text
downloadPrepareRequestDTOId :: DownloadPrepareRequestDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
downloadPrepareRequestDTOId
      , Text
"downloadUrl" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
downloadPrepareRequestDTODownloadUrl
      ]


-- | Construct a value of type 'DownloadPrepareRequestDTO' (by applying it's required fields, if any)
mkDownloadPrepareRequestDTO
  :: Text -- ^ 'downloadPrepareRequestDTOId'
  -> DownloadPrepareRequestDTO
mkDownloadPrepareRequestDTO :: Text -> DownloadPrepareRequestDTO
mkDownloadPrepareRequestDTO Text
downloadPrepareRequestDTOId =
  DownloadPrepareRequestDTO :: Text -> Maybe Text -> DownloadPrepareRequestDTO
DownloadPrepareRequestDTO
  { Text
downloadPrepareRequestDTOId :: Text
downloadPrepareRequestDTOId :: Text
downloadPrepareRequestDTOId
  , downloadPrepareRequestDTODownloadUrl :: Maybe Text
downloadPrepareRequestDTODownloadUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditExperimentParams
-- | EditExperimentParams
data EditExperimentParams = EditExperimentParams
    { EditExperimentParams -> Maybe Text
editExperimentParamsName        :: !(Maybe Text) -- ^ "name"
    -- ^ "description"
    , EditExperimentParams -> Maybe Text
editExperimentParamsDescription :: !(Maybe Text) -- ^ "description"
    -- ^ "tags"
    , EditExperimentParams -> Maybe [Text]
editExperimentParamsTags        :: !(Maybe [Text]) -- ^ "tags"
    -- ^ "properties"
    , EditExperimentParams -> Maybe [KeyValueProperty]
editExperimentParamsProperties  :: !(Maybe [KeyValueProperty]) -- ^ "properties"
    }
    deriving (Int -> EditExperimentParams -> ShowS
[EditExperimentParams] -> ShowS
EditExperimentParams -> FilePath
(Int -> EditExperimentParams -> ShowS)
-> (EditExperimentParams -> FilePath)
-> ([EditExperimentParams] -> ShowS)
-> Show EditExperimentParams
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EditExperimentParams] -> ShowS
$cshowList :: [EditExperimentParams] -> ShowS
show :: EditExperimentParams -> FilePath
$cshow :: EditExperimentParams -> FilePath
showsPrec :: Int -> EditExperimentParams -> ShowS
$cshowsPrec :: Int -> EditExperimentParams -> ShowS
P.Show, EditExperimentParams -> EditExperimentParams -> Bool
(EditExperimentParams -> EditExperimentParams -> Bool)
-> (EditExperimentParams -> EditExperimentParams -> Bool)
-> Eq EditExperimentParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditExperimentParams -> EditExperimentParams -> Bool
$c/= :: EditExperimentParams -> EditExperimentParams -> Bool
== :: EditExperimentParams -> EditExperimentParams -> Bool
$c== :: EditExperimentParams -> EditExperimentParams -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditExperimentParams
instance A.FromJSON EditExperimentParams where
  parseJSON :: Value -> Parser EditExperimentParams
parseJSON = FilePath
-> (Object -> Parser EditExperimentParams)
-> Value
-> Parser EditExperimentParams
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"EditExperimentParams" ((Object -> Parser EditExperimentParams)
 -> Value -> Parser EditExperimentParams)
-> (Object -> Parser EditExperimentParams)
-> Value
-> Parser EditExperimentParams
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe [KeyValueProperty]
-> EditExperimentParams
EditExperimentParams
      (Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe [KeyValueProperty]
 -> EditExperimentParams)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe [KeyValueProperty]
      -> EditExperimentParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"name")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe [KeyValueProperty]
   -> EditExperimentParams)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text] -> Maybe [KeyValueProperty] -> EditExperimentParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")
      Parser
  (Maybe [Text] -> Maybe [KeyValueProperty] -> EditExperimentParams)
-> Parser (Maybe [Text])
-> Parser (Maybe [KeyValueProperty] -> EditExperimentParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"tags")
      Parser (Maybe [KeyValueProperty] -> EditExperimentParams)
-> Parser (Maybe [KeyValueProperty]) -> Parser EditExperimentParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [KeyValueProperty])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"properties")

-- | ToJSON EditExperimentParams
instance A.ToJSON EditExperimentParams where
  toJSON :: EditExperimentParams -> Value
toJSON EditExperimentParams {Maybe [Text]
Maybe [KeyValueProperty]
Maybe Text
editExperimentParamsProperties :: Maybe [KeyValueProperty]
editExperimentParamsTags :: Maybe [Text]
editExperimentParamsDescription :: Maybe Text
editExperimentParamsName :: Maybe Text
editExperimentParamsProperties :: EditExperimentParams -> Maybe [KeyValueProperty]
editExperimentParamsTags :: EditExperimentParams -> Maybe [Text]
editExperimentParamsDescription :: EditExperimentParams -> Maybe Text
editExperimentParamsName :: EditExperimentParams -> Maybe Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
editExperimentParamsName
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
editExperimentParamsDescription
      , Text
"tags" Text -> Maybe [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Text]
editExperimentParamsTags
      , Text
"properties" Text -> Maybe [KeyValueProperty] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [KeyValueProperty]
editExperimentParamsProperties
      ]


-- | Construct a value of type 'EditExperimentParams' (by applying it's required fields, if any)
mkEditExperimentParams
  :: EditExperimentParams
mkEditExperimentParams :: EditExperimentParams
mkEditExperimentParams =
  EditExperimentParams :: Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe [KeyValueProperty]
-> EditExperimentParams
EditExperimentParams
  { editExperimentParamsName :: Maybe Text
editExperimentParamsName = Maybe Text
forall a. Maybe a
Nothing
  , editExperimentParamsDescription :: Maybe Text
editExperimentParamsDescription = Maybe Text
forall a. Maybe a
Nothing
  , editExperimentParamsTags :: Maybe [Text]
editExperimentParamsTags = Maybe [Text]
forall a. Maybe a
Nothing
  , editExperimentParamsProperties :: Maybe [KeyValueProperty]
editExperimentParamsProperties = Maybe [KeyValueProperty]
forall a. Maybe a
Nothing
  }

-- ** Error
-- | Error
data Error = Error
    { Error -> Int
errorCode    :: !(Int) -- ^ /Required/ "code"
    -- ^ /Required/ "message"
    , Error -> Text
errorMessage :: !(Text) -- ^ /Required/ "message"
    -- ^ "type"
    , Error -> Maybe ApiErrorTypeDTO
errorType    :: !(Maybe ApiErrorTypeDTO) -- ^ "type"
    }
    deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> FilePath
(Int -> Error -> ShowS)
-> (Error -> FilePath) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> FilePath
$cshow :: Error -> FilePath
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
P.Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
P.Eq, P.Typeable)

-- | FromJSON Error
instance A.FromJSON Error where
  parseJSON :: Value -> Parser Error
parseJSON = FilePath -> (Object -> Parser Error) -> Value -> Parser Error
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Error" ((Object -> Parser Error) -> Value -> Parser Error)
-> (Object -> Parser Error) -> Value -> Parser Error
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Int -> Text -> Maybe ApiErrorTypeDTO -> Error
Error
      (Int -> Text -> Maybe ApiErrorTypeDTO -> Error)
-> Parser Int -> Parser (Text -> Maybe ApiErrorTypeDTO -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"code")
      Parser (Text -> Maybe ApiErrorTypeDTO -> Error)
-> Parser Text -> Parser (Maybe ApiErrorTypeDTO -> Error)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"message")
      Parser (Maybe ApiErrorTypeDTO -> Error)
-> Parser (Maybe ApiErrorTypeDTO) -> Parser Error
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe ApiErrorTypeDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"type")

-- | ToJSON Error
instance A.ToJSON Error where
  toJSON :: Error -> Value
toJSON Error {Int
Maybe ApiErrorTypeDTO
Text
errorType :: Maybe ApiErrorTypeDTO
errorMessage :: Text
errorCode :: Int
errorType :: Error -> Maybe ApiErrorTypeDTO
errorMessage :: Error -> Text
errorCode :: Error -> Int
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"code" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
errorCode
      , Text
"message" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
errorMessage
      , Text
"type" Text -> Maybe ApiErrorTypeDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ApiErrorTypeDTO
errorType
      ]


-- | Construct a value of type 'Error' (by applying it's required fields, if any)
mkError
  :: Int -- ^ 'errorCode'
  -> Text -- ^ 'errorMessage'
  -> Error
mkError :: Int -> Text -> Error
mkError Int
errorCode Text
errorMessage =
  Error :: Int -> Text -> Maybe ApiErrorTypeDTO -> Error
Error
  { Int
errorCode :: Int
errorCode :: Int
errorCode
  , Text
errorMessage :: Text
errorMessage :: Text
errorMessage
  , errorType :: Maybe ApiErrorTypeDTO
errorType = Maybe ApiErrorTypeDTO
forall a. Maybe a
Nothing
  }

-- ** Experiment
-- | Experiment
data Experiment = Experiment
    { Experiment -> Maybe [Channel]
experimentChannels           :: !(Maybe [Channel]) -- ^ "channels"
    -- ^ "state"
    , Experiment -> Maybe ExperimentState
experimentState              :: !(Maybe ExperimentState) -- ^ "state"
    -- ^ "timeOfCompletion"
    , Experiment -> Maybe DateTime
experimentTimeOfCompletion   :: !(Maybe DateTime) -- ^ "timeOfCompletion"
    -- ^ "checkpointId"
    , Experiment -> Maybe Text
experimentCheckpointId       :: !(Maybe Text) -- ^ "checkpointId"
    -- ^ "paths"
    , Experiment -> Maybe ExperimentPaths
experimentPaths              :: !(Maybe ExperimentPaths) -- ^ "paths"
    -- ^ "responding"
    , Experiment -> Maybe Bool
experimentResponding         :: !(Maybe Bool) -- ^ "responding"
    -- ^ "organizationId"
    , Experiment -> Maybe Text
experimentOrganizationId     :: !(Maybe Text) -- ^ "organizationId"
    -- ^ "stateTransitions"
    , Experiment -> Maybe StateTransitions
experimentStateTransitions   :: !(Maybe StateTransitions) -- ^ "stateTransitions"
    -- ^ "parameters"
    , Experiment -> Maybe [Parameter]
experimentParameters         :: !(Maybe [Parameter]) -- ^ "parameters"
    -- ^ "channelsLastValues"
    , Experiment -> Maybe [ChannelWithValue]
experimentChannelsLastValues :: !(Maybe [ChannelWithValue]) -- ^ "channelsLastValues"
    -- ^ "storageSize"
    , Experiment -> Maybe Integer
experimentStorageSize        :: !(Maybe Integer) -- ^ "storageSize"
    -- ^ "name"
    , Experiment -> Maybe Text
experimentName               :: !(Maybe Text) -- ^ "name"
    -- ^ "notebookId"
    , Experiment -> Maybe Text
experimentNotebookId         :: !(Maybe Text) -- ^ "notebookId"
    -- ^ "projectName"
    , Experiment -> Maybe Text
experimentProjectName        :: !(Maybe Text) -- ^ "projectName"
    -- ^ "hostname"
    , Experiment -> Maybe Text
experimentHostname           :: !(Maybe Text) -- ^ "hostname"
    -- ^ "trashed"
    , Experiment -> Maybe Bool
experimentTrashed            :: !(Maybe Bool) -- ^ "trashed"
    -- ^ "description"
    , Experiment -> Maybe Text
experimentDescription        :: !(Maybe Text) -- ^ "description"
    -- ^ "tags"
    , Experiment -> Maybe [Text]
experimentTags               :: !(Maybe [Text]) -- ^ "tags"
    -- ^ "channelsSize"
    , Experiment -> Maybe Integer
experimentChannelsSize       :: !(Maybe Integer) -- ^ "channelsSize"
    -- ^ "timeOfCreation"
    , Experiment -> Maybe DateTime
experimentTimeOfCreation     :: !(Maybe DateTime) -- ^ "timeOfCreation"
    -- ^ "projectId"
    , Experiment -> Maybe Text
experimentProjectId          :: !(Maybe Text) -- ^ "projectId"
    -- ^ "organizationName"
    , Experiment -> Maybe Text
experimentOrganizationName   :: !(Maybe Text) -- ^ "organizationName"
    -- ^ "isCodeAccessible"
    , Experiment -> Maybe Bool
experimentIsCodeAccessible   :: !(Maybe Bool) -- ^ "isCodeAccessible"
    -- ^ "traceback"
    , Experiment -> Maybe Text
experimentTraceback          :: !(Maybe Text) -- ^ "traceback"
    -- ^ "entrypoint"
    , Experiment -> Maybe Text
experimentEntrypoint         :: !(Maybe Text) -- ^ "entrypoint"
    -- ^ "runningTime"
    , Experiment -> Maybe Integer
experimentRunningTime        :: !(Maybe Integer) -- ^ "runningTime"
    -- ^ /Required/ "id"
    , Experiment -> Text
experimentId                 :: !(Text) -- ^ /Required/ "id"
    -- ^ "inputs"
    , Experiment -> Maybe [InputMetadata]
experimentInputs             :: !(Maybe [InputMetadata]) -- ^ "inputs"
    -- ^ "properties"
    , Experiment -> Maybe [KeyValueProperty]
experimentProperties         :: !(Maybe [KeyValueProperty]) -- ^ "properties"
    -- ^ /Required/ "shortId"
    , Experiment -> Text
experimentShortId            :: !(Text) -- ^ /Required/ "shortId"
    -- ^ "componentsVersions"
    , Experiment -> Maybe [ComponentVersion]
experimentComponentsVersions :: !(Maybe [ComponentVersion]) -- ^ "componentsVersions"
    -- ^ "owner"
    , Experiment -> Maybe Text
experimentOwner              :: !(Maybe Text) -- ^ "owner"
    }
    deriving (Int -> Experiment -> ShowS
[Experiment] -> ShowS
Experiment -> FilePath
(Int -> Experiment -> ShowS)
-> (Experiment -> FilePath)
-> ([Experiment] -> ShowS)
-> Show Experiment
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Experiment] -> ShowS
$cshowList :: [Experiment] -> ShowS
show :: Experiment -> FilePath
$cshow :: Experiment -> FilePath
showsPrec :: Int -> Experiment -> ShowS
$cshowsPrec :: Int -> Experiment -> ShowS
P.Show, Experiment -> Experiment -> Bool
(Experiment -> Experiment -> Bool)
-> (Experiment -> Experiment -> Bool) -> Eq Experiment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Experiment -> Experiment -> Bool
$c/= :: Experiment -> Experiment -> Bool
== :: Experiment -> Experiment -> Bool
$c== :: Experiment -> Experiment -> Bool
P.Eq, P.Typeable)

-- | FromJSON Experiment
instance A.FromJSON Experiment where
  parseJSON :: Value -> Parser Experiment
parseJSON = FilePath
-> (Object -> Parser Experiment) -> Value -> Parser Experiment
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Experiment" ((Object -> Parser Experiment) -> Value -> Parser Experiment)
-> (Object -> Parser Experiment) -> Value -> Parser Experiment
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Channel]
-> Maybe ExperimentState
-> Maybe DateTime
-> Maybe Text
-> Maybe ExperimentPaths
-> Maybe Bool
-> Maybe Text
-> Maybe StateTransitions
-> Maybe [Parameter]
-> Maybe [ChannelWithValue]
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe [Text]
-> Maybe Integer
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Text
-> Maybe [InputMetadata]
-> Maybe [KeyValueProperty]
-> Text
-> Maybe [ComponentVersion]
-> Maybe Text
-> Experiment
Experiment
      (Maybe [Channel]
 -> Maybe ExperimentState
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe ExperimentPaths
 -> Maybe Bool
 -> Maybe Text
 -> Maybe StateTransitions
 -> Maybe [Parameter]
 -> Maybe [ChannelWithValue]
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Integer
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Text
 -> Maybe [InputMetadata]
 -> Maybe [KeyValueProperty]
 -> Text
 -> Maybe [ComponentVersion]
 -> Maybe Text
 -> Experiment)
-> Parser (Maybe [Channel])
-> Parser
     (Maybe ExperimentState
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe ExperimentPaths
      -> Maybe Bool
      -> Maybe Text
      -> Maybe StateTransitions
      -> Maybe [Parameter]
      -> Maybe [ChannelWithValue]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe [Channel])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channels")
      Parser
  (Maybe ExperimentState
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe ExperimentPaths
   -> Maybe Bool
   -> Maybe Text
   -> Maybe StateTransitions
   -> Maybe [Parameter]
   -> Maybe [ChannelWithValue]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe ExperimentState)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe ExperimentPaths
      -> Maybe Bool
      -> Maybe Text
      -> Maybe StateTransitions
      -> Maybe [Parameter]
      -> Maybe [ChannelWithValue]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe ExperimentState)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"state")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe ExperimentPaths
   -> Maybe Bool
   -> Maybe Text
   -> Maybe StateTransitions
   -> Maybe [Parameter]
   -> Maybe [ChannelWithValue]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe ExperimentPaths
      -> Maybe Bool
      -> Maybe Text
      -> Maybe StateTransitions
      -> Maybe [Parameter]
      -> Maybe [ChannelWithValue]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"timeOfCompletion")
      Parser
  (Maybe Text
   -> Maybe ExperimentPaths
   -> Maybe Bool
   -> Maybe Text
   -> Maybe StateTransitions
   -> Maybe [Parameter]
   -> Maybe [ChannelWithValue]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe ExperimentPaths
      -> Maybe Bool
      -> Maybe Text
      -> Maybe StateTransitions
      -> Maybe [Parameter]
      -> Maybe [ChannelWithValue]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"checkpointId")
      Parser
  (Maybe ExperimentPaths
   -> Maybe Bool
   -> Maybe Text
   -> Maybe StateTransitions
   -> Maybe [Parameter]
   -> Maybe [ChannelWithValue]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe ExperimentPaths)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe StateTransitions
      -> Maybe [Parameter]
      -> Maybe [ChannelWithValue]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe ExperimentPaths)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"paths")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe StateTransitions
   -> Maybe [Parameter]
   -> Maybe [ChannelWithValue]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe StateTransitions
      -> Maybe [Parameter]
      -> Maybe [ChannelWithValue]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"responding")
      Parser
  (Maybe Text
   -> Maybe StateTransitions
   -> Maybe [Parameter]
   -> Maybe [ChannelWithValue]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe StateTransitions
      -> Maybe [Parameter]
      -> Maybe [ChannelWithValue]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"organizationId")
      Parser
  (Maybe StateTransitions
   -> Maybe [Parameter]
   -> Maybe [ChannelWithValue]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe StateTransitions)
-> Parser
     (Maybe [Parameter]
      -> Maybe [ChannelWithValue]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe StateTransitions)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"stateTransitions")
      Parser
  (Maybe [Parameter]
   -> Maybe [ChannelWithValue]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe [Parameter])
-> Parser
     (Maybe [ChannelWithValue]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [Parameter])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"parameters")
      Parser
  (Maybe [ChannelWithValue]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe [ChannelWithValue])
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [ChannelWithValue])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channelsLastValues")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"storageSize")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"name")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"notebookId")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"projectName")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"hostname")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"trashed")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")
      Parser
  (Maybe [Text]
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"tags")
      Parser
  (Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channelsSize")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"timeOfCreation")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"projectId")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"organizationName")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"isCodeAccessible")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"traceback")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"entrypoint")
      Parser
  (Maybe Integer
   -> Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe Integer)
-> Parser
     (Text
      -> Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"runningTime")
      Parser
  (Text
   -> Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser Text
-> Parser
     (Maybe [InputMetadata]
      -> Maybe [KeyValueProperty]
      -> Text
      -> Maybe [ComponentVersion]
      -> Maybe Text
      -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser
  (Maybe [InputMetadata]
   -> Maybe [KeyValueProperty]
   -> Text
   -> Maybe [ComponentVersion]
   -> Maybe Text
   -> Experiment)
-> Parser (Maybe [InputMetadata])
-> Parser
     (Maybe [KeyValueProperty]
      -> Text -> Maybe [ComponentVersion] -> Maybe Text -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [InputMetadata])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"inputs")
      Parser
  (Maybe [KeyValueProperty]
   -> Text -> Maybe [ComponentVersion] -> Maybe Text -> Experiment)
-> Parser (Maybe [KeyValueProperty])
-> Parser
     (Text -> Maybe [ComponentVersion] -> Maybe Text -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [KeyValueProperty])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"properties")
      Parser
  (Text -> Maybe [ComponentVersion] -> Maybe Text -> Experiment)
-> Parser Text
-> Parser (Maybe [ComponentVersion] -> Maybe Text -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"shortId")
      Parser (Maybe [ComponentVersion] -> Maybe Text -> Experiment)
-> Parser (Maybe [ComponentVersion])
-> Parser (Maybe Text -> Experiment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [ComponentVersion])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"componentsVersions")
      Parser (Maybe Text -> Experiment)
-> Parser (Maybe Text) -> Parser Experiment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"owner")

-- | ToJSON Experiment
instance A.ToJSON Experiment where
  toJSON :: Experiment -> Value
toJSON Experiment {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe [Parameter]
Maybe [KeyValueProperty]
Maybe [InputMetadata]
Maybe [ComponentVersion]
Maybe [ChannelWithValue]
Maybe [Channel]
Maybe Text
Maybe DateTime
Maybe ExperimentState
Maybe StateTransitions
Maybe ExperimentPaths
Text
experimentOwner :: Maybe Text
experimentComponentsVersions :: Maybe [ComponentVersion]
experimentShortId :: Text
experimentProperties :: Maybe [KeyValueProperty]
experimentInputs :: Maybe [InputMetadata]
experimentId :: Text
experimentRunningTime :: Maybe Integer
experimentEntrypoint :: Maybe Text
experimentTraceback :: Maybe Text
experimentIsCodeAccessible :: Maybe Bool
experimentOrganizationName :: Maybe Text
experimentProjectId :: Maybe Text
experimentTimeOfCreation :: Maybe DateTime
experimentChannelsSize :: Maybe Integer
experimentTags :: Maybe [Text]
experimentDescription :: Maybe Text
experimentTrashed :: Maybe Bool
experimentHostname :: Maybe Text
experimentProjectName :: Maybe Text
experimentNotebookId :: Maybe Text
experimentName :: Maybe Text
experimentStorageSize :: Maybe Integer
experimentChannelsLastValues :: Maybe [ChannelWithValue]
experimentParameters :: Maybe [Parameter]
experimentStateTransitions :: Maybe StateTransitions
experimentOrganizationId :: Maybe Text
experimentResponding :: Maybe Bool
experimentPaths :: Maybe ExperimentPaths
experimentCheckpointId :: Maybe Text
experimentTimeOfCompletion :: Maybe DateTime
experimentState :: Maybe ExperimentState
experimentChannels :: Maybe [Channel]
experimentOwner :: Experiment -> Maybe Text
experimentComponentsVersions :: Experiment -> Maybe [ComponentVersion]
experimentShortId :: Experiment -> Text
experimentProperties :: Experiment -> Maybe [KeyValueProperty]
experimentInputs :: Experiment -> Maybe [InputMetadata]
experimentId :: Experiment -> Text
experimentRunningTime :: Experiment -> Maybe Integer
experimentEntrypoint :: Experiment -> Maybe Text
experimentTraceback :: Experiment -> Maybe Text
experimentIsCodeAccessible :: Experiment -> Maybe Bool
experimentOrganizationName :: Experiment -> Maybe Text
experimentProjectId :: Experiment -> Maybe Text
experimentTimeOfCreation :: Experiment -> Maybe DateTime
experimentChannelsSize :: Experiment -> Maybe Integer
experimentTags :: Experiment -> Maybe [Text]
experimentDescription :: Experiment -> Maybe Text
experimentTrashed :: Experiment -> Maybe Bool
experimentHostname :: Experiment -> Maybe Text
experimentProjectName :: Experiment -> Maybe Text
experimentNotebookId :: Experiment -> Maybe Text
experimentName :: Experiment -> Maybe Text
experimentStorageSize :: Experiment -> Maybe Integer
experimentChannelsLastValues :: Experiment -> Maybe [ChannelWithValue]
experimentParameters :: Experiment -> Maybe [Parameter]
experimentStateTransitions :: Experiment -> Maybe StateTransitions
experimentOrganizationId :: Experiment -> Maybe Text
experimentResponding :: Experiment -> Maybe Bool
experimentPaths :: Experiment -> Maybe ExperimentPaths
experimentCheckpointId :: Experiment -> Maybe Text
experimentTimeOfCompletion :: Experiment -> Maybe DateTime
experimentState :: Experiment -> Maybe ExperimentState
experimentChannels :: Experiment -> Maybe [Channel]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"channels" Text -> Maybe [Channel] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Channel]
experimentChannels
      , Text
"state" Text -> Maybe ExperimentState -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ExperimentState
experimentState
      , Text
"timeOfCompletion" Text -> Maybe DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe DateTime
experimentTimeOfCompletion
      , Text
"checkpointId" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentCheckpointId
      , Text
"paths" Text -> Maybe ExperimentPaths -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ExperimentPaths
experimentPaths
      , Text
"responding" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
experimentResponding
      , Text
"organizationId" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentOrganizationId
      , Text
"stateTransitions" Text -> Maybe StateTransitions -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe StateTransitions
experimentStateTransitions
      , Text
"parameters" Text -> Maybe [Parameter] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Parameter]
experimentParameters
      , Text
"channelsLastValues" Text -> Maybe [ChannelWithValue] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [ChannelWithValue]
experimentChannelsLastValues
      , Text
"storageSize" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
experimentStorageSize
      , Text
"name" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentName
      , Text
"notebookId" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentNotebookId
      , Text
"projectName" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentProjectName
      , Text
"hostname" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentHostname
      , Text
"trashed" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
experimentTrashed
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentDescription
      , Text
"tags" Text -> Maybe [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Text]
experimentTags
      , Text
"channelsSize" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
experimentChannelsSize
      , Text
"timeOfCreation" Text -> Maybe DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe DateTime
experimentTimeOfCreation
      , Text
"projectId" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentProjectId
      , Text
"organizationName" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentOrganizationName
      , Text
"isCodeAccessible" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
experimentIsCodeAccessible
      , Text
"traceback" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentTraceback
      , Text
"entrypoint" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentEntrypoint
      , Text
"runningTime" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
experimentRunningTime
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
experimentId
      , Text
"inputs" Text -> Maybe [InputMetadata] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [InputMetadata]
experimentInputs
      , Text
"properties" Text -> Maybe [KeyValueProperty] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [KeyValueProperty]
experimentProperties
      , Text
"shortId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
experimentShortId
      , Text
"componentsVersions" Text -> Maybe [ComponentVersion] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [ComponentVersion]
experimentComponentsVersions
      , Text
"owner" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentOwner
      ]


-- | Construct a value of type 'Experiment' (by applying it's required fields, if any)
mkExperiment
  :: Text -- ^ 'experimentId'
  -> Text -- ^ 'experimentShortId'
  -> Experiment
mkExperiment :: Text -> Text -> Experiment
mkExperiment Text
experimentId Text
experimentShortId =
  Experiment :: Maybe [Channel]
-> Maybe ExperimentState
-> Maybe DateTime
-> Maybe Text
-> Maybe ExperimentPaths
-> Maybe Bool
-> Maybe Text
-> Maybe StateTransitions
-> Maybe [Parameter]
-> Maybe [ChannelWithValue]
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe [Text]
-> Maybe Integer
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Text
-> Maybe [InputMetadata]
-> Maybe [KeyValueProperty]
-> Text
-> Maybe [ComponentVersion]
-> Maybe Text
-> Experiment
Experiment
  { experimentChannels :: Maybe [Channel]
experimentChannels = Maybe [Channel]
forall a. Maybe a
Nothing
  , experimentState :: Maybe ExperimentState
experimentState = Maybe ExperimentState
forall a. Maybe a
Nothing
  , experimentTimeOfCompletion :: Maybe DateTime
experimentTimeOfCompletion = Maybe DateTime
forall a. Maybe a
Nothing
  , experimentCheckpointId :: Maybe Text
experimentCheckpointId = Maybe Text
forall a. Maybe a
Nothing
  , experimentPaths :: Maybe ExperimentPaths
experimentPaths = Maybe ExperimentPaths
forall a. Maybe a
Nothing
  , experimentResponding :: Maybe Bool
experimentResponding = Maybe Bool
forall a. Maybe a
Nothing
  , experimentOrganizationId :: Maybe Text
experimentOrganizationId = Maybe Text
forall a. Maybe a
Nothing
  , experimentStateTransitions :: Maybe StateTransitions
experimentStateTransitions = Maybe StateTransitions
forall a. Maybe a
Nothing
  , experimentParameters :: Maybe [Parameter]
experimentParameters = Maybe [Parameter]
forall a. Maybe a
Nothing
  , experimentChannelsLastValues :: Maybe [ChannelWithValue]
experimentChannelsLastValues = Maybe [ChannelWithValue]
forall a. Maybe a
Nothing
  , experimentStorageSize :: Maybe Integer
experimentStorageSize = Maybe Integer
forall a. Maybe a
Nothing
  , experimentName :: Maybe Text
experimentName = Maybe Text
forall a. Maybe a
Nothing
  , experimentNotebookId :: Maybe Text
experimentNotebookId = Maybe Text
forall a. Maybe a
Nothing
  , experimentProjectName :: Maybe Text
experimentProjectName = Maybe Text
forall a. Maybe a
Nothing
  , experimentHostname :: Maybe Text
experimentHostname = Maybe Text
forall a. Maybe a
Nothing
  , experimentTrashed :: Maybe Bool
experimentTrashed = Maybe Bool
forall a. Maybe a
Nothing
  , experimentDescription :: Maybe Text
experimentDescription = Maybe Text
forall a. Maybe a
Nothing
  , experimentTags :: Maybe [Text]
experimentTags = Maybe [Text]
forall a. Maybe a
Nothing
  , experimentChannelsSize :: Maybe Integer
experimentChannelsSize = Maybe Integer
forall a. Maybe a
Nothing
  , experimentTimeOfCreation :: Maybe DateTime
experimentTimeOfCreation = Maybe DateTime
forall a. Maybe a
Nothing
  , experimentProjectId :: Maybe Text
experimentProjectId = Maybe Text
forall a. Maybe a
Nothing
  , experimentOrganizationName :: Maybe Text
experimentOrganizationName = Maybe Text
forall a. Maybe a
Nothing
  , experimentIsCodeAccessible :: Maybe Bool
experimentIsCodeAccessible = Maybe Bool
forall a. Maybe a
Nothing
  , experimentTraceback :: Maybe Text
experimentTraceback = Maybe Text
forall a. Maybe a
Nothing
  , experimentEntrypoint :: Maybe Text
experimentEntrypoint = Maybe Text
forall a. Maybe a
Nothing
  , experimentRunningTime :: Maybe Integer
experimentRunningTime = Maybe Integer
forall a. Maybe a
Nothing
  , Text
experimentId :: Text
experimentId :: Text
experimentId
  , experimentInputs :: Maybe [InputMetadata]
experimentInputs = Maybe [InputMetadata]
forall a. Maybe a
Nothing
  , experimentProperties :: Maybe [KeyValueProperty]
experimentProperties = Maybe [KeyValueProperty]
forall a. Maybe a
Nothing
  , Text
experimentShortId :: Text
experimentShortId :: Text
experimentShortId
  , experimentComponentsVersions :: Maybe [ComponentVersion]
experimentComponentsVersions = Maybe [ComponentVersion]
forall a. Maybe a
Nothing
  , experimentOwner :: Maybe Text
experimentOwner = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ExperimentCreationParams
-- | ExperimentCreationParams
data ExperimentCreationParams = ExperimentCreationParams
    { ExperimentCreationParams -> Maybe Bool
experimentCreationParamsMonitored        :: !(Maybe Bool) -- ^ "monitored"
    -- ^ "hostname"
    , ExperimentCreationParams -> Maybe Text
experimentCreationParamsHostname         :: !(Maybe Text) -- ^ "hostname"
    -- ^ "checkpointId"
    , ExperimentCreationParams -> Maybe Text
experimentCreationParamsCheckpointId     :: !(Maybe Text) -- ^ "checkpointId"
    -- ^ /Required/ "projectId"
    , ExperimentCreationParams -> Text
experimentCreationParamsProjectId        :: !(Text) -- ^ /Required/ "projectId"
    -- ^ "gitInfo"
    , ExperimentCreationParams -> Maybe GitInfoDTO
experimentCreationParamsGitInfo          :: !(Maybe GitInfoDTO) -- ^ "gitInfo"
    -- ^ /Required/ "properties"
    , ExperimentCreationParams -> [KeyValueProperty]
experimentCreationParamsProperties       :: !([KeyValueProperty]) -- ^ /Required/ "properties"
    -- ^ "configPath"
    , ExperimentCreationParams -> Maybe Text
experimentCreationParamsConfigPath       :: !(Maybe Text) -- ^ "configPath"
    -- ^ /Required/ "execArgsTemplate"
    , ExperimentCreationParams -> Text
experimentCreationParamsExecArgsTemplate :: !(Text) -- ^ /Required/ "execArgsTemplate"
    -- ^ /Required/ "parameters"
    , ExperimentCreationParams -> [Parameter]
experimentCreationParamsParameters       :: !([Parameter]) -- ^ /Required/ "parameters"
    -- ^ /Required/ "enqueueCommand"
    , ExperimentCreationParams -> Text
experimentCreationParamsEnqueueCommand   :: !(Text) -- ^ /Required/ "enqueueCommand"
    -- ^ /Required/ "name"
    , ExperimentCreationParams -> Text
experimentCreationParamsName             :: !(Text) -- ^ /Required/ "name"
    -- ^ "notebookId"
    , ExperimentCreationParams -> Maybe Text
experimentCreationParamsNotebookId       :: !(Maybe Text) -- ^ "notebookId"
    -- ^ "description"
    , ExperimentCreationParams -> Maybe Text
experimentCreationParamsDescription      :: !(Maybe Text) -- ^ "description"
    -- ^ /Required/ "tags"
    , ExperimentCreationParams -> [Text]
experimentCreationParamsTags             :: !([Text]) -- ^ /Required/ "tags"
    -- ^ "abortable"
    , ExperimentCreationParams -> Maybe Bool
experimentCreationParamsAbortable        :: !(Maybe Bool) -- ^ "abortable"
    -- ^ "entrypoint"
    , ExperimentCreationParams -> Maybe Text
experimentCreationParamsEntrypoint       :: !(Maybe Text) -- ^ "entrypoint"
    }
    deriving (Int -> ExperimentCreationParams -> ShowS
[ExperimentCreationParams] -> ShowS
ExperimentCreationParams -> FilePath
(Int -> ExperimentCreationParams -> ShowS)
-> (ExperimentCreationParams -> FilePath)
-> ([ExperimentCreationParams] -> ShowS)
-> Show ExperimentCreationParams
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExperimentCreationParams] -> ShowS
$cshowList :: [ExperimentCreationParams] -> ShowS
show :: ExperimentCreationParams -> FilePath
$cshow :: ExperimentCreationParams -> FilePath
showsPrec :: Int -> ExperimentCreationParams -> ShowS
$cshowsPrec :: Int -> ExperimentCreationParams -> ShowS
P.Show, ExperimentCreationParams -> ExperimentCreationParams -> Bool
(ExperimentCreationParams -> ExperimentCreationParams -> Bool)
-> (ExperimentCreationParams -> ExperimentCreationParams -> Bool)
-> Eq ExperimentCreationParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExperimentCreationParams -> ExperimentCreationParams -> Bool
$c/= :: ExperimentCreationParams -> ExperimentCreationParams -> Bool
== :: ExperimentCreationParams -> ExperimentCreationParams -> Bool
$c== :: ExperimentCreationParams -> ExperimentCreationParams -> Bool
P.Eq, P.Typeable)

-- | FromJSON ExperimentCreationParams
instance A.FromJSON ExperimentCreationParams where
  parseJSON :: Value -> Parser ExperimentCreationParams
parseJSON = FilePath
-> (Object -> Parser ExperimentCreationParams)
-> Value
-> Parser ExperimentCreationParams
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ExperimentCreationParams" ((Object -> Parser ExperimentCreationParams)
 -> Value -> Parser ExperimentCreationParams)
-> (Object -> Parser ExperimentCreationParams)
-> Value
-> Parser ExperimentCreationParams
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe GitInfoDTO
-> [KeyValueProperty]
-> Maybe Text
-> Text
-> [Parameter]
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> Maybe Bool
-> Maybe Text
-> ExperimentCreationParams
ExperimentCreationParams
      (Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Maybe GitInfoDTO
 -> [KeyValueProperty]
 -> Maybe Text
 -> Text
 -> [Parameter]
 -> Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> [Text]
 -> Maybe Bool
 -> Maybe Text
 -> ExperimentCreationParams)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe GitInfoDTO
      -> [KeyValueProperty]
      -> Maybe Text
      -> Text
      -> [Parameter]
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"monitored")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe GitInfoDTO
   -> [KeyValueProperty]
   -> Maybe Text
   -> Text
   -> [Parameter]
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text
      -> Maybe GitInfoDTO
      -> [KeyValueProperty]
      -> Maybe Text
      -> Text
      -> [Parameter]
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"hostname")
      Parser
  (Maybe Text
   -> Text
   -> Maybe GitInfoDTO
   -> [KeyValueProperty]
   -> Maybe Text
   -> Text
   -> [Parameter]
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Maybe GitInfoDTO
      -> [KeyValueProperty]
      -> Maybe Text
      -> Text
      -> [Parameter]
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"checkpointId")
      Parser
  (Text
   -> Maybe GitInfoDTO
   -> [KeyValueProperty]
   -> Maybe Text
   -> Text
   -> [Parameter]
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser Text
-> Parser
     (Maybe GitInfoDTO
      -> [KeyValueProperty]
      -> Maybe Text
      -> Text
      -> [Parameter]
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"projectId")
      Parser
  (Maybe GitInfoDTO
   -> [KeyValueProperty]
   -> Maybe Text
   -> Text
   -> [Parameter]
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser (Maybe GitInfoDTO)
-> Parser
     ([KeyValueProperty]
      -> Maybe Text
      -> Text
      -> [Parameter]
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe GitInfoDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"gitInfo")
      Parser
  ([KeyValueProperty]
   -> Maybe Text
   -> Text
   -> [Parameter]
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser [KeyValueProperty]
-> Parser
     (Maybe Text
      -> Text
      -> [Parameter]
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [KeyValueProperty]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"properties")
      Parser
  (Maybe Text
   -> Text
   -> [Parameter]
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> [Parameter]
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"configPath")
      Parser
  (Text
   -> [Parameter]
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser Text
-> Parser
     ([Parameter]
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"execArgsTemplate")
      Parser
  ([Parameter]
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser [Parameter]
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Parameter]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"parameters")
      Parser
  (Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"enqueueCommand")
      Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> [Text]
      -> Maybe Bool
      -> Maybe Text
      -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (Maybe Text
   -> Maybe Text
   -> [Text]
   -> Maybe Bool
   -> Maybe Text
   -> ExperimentCreationParams)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> [Text] -> Maybe Bool -> Maybe Text -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"notebookId")
      Parser
  (Maybe Text
   -> [Text] -> Maybe Bool -> Maybe Text -> ExperimentCreationParams)
-> Parser (Maybe Text)
-> Parser
     ([Text] -> Maybe Bool -> Maybe Text -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")
      Parser
  ([Text] -> Maybe Bool -> Maybe Text -> ExperimentCreationParams)
-> Parser [Text]
-> Parser (Maybe Bool -> Maybe Text -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"tags")
      Parser (Maybe Bool -> Maybe Text -> ExperimentCreationParams)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> ExperimentCreationParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"abortable")
      Parser (Maybe Text -> ExperimentCreationParams)
-> Parser (Maybe Text) -> Parser ExperimentCreationParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"entrypoint")

-- | ToJSON ExperimentCreationParams
instance A.ToJSON ExperimentCreationParams where
  toJSON :: ExperimentCreationParams -> Value
toJSON ExperimentCreationParams {[Text]
[Parameter]
[KeyValueProperty]
Maybe Bool
Maybe Text
Maybe GitInfoDTO
Text
experimentCreationParamsEntrypoint :: Maybe Text
experimentCreationParamsAbortable :: Maybe Bool
experimentCreationParamsTags :: [Text]
experimentCreationParamsDescription :: Maybe Text
experimentCreationParamsNotebookId :: Maybe Text
experimentCreationParamsName :: Text
experimentCreationParamsEnqueueCommand :: Text
experimentCreationParamsParameters :: [Parameter]
experimentCreationParamsExecArgsTemplate :: Text
experimentCreationParamsConfigPath :: Maybe Text
experimentCreationParamsProperties :: [KeyValueProperty]
experimentCreationParamsGitInfo :: Maybe GitInfoDTO
experimentCreationParamsProjectId :: Text
experimentCreationParamsCheckpointId :: Maybe Text
experimentCreationParamsHostname :: Maybe Text
experimentCreationParamsMonitored :: Maybe Bool
experimentCreationParamsEntrypoint :: ExperimentCreationParams -> Maybe Text
experimentCreationParamsAbortable :: ExperimentCreationParams -> Maybe Bool
experimentCreationParamsTags :: ExperimentCreationParams -> [Text]
experimentCreationParamsDescription :: ExperimentCreationParams -> Maybe Text
experimentCreationParamsNotebookId :: ExperimentCreationParams -> Maybe Text
experimentCreationParamsName :: ExperimentCreationParams -> Text
experimentCreationParamsEnqueueCommand :: ExperimentCreationParams -> Text
experimentCreationParamsParameters :: ExperimentCreationParams -> [Parameter]
experimentCreationParamsExecArgsTemplate :: ExperimentCreationParams -> Text
experimentCreationParamsConfigPath :: ExperimentCreationParams -> Maybe Text
experimentCreationParamsProperties :: ExperimentCreationParams -> [KeyValueProperty]
experimentCreationParamsGitInfo :: ExperimentCreationParams -> Maybe GitInfoDTO
experimentCreationParamsProjectId :: ExperimentCreationParams -> Text
experimentCreationParamsCheckpointId :: ExperimentCreationParams -> Maybe Text
experimentCreationParamsHostname :: ExperimentCreationParams -> Maybe Text
experimentCreationParamsMonitored :: ExperimentCreationParams -> Maybe Bool
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"monitored" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
experimentCreationParamsMonitored
      , Text
"hostname" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentCreationParamsHostname
      , Text
"checkpointId" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentCreationParamsCheckpointId
      , Text
"projectId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
experimentCreationParamsProjectId
      , Text
"gitInfo" Text -> Maybe GitInfoDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe GitInfoDTO
experimentCreationParamsGitInfo
      , Text
"properties" Text -> [KeyValueProperty] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [KeyValueProperty]
experimentCreationParamsProperties
      , Text
"configPath" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentCreationParamsConfigPath
      , Text
"execArgsTemplate" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
experimentCreationParamsExecArgsTemplate
      , Text
"parameters" Text -> [Parameter] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Parameter]
experimentCreationParamsParameters
      , Text
"enqueueCommand" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
experimentCreationParamsEnqueueCommand
      , Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
experimentCreationParamsName
      , Text
"notebookId" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentCreationParamsNotebookId
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentCreationParamsDescription
      , Text
"tags" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
experimentCreationParamsTags
      , Text
"abortable" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
experimentCreationParamsAbortable
      , Text
"entrypoint" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
experimentCreationParamsEntrypoint
      ]


-- | Construct a value of type 'ExperimentCreationParams' (by applying it's required fields, if any)
mkExperimentCreationParams
  :: Text -- ^ 'experimentCreationParamsProjectId'
  -> [KeyValueProperty] -- ^ 'experimentCreationParamsProperties'
  -> Text -- ^ 'experimentCreationParamsExecArgsTemplate'
  -> [Parameter] -- ^ 'experimentCreationParamsParameters'
  -> Text -- ^ 'experimentCreationParamsEnqueueCommand'
  -> Text -- ^ 'experimentCreationParamsName'
  -> [Text] -- ^ 'experimentCreationParamsTags'
  -> ExperimentCreationParams
mkExperimentCreationParams :: Text
-> [KeyValueProperty]
-> Text
-> [Parameter]
-> Text
-> Text
-> [Text]
-> ExperimentCreationParams
mkExperimentCreationParams Text
experimentCreationParamsProjectId [KeyValueProperty]
experimentCreationParamsProperties Text
experimentCreationParamsExecArgsTemplate [Parameter]
experimentCreationParamsParameters Text
experimentCreationParamsEnqueueCommand Text
experimentCreationParamsName [Text]
experimentCreationParamsTags =
  ExperimentCreationParams :: Maybe Bool
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe GitInfoDTO
-> [KeyValueProperty]
-> Maybe Text
-> Text
-> [Parameter]
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> Maybe Bool
-> Maybe Text
-> ExperimentCreationParams
ExperimentCreationParams
  { experimentCreationParamsMonitored :: Maybe Bool
experimentCreationParamsMonitored = Maybe Bool
forall a. Maybe a
Nothing
  , experimentCreationParamsHostname :: Maybe Text
experimentCreationParamsHostname = Maybe Text
forall a. Maybe a
Nothing
  , experimentCreationParamsCheckpointId :: Maybe Text
experimentCreationParamsCheckpointId = Maybe Text
forall a. Maybe a
Nothing
  , Text
experimentCreationParamsProjectId :: Text
experimentCreationParamsProjectId :: Text
experimentCreationParamsProjectId
  , experimentCreationParamsGitInfo :: Maybe GitInfoDTO
experimentCreationParamsGitInfo = Maybe GitInfoDTO
forall a. Maybe a
Nothing
  , [KeyValueProperty]
experimentCreationParamsProperties :: [KeyValueProperty]
experimentCreationParamsProperties :: [KeyValueProperty]
experimentCreationParamsProperties
  , experimentCreationParamsConfigPath :: Maybe Text
experimentCreationParamsConfigPath = Maybe Text
forall a. Maybe a
Nothing
  , Text
experimentCreationParamsExecArgsTemplate :: Text
experimentCreationParamsExecArgsTemplate :: Text
experimentCreationParamsExecArgsTemplate
  , [Parameter]
experimentCreationParamsParameters :: [Parameter]
experimentCreationParamsParameters :: [Parameter]
experimentCreationParamsParameters
  , Text
experimentCreationParamsEnqueueCommand :: Text
experimentCreationParamsEnqueueCommand :: Text
experimentCreationParamsEnqueueCommand
  , Text
experimentCreationParamsName :: Text
experimentCreationParamsName :: Text
experimentCreationParamsName
  , experimentCreationParamsNotebookId :: Maybe Text
experimentCreationParamsNotebookId = Maybe Text
forall a. Maybe a
Nothing
  , experimentCreationParamsDescription :: Maybe Text
experimentCreationParamsDescription = Maybe Text
forall a. Maybe a
Nothing
  , [Text]
experimentCreationParamsTags :: [Text]
experimentCreationParamsTags :: [Text]
experimentCreationParamsTags
  , experimentCreationParamsAbortable :: Maybe Bool
experimentCreationParamsAbortable = Maybe Bool
forall a. Maybe a
Nothing
  , experimentCreationParamsEntrypoint :: Maybe Text
experimentCreationParamsEntrypoint = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ExperimentPaths
-- | ExperimentPaths
data ExperimentPaths = ExperimentPaths
    { ExperimentPaths -> Text
experimentPathsOutput :: !(Text) -- ^ /Required/ "output"
    -- ^ /Required/ "source"
    , ExperimentPaths -> Text
experimentPathsSource :: !(Text) -- ^ /Required/ "source"
    }
    deriving (Int -> ExperimentPaths -> ShowS
[ExperimentPaths] -> ShowS
ExperimentPaths -> FilePath
(Int -> ExperimentPaths -> ShowS)
-> (ExperimentPaths -> FilePath)
-> ([ExperimentPaths] -> ShowS)
-> Show ExperimentPaths
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExperimentPaths] -> ShowS
$cshowList :: [ExperimentPaths] -> ShowS
show :: ExperimentPaths -> FilePath
$cshow :: ExperimentPaths -> FilePath
showsPrec :: Int -> ExperimentPaths -> ShowS
$cshowsPrec :: Int -> ExperimentPaths -> ShowS
P.Show, ExperimentPaths -> ExperimentPaths -> Bool
(ExperimentPaths -> ExperimentPaths -> Bool)
-> (ExperimentPaths -> ExperimentPaths -> Bool)
-> Eq ExperimentPaths
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExperimentPaths -> ExperimentPaths -> Bool
$c/= :: ExperimentPaths -> ExperimentPaths -> Bool
== :: ExperimentPaths -> ExperimentPaths -> Bool
$c== :: ExperimentPaths -> ExperimentPaths -> Bool
P.Eq, P.Typeable)

-- | FromJSON ExperimentPaths
instance A.FromJSON ExperimentPaths where
  parseJSON :: Value -> Parser ExperimentPaths
parseJSON = FilePath
-> (Object -> Parser ExperimentPaths)
-> Value
-> Parser ExperimentPaths
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ExperimentPaths" ((Object -> Parser ExperimentPaths)
 -> Value -> Parser ExperimentPaths)
-> (Object -> Parser ExperimentPaths)
-> Value
-> Parser ExperimentPaths
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> ExperimentPaths
ExperimentPaths
      (Text -> Text -> ExperimentPaths)
-> Parser Text -> Parser (Text -> ExperimentPaths)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"output")
      Parser (Text -> ExperimentPaths)
-> Parser Text -> Parser ExperimentPaths
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"source")

-- | ToJSON ExperimentPaths
instance A.ToJSON ExperimentPaths where
  toJSON :: ExperimentPaths -> Value
toJSON ExperimentPaths {Text
experimentPathsSource :: Text
experimentPathsOutput :: Text
experimentPathsSource :: ExperimentPaths -> Text
experimentPathsOutput :: ExperimentPaths -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"output" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
experimentPathsOutput
      , Text
"source" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
experimentPathsSource
      ]


-- | Construct a value of type 'ExperimentPaths' (by applying it's required fields, if any)
mkExperimentPaths
  :: Text -- ^ 'experimentPathsOutput'
  -> Text -- ^ 'experimentPathsSource'
  -> ExperimentPaths
mkExperimentPaths :: Text -> Text -> ExperimentPaths
mkExperimentPaths Text
experimentPathsOutput Text
experimentPathsSource =
  ExperimentPaths :: Text -> Text -> ExperimentPaths
ExperimentPaths
  { Text
experimentPathsOutput :: Text
experimentPathsOutput :: Text
experimentPathsOutput
  , Text
experimentPathsSource :: Text
experimentPathsSource :: Text
experimentPathsSource
  }

-- ** ExperimentsAttributesNamesDTO
-- | ExperimentsAttributesNamesDTO
data ExperimentsAttributesNamesDTO = ExperimentsAttributesNamesDTO
    { ExperimentsAttributesNamesDTO -> [Text]
experimentsAttributesNamesDTOTextParametersNames    :: !([Text]) -- ^ /Required/ "textParametersNames"
    -- ^ /Required/ "propertiesNames"
    , ExperimentsAttributesNamesDTO -> [Text]
experimentsAttributesNamesDTOPropertiesNames        :: !([Text]) -- ^ /Required/ "propertiesNames"
    -- ^ /Required/ "numericChannelsNames"
    , ExperimentsAttributesNamesDTO -> [Text]
experimentsAttributesNamesDTONumericChannelsNames   :: !([Text]) -- ^ /Required/ "numericChannelsNames"
    -- ^ /Required/ "numericParametersNames"
    , ExperimentsAttributesNamesDTO -> [Text]
experimentsAttributesNamesDTONumericParametersNames :: !([Text]) -- ^ /Required/ "numericParametersNames"
    -- ^ /Required/ "textChannelsNames"
    , ExperimentsAttributesNamesDTO -> [Text]
experimentsAttributesNamesDTOTextChannelsNames      :: !([Text]) -- ^ /Required/ "textChannelsNames"
    }
    deriving (Int -> ExperimentsAttributesNamesDTO -> ShowS
[ExperimentsAttributesNamesDTO] -> ShowS
ExperimentsAttributesNamesDTO -> FilePath
(Int -> ExperimentsAttributesNamesDTO -> ShowS)
-> (ExperimentsAttributesNamesDTO -> FilePath)
-> ([ExperimentsAttributesNamesDTO] -> ShowS)
-> Show ExperimentsAttributesNamesDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExperimentsAttributesNamesDTO] -> ShowS
$cshowList :: [ExperimentsAttributesNamesDTO] -> ShowS
show :: ExperimentsAttributesNamesDTO -> FilePath
$cshow :: ExperimentsAttributesNamesDTO -> FilePath
showsPrec :: Int -> ExperimentsAttributesNamesDTO -> ShowS
$cshowsPrec :: Int -> ExperimentsAttributesNamesDTO -> ShowS
P.Show, ExperimentsAttributesNamesDTO
-> ExperimentsAttributesNamesDTO -> Bool
(ExperimentsAttributesNamesDTO
 -> ExperimentsAttributesNamesDTO -> Bool)
-> (ExperimentsAttributesNamesDTO
    -> ExperimentsAttributesNamesDTO -> Bool)
-> Eq ExperimentsAttributesNamesDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExperimentsAttributesNamesDTO
-> ExperimentsAttributesNamesDTO -> Bool
$c/= :: ExperimentsAttributesNamesDTO
-> ExperimentsAttributesNamesDTO -> Bool
== :: ExperimentsAttributesNamesDTO
-> ExperimentsAttributesNamesDTO -> Bool
$c== :: ExperimentsAttributesNamesDTO
-> ExperimentsAttributesNamesDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ExperimentsAttributesNamesDTO
instance A.FromJSON ExperimentsAttributesNamesDTO where
  parseJSON :: Value -> Parser ExperimentsAttributesNamesDTO
parseJSON = FilePath
-> (Object -> Parser ExperimentsAttributesNamesDTO)
-> Value
-> Parser ExperimentsAttributesNamesDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ExperimentsAttributesNamesDTO" ((Object -> Parser ExperimentsAttributesNamesDTO)
 -> Value -> Parser ExperimentsAttributesNamesDTO)
-> (Object -> Parser ExperimentsAttributesNamesDTO)
-> Value
-> Parser ExperimentsAttributesNamesDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> ExperimentsAttributesNamesDTO
ExperimentsAttributesNamesDTO
      ([Text]
 -> [Text]
 -> [Text]
 -> [Text]
 -> [Text]
 -> ExperimentsAttributesNamesDTO)
-> Parser [Text]
-> Parser
     ([Text]
      -> [Text] -> [Text] -> [Text] -> ExperimentsAttributesNamesDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"textParametersNames")
      Parser
  ([Text]
   -> [Text] -> [Text] -> [Text] -> ExperimentsAttributesNamesDTO)
-> Parser [Text]
-> Parser
     ([Text] -> [Text] -> [Text] -> ExperimentsAttributesNamesDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"propertiesNames")
      Parser
  ([Text] -> [Text] -> [Text] -> ExperimentsAttributesNamesDTO)
-> Parser [Text]
-> Parser ([Text] -> [Text] -> ExperimentsAttributesNamesDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"numericChannelsNames")
      Parser ([Text] -> [Text] -> ExperimentsAttributesNamesDTO)
-> Parser [Text]
-> Parser ([Text] -> ExperimentsAttributesNamesDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"numericParametersNames")
      Parser ([Text] -> ExperimentsAttributesNamesDTO)
-> Parser [Text] -> Parser ExperimentsAttributesNamesDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"textChannelsNames")

-- | ToJSON ExperimentsAttributesNamesDTO
instance A.ToJSON ExperimentsAttributesNamesDTO where
  toJSON :: ExperimentsAttributesNamesDTO -> Value
toJSON ExperimentsAttributesNamesDTO {[Text]
experimentsAttributesNamesDTOTextChannelsNames :: [Text]
experimentsAttributesNamesDTONumericParametersNames :: [Text]
experimentsAttributesNamesDTONumericChannelsNames :: [Text]
experimentsAttributesNamesDTOPropertiesNames :: [Text]
experimentsAttributesNamesDTOTextParametersNames :: [Text]
experimentsAttributesNamesDTOTextChannelsNames :: ExperimentsAttributesNamesDTO -> [Text]
experimentsAttributesNamesDTONumericParametersNames :: ExperimentsAttributesNamesDTO -> [Text]
experimentsAttributesNamesDTONumericChannelsNames :: ExperimentsAttributesNamesDTO -> [Text]
experimentsAttributesNamesDTOPropertiesNames :: ExperimentsAttributesNamesDTO -> [Text]
experimentsAttributesNamesDTOTextParametersNames :: ExperimentsAttributesNamesDTO -> [Text]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"textParametersNames" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
experimentsAttributesNamesDTOTextParametersNames
      , Text
"propertiesNames" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
experimentsAttributesNamesDTOPropertiesNames
      , Text
"numericChannelsNames" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
experimentsAttributesNamesDTONumericChannelsNames
      , Text
"numericParametersNames" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
experimentsAttributesNamesDTONumericParametersNames
      , Text
"textChannelsNames" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
experimentsAttributesNamesDTOTextChannelsNames
      ]


-- | Construct a value of type 'ExperimentsAttributesNamesDTO' (by applying it's required fields, if any)
mkExperimentsAttributesNamesDTO
  :: [Text] -- ^ 'experimentsAttributesNamesDTOTextParametersNames'
  -> [Text] -- ^ 'experimentsAttributesNamesDTOPropertiesNames'
  -> [Text] -- ^ 'experimentsAttributesNamesDTONumericChannelsNames'
  -> [Text] -- ^ 'experimentsAttributesNamesDTONumericParametersNames'
  -> [Text] -- ^ 'experimentsAttributesNamesDTOTextChannelsNames'
  -> ExperimentsAttributesNamesDTO
mkExperimentsAttributesNamesDTO :: [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> ExperimentsAttributesNamesDTO
mkExperimentsAttributesNamesDTO [Text]
experimentsAttributesNamesDTOTextParametersNames [Text]
experimentsAttributesNamesDTOPropertiesNames [Text]
experimentsAttributesNamesDTONumericChannelsNames [Text]
experimentsAttributesNamesDTONumericParametersNames [Text]
experimentsAttributesNamesDTOTextChannelsNames =
  ExperimentsAttributesNamesDTO :: [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> ExperimentsAttributesNamesDTO
ExperimentsAttributesNamesDTO
  { [Text]
experimentsAttributesNamesDTOTextParametersNames :: [Text]
experimentsAttributesNamesDTOTextParametersNames :: [Text]
experimentsAttributesNamesDTOTextParametersNames
  , [Text]
experimentsAttributesNamesDTOPropertiesNames :: [Text]
experimentsAttributesNamesDTOPropertiesNames :: [Text]
experimentsAttributesNamesDTOPropertiesNames
  , [Text]
experimentsAttributesNamesDTONumericChannelsNames :: [Text]
experimentsAttributesNamesDTONumericChannelsNames :: [Text]
experimentsAttributesNamesDTONumericChannelsNames
  , [Text]
experimentsAttributesNamesDTONumericParametersNames :: [Text]
experimentsAttributesNamesDTONumericParametersNames :: [Text]
experimentsAttributesNamesDTONumericParametersNames
  , [Text]
experimentsAttributesNamesDTOTextChannelsNames :: [Text]
experimentsAttributesNamesDTOTextChannelsNames :: [Text]
experimentsAttributesNamesDTOTextChannelsNames
  }

-- ** File
-- | File
data File = File
    { File -> Text
filePath :: !(Text) -- ^ /Required/ "path"
    }
    deriving (Int -> File -> ShowS
[File] -> ShowS
File -> FilePath
(Int -> File -> ShowS)
-> (File -> FilePath) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> FilePath
$cshow :: File -> FilePath
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
P.Show, File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
P.Eq, P.Typeable)

-- | FromJSON File
instance A.FromJSON File where
  parseJSON :: Value -> Parser File
parseJSON = FilePath -> (Object -> Parser File) -> Value -> Parser File
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"File" ((Object -> Parser File) -> Value -> Parser File)
-> (Object -> Parser File) -> Value -> Parser File
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> File
File
      (Text -> File) -> Parser Text -> Parser File
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"path")

-- | ToJSON File
instance A.ToJSON File where
  toJSON :: File -> Value
toJSON File {Text
filePath :: Text
filePath :: File -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"path" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
filePath
      ]


-- | Construct a value of type 'File' (by applying it's required fields, if any)
mkFile
  :: Text -- ^ 'filePath'
  -> File
mkFile :: Text -> File
mkFile Text
filePath =
  File :: Text -> File
File
  { Text
filePath :: Text
filePath :: Text
filePath
  }

-- ** GitCommitDTO
-- | GitCommitDTO
data GitCommitDTO = GitCommitDTO
    { GitCommitDTO -> Text
gitCommitDTOAuthorEmail :: !(Text) -- ^ /Required/ "authorEmail"
    -- ^ /Required/ "commitId"
    , GitCommitDTO -> Text
gitCommitDTOCommitId    :: !(Text) -- ^ /Required/ "commitId"
    -- ^ /Required/ "message"
    , GitCommitDTO -> Text
gitCommitDTOMessage     :: !(Text) -- ^ /Required/ "message"
    -- ^ /Required/ "commitDate"
    , GitCommitDTO -> DateTime
gitCommitDTOCommitDate  :: !(DateTime) -- ^ /Required/ "commitDate"
    -- ^ /Required/ "authorName"
    , GitCommitDTO -> Text
gitCommitDTOAuthorName  :: !(Text) -- ^ /Required/ "authorName"
    }
    deriving (Int -> GitCommitDTO -> ShowS
[GitCommitDTO] -> ShowS
GitCommitDTO -> FilePath
(Int -> GitCommitDTO -> ShowS)
-> (GitCommitDTO -> FilePath)
-> ([GitCommitDTO] -> ShowS)
-> Show GitCommitDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GitCommitDTO] -> ShowS
$cshowList :: [GitCommitDTO] -> ShowS
show :: GitCommitDTO -> FilePath
$cshow :: GitCommitDTO -> FilePath
showsPrec :: Int -> GitCommitDTO -> ShowS
$cshowsPrec :: Int -> GitCommitDTO -> ShowS
P.Show, GitCommitDTO -> GitCommitDTO -> Bool
(GitCommitDTO -> GitCommitDTO -> Bool)
-> (GitCommitDTO -> GitCommitDTO -> Bool) -> Eq GitCommitDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitCommitDTO -> GitCommitDTO -> Bool
$c/= :: GitCommitDTO -> GitCommitDTO -> Bool
== :: GitCommitDTO -> GitCommitDTO -> Bool
$c== :: GitCommitDTO -> GitCommitDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON GitCommitDTO
instance A.FromJSON GitCommitDTO where
  parseJSON :: Value -> Parser GitCommitDTO
parseJSON = FilePath
-> (Object -> Parser GitCommitDTO) -> Value -> Parser GitCommitDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"GitCommitDTO" ((Object -> Parser GitCommitDTO) -> Value -> Parser GitCommitDTO)
-> (Object -> Parser GitCommitDTO) -> Value -> Parser GitCommitDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Text -> DateTime -> Text -> GitCommitDTO
GitCommitDTO
      (Text -> Text -> Text -> DateTime -> Text -> GitCommitDTO)
-> Parser Text
-> Parser (Text -> Text -> DateTime -> Text -> GitCommitDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"authorEmail")
      Parser (Text -> Text -> DateTime -> Text -> GitCommitDTO)
-> Parser Text -> Parser (Text -> DateTime -> Text -> GitCommitDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"commitId")
      Parser (Text -> DateTime -> Text -> GitCommitDTO)
-> Parser Text -> Parser (DateTime -> Text -> GitCommitDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"message")
      Parser (DateTime -> Text -> GitCommitDTO)
-> Parser DateTime -> Parser (Text -> GitCommitDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser DateTime
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"commitDate")
      Parser (Text -> GitCommitDTO) -> Parser Text -> Parser GitCommitDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"authorName")

-- | ToJSON GitCommitDTO
instance A.ToJSON GitCommitDTO where
  toJSON :: GitCommitDTO -> Value
toJSON GitCommitDTO {Text
DateTime
gitCommitDTOAuthorName :: Text
gitCommitDTOCommitDate :: DateTime
gitCommitDTOMessage :: Text
gitCommitDTOCommitId :: Text
gitCommitDTOAuthorEmail :: Text
gitCommitDTOAuthorName :: GitCommitDTO -> Text
gitCommitDTOCommitDate :: GitCommitDTO -> DateTime
gitCommitDTOMessage :: GitCommitDTO -> Text
gitCommitDTOCommitId :: GitCommitDTO -> Text
gitCommitDTOAuthorEmail :: GitCommitDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"authorEmail" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
gitCommitDTOAuthorEmail
      , Text
"commitId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
gitCommitDTOCommitId
      , Text
"message" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
gitCommitDTOMessage
      , Text
"commitDate" Text -> DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DateTime
gitCommitDTOCommitDate
      , Text
"authorName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
gitCommitDTOAuthorName
      ]


-- | Construct a value of type 'GitCommitDTO' (by applying it's required fields, if any)
mkGitCommitDTO
  :: Text -- ^ 'gitCommitDTOAuthorEmail'
  -> Text -- ^ 'gitCommitDTOCommitId'
  -> Text -- ^ 'gitCommitDTOMessage'
  -> DateTime -- ^ 'gitCommitDTOCommitDate'
  -> Text -- ^ 'gitCommitDTOAuthorName'
  -> GitCommitDTO
mkGitCommitDTO :: Text -> Text -> Text -> DateTime -> Text -> GitCommitDTO
mkGitCommitDTO Text
gitCommitDTOAuthorEmail Text
gitCommitDTOCommitId Text
gitCommitDTOMessage DateTime
gitCommitDTOCommitDate Text
gitCommitDTOAuthorName =
  GitCommitDTO :: Text -> Text -> Text -> DateTime -> Text -> GitCommitDTO
GitCommitDTO
  { Text
gitCommitDTOAuthorEmail :: Text
gitCommitDTOAuthorEmail :: Text
gitCommitDTOAuthorEmail
  , Text
gitCommitDTOCommitId :: Text
gitCommitDTOCommitId :: Text
gitCommitDTOCommitId
  , Text
gitCommitDTOMessage :: Text
gitCommitDTOMessage :: Text
gitCommitDTOMessage
  , DateTime
gitCommitDTOCommitDate :: DateTime
gitCommitDTOCommitDate :: DateTime
gitCommitDTOCommitDate
  , Text
gitCommitDTOAuthorName :: Text
gitCommitDTOAuthorName :: Text
gitCommitDTOAuthorName
  }

-- ** GitInfoDTO
-- | GitInfoDTO
data GitInfoDTO = GitInfoDTO
    { GitInfoDTO -> Maybe Text
gitInfoDTOCurrentBranch   :: !(Maybe Text) -- ^ "currentBranch"
    -- ^ "remotes"
    , GitInfoDTO -> Maybe [Text]
gitInfoDTORemotes         :: !(Maybe [Text]) -- ^ "remotes"
    -- ^ /Required/ "commit"
    , GitInfoDTO -> GitCommitDTO
gitInfoDTOCommit          :: !(GitCommitDTO) -- ^ /Required/ "commit"
    -- ^ /Required/ "repositoryDirty"
    , GitInfoDTO -> Bool
gitInfoDTORepositoryDirty :: !(Bool) -- ^ /Required/ "repositoryDirty"
    }
    deriving (Int -> GitInfoDTO -> ShowS
[GitInfoDTO] -> ShowS
GitInfoDTO -> FilePath
(Int -> GitInfoDTO -> ShowS)
-> (GitInfoDTO -> FilePath)
-> ([GitInfoDTO] -> ShowS)
-> Show GitInfoDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GitInfoDTO] -> ShowS
$cshowList :: [GitInfoDTO] -> ShowS
show :: GitInfoDTO -> FilePath
$cshow :: GitInfoDTO -> FilePath
showsPrec :: Int -> GitInfoDTO -> ShowS
$cshowsPrec :: Int -> GitInfoDTO -> ShowS
P.Show, GitInfoDTO -> GitInfoDTO -> Bool
(GitInfoDTO -> GitInfoDTO -> Bool)
-> (GitInfoDTO -> GitInfoDTO -> Bool) -> Eq GitInfoDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitInfoDTO -> GitInfoDTO -> Bool
$c/= :: GitInfoDTO -> GitInfoDTO -> Bool
== :: GitInfoDTO -> GitInfoDTO -> Bool
$c== :: GitInfoDTO -> GitInfoDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON GitInfoDTO
instance A.FromJSON GitInfoDTO where
  parseJSON :: Value -> Parser GitInfoDTO
parseJSON = FilePath
-> (Object -> Parser GitInfoDTO) -> Value -> Parser GitInfoDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"GitInfoDTO" ((Object -> Parser GitInfoDTO) -> Value -> Parser GitInfoDTO)
-> (Object -> Parser GitInfoDTO) -> Value -> Parser GitInfoDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe [Text] -> GitCommitDTO -> Bool -> GitInfoDTO
GitInfoDTO
      (Maybe Text -> Maybe [Text] -> GitCommitDTO -> Bool -> GitInfoDTO)
-> Parser (Maybe Text)
-> Parser (Maybe [Text] -> GitCommitDTO -> Bool -> GitInfoDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"currentBranch")
      Parser (Maybe [Text] -> GitCommitDTO -> Bool -> GitInfoDTO)
-> Parser (Maybe [Text])
-> Parser (GitCommitDTO -> Bool -> GitInfoDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"remotes")
      Parser (GitCommitDTO -> Bool -> GitInfoDTO)
-> Parser GitCommitDTO -> Parser (Bool -> GitInfoDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser GitCommitDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"commit")
      Parser (Bool -> GitInfoDTO) -> Parser Bool -> Parser GitInfoDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"repositoryDirty")

-- | ToJSON GitInfoDTO
instance A.ToJSON GitInfoDTO where
  toJSON :: GitInfoDTO -> Value
toJSON GitInfoDTO {Bool
Maybe [Text]
Maybe Text
GitCommitDTO
gitInfoDTORepositoryDirty :: Bool
gitInfoDTOCommit :: GitCommitDTO
gitInfoDTORemotes :: Maybe [Text]
gitInfoDTOCurrentBranch :: Maybe Text
gitInfoDTORepositoryDirty :: GitInfoDTO -> Bool
gitInfoDTOCommit :: GitInfoDTO -> GitCommitDTO
gitInfoDTORemotes :: GitInfoDTO -> Maybe [Text]
gitInfoDTOCurrentBranch :: GitInfoDTO -> Maybe Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"currentBranch" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
gitInfoDTOCurrentBranch
      , Text
"remotes" Text -> Maybe [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Text]
gitInfoDTORemotes
      , Text
"commit" Text -> GitCommitDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GitCommitDTO
gitInfoDTOCommit
      , Text
"repositoryDirty" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
gitInfoDTORepositoryDirty
      ]


-- | Construct a value of type 'GitInfoDTO' (by applying it's required fields, if any)
mkGitInfoDTO
  :: GitCommitDTO -- ^ 'gitInfoDTOCommit'
  -> Bool -- ^ 'gitInfoDTORepositoryDirty'
  -> GitInfoDTO
mkGitInfoDTO :: GitCommitDTO -> Bool -> GitInfoDTO
mkGitInfoDTO GitCommitDTO
gitInfoDTOCommit Bool
gitInfoDTORepositoryDirty =
  GitInfoDTO :: Maybe Text -> Maybe [Text] -> GitCommitDTO -> Bool -> GitInfoDTO
GitInfoDTO
  { gitInfoDTOCurrentBranch :: Maybe Text
gitInfoDTOCurrentBranch = Maybe Text
forall a. Maybe a
Nothing
  , gitInfoDTORemotes :: Maybe [Text]
gitInfoDTORemotes = Maybe [Text]
forall a. Maybe a
Nothing
  , GitCommitDTO
gitInfoDTOCommit :: GitCommitDTO
gitInfoDTOCommit :: GitCommitDTO
gitInfoDTOCommit
  , Bool
gitInfoDTORepositoryDirty :: Bool
gitInfoDTORepositoryDirty :: Bool
gitInfoDTORepositoryDirty
  }

-- ** GlobalConfiguration
-- | GlobalConfiguration
data GlobalConfiguration = GlobalConfiguration
    { GlobalConfiguration -> DateTime
globalConfigurationLicenseExpiration :: !(DateTime) -- ^ /Required/ "licenseExpiration"
    }
    deriving (Int -> GlobalConfiguration -> ShowS
[GlobalConfiguration] -> ShowS
GlobalConfiguration -> FilePath
(Int -> GlobalConfiguration -> ShowS)
-> (GlobalConfiguration -> FilePath)
-> ([GlobalConfiguration] -> ShowS)
-> Show GlobalConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GlobalConfiguration] -> ShowS
$cshowList :: [GlobalConfiguration] -> ShowS
show :: GlobalConfiguration -> FilePath
$cshow :: GlobalConfiguration -> FilePath
showsPrec :: Int -> GlobalConfiguration -> ShowS
$cshowsPrec :: Int -> GlobalConfiguration -> ShowS
P.Show, GlobalConfiguration -> GlobalConfiguration -> Bool
(GlobalConfiguration -> GlobalConfiguration -> Bool)
-> (GlobalConfiguration -> GlobalConfiguration -> Bool)
-> Eq GlobalConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalConfiguration -> GlobalConfiguration -> Bool
$c/= :: GlobalConfiguration -> GlobalConfiguration -> Bool
== :: GlobalConfiguration -> GlobalConfiguration -> Bool
$c== :: GlobalConfiguration -> GlobalConfiguration -> Bool
P.Eq, P.Typeable)

-- | FromJSON GlobalConfiguration
instance A.FromJSON GlobalConfiguration where
  parseJSON :: Value -> Parser GlobalConfiguration
parseJSON = FilePath
-> (Object -> Parser GlobalConfiguration)
-> Value
-> Parser GlobalConfiguration
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"GlobalConfiguration" ((Object -> Parser GlobalConfiguration)
 -> Value -> Parser GlobalConfiguration)
-> (Object -> Parser GlobalConfiguration)
-> Value
-> Parser GlobalConfiguration
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    DateTime -> GlobalConfiguration
GlobalConfiguration
      (DateTime -> GlobalConfiguration)
-> Parser DateTime -> Parser GlobalConfiguration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser DateTime
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"licenseExpiration")

-- | ToJSON GlobalConfiguration
instance A.ToJSON GlobalConfiguration where
  toJSON :: GlobalConfiguration -> Value
toJSON GlobalConfiguration {DateTime
globalConfigurationLicenseExpiration :: DateTime
globalConfigurationLicenseExpiration :: GlobalConfiguration -> DateTime
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"licenseExpiration" Text -> DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DateTime
globalConfigurationLicenseExpiration
      ]


-- | Construct a value of type 'GlobalConfiguration' (by applying it's required fields, if any)
mkGlobalConfiguration
  :: DateTime -- ^ 'globalConfigurationLicenseExpiration'
  -> GlobalConfiguration
mkGlobalConfiguration :: DateTime -> GlobalConfiguration
mkGlobalConfiguration DateTime
globalConfigurationLicenseExpiration =
  GlobalConfiguration :: DateTime -> GlobalConfiguration
GlobalConfiguration
  { DateTime
globalConfigurationLicenseExpiration :: DateTime
globalConfigurationLicenseExpiration :: DateTime
globalConfigurationLicenseExpiration
  }

-- ** InputChannelValues
-- | InputChannelValues
data InputChannelValues = InputChannelValues
    { InputChannelValues -> Text
inputChannelValuesChannelId :: !(Text) -- ^ /Required/ "channelId"
    -- ^ /Required/ "values"
    , InputChannelValues -> [Point]
inputChannelValuesValues    :: !([Point]) -- ^ /Required/ "values"
    }
    deriving (Int -> InputChannelValues -> ShowS
[InputChannelValues] -> ShowS
InputChannelValues -> FilePath
(Int -> InputChannelValues -> ShowS)
-> (InputChannelValues -> FilePath)
-> ([InputChannelValues] -> ShowS)
-> Show InputChannelValues
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InputChannelValues] -> ShowS
$cshowList :: [InputChannelValues] -> ShowS
show :: InputChannelValues -> FilePath
$cshow :: InputChannelValues -> FilePath
showsPrec :: Int -> InputChannelValues -> ShowS
$cshowsPrec :: Int -> InputChannelValues -> ShowS
P.Show, InputChannelValues -> InputChannelValues -> Bool
(InputChannelValues -> InputChannelValues -> Bool)
-> (InputChannelValues -> InputChannelValues -> Bool)
-> Eq InputChannelValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputChannelValues -> InputChannelValues -> Bool
$c/= :: InputChannelValues -> InputChannelValues -> Bool
== :: InputChannelValues -> InputChannelValues -> Bool
$c== :: InputChannelValues -> InputChannelValues -> Bool
P.Eq, P.Typeable)

-- | FromJSON InputChannelValues
instance A.FromJSON InputChannelValues where
  parseJSON :: Value -> Parser InputChannelValues
parseJSON = FilePath
-> (Object -> Parser InputChannelValues)
-> Value
-> Parser InputChannelValues
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"InputChannelValues" ((Object -> Parser InputChannelValues)
 -> Value -> Parser InputChannelValues)
-> (Object -> Parser InputChannelValues)
-> Value
-> Parser InputChannelValues
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> [Point] -> InputChannelValues
InputChannelValues
      (Text -> [Point] -> InputChannelValues)
-> Parser Text -> Parser ([Point] -> InputChannelValues)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelId")
      Parser ([Point] -> InputChannelValues)
-> Parser [Point] -> Parser InputChannelValues
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Point]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"values")

-- | ToJSON InputChannelValues
instance A.ToJSON InputChannelValues where
  toJSON :: InputChannelValues -> Value
toJSON InputChannelValues {[Point]
Text
inputChannelValuesValues :: [Point]
inputChannelValuesChannelId :: Text
inputChannelValuesValues :: InputChannelValues -> [Point]
inputChannelValuesChannelId :: InputChannelValues -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"channelId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
inputChannelValuesChannelId
      , Text
"values" Text -> [Point] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Point]
inputChannelValuesValues
      ]


-- | Construct a value of type 'InputChannelValues' (by applying it's required fields, if any)
mkInputChannelValues
  :: Text -- ^ 'inputChannelValuesChannelId'
  -> [Point] -- ^ 'inputChannelValuesValues'
  -> InputChannelValues
mkInputChannelValues :: Text -> [Point] -> InputChannelValues
mkInputChannelValues Text
inputChannelValuesChannelId [Point]
inputChannelValuesValues =
  InputChannelValues :: Text -> [Point] -> InputChannelValues
InputChannelValues
  { Text
inputChannelValuesChannelId :: Text
inputChannelValuesChannelId :: Text
inputChannelValuesChannelId
  , [Point]
inputChannelValuesValues :: [Point]
inputChannelValuesValues :: [Point]
inputChannelValuesValues
  }

-- ** InputImageDTO
-- | InputImageDTO
data InputImageDTO = InputImageDTO
    { InputImageDTO -> Maybe Text
inputImageDTOName        :: !(Maybe Text) -- ^ "name"
    -- ^ "description"
    , InputImageDTO -> Maybe Text
inputImageDTODescription :: !(Maybe Text) -- ^ "description"
    -- ^ "data"
    , InputImageDTO -> Maybe Text
inputImageDTOData        :: !(Maybe Text) -- ^ "data"
    }
    deriving (Int -> InputImageDTO -> ShowS
[InputImageDTO] -> ShowS
InputImageDTO -> FilePath
(Int -> InputImageDTO -> ShowS)
-> (InputImageDTO -> FilePath)
-> ([InputImageDTO] -> ShowS)
-> Show InputImageDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InputImageDTO] -> ShowS
$cshowList :: [InputImageDTO] -> ShowS
show :: InputImageDTO -> FilePath
$cshow :: InputImageDTO -> FilePath
showsPrec :: Int -> InputImageDTO -> ShowS
$cshowsPrec :: Int -> InputImageDTO -> ShowS
P.Show, InputImageDTO -> InputImageDTO -> Bool
(InputImageDTO -> InputImageDTO -> Bool)
-> (InputImageDTO -> InputImageDTO -> Bool) -> Eq InputImageDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputImageDTO -> InputImageDTO -> Bool
$c/= :: InputImageDTO -> InputImageDTO -> Bool
== :: InputImageDTO -> InputImageDTO -> Bool
$c== :: InputImageDTO -> InputImageDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON InputImageDTO
instance A.FromJSON InputImageDTO where
  parseJSON :: Value -> Parser InputImageDTO
parseJSON = FilePath
-> (Object -> Parser InputImageDTO)
-> Value
-> Parser InputImageDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"InputImageDTO" ((Object -> Parser InputImageDTO) -> Value -> Parser InputImageDTO)
-> (Object -> Parser InputImageDTO)
-> Value
-> Parser InputImageDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> Maybe Text -> InputImageDTO
InputImageDTO
      (Maybe Text -> Maybe Text -> Maybe Text -> InputImageDTO)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> InputImageDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"name")
      Parser (Maybe Text -> Maybe Text -> InputImageDTO)
-> Parser (Maybe Text) -> Parser (Maybe Text -> InputImageDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")
      Parser (Maybe Text -> InputImageDTO)
-> Parser (Maybe Text) -> Parser InputImageDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"data")

-- | ToJSON InputImageDTO
instance A.ToJSON InputImageDTO where
  toJSON :: InputImageDTO -> Value
toJSON InputImageDTO {Maybe Text
inputImageDTOData :: Maybe Text
inputImageDTODescription :: Maybe Text
inputImageDTOName :: Maybe Text
inputImageDTOData :: InputImageDTO -> Maybe Text
inputImageDTODescription :: InputImageDTO -> Maybe Text
inputImageDTOName :: InputImageDTO -> Maybe Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
inputImageDTOName
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
inputImageDTODescription
      , Text
"data" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
inputImageDTOData
      ]


-- | Construct a value of type 'InputImageDTO' (by applying it's required fields, if any)
mkInputImageDTO
  :: InputImageDTO
mkInputImageDTO :: InputImageDTO
mkInputImageDTO =
  InputImageDTO :: Maybe Text -> Maybe Text -> Maybe Text -> InputImageDTO
InputImageDTO
  { inputImageDTOName :: Maybe Text
inputImageDTOName = Maybe Text
forall a. Maybe a
Nothing
  , inputImageDTODescription :: Maybe Text
inputImageDTODescription = Maybe Text
forall a. Maybe a
Nothing
  , inputImageDTOData :: Maybe Text
inputImageDTOData = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** InputMetadata
-- | InputMetadata
data InputMetadata = InputMetadata
    { InputMetadata -> Text
inputMetadataSource      :: !(Text) -- ^ /Required/ "source"
    -- ^ /Required/ "destination"
    , InputMetadata -> Text
inputMetadataDestination :: !(Text) -- ^ /Required/ "destination"
    -- ^ /Required/ "size"
    , InputMetadata -> Integer
inputMetadataSize        :: !(Integer) -- ^ /Required/ "size"
    }
    deriving (Int -> InputMetadata -> ShowS
[InputMetadata] -> ShowS
InputMetadata -> FilePath
(Int -> InputMetadata -> ShowS)
-> (InputMetadata -> FilePath)
-> ([InputMetadata] -> ShowS)
-> Show InputMetadata
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InputMetadata] -> ShowS
$cshowList :: [InputMetadata] -> ShowS
show :: InputMetadata -> FilePath
$cshow :: InputMetadata -> FilePath
showsPrec :: Int -> InputMetadata -> ShowS
$cshowsPrec :: Int -> InputMetadata -> ShowS
P.Show, InputMetadata -> InputMetadata -> Bool
(InputMetadata -> InputMetadata -> Bool)
-> (InputMetadata -> InputMetadata -> Bool) -> Eq InputMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputMetadata -> InputMetadata -> Bool
$c/= :: InputMetadata -> InputMetadata -> Bool
== :: InputMetadata -> InputMetadata -> Bool
$c== :: InputMetadata -> InputMetadata -> Bool
P.Eq, P.Typeable)

-- | FromJSON InputMetadata
instance A.FromJSON InputMetadata where
  parseJSON :: Value -> Parser InputMetadata
parseJSON = FilePath
-> (Object -> Parser InputMetadata)
-> Value
-> Parser InputMetadata
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"InputMetadata" ((Object -> Parser InputMetadata) -> Value -> Parser InputMetadata)
-> (Object -> Parser InputMetadata)
-> Value
-> Parser InputMetadata
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Integer -> InputMetadata
InputMetadata
      (Text -> Text -> Integer -> InputMetadata)
-> Parser Text -> Parser (Text -> Integer -> InputMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"source")
      Parser (Text -> Integer -> InputMetadata)
-> Parser Text -> Parser (Integer -> InputMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"destination")
      Parser (Integer -> InputMetadata)
-> Parser Integer -> Parser InputMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"size")

-- | ToJSON InputMetadata
instance A.ToJSON InputMetadata where
  toJSON :: InputMetadata -> Value
toJSON InputMetadata {Integer
Text
inputMetadataSize :: Integer
inputMetadataDestination :: Text
inputMetadataSource :: Text
inputMetadataSize :: InputMetadata -> Integer
inputMetadataDestination :: InputMetadata -> Text
inputMetadataSource :: InputMetadata -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"source" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
inputMetadataSource
      , Text
"destination" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
inputMetadataDestination
      , Text
"size" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
inputMetadataSize
      ]


-- | Construct a value of type 'InputMetadata' (by applying it's required fields, if any)
mkInputMetadata
  :: Text -- ^ 'inputMetadataSource'
  -> Text -- ^ 'inputMetadataDestination'
  -> Integer -- ^ 'inputMetadataSize'
  -> InputMetadata
mkInputMetadata :: Text -> Text -> Integer -> InputMetadata
mkInputMetadata Text
inputMetadataSource Text
inputMetadataDestination Integer
inputMetadataSize =
  InputMetadata :: Text -> Text -> Integer -> InputMetadata
InputMetadata
  { Text
inputMetadataSource :: Text
inputMetadataSource :: Text
inputMetadataSource
  , Text
inputMetadataDestination :: Text
inputMetadataDestination :: Text
inputMetadataDestination
  , Integer
inputMetadataSize :: Integer
inputMetadataSize :: Integer
inputMetadataSize
  }

-- ** KeyValueProperty
-- | KeyValueProperty
data KeyValueProperty = KeyValueProperty
    { KeyValueProperty -> Text
keyValuePropertyKey   :: !(Text) -- ^ /Required/ "key"
    -- ^ /Required/ "value"
    , KeyValueProperty -> Text
keyValuePropertyValue :: !(Text) -- ^ /Required/ "value"
    }
    deriving (Int -> KeyValueProperty -> ShowS
[KeyValueProperty] -> ShowS
KeyValueProperty -> FilePath
(Int -> KeyValueProperty -> ShowS)
-> (KeyValueProperty -> FilePath)
-> ([KeyValueProperty] -> ShowS)
-> Show KeyValueProperty
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [KeyValueProperty] -> ShowS
$cshowList :: [KeyValueProperty] -> ShowS
show :: KeyValueProperty -> FilePath
$cshow :: KeyValueProperty -> FilePath
showsPrec :: Int -> KeyValueProperty -> ShowS
$cshowsPrec :: Int -> KeyValueProperty -> ShowS
P.Show, KeyValueProperty -> KeyValueProperty -> Bool
(KeyValueProperty -> KeyValueProperty -> Bool)
-> (KeyValueProperty -> KeyValueProperty -> Bool)
-> Eq KeyValueProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyValueProperty -> KeyValueProperty -> Bool
$c/= :: KeyValueProperty -> KeyValueProperty -> Bool
== :: KeyValueProperty -> KeyValueProperty -> Bool
$c== :: KeyValueProperty -> KeyValueProperty -> Bool
P.Eq, P.Typeable)

-- | FromJSON KeyValueProperty
instance A.FromJSON KeyValueProperty where
  parseJSON :: Value -> Parser KeyValueProperty
parseJSON = FilePath
-> (Object -> Parser KeyValueProperty)
-> Value
-> Parser KeyValueProperty
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"KeyValueProperty" ((Object -> Parser KeyValueProperty)
 -> Value -> Parser KeyValueProperty)
-> (Object -> Parser KeyValueProperty)
-> Value
-> Parser KeyValueProperty
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> KeyValueProperty
KeyValueProperty
      (Text -> Text -> KeyValueProperty)
-> Parser Text -> Parser (Text -> KeyValueProperty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"key")
      Parser (Text -> KeyValueProperty)
-> Parser Text -> Parser KeyValueProperty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"value")

-- | ToJSON KeyValueProperty
instance A.ToJSON KeyValueProperty where
  toJSON :: KeyValueProperty -> Value
toJSON KeyValueProperty {Text
keyValuePropertyValue :: Text
keyValuePropertyKey :: Text
keyValuePropertyValue :: KeyValueProperty -> Text
keyValuePropertyKey :: KeyValueProperty -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"key" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
keyValuePropertyKey
      , Text
"value" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
keyValuePropertyValue
      ]


-- | Construct a value of type 'KeyValueProperty' (by applying it's required fields, if any)
mkKeyValueProperty
  :: Text -- ^ 'keyValuePropertyKey'
  -> Text -- ^ 'keyValuePropertyValue'
  -> KeyValueProperty
mkKeyValueProperty :: Text -> Text -> KeyValueProperty
mkKeyValueProperty Text
keyValuePropertyKey Text
keyValuePropertyValue =
  KeyValueProperty :: Text -> Text -> KeyValueProperty
KeyValueProperty
  { Text
keyValuePropertyKey :: Text
keyValuePropertyKey :: Text
keyValuePropertyKey
  , Text
keyValuePropertyValue :: Text
keyValuePropertyValue :: Text
keyValuePropertyValue
  }

-- ** LimitedChannelValuesDTO
-- | LimitedChannelValuesDTO
data LimitedChannelValuesDTO = LimitedChannelValuesDTO
    { LimitedChannelValuesDTO -> Text
limitedChannelValuesDTOChannelId      :: !(Text) -- ^ /Required/ "channelId"
    -- ^ /Required/ "values"
    , LimitedChannelValuesDTO -> [PointValueDTO]
limitedChannelValuesDTOValues         :: !([PointValueDTO]) -- ^ /Required/ "values"
    -- ^ /Required/ "totalItemCount"
    , LimitedChannelValuesDTO -> Int
limitedChannelValuesDTOTotalItemCount :: !(Int) -- ^ /Required/ "totalItemCount"
    }
    deriving (Int -> LimitedChannelValuesDTO -> ShowS
[LimitedChannelValuesDTO] -> ShowS
LimitedChannelValuesDTO -> FilePath
(Int -> LimitedChannelValuesDTO -> ShowS)
-> (LimitedChannelValuesDTO -> FilePath)
-> ([LimitedChannelValuesDTO] -> ShowS)
-> Show LimitedChannelValuesDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LimitedChannelValuesDTO] -> ShowS
$cshowList :: [LimitedChannelValuesDTO] -> ShowS
show :: LimitedChannelValuesDTO -> FilePath
$cshow :: LimitedChannelValuesDTO -> FilePath
showsPrec :: Int -> LimitedChannelValuesDTO -> ShowS
$cshowsPrec :: Int -> LimitedChannelValuesDTO -> ShowS
P.Show, LimitedChannelValuesDTO -> LimitedChannelValuesDTO -> Bool
(LimitedChannelValuesDTO -> LimitedChannelValuesDTO -> Bool)
-> (LimitedChannelValuesDTO -> LimitedChannelValuesDTO -> Bool)
-> Eq LimitedChannelValuesDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LimitedChannelValuesDTO -> LimitedChannelValuesDTO -> Bool
$c/= :: LimitedChannelValuesDTO -> LimitedChannelValuesDTO -> Bool
== :: LimitedChannelValuesDTO -> LimitedChannelValuesDTO -> Bool
$c== :: LimitedChannelValuesDTO -> LimitedChannelValuesDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON LimitedChannelValuesDTO
instance A.FromJSON LimitedChannelValuesDTO where
  parseJSON :: Value -> Parser LimitedChannelValuesDTO
parseJSON = FilePath
-> (Object -> Parser LimitedChannelValuesDTO)
-> Value
-> Parser LimitedChannelValuesDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"LimitedChannelValuesDTO" ((Object -> Parser LimitedChannelValuesDTO)
 -> Value -> Parser LimitedChannelValuesDTO)
-> (Object -> Parser LimitedChannelValuesDTO)
-> Value
-> Parser LimitedChannelValuesDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> [PointValueDTO] -> Int -> LimitedChannelValuesDTO
LimitedChannelValuesDTO
      (Text -> [PointValueDTO] -> Int -> LimitedChannelValuesDTO)
-> Parser Text
-> Parser ([PointValueDTO] -> Int -> LimitedChannelValuesDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channelId")
      Parser ([PointValueDTO] -> Int -> LimitedChannelValuesDTO)
-> Parser [PointValueDTO]
-> Parser (Int -> LimitedChannelValuesDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [PointValueDTO]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"values")
      Parser (Int -> LimitedChannelValuesDTO)
-> Parser Int -> Parser LimitedChannelValuesDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"totalItemCount")

-- | ToJSON LimitedChannelValuesDTO
instance A.ToJSON LimitedChannelValuesDTO where
  toJSON :: LimitedChannelValuesDTO -> Value
toJSON LimitedChannelValuesDTO {Int
[PointValueDTO]
Text
limitedChannelValuesDTOTotalItemCount :: Int
limitedChannelValuesDTOValues :: [PointValueDTO]
limitedChannelValuesDTOChannelId :: Text
limitedChannelValuesDTOTotalItemCount :: LimitedChannelValuesDTO -> Int
limitedChannelValuesDTOValues :: LimitedChannelValuesDTO -> [PointValueDTO]
limitedChannelValuesDTOChannelId :: LimitedChannelValuesDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"channelId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
limitedChannelValuesDTOChannelId
      , Text
"values" Text -> [PointValueDTO] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [PointValueDTO]
limitedChannelValuesDTOValues
      , Text
"totalItemCount" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
limitedChannelValuesDTOTotalItemCount
      ]


-- | Construct a value of type 'LimitedChannelValuesDTO' (by applying it's required fields, if any)
mkLimitedChannelValuesDTO
  :: Text -- ^ 'limitedChannelValuesDTOChannelId'
  -> [PointValueDTO] -- ^ 'limitedChannelValuesDTOValues'
  -> Int -- ^ 'limitedChannelValuesDTOTotalItemCount'
  -> LimitedChannelValuesDTO
mkLimitedChannelValuesDTO :: Text -> [PointValueDTO] -> Int -> LimitedChannelValuesDTO
mkLimitedChannelValuesDTO Text
limitedChannelValuesDTOChannelId [PointValueDTO]
limitedChannelValuesDTOValues Int
limitedChannelValuesDTOTotalItemCount =
  LimitedChannelValuesDTO :: Text -> [PointValueDTO] -> Int -> LimitedChannelValuesDTO
LimitedChannelValuesDTO
  { Text
limitedChannelValuesDTOChannelId :: Text
limitedChannelValuesDTOChannelId :: Text
limitedChannelValuesDTOChannelId
  , [PointValueDTO]
limitedChannelValuesDTOValues :: [PointValueDTO]
limitedChannelValuesDTOValues :: [PointValueDTO]
limitedChannelValuesDTOValues
  , Int
limitedChannelValuesDTOTotalItemCount :: Int
limitedChannelValuesDTOTotalItemCount :: Int
limitedChannelValuesDTOTotalItemCount
  }

-- ** Link
-- | Link
data Link = Link
    { Link -> Text
linkUrl :: !(Text) -- ^ /Required/ "url"
    }
    deriving (Int -> Link -> ShowS
[Link] -> ShowS
Link -> FilePath
(Int -> Link -> ShowS)
-> (Link -> FilePath) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> FilePath
$cshow :: Link -> FilePath
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
P.Show, Link -> Link -> Bool
(Link -> Link -> Bool) -> (Link -> Link -> Bool) -> Eq Link
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: Link -> Link -> Bool
P.Eq, P.Typeable)

-- | FromJSON Link
instance A.FromJSON Link where
  parseJSON :: Value -> Parser Link
parseJSON = FilePath -> (Object -> Parser Link) -> Value -> Parser Link
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Link" ((Object -> Parser Link) -> Value -> Parser Link)
-> (Object -> Parser Link) -> Value -> Parser Link
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Link
Link
      (Text -> Link) -> Parser Text -> Parser Link
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"url")

-- | ToJSON Link
instance A.ToJSON Link where
  toJSON :: Link -> Value
toJSON Link {Text
linkUrl :: Text
linkUrl :: Link -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"url" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
linkUrl
      ]


-- | Construct a value of type 'Link' (by applying it's required fields, if any)
mkLink
  :: Text -- ^ 'linkUrl'
  -> Link
mkLink :: Text -> Link
mkLink Text
linkUrl =
  Link :: Text -> Link
Link
  { Text
linkUrl :: Text
linkUrl :: Text
linkUrl
  }

-- ** LinkDTO
-- | LinkDTO
data LinkDTO = LinkDTO
    { LinkDTO -> Text
linkDTOUrl :: !(Text) -- ^ /Required/ "url"
    }
    deriving (Int -> LinkDTO -> ShowS
[LinkDTO] -> ShowS
LinkDTO -> FilePath
(Int -> LinkDTO -> ShowS)
-> (LinkDTO -> FilePath) -> ([LinkDTO] -> ShowS) -> Show LinkDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LinkDTO] -> ShowS
$cshowList :: [LinkDTO] -> ShowS
show :: LinkDTO -> FilePath
$cshow :: LinkDTO -> FilePath
showsPrec :: Int -> LinkDTO -> ShowS
$cshowsPrec :: Int -> LinkDTO -> ShowS
P.Show, LinkDTO -> LinkDTO -> Bool
(LinkDTO -> LinkDTO -> Bool)
-> (LinkDTO -> LinkDTO -> Bool) -> Eq LinkDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkDTO -> LinkDTO -> Bool
$c/= :: LinkDTO -> LinkDTO -> Bool
== :: LinkDTO -> LinkDTO -> Bool
$c== :: LinkDTO -> LinkDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON LinkDTO
instance A.FromJSON LinkDTO where
  parseJSON :: Value -> Parser LinkDTO
parseJSON = FilePath -> (Object -> Parser LinkDTO) -> Value -> Parser LinkDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"LinkDTO" ((Object -> Parser LinkDTO) -> Value -> Parser LinkDTO)
-> (Object -> Parser LinkDTO) -> Value -> Parser LinkDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> LinkDTO
LinkDTO
      (Text -> LinkDTO) -> Parser Text -> Parser LinkDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"url")

-- | ToJSON LinkDTO
instance A.ToJSON LinkDTO where
  toJSON :: LinkDTO -> Value
toJSON LinkDTO {Text
linkDTOUrl :: Text
linkDTOUrl :: LinkDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"url" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
linkDTOUrl
      ]


-- | Construct a value of type 'LinkDTO' (by applying it's required fields, if any)
mkLinkDTO
  :: Text -- ^ 'linkDTOUrl'
  -> LinkDTO
mkLinkDTO :: Text -> LinkDTO
mkLinkDTO Text
linkDTOUrl =
  LinkDTO :: Text -> LinkDTO
LinkDTO
  { Text
linkDTOUrl :: Text
linkDTOUrl :: Text
linkDTOUrl
  }

-- ** LoginActionsListDTO
-- | LoginActionsListDTO
data LoginActionsListDTO = LoginActionsListDTO
    { LoginActionsListDTO -> [LoginActionDTO]
loginActionsListDTORequiredActions :: !([LoginActionDTO]) -- ^ /Required/ "requiredActions"
    }
    deriving (Int -> LoginActionsListDTO -> ShowS
[LoginActionsListDTO] -> ShowS
LoginActionsListDTO -> FilePath
(Int -> LoginActionsListDTO -> ShowS)
-> (LoginActionsListDTO -> FilePath)
-> ([LoginActionsListDTO] -> ShowS)
-> Show LoginActionsListDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LoginActionsListDTO] -> ShowS
$cshowList :: [LoginActionsListDTO] -> ShowS
show :: LoginActionsListDTO -> FilePath
$cshow :: LoginActionsListDTO -> FilePath
showsPrec :: Int -> LoginActionsListDTO -> ShowS
$cshowsPrec :: Int -> LoginActionsListDTO -> ShowS
P.Show, LoginActionsListDTO -> LoginActionsListDTO -> Bool
(LoginActionsListDTO -> LoginActionsListDTO -> Bool)
-> (LoginActionsListDTO -> LoginActionsListDTO -> Bool)
-> Eq LoginActionsListDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginActionsListDTO -> LoginActionsListDTO -> Bool
$c/= :: LoginActionsListDTO -> LoginActionsListDTO -> Bool
== :: LoginActionsListDTO -> LoginActionsListDTO -> Bool
$c== :: LoginActionsListDTO -> LoginActionsListDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON LoginActionsListDTO
instance A.FromJSON LoginActionsListDTO where
  parseJSON :: Value -> Parser LoginActionsListDTO
parseJSON = FilePath
-> (Object -> Parser LoginActionsListDTO)
-> Value
-> Parser LoginActionsListDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"LoginActionsListDTO" ((Object -> Parser LoginActionsListDTO)
 -> Value -> Parser LoginActionsListDTO)
-> (Object -> Parser LoginActionsListDTO)
-> Value
-> Parser LoginActionsListDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [LoginActionDTO] -> LoginActionsListDTO
LoginActionsListDTO
      ([LoginActionDTO] -> LoginActionsListDTO)
-> Parser [LoginActionDTO] -> Parser LoginActionsListDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [LoginActionDTO]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"requiredActions")

-- | ToJSON LoginActionsListDTO
instance A.ToJSON LoginActionsListDTO where
  toJSON :: LoginActionsListDTO -> Value
toJSON LoginActionsListDTO {[LoginActionDTO]
loginActionsListDTORequiredActions :: [LoginActionDTO]
loginActionsListDTORequiredActions :: LoginActionsListDTO -> [LoginActionDTO]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"requiredActions" Text -> [LoginActionDTO] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [LoginActionDTO]
loginActionsListDTORequiredActions
      ]


-- | Construct a value of type 'LoginActionsListDTO' (by applying it's required fields, if any)
mkLoginActionsListDTO
  :: [LoginActionDTO] -- ^ 'loginActionsListDTORequiredActions'
  -> LoginActionsListDTO
mkLoginActionsListDTO :: [LoginActionDTO] -> LoginActionsListDTO
mkLoginActionsListDTO [LoginActionDTO]
loginActionsListDTORequiredActions =
  LoginActionsListDTO :: [LoginActionDTO] -> LoginActionsListDTO
LoginActionsListDTO
  { [LoginActionDTO]
loginActionsListDTORequiredActions :: [LoginActionDTO]
loginActionsListDTORequiredActions :: [LoginActionDTO]
loginActionsListDTORequiredActions
  }

-- ** NeptuneApiToken
-- | NeptuneApiToken
data NeptuneApiToken = NeptuneApiToken
    { NeptuneApiToken -> Text
neptuneApiTokenToken :: !(Text) -- ^ /Required/ "token"
    }
    deriving (Int -> NeptuneApiToken -> ShowS
[NeptuneApiToken] -> ShowS
NeptuneApiToken -> FilePath
(Int -> NeptuneApiToken -> ShowS)
-> (NeptuneApiToken -> FilePath)
-> ([NeptuneApiToken] -> ShowS)
-> Show NeptuneApiToken
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NeptuneApiToken] -> ShowS
$cshowList :: [NeptuneApiToken] -> ShowS
show :: NeptuneApiToken -> FilePath
$cshow :: NeptuneApiToken -> FilePath
showsPrec :: Int -> NeptuneApiToken -> ShowS
$cshowsPrec :: Int -> NeptuneApiToken -> ShowS
P.Show, NeptuneApiToken -> NeptuneApiToken -> Bool
(NeptuneApiToken -> NeptuneApiToken -> Bool)
-> (NeptuneApiToken -> NeptuneApiToken -> Bool)
-> Eq NeptuneApiToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NeptuneApiToken -> NeptuneApiToken -> Bool
$c/= :: NeptuneApiToken -> NeptuneApiToken -> Bool
== :: NeptuneApiToken -> NeptuneApiToken -> Bool
$c== :: NeptuneApiToken -> NeptuneApiToken -> Bool
P.Eq, P.Typeable)

-- | FromJSON NeptuneApiToken
instance A.FromJSON NeptuneApiToken where
  parseJSON :: Value -> Parser NeptuneApiToken
parseJSON = FilePath
-> (Object -> Parser NeptuneApiToken)
-> Value
-> Parser NeptuneApiToken
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"NeptuneApiToken" ((Object -> Parser NeptuneApiToken)
 -> Value -> Parser NeptuneApiToken)
-> (Object -> Parser NeptuneApiToken)
-> Value
-> Parser NeptuneApiToken
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> NeptuneApiToken
NeptuneApiToken
      (Text -> NeptuneApiToken) -> Parser Text -> Parser NeptuneApiToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"token")

-- | ToJSON NeptuneApiToken
instance A.ToJSON NeptuneApiToken where
  toJSON :: NeptuneApiToken -> Value
toJSON NeptuneApiToken {Text
neptuneApiTokenToken :: Text
neptuneApiTokenToken :: NeptuneApiToken -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"token" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
neptuneApiTokenToken
      ]


-- | Construct a value of type 'NeptuneApiToken' (by applying it's required fields, if any)
mkNeptuneApiToken
  :: Text -- ^ 'neptuneApiTokenToken'
  -> NeptuneApiToken
mkNeptuneApiToken :: Text -> NeptuneApiToken
mkNeptuneApiToken Text
neptuneApiTokenToken =
  NeptuneApiToken :: Text -> NeptuneApiToken
NeptuneApiToken
  { Text
neptuneApiTokenToken :: Text
neptuneApiTokenToken :: Text
neptuneApiTokenToken
  }

-- ** NeptuneOauthToken
-- | NeptuneOauthToken
data NeptuneOauthToken = NeptuneOauthToken
    { NeptuneOauthToken -> Text
neptuneOauthTokenAccessToken  :: !(Text) -- ^ /Required/ "accessToken"
    -- ^ /Required/ "refreshToken"
    , NeptuneOauthToken -> Text
neptuneOauthTokenRefreshToken :: !(Text) -- ^ /Required/ "refreshToken"
    -- ^ /Required/ "username"
    , NeptuneOauthToken -> Text
neptuneOauthTokenUsername     :: !(Text) -- ^ /Required/ "username"
    }
    deriving (Int -> NeptuneOauthToken -> ShowS
[NeptuneOauthToken] -> ShowS
NeptuneOauthToken -> FilePath
(Int -> NeptuneOauthToken -> ShowS)
-> (NeptuneOauthToken -> FilePath)
-> ([NeptuneOauthToken] -> ShowS)
-> Show NeptuneOauthToken
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NeptuneOauthToken] -> ShowS
$cshowList :: [NeptuneOauthToken] -> ShowS
show :: NeptuneOauthToken -> FilePath
$cshow :: NeptuneOauthToken -> FilePath
showsPrec :: Int -> NeptuneOauthToken -> ShowS
$cshowsPrec :: Int -> NeptuneOauthToken -> ShowS
P.Show, NeptuneOauthToken -> NeptuneOauthToken -> Bool
(NeptuneOauthToken -> NeptuneOauthToken -> Bool)
-> (NeptuneOauthToken -> NeptuneOauthToken -> Bool)
-> Eq NeptuneOauthToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NeptuneOauthToken -> NeptuneOauthToken -> Bool
$c/= :: NeptuneOauthToken -> NeptuneOauthToken -> Bool
== :: NeptuneOauthToken -> NeptuneOauthToken -> Bool
$c== :: NeptuneOauthToken -> NeptuneOauthToken -> Bool
P.Eq, P.Typeable)

-- | FromJSON NeptuneOauthToken
instance A.FromJSON NeptuneOauthToken where
  parseJSON :: Value -> Parser NeptuneOauthToken
parseJSON = FilePath
-> (Object -> Parser NeptuneOauthToken)
-> Value
-> Parser NeptuneOauthToken
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"NeptuneOauthToken" ((Object -> Parser NeptuneOauthToken)
 -> Value -> Parser NeptuneOauthToken)
-> (Object -> Parser NeptuneOauthToken)
-> Value
-> Parser NeptuneOauthToken
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Text -> NeptuneOauthToken
NeptuneOauthToken
      (Text -> Text -> Text -> NeptuneOauthToken)
-> Parser Text -> Parser (Text -> Text -> NeptuneOauthToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"accessToken")
      Parser (Text -> Text -> NeptuneOauthToken)
-> Parser Text -> Parser (Text -> NeptuneOauthToken)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"refreshToken")
      Parser (Text -> NeptuneOauthToken)
-> Parser Text -> Parser NeptuneOauthToken
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"username")

-- | ToJSON NeptuneOauthToken
instance A.ToJSON NeptuneOauthToken where
  toJSON :: NeptuneOauthToken -> Value
toJSON NeptuneOauthToken {Text
neptuneOauthTokenUsername :: Text
neptuneOauthTokenRefreshToken :: Text
neptuneOauthTokenAccessToken :: Text
neptuneOauthTokenUsername :: NeptuneOauthToken -> Text
neptuneOauthTokenRefreshToken :: NeptuneOauthToken -> Text
neptuneOauthTokenAccessToken :: NeptuneOauthToken -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"accessToken" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
neptuneOauthTokenAccessToken
      , Text
"refreshToken" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
neptuneOauthTokenRefreshToken
      , Text
"username" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
neptuneOauthTokenUsername
      ]


-- | Construct a value of type 'NeptuneOauthToken' (by applying it's required fields, if any)
mkNeptuneOauthToken
  :: Text -- ^ 'neptuneOauthTokenAccessToken'
  -> Text -- ^ 'neptuneOauthTokenRefreshToken'
  -> Text -- ^ 'neptuneOauthTokenUsername'
  -> NeptuneOauthToken
mkNeptuneOauthToken :: Text -> Text -> Text -> NeptuneOauthToken
mkNeptuneOauthToken Text
neptuneOauthTokenAccessToken Text
neptuneOauthTokenRefreshToken Text
neptuneOauthTokenUsername =
  NeptuneOauthToken :: Text -> Text -> Text -> NeptuneOauthToken
NeptuneOauthToken
  { Text
neptuneOauthTokenAccessToken :: Text
neptuneOauthTokenAccessToken :: Text
neptuneOauthTokenAccessToken
  , Text
neptuneOauthTokenRefreshToken :: Text
neptuneOauthTokenRefreshToken :: Text
neptuneOauthTokenRefreshToken
  , Text
neptuneOauthTokenUsername :: Text
neptuneOauthTokenUsername :: Text
neptuneOauthTokenUsername
  }

-- ** NewOrganizationInvitationDTO
-- | NewOrganizationInvitationDTO
data NewOrganizationInvitationDTO = NewOrganizationInvitationDTO
    { NewOrganizationInvitationDTO -> OrganizationRoleDTO
newOrganizationInvitationDTORoleGrant :: !(OrganizationRoleDTO) -- ^ /Required/ "roleGrant"
    -- ^ /Required/ "addToAllProjects"
    , NewOrganizationInvitationDTO -> Bool
newOrganizationInvitationDTOAddToAllProjects :: !(Bool) -- ^ /Required/ "addToAllProjects"
    -- ^ /Required/ "organizationIdentifier"
    , NewOrganizationInvitationDTO -> Text
newOrganizationInvitationDTOOrganizationIdentifier :: !(Text) -- ^ /Required/ "organizationIdentifier"
    -- ^ /Required/ "invitee"
    , NewOrganizationInvitationDTO -> Text
newOrganizationInvitationDTOInvitee :: !(Text) -- ^ /Required/ "invitee"
    -- ^ /Required/ "invitationType"
    , NewOrganizationInvitationDTO -> InvitationTypeEnumDTO
newOrganizationInvitationDTOInvitationType :: !(InvitationTypeEnumDTO) -- ^ /Required/ "invitationType"
    }
    deriving (Int -> NewOrganizationInvitationDTO -> ShowS
[NewOrganizationInvitationDTO] -> ShowS
NewOrganizationInvitationDTO -> FilePath
(Int -> NewOrganizationInvitationDTO -> ShowS)
-> (NewOrganizationInvitationDTO -> FilePath)
-> ([NewOrganizationInvitationDTO] -> ShowS)
-> Show NewOrganizationInvitationDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewOrganizationInvitationDTO] -> ShowS
$cshowList :: [NewOrganizationInvitationDTO] -> ShowS
show :: NewOrganizationInvitationDTO -> FilePath
$cshow :: NewOrganizationInvitationDTO -> FilePath
showsPrec :: Int -> NewOrganizationInvitationDTO -> ShowS
$cshowsPrec :: Int -> NewOrganizationInvitationDTO -> ShowS
P.Show, NewOrganizationInvitationDTO
-> NewOrganizationInvitationDTO -> Bool
(NewOrganizationInvitationDTO
 -> NewOrganizationInvitationDTO -> Bool)
-> (NewOrganizationInvitationDTO
    -> NewOrganizationInvitationDTO -> Bool)
-> Eq NewOrganizationInvitationDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewOrganizationInvitationDTO
-> NewOrganizationInvitationDTO -> Bool
$c/= :: NewOrganizationInvitationDTO
-> NewOrganizationInvitationDTO -> Bool
== :: NewOrganizationInvitationDTO
-> NewOrganizationInvitationDTO -> Bool
$c== :: NewOrganizationInvitationDTO
-> NewOrganizationInvitationDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON NewOrganizationInvitationDTO
instance A.FromJSON NewOrganizationInvitationDTO where
  parseJSON :: Value -> Parser NewOrganizationInvitationDTO
parseJSON = FilePath
-> (Object -> Parser NewOrganizationInvitationDTO)
-> Value
-> Parser NewOrganizationInvitationDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"NewOrganizationInvitationDTO" ((Object -> Parser NewOrganizationInvitationDTO)
 -> Value -> Parser NewOrganizationInvitationDTO)
-> (Object -> Parser NewOrganizationInvitationDTO)
-> Value
-> Parser NewOrganizationInvitationDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    OrganizationRoleDTO
-> Bool
-> Text
-> Text
-> InvitationTypeEnumDTO
-> NewOrganizationInvitationDTO
NewOrganizationInvitationDTO
      (OrganizationRoleDTO
 -> Bool
 -> Text
 -> Text
 -> InvitationTypeEnumDTO
 -> NewOrganizationInvitationDTO)
-> Parser OrganizationRoleDTO
-> Parser
     (Bool
      -> Text
      -> Text
      -> InvitationTypeEnumDTO
      -> NewOrganizationInvitationDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser OrganizationRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"roleGrant")
      Parser
  (Bool
   -> Text
   -> Text
   -> InvitationTypeEnumDTO
   -> NewOrganizationInvitationDTO)
-> Parser Bool
-> Parser
     (Text
      -> Text -> InvitationTypeEnumDTO -> NewOrganizationInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"addToAllProjects")
      Parser
  (Text
   -> Text -> InvitationTypeEnumDTO -> NewOrganizationInvitationDTO)
-> Parser Text
-> Parser
     (Text -> InvitationTypeEnumDTO -> NewOrganizationInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationIdentifier")
      Parser
  (Text -> InvitationTypeEnumDTO -> NewOrganizationInvitationDTO)
-> Parser Text
-> Parser (InvitationTypeEnumDTO -> NewOrganizationInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitee")
      Parser (InvitationTypeEnumDTO -> NewOrganizationInvitationDTO)
-> Parser InvitationTypeEnumDTO
-> Parser NewOrganizationInvitationDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser InvitationTypeEnumDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitationType")

-- | ToJSON NewOrganizationInvitationDTO
instance A.ToJSON NewOrganizationInvitationDTO where
  toJSON :: NewOrganizationInvitationDTO -> Value
toJSON NewOrganizationInvitationDTO {Bool
Text
OrganizationRoleDTO
InvitationTypeEnumDTO
newOrganizationInvitationDTOInvitationType :: InvitationTypeEnumDTO
newOrganizationInvitationDTOInvitee :: Text
newOrganizationInvitationDTOOrganizationIdentifier :: Text
newOrganizationInvitationDTOAddToAllProjects :: Bool
newOrganizationInvitationDTORoleGrant :: OrganizationRoleDTO
newOrganizationInvitationDTOInvitationType :: NewOrganizationInvitationDTO -> InvitationTypeEnumDTO
newOrganizationInvitationDTOInvitee :: NewOrganizationInvitationDTO -> Text
newOrganizationInvitationDTOOrganizationIdentifier :: NewOrganizationInvitationDTO -> Text
newOrganizationInvitationDTOAddToAllProjects :: NewOrganizationInvitationDTO -> Bool
newOrganizationInvitationDTORoleGrant :: NewOrganizationInvitationDTO -> OrganizationRoleDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"roleGrant" Text -> OrganizationRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationRoleDTO
newOrganizationInvitationDTORoleGrant
      , Text
"addToAllProjects" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
newOrganizationInvitationDTOAddToAllProjects
      , Text
"organizationIdentifier" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newOrganizationInvitationDTOOrganizationIdentifier
      , Text
"invitee" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newOrganizationInvitationDTOInvitee
      , Text
"invitationType" Text -> InvitationTypeEnumDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InvitationTypeEnumDTO
newOrganizationInvitationDTOInvitationType
      ]


-- | Construct a value of type 'NewOrganizationInvitationDTO' (by applying it's required fields, if any)
mkNewOrganizationInvitationDTO
  :: OrganizationRoleDTO -- ^ 'newOrganizationInvitationDTORoleGrant'
  -> Bool -- ^ 'newOrganizationInvitationDTOAddToAllProjects'
  -> Text -- ^ 'newOrganizationInvitationDTOOrganizationIdentifier'
  -> Text -- ^ 'newOrganizationInvitationDTOInvitee'
  -> InvitationTypeEnumDTO -- ^ 'newOrganizationInvitationDTOInvitationType'
  -> NewOrganizationInvitationDTO
mkNewOrganizationInvitationDTO :: OrganizationRoleDTO
-> Bool
-> Text
-> Text
-> InvitationTypeEnumDTO
-> NewOrganizationInvitationDTO
mkNewOrganizationInvitationDTO OrganizationRoleDTO
newOrganizationInvitationDTORoleGrant Bool
newOrganizationInvitationDTOAddToAllProjects Text
newOrganizationInvitationDTOOrganizationIdentifier Text
newOrganizationInvitationDTOInvitee InvitationTypeEnumDTO
newOrganizationInvitationDTOInvitationType =
  NewOrganizationInvitationDTO :: OrganizationRoleDTO
-> Bool
-> Text
-> Text
-> InvitationTypeEnumDTO
-> NewOrganizationInvitationDTO
NewOrganizationInvitationDTO
  { OrganizationRoleDTO
newOrganizationInvitationDTORoleGrant :: OrganizationRoleDTO
newOrganizationInvitationDTORoleGrant :: OrganizationRoleDTO
newOrganizationInvitationDTORoleGrant
  , Bool
newOrganizationInvitationDTOAddToAllProjects :: Bool
newOrganizationInvitationDTOAddToAllProjects :: Bool
newOrganizationInvitationDTOAddToAllProjects
  , Text
newOrganizationInvitationDTOOrganizationIdentifier :: Text
newOrganizationInvitationDTOOrganizationIdentifier :: Text
newOrganizationInvitationDTOOrganizationIdentifier
  , Text
newOrganizationInvitationDTOInvitee :: Text
newOrganizationInvitationDTOInvitee :: Text
newOrganizationInvitationDTOInvitee
  , InvitationTypeEnumDTO
newOrganizationInvitationDTOInvitationType :: InvitationTypeEnumDTO
newOrganizationInvitationDTOInvitationType :: InvitationTypeEnumDTO
newOrganizationInvitationDTOInvitationType
  }

-- ** NewOrganizationMemberDTO
-- | NewOrganizationMemberDTO
data NewOrganizationMemberDTO = NewOrganizationMemberDTO
    { NewOrganizationMemberDTO -> Text
newOrganizationMemberDTOUserId :: !(Text) -- ^ /Required/ "userId"
    -- ^ /Required/ "role"
    , NewOrganizationMemberDTO -> OrganizationRoleDTO
newOrganizationMemberDTORole   :: !(OrganizationRoleDTO) -- ^ /Required/ "role"
    }
    deriving (Int -> NewOrganizationMemberDTO -> ShowS
[NewOrganizationMemberDTO] -> ShowS
NewOrganizationMemberDTO -> FilePath
(Int -> NewOrganizationMemberDTO -> ShowS)
-> (NewOrganizationMemberDTO -> FilePath)
-> ([NewOrganizationMemberDTO] -> ShowS)
-> Show NewOrganizationMemberDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewOrganizationMemberDTO] -> ShowS
$cshowList :: [NewOrganizationMemberDTO] -> ShowS
show :: NewOrganizationMemberDTO -> FilePath
$cshow :: NewOrganizationMemberDTO -> FilePath
showsPrec :: Int -> NewOrganizationMemberDTO -> ShowS
$cshowsPrec :: Int -> NewOrganizationMemberDTO -> ShowS
P.Show, NewOrganizationMemberDTO -> NewOrganizationMemberDTO -> Bool
(NewOrganizationMemberDTO -> NewOrganizationMemberDTO -> Bool)
-> (NewOrganizationMemberDTO -> NewOrganizationMemberDTO -> Bool)
-> Eq NewOrganizationMemberDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewOrganizationMemberDTO -> NewOrganizationMemberDTO -> Bool
$c/= :: NewOrganizationMemberDTO -> NewOrganizationMemberDTO -> Bool
== :: NewOrganizationMemberDTO -> NewOrganizationMemberDTO -> Bool
$c== :: NewOrganizationMemberDTO -> NewOrganizationMemberDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON NewOrganizationMemberDTO
instance A.FromJSON NewOrganizationMemberDTO where
  parseJSON :: Value -> Parser NewOrganizationMemberDTO
parseJSON = FilePath
-> (Object -> Parser NewOrganizationMemberDTO)
-> Value
-> Parser NewOrganizationMemberDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"NewOrganizationMemberDTO" ((Object -> Parser NewOrganizationMemberDTO)
 -> Value -> Parser NewOrganizationMemberDTO)
-> (Object -> Parser NewOrganizationMemberDTO)
-> Value
-> Parser NewOrganizationMemberDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> OrganizationRoleDTO -> NewOrganizationMemberDTO
NewOrganizationMemberDTO
      (Text -> OrganizationRoleDTO -> NewOrganizationMemberDTO)
-> Parser Text
-> Parser (OrganizationRoleDTO -> NewOrganizationMemberDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"userId")
      Parser (OrganizationRoleDTO -> NewOrganizationMemberDTO)
-> Parser OrganizationRoleDTO -> Parser NewOrganizationMemberDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser OrganizationRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"role")

-- | ToJSON NewOrganizationMemberDTO
instance A.ToJSON NewOrganizationMemberDTO where
  toJSON :: NewOrganizationMemberDTO -> Value
toJSON NewOrganizationMemberDTO {Text
OrganizationRoleDTO
newOrganizationMemberDTORole :: OrganizationRoleDTO
newOrganizationMemberDTOUserId :: Text
newOrganizationMemberDTORole :: NewOrganizationMemberDTO -> OrganizationRoleDTO
newOrganizationMemberDTOUserId :: NewOrganizationMemberDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"userId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newOrganizationMemberDTOUserId
      , Text
"role" Text -> OrganizationRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationRoleDTO
newOrganizationMemberDTORole
      ]


-- | Construct a value of type 'NewOrganizationMemberDTO' (by applying it's required fields, if any)
mkNewOrganizationMemberDTO
  :: Text -- ^ 'newOrganizationMemberDTOUserId'
  -> OrganizationRoleDTO -- ^ 'newOrganizationMemberDTORole'
  -> NewOrganizationMemberDTO
mkNewOrganizationMemberDTO :: Text -> OrganizationRoleDTO -> NewOrganizationMemberDTO
mkNewOrganizationMemberDTO Text
newOrganizationMemberDTOUserId OrganizationRoleDTO
newOrganizationMemberDTORole =
  NewOrganizationMemberDTO :: Text -> OrganizationRoleDTO -> NewOrganizationMemberDTO
NewOrganizationMemberDTO
  { Text
newOrganizationMemberDTOUserId :: Text
newOrganizationMemberDTOUserId :: Text
newOrganizationMemberDTOUserId
  , OrganizationRoleDTO
newOrganizationMemberDTORole :: OrganizationRoleDTO
newOrganizationMemberDTORole :: OrganizationRoleDTO
newOrganizationMemberDTORole
  }

-- ** NewProjectDTO
-- | NewProjectDTO
data NewProjectDTO = NewProjectDTO
    { NewProjectDTO -> Text
newProjectDTOName           :: !(Text) -- ^ /Required/ "name"
    -- ^ "description"
    , NewProjectDTO -> Maybe Text
newProjectDTODescription    :: !(Maybe Text) -- ^ "description"
    -- ^ /Required/ "projectKey"
    , NewProjectDTO -> Text
newProjectDTOProjectKey     :: !(Text) -- ^ /Required/ "projectKey"
    -- ^ /Required/ "organizationId"
    , NewProjectDTO -> Text
newProjectDTOOrganizationId :: !(Text) -- ^ /Required/ "organizationId"
    -- ^ "visibility"
    , NewProjectDTO -> Maybe ProjectVisibilityDTO
newProjectDTOVisibility     :: !(Maybe ProjectVisibilityDTO) -- ^ "visibility"
    -- ^ "displayClass"
    , NewProjectDTO -> Maybe Text
newProjectDTODisplayClass   :: !(Maybe Text) -- ^ "displayClass"
    }
    deriving (Int -> NewProjectDTO -> ShowS
[NewProjectDTO] -> ShowS
NewProjectDTO -> FilePath
(Int -> NewProjectDTO -> ShowS)
-> (NewProjectDTO -> FilePath)
-> ([NewProjectDTO] -> ShowS)
-> Show NewProjectDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewProjectDTO] -> ShowS
$cshowList :: [NewProjectDTO] -> ShowS
show :: NewProjectDTO -> FilePath
$cshow :: NewProjectDTO -> FilePath
showsPrec :: Int -> NewProjectDTO -> ShowS
$cshowsPrec :: Int -> NewProjectDTO -> ShowS
P.Show, NewProjectDTO -> NewProjectDTO -> Bool
(NewProjectDTO -> NewProjectDTO -> Bool)
-> (NewProjectDTO -> NewProjectDTO -> Bool) -> Eq NewProjectDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewProjectDTO -> NewProjectDTO -> Bool
$c/= :: NewProjectDTO -> NewProjectDTO -> Bool
== :: NewProjectDTO -> NewProjectDTO -> Bool
$c== :: NewProjectDTO -> NewProjectDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON NewProjectDTO
instance A.FromJSON NewProjectDTO where
  parseJSON :: Value -> Parser NewProjectDTO
parseJSON = FilePath
-> (Object -> Parser NewProjectDTO)
-> Value
-> Parser NewProjectDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"NewProjectDTO" ((Object -> Parser NewProjectDTO) -> Value -> Parser NewProjectDTO)
-> (Object -> Parser NewProjectDTO)
-> Value
-> Parser NewProjectDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe Text
-> Text
-> Text
-> Maybe ProjectVisibilityDTO
-> Maybe Text
-> NewProjectDTO
NewProjectDTO
      (Text
 -> Maybe Text
 -> Text
 -> Text
 -> Maybe ProjectVisibilityDTO
 -> Maybe Text
 -> NewProjectDTO)
-> Parser Text
-> Parser
     (Maybe Text
      -> Text
      -> Text
      -> Maybe ProjectVisibilityDTO
      -> Maybe Text
      -> NewProjectDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (Maybe Text
   -> Text
   -> Text
   -> Maybe ProjectVisibilityDTO
   -> Maybe Text
   -> NewProjectDTO)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Text
      -> Maybe ProjectVisibilityDTO
      -> Maybe Text
      -> NewProjectDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")
      Parser
  (Text
   -> Text
   -> Maybe ProjectVisibilityDTO
   -> Maybe Text
   -> NewProjectDTO)
-> Parser Text
-> Parser
     (Text -> Maybe ProjectVisibilityDTO -> Maybe Text -> NewProjectDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"projectKey")
      Parser
  (Text -> Maybe ProjectVisibilityDTO -> Maybe Text -> NewProjectDTO)
-> Parser Text
-> Parser
     (Maybe ProjectVisibilityDTO -> Maybe Text -> NewProjectDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationId")
      Parser (Maybe ProjectVisibilityDTO -> Maybe Text -> NewProjectDTO)
-> Parser (Maybe ProjectVisibilityDTO)
-> Parser (Maybe Text -> NewProjectDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe ProjectVisibilityDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"visibility")
      Parser (Maybe Text -> NewProjectDTO)
-> Parser (Maybe Text) -> Parser NewProjectDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"displayClass")

-- | ToJSON NewProjectDTO
instance A.ToJSON NewProjectDTO where
  toJSON :: NewProjectDTO -> Value
toJSON NewProjectDTO {Maybe Text
Maybe ProjectVisibilityDTO
Text
newProjectDTODisplayClass :: Maybe Text
newProjectDTOVisibility :: Maybe ProjectVisibilityDTO
newProjectDTOOrganizationId :: Text
newProjectDTOProjectKey :: Text
newProjectDTODescription :: Maybe Text
newProjectDTOName :: Text
newProjectDTODisplayClass :: NewProjectDTO -> Maybe Text
newProjectDTOVisibility :: NewProjectDTO -> Maybe ProjectVisibilityDTO
newProjectDTOOrganizationId :: NewProjectDTO -> Text
newProjectDTOProjectKey :: NewProjectDTO -> Text
newProjectDTODescription :: NewProjectDTO -> Maybe Text
newProjectDTOName :: NewProjectDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newProjectDTOName
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
newProjectDTODescription
      , Text
"projectKey" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newProjectDTOProjectKey
      , Text
"organizationId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newProjectDTOOrganizationId
      , Text
"visibility" Text -> Maybe ProjectVisibilityDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ProjectVisibilityDTO
newProjectDTOVisibility
      , Text
"displayClass" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
newProjectDTODisplayClass
      ]


-- | Construct a value of type 'NewProjectDTO' (by applying it's required fields, if any)
mkNewProjectDTO
  :: Text -- ^ 'newProjectDTOName'
  -> Text -- ^ 'newProjectDTOProjectKey'
  -> Text -- ^ 'newProjectDTOOrganizationId'
  -> NewProjectDTO
mkNewProjectDTO :: Text -> Text -> Text -> NewProjectDTO
mkNewProjectDTO Text
newProjectDTOName Text
newProjectDTOProjectKey Text
newProjectDTOOrganizationId =
  NewProjectDTO :: Text
-> Maybe Text
-> Text
-> Text
-> Maybe ProjectVisibilityDTO
-> Maybe Text
-> NewProjectDTO
NewProjectDTO
  { Text
newProjectDTOName :: Text
newProjectDTOName :: Text
newProjectDTOName
  , newProjectDTODescription :: Maybe Text
newProjectDTODescription = Maybe Text
forall a. Maybe a
Nothing
  , Text
newProjectDTOProjectKey :: Text
newProjectDTOProjectKey :: Text
newProjectDTOProjectKey
  , Text
newProjectDTOOrganizationId :: Text
newProjectDTOOrganizationId :: Text
newProjectDTOOrganizationId
  , newProjectDTOVisibility :: Maybe ProjectVisibilityDTO
newProjectDTOVisibility = Maybe ProjectVisibilityDTO
forall a. Maybe a
Nothing
  , newProjectDTODisplayClass :: Maybe Text
newProjectDTODisplayClass = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** NewProjectInvitationDTO
-- | NewProjectInvitationDTO
data NewProjectInvitationDTO = NewProjectInvitationDTO
    { NewProjectInvitationDTO -> Text
newProjectInvitationDTOProjectIdentifier :: !(Text) -- ^ /Required/ "projectIdentifier"
    -- ^ /Required/ "invitee"
    , NewProjectInvitationDTO -> Text
newProjectInvitationDTOInvitee           :: !(Text) -- ^ /Required/ "invitee"
    -- ^ /Required/ "invitationType"
    , NewProjectInvitationDTO -> InvitationTypeEnumDTO
newProjectInvitationDTOInvitationType    :: !(InvitationTypeEnumDTO) -- ^ /Required/ "invitationType"
    -- ^ /Required/ "roleGrant"
    , NewProjectInvitationDTO -> ProjectRoleDTO
newProjectInvitationDTORoleGrant         :: !(ProjectRoleDTO) -- ^ /Required/ "roleGrant"
    }
    deriving (Int -> NewProjectInvitationDTO -> ShowS
[NewProjectInvitationDTO] -> ShowS
NewProjectInvitationDTO -> FilePath
(Int -> NewProjectInvitationDTO -> ShowS)
-> (NewProjectInvitationDTO -> FilePath)
-> ([NewProjectInvitationDTO] -> ShowS)
-> Show NewProjectInvitationDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewProjectInvitationDTO] -> ShowS
$cshowList :: [NewProjectInvitationDTO] -> ShowS
show :: NewProjectInvitationDTO -> FilePath
$cshow :: NewProjectInvitationDTO -> FilePath
showsPrec :: Int -> NewProjectInvitationDTO -> ShowS
$cshowsPrec :: Int -> NewProjectInvitationDTO -> ShowS
P.Show, NewProjectInvitationDTO -> NewProjectInvitationDTO -> Bool
(NewProjectInvitationDTO -> NewProjectInvitationDTO -> Bool)
-> (NewProjectInvitationDTO -> NewProjectInvitationDTO -> Bool)
-> Eq NewProjectInvitationDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewProjectInvitationDTO -> NewProjectInvitationDTO -> Bool
$c/= :: NewProjectInvitationDTO -> NewProjectInvitationDTO -> Bool
== :: NewProjectInvitationDTO -> NewProjectInvitationDTO -> Bool
$c== :: NewProjectInvitationDTO -> NewProjectInvitationDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON NewProjectInvitationDTO
instance A.FromJSON NewProjectInvitationDTO where
  parseJSON :: Value -> Parser NewProjectInvitationDTO
parseJSON = FilePath
-> (Object -> Parser NewProjectInvitationDTO)
-> Value
-> Parser NewProjectInvitationDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"NewProjectInvitationDTO" ((Object -> Parser NewProjectInvitationDTO)
 -> Value -> Parser NewProjectInvitationDTO)
-> (Object -> Parser NewProjectInvitationDTO)
-> Value
-> Parser NewProjectInvitationDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text
-> InvitationTypeEnumDTO
-> ProjectRoleDTO
-> NewProjectInvitationDTO
NewProjectInvitationDTO
      (Text
 -> Text
 -> InvitationTypeEnumDTO
 -> ProjectRoleDTO
 -> NewProjectInvitationDTO)
-> Parser Text
-> Parser
     (Text
      -> InvitationTypeEnumDTO
      -> ProjectRoleDTO
      -> NewProjectInvitationDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"projectIdentifier")
      Parser
  (Text
   -> InvitationTypeEnumDTO
   -> ProjectRoleDTO
   -> NewProjectInvitationDTO)
-> Parser Text
-> Parser
     (InvitationTypeEnumDTO
      -> ProjectRoleDTO -> NewProjectInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitee")
      Parser
  (InvitationTypeEnumDTO
   -> ProjectRoleDTO -> NewProjectInvitationDTO)
-> Parser InvitationTypeEnumDTO
-> Parser (ProjectRoleDTO -> NewProjectInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser InvitationTypeEnumDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitationType")
      Parser (ProjectRoleDTO -> NewProjectInvitationDTO)
-> Parser ProjectRoleDTO -> Parser NewProjectInvitationDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ProjectRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"roleGrant")

-- | ToJSON NewProjectInvitationDTO
instance A.ToJSON NewProjectInvitationDTO where
  toJSON :: NewProjectInvitationDTO -> Value
toJSON NewProjectInvitationDTO {Text
ProjectRoleDTO
InvitationTypeEnumDTO
newProjectInvitationDTORoleGrant :: ProjectRoleDTO
newProjectInvitationDTOInvitationType :: InvitationTypeEnumDTO
newProjectInvitationDTOInvitee :: Text
newProjectInvitationDTOProjectIdentifier :: Text
newProjectInvitationDTORoleGrant :: NewProjectInvitationDTO -> ProjectRoleDTO
newProjectInvitationDTOInvitationType :: NewProjectInvitationDTO -> InvitationTypeEnumDTO
newProjectInvitationDTOInvitee :: NewProjectInvitationDTO -> Text
newProjectInvitationDTOProjectIdentifier :: NewProjectInvitationDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"projectIdentifier" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newProjectInvitationDTOProjectIdentifier
      , Text
"invitee" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newProjectInvitationDTOInvitee
      , Text
"invitationType" Text -> InvitationTypeEnumDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InvitationTypeEnumDTO
newProjectInvitationDTOInvitationType
      , Text
"roleGrant" Text -> ProjectRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProjectRoleDTO
newProjectInvitationDTORoleGrant
      ]


-- | Construct a value of type 'NewProjectInvitationDTO' (by applying it's required fields, if any)
mkNewProjectInvitationDTO
  :: Text -- ^ 'newProjectInvitationDTOProjectIdentifier'
  -> Text -- ^ 'newProjectInvitationDTOInvitee'
  -> InvitationTypeEnumDTO -- ^ 'newProjectInvitationDTOInvitationType'
  -> ProjectRoleDTO -- ^ 'newProjectInvitationDTORoleGrant'
  -> NewProjectInvitationDTO
mkNewProjectInvitationDTO :: Text
-> Text
-> InvitationTypeEnumDTO
-> ProjectRoleDTO
-> NewProjectInvitationDTO
mkNewProjectInvitationDTO Text
newProjectInvitationDTOProjectIdentifier Text
newProjectInvitationDTOInvitee InvitationTypeEnumDTO
newProjectInvitationDTOInvitationType ProjectRoleDTO
newProjectInvitationDTORoleGrant =
  NewProjectInvitationDTO :: Text
-> Text
-> InvitationTypeEnumDTO
-> ProjectRoleDTO
-> NewProjectInvitationDTO
NewProjectInvitationDTO
  { Text
newProjectInvitationDTOProjectIdentifier :: Text
newProjectInvitationDTOProjectIdentifier :: Text
newProjectInvitationDTOProjectIdentifier
  , Text
newProjectInvitationDTOInvitee :: Text
newProjectInvitationDTOInvitee :: Text
newProjectInvitationDTOInvitee
  , InvitationTypeEnumDTO
newProjectInvitationDTOInvitationType :: InvitationTypeEnumDTO
newProjectInvitationDTOInvitationType :: InvitationTypeEnumDTO
newProjectInvitationDTOInvitationType
  , ProjectRoleDTO
newProjectInvitationDTORoleGrant :: ProjectRoleDTO
newProjectInvitationDTORoleGrant :: ProjectRoleDTO
newProjectInvitationDTORoleGrant
  }

-- ** NewProjectMemberDTO
-- | NewProjectMemberDTO
data NewProjectMemberDTO = NewProjectMemberDTO
    { NewProjectMemberDTO -> Text
newProjectMemberDTOUserId :: !(Text) -- ^ /Required/ "userId"
    -- ^ /Required/ "role"
    , NewProjectMemberDTO -> ProjectRoleDTO
newProjectMemberDTORole   :: !(ProjectRoleDTO) -- ^ /Required/ "role"
    }
    deriving (Int -> NewProjectMemberDTO -> ShowS
[NewProjectMemberDTO] -> ShowS
NewProjectMemberDTO -> FilePath
(Int -> NewProjectMemberDTO -> ShowS)
-> (NewProjectMemberDTO -> FilePath)
-> ([NewProjectMemberDTO] -> ShowS)
-> Show NewProjectMemberDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewProjectMemberDTO] -> ShowS
$cshowList :: [NewProjectMemberDTO] -> ShowS
show :: NewProjectMemberDTO -> FilePath
$cshow :: NewProjectMemberDTO -> FilePath
showsPrec :: Int -> NewProjectMemberDTO -> ShowS
$cshowsPrec :: Int -> NewProjectMemberDTO -> ShowS
P.Show, NewProjectMemberDTO -> NewProjectMemberDTO -> Bool
(NewProjectMemberDTO -> NewProjectMemberDTO -> Bool)
-> (NewProjectMemberDTO -> NewProjectMemberDTO -> Bool)
-> Eq NewProjectMemberDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewProjectMemberDTO -> NewProjectMemberDTO -> Bool
$c/= :: NewProjectMemberDTO -> NewProjectMemberDTO -> Bool
== :: NewProjectMemberDTO -> NewProjectMemberDTO -> Bool
$c== :: NewProjectMemberDTO -> NewProjectMemberDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON NewProjectMemberDTO
instance A.FromJSON NewProjectMemberDTO where
  parseJSON :: Value -> Parser NewProjectMemberDTO
parseJSON = FilePath
-> (Object -> Parser NewProjectMemberDTO)
-> Value
-> Parser NewProjectMemberDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"NewProjectMemberDTO" ((Object -> Parser NewProjectMemberDTO)
 -> Value -> Parser NewProjectMemberDTO)
-> (Object -> Parser NewProjectMemberDTO)
-> Value
-> Parser NewProjectMemberDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> ProjectRoleDTO -> NewProjectMemberDTO
NewProjectMemberDTO
      (Text -> ProjectRoleDTO -> NewProjectMemberDTO)
-> Parser Text -> Parser (ProjectRoleDTO -> NewProjectMemberDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"userId")
      Parser (ProjectRoleDTO -> NewProjectMemberDTO)
-> Parser ProjectRoleDTO -> Parser NewProjectMemberDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ProjectRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"role")

-- | ToJSON NewProjectMemberDTO
instance A.ToJSON NewProjectMemberDTO where
  toJSON :: NewProjectMemberDTO -> Value
toJSON NewProjectMemberDTO {Text
ProjectRoleDTO
newProjectMemberDTORole :: ProjectRoleDTO
newProjectMemberDTOUserId :: Text
newProjectMemberDTORole :: NewProjectMemberDTO -> ProjectRoleDTO
newProjectMemberDTOUserId :: NewProjectMemberDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"userId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newProjectMemberDTOUserId
      , Text
"role" Text -> ProjectRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProjectRoleDTO
newProjectMemberDTORole
      ]


-- | Construct a value of type 'NewProjectMemberDTO' (by applying it's required fields, if any)
mkNewProjectMemberDTO
  :: Text -- ^ 'newProjectMemberDTOUserId'
  -> ProjectRoleDTO -- ^ 'newProjectMemberDTORole'
  -> NewProjectMemberDTO
mkNewProjectMemberDTO :: Text -> ProjectRoleDTO -> NewProjectMemberDTO
mkNewProjectMemberDTO Text
newProjectMemberDTOUserId ProjectRoleDTO
newProjectMemberDTORole =
  NewProjectMemberDTO :: Text -> ProjectRoleDTO -> NewProjectMemberDTO
NewProjectMemberDTO
  { Text
newProjectMemberDTOUserId :: Text
newProjectMemberDTOUserId :: Text
newProjectMemberDTOUserId
  , ProjectRoleDTO
newProjectMemberDTORole :: ProjectRoleDTO
newProjectMemberDTORole :: ProjectRoleDTO
newProjectMemberDTORole
  }

-- ** NewReservationDTO
-- | NewReservationDTO
data NewReservationDTO = NewReservationDTO
    { NewReservationDTO -> Text
newReservationDTOName :: !(Text) -- ^ /Required/ "name"
    }
    deriving (Int -> NewReservationDTO -> ShowS
[NewReservationDTO] -> ShowS
NewReservationDTO -> FilePath
(Int -> NewReservationDTO -> ShowS)
-> (NewReservationDTO -> FilePath)
-> ([NewReservationDTO] -> ShowS)
-> Show NewReservationDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewReservationDTO] -> ShowS
$cshowList :: [NewReservationDTO] -> ShowS
show :: NewReservationDTO -> FilePath
$cshow :: NewReservationDTO -> FilePath
showsPrec :: Int -> NewReservationDTO -> ShowS
$cshowsPrec :: Int -> NewReservationDTO -> ShowS
P.Show, NewReservationDTO -> NewReservationDTO -> Bool
(NewReservationDTO -> NewReservationDTO -> Bool)
-> (NewReservationDTO -> NewReservationDTO -> Bool)
-> Eq NewReservationDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewReservationDTO -> NewReservationDTO -> Bool
$c/= :: NewReservationDTO -> NewReservationDTO -> Bool
== :: NewReservationDTO -> NewReservationDTO -> Bool
$c== :: NewReservationDTO -> NewReservationDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON NewReservationDTO
instance A.FromJSON NewReservationDTO where
  parseJSON :: Value -> Parser NewReservationDTO
parseJSON = FilePath
-> (Object -> Parser NewReservationDTO)
-> Value
-> Parser NewReservationDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"NewReservationDTO" ((Object -> Parser NewReservationDTO)
 -> Value -> Parser NewReservationDTO)
-> (Object -> Parser NewReservationDTO)
-> Value
-> Parser NewReservationDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> NewReservationDTO
NewReservationDTO
      (Text -> NewReservationDTO)
-> Parser Text -> Parser NewReservationDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")

-- | ToJSON NewReservationDTO
instance A.ToJSON NewReservationDTO where
  toJSON :: NewReservationDTO -> Value
toJSON NewReservationDTO {Text
newReservationDTOName :: Text
newReservationDTOName :: NewReservationDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
newReservationDTOName
      ]


-- | Construct a value of type 'NewReservationDTO' (by applying it's required fields, if any)
mkNewReservationDTO
  :: Text -- ^ 'newReservationDTOName'
  -> NewReservationDTO
mkNewReservationDTO :: Text -> NewReservationDTO
mkNewReservationDTO Text
newReservationDTOName =
  NewReservationDTO :: Text -> NewReservationDTO
NewReservationDTO
  { Text
newReservationDTOName :: Text
newReservationDTOName :: Text
newReservationDTOName
  }

-- ** OrganizationCreationParamsDTO
-- | OrganizationCreationParamsDTO
data OrganizationCreationParamsDTO = OrganizationCreationParamsDTO
    { OrganizationCreationParamsDTO -> Text
organizationCreationParamsDTOName             :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "organizationType"
    , OrganizationCreationParamsDTO -> OrganizationTypeDTO
organizationCreationParamsDTOOrganizationType :: !(OrganizationTypeDTO) -- ^ /Required/ "organizationType"
    -- ^ "discountCode"
    , OrganizationCreationParamsDTO -> Maybe DiscountCodeDTO
organizationCreationParamsDTODiscountCode     :: !(Maybe DiscountCodeDTO) -- ^ "discountCode"
    }
    deriving (Int -> OrganizationCreationParamsDTO -> ShowS
[OrganizationCreationParamsDTO] -> ShowS
OrganizationCreationParamsDTO -> FilePath
(Int -> OrganizationCreationParamsDTO -> ShowS)
-> (OrganizationCreationParamsDTO -> FilePath)
-> ([OrganizationCreationParamsDTO] -> ShowS)
-> Show OrganizationCreationParamsDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationCreationParamsDTO] -> ShowS
$cshowList :: [OrganizationCreationParamsDTO] -> ShowS
show :: OrganizationCreationParamsDTO -> FilePath
$cshow :: OrganizationCreationParamsDTO -> FilePath
showsPrec :: Int -> OrganizationCreationParamsDTO -> ShowS
$cshowsPrec :: Int -> OrganizationCreationParamsDTO -> ShowS
P.Show, OrganizationCreationParamsDTO
-> OrganizationCreationParamsDTO -> Bool
(OrganizationCreationParamsDTO
 -> OrganizationCreationParamsDTO -> Bool)
-> (OrganizationCreationParamsDTO
    -> OrganizationCreationParamsDTO -> Bool)
-> Eq OrganizationCreationParamsDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationCreationParamsDTO
-> OrganizationCreationParamsDTO -> Bool
$c/= :: OrganizationCreationParamsDTO
-> OrganizationCreationParamsDTO -> Bool
== :: OrganizationCreationParamsDTO
-> OrganizationCreationParamsDTO -> Bool
$c== :: OrganizationCreationParamsDTO
-> OrganizationCreationParamsDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationCreationParamsDTO
instance A.FromJSON OrganizationCreationParamsDTO where
  parseJSON :: Value -> Parser OrganizationCreationParamsDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationCreationParamsDTO)
-> Value
-> Parser OrganizationCreationParamsDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationCreationParamsDTO" ((Object -> Parser OrganizationCreationParamsDTO)
 -> Value -> Parser OrganizationCreationParamsDTO)
-> (Object -> Parser OrganizationCreationParamsDTO)
-> Value
-> Parser OrganizationCreationParamsDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> OrganizationTypeDTO
-> Maybe DiscountCodeDTO
-> OrganizationCreationParamsDTO
OrganizationCreationParamsDTO
      (Text
 -> OrganizationTypeDTO
 -> Maybe DiscountCodeDTO
 -> OrganizationCreationParamsDTO)
-> Parser Text
-> Parser
     (OrganizationTypeDTO
      -> Maybe DiscountCodeDTO -> OrganizationCreationParamsDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (OrganizationTypeDTO
   -> Maybe DiscountCodeDTO -> OrganizationCreationParamsDTO)
-> Parser OrganizationTypeDTO
-> Parser (Maybe DiscountCodeDTO -> OrganizationCreationParamsDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser OrganizationTypeDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationType")
      Parser (Maybe DiscountCodeDTO -> OrganizationCreationParamsDTO)
-> Parser (Maybe DiscountCodeDTO)
-> Parser OrganizationCreationParamsDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe DiscountCodeDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"discountCode")

-- | ToJSON OrganizationCreationParamsDTO
instance A.ToJSON OrganizationCreationParamsDTO where
  toJSON :: OrganizationCreationParamsDTO -> Value
toJSON OrganizationCreationParamsDTO {Maybe DiscountCodeDTO
Text
OrganizationTypeDTO
organizationCreationParamsDTODiscountCode :: Maybe DiscountCodeDTO
organizationCreationParamsDTOOrganizationType :: OrganizationTypeDTO
organizationCreationParamsDTOName :: Text
organizationCreationParamsDTODiscountCode :: OrganizationCreationParamsDTO -> Maybe DiscountCodeDTO
organizationCreationParamsDTOOrganizationType :: OrganizationCreationParamsDTO -> OrganizationTypeDTO
organizationCreationParamsDTOName :: OrganizationCreationParamsDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationCreationParamsDTOName
      , Text
"organizationType" Text -> OrganizationTypeDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationTypeDTO
organizationCreationParamsDTOOrganizationType
      , Text
"discountCode" Text -> Maybe DiscountCodeDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe DiscountCodeDTO
organizationCreationParamsDTODiscountCode
      ]


-- | Construct a value of type 'OrganizationCreationParamsDTO' (by applying it's required fields, if any)
mkOrganizationCreationParamsDTO
  :: Text -- ^ 'organizationCreationParamsDTOName'
  -> OrganizationTypeDTO -- ^ 'organizationCreationParamsDTOOrganizationType'
  -> OrganizationCreationParamsDTO
mkOrganizationCreationParamsDTO :: Text -> OrganizationTypeDTO -> OrganizationCreationParamsDTO
mkOrganizationCreationParamsDTO Text
organizationCreationParamsDTOName OrganizationTypeDTO
organizationCreationParamsDTOOrganizationType =
  OrganizationCreationParamsDTO :: Text
-> OrganizationTypeDTO
-> Maybe DiscountCodeDTO
-> OrganizationCreationParamsDTO
OrganizationCreationParamsDTO
  { Text
organizationCreationParamsDTOName :: Text
organizationCreationParamsDTOName :: Text
organizationCreationParamsDTOName
  , OrganizationTypeDTO
organizationCreationParamsDTOOrganizationType :: OrganizationTypeDTO
organizationCreationParamsDTOOrganizationType :: OrganizationTypeDTO
organizationCreationParamsDTOOrganizationType
  , organizationCreationParamsDTODiscountCode :: Maybe DiscountCodeDTO
organizationCreationParamsDTODiscountCode = Maybe DiscountCodeDTO
forall a. Maybe a
Nothing
  }

-- ** OrganizationDTO
-- | OrganizationDTO
data OrganizationDTO = OrganizationDTO
    { OrganizationDTO -> Text
organizationDTOName             :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "paymentStatus"
    , OrganizationDTO -> Text
organizationDTOPaymentStatus    :: !(Text) -- ^ /Required/ "paymentStatus"
    -- ^ /Required/ "avatarUrl"
    , OrganizationDTO -> Text
organizationDTOAvatarUrl        :: !(Text) -- ^ /Required/ "avatarUrl"
    -- ^ /Required/ "organizationType"
    , OrganizationDTO -> OrganizationTypeDTO
organizationDTOOrganizationType :: !(OrganizationTypeDTO) -- ^ /Required/ "organizationType"
    -- ^ /Required/ "avatarSource"
    , OrganizationDTO -> AvatarSourceEnum
organizationDTOAvatarSource     :: !(AvatarSourceEnum) -- ^ /Required/ "avatarSource"
    -- ^ "info"
    , OrganizationDTO -> Maybe Text
organizationDTOInfo             :: !(Maybe Text) -- ^ "info"
    -- ^ /Required/ "id"
    , OrganizationDTO -> Text
organizationDTOId               :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "created"
    , OrganizationDTO -> DateTime
organizationDTOCreated          :: !(DateTime) -- ^ /Required/ "created"
    }
    deriving (Int -> OrganizationDTO -> ShowS
[OrganizationDTO] -> ShowS
OrganizationDTO -> FilePath
(Int -> OrganizationDTO -> ShowS)
-> (OrganizationDTO -> FilePath)
-> ([OrganizationDTO] -> ShowS)
-> Show OrganizationDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationDTO] -> ShowS
$cshowList :: [OrganizationDTO] -> ShowS
show :: OrganizationDTO -> FilePath
$cshow :: OrganizationDTO -> FilePath
showsPrec :: Int -> OrganizationDTO -> ShowS
$cshowsPrec :: Int -> OrganizationDTO -> ShowS
P.Show, OrganizationDTO -> OrganizationDTO -> Bool
(OrganizationDTO -> OrganizationDTO -> Bool)
-> (OrganizationDTO -> OrganizationDTO -> Bool)
-> Eq OrganizationDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationDTO -> OrganizationDTO -> Bool
$c/= :: OrganizationDTO -> OrganizationDTO -> Bool
== :: OrganizationDTO -> OrganizationDTO -> Bool
$c== :: OrganizationDTO -> OrganizationDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationDTO
instance A.FromJSON OrganizationDTO where
  parseJSON :: Value -> Parser OrganizationDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationDTO)
-> Value
-> Parser OrganizationDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationDTO" ((Object -> Parser OrganizationDTO)
 -> Value -> Parser OrganizationDTO)
-> (Object -> Parser OrganizationDTO)
-> Value
-> Parser OrganizationDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text
-> Text
-> OrganizationTypeDTO
-> AvatarSourceEnum
-> Maybe Text
-> Text
-> DateTime
-> OrganizationDTO
OrganizationDTO
      (Text
 -> Text
 -> Text
 -> OrganizationTypeDTO
 -> AvatarSourceEnum
 -> Maybe Text
 -> Text
 -> DateTime
 -> OrganizationDTO)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> OrganizationTypeDTO
      -> AvatarSourceEnum
      -> Maybe Text
      -> Text
      -> DateTime
      -> OrganizationDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (Text
   -> Text
   -> OrganizationTypeDTO
   -> AvatarSourceEnum
   -> Maybe Text
   -> Text
   -> DateTime
   -> OrganizationDTO)
-> Parser Text
-> Parser
     (Text
      -> OrganizationTypeDTO
      -> AvatarSourceEnum
      -> Maybe Text
      -> Text
      -> DateTime
      -> OrganizationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"paymentStatus")
      Parser
  (Text
   -> OrganizationTypeDTO
   -> AvatarSourceEnum
   -> Maybe Text
   -> Text
   -> DateTime
   -> OrganizationDTO)
-> Parser Text
-> Parser
     (OrganizationTypeDTO
      -> AvatarSourceEnum
      -> Maybe Text
      -> Text
      -> DateTime
      -> OrganizationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarUrl")
      Parser
  (OrganizationTypeDTO
   -> AvatarSourceEnum
   -> Maybe Text
   -> Text
   -> DateTime
   -> OrganizationDTO)
-> Parser OrganizationTypeDTO
-> Parser
     (AvatarSourceEnum
      -> Maybe Text -> Text -> DateTime -> OrganizationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser OrganizationTypeDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationType")
      Parser
  (AvatarSourceEnum
   -> Maybe Text -> Text -> DateTime -> OrganizationDTO)
-> Parser AvatarSourceEnum
-> Parser (Maybe Text -> Text -> DateTime -> OrganizationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser AvatarSourceEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarSource")
      Parser (Maybe Text -> Text -> DateTime -> OrganizationDTO)
-> Parser (Maybe Text)
-> Parser (Text -> DateTime -> OrganizationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"info")
      Parser (Text -> DateTime -> OrganizationDTO)
-> Parser Text -> Parser (DateTime -> OrganizationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser (DateTime -> OrganizationDTO)
-> Parser DateTime -> Parser OrganizationDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser DateTime
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"created")

-- | ToJSON OrganizationDTO
instance A.ToJSON OrganizationDTO where
  toJSON :: OrganizationDTO -> Value
toJSON OrganizationDTO {Maybe Text
Text
DateTime
OrganizationTypeDTO
AvatarSourceEnum
organizationDTOCreated :: DateTime
organizationDTOId :: Text
organizationDTOInfo :: Maybe Text
organizationDTOAvatarSource :: AvatarSourceEnum
organizationDTOOrganizationType :: OrganizationTypeDTO
organizationDTOAvatarUrl :: Text
organizationDTOPaymentStatus :: Text
organizationDTOName :: Text
organizationDTOCreated :: OrganizationDTO -> DateTime
organizationDTOId :: OrganizationDTO -> Text
organizationDTOInfo :: OrganizationDTO -> Maybe Text
organizationDTOAvatarSource :: OrganizationDTO -> AvatarSourceEnum
organizationDTOOrganizationType :: OrganizationDTO -> OrganizationTypeDTO
organizationDTOAvatarUrl :: OrganizationDTO -> Text
organizationDTOPaymentStatus :: OrganizationDTO -> Text
organizationDTOName :: OrganizationDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationDTOName
      , Text
"paymentStatus" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationDTOPaymentStatus
      , Text
"avatarUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationDTOAvatarUrl
      , Text
"organizationType" Text -> OrganizationTypeDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationTypeDTO
organizationDTOOrganizationType
      , Text
"avatarSource" Text -> AvatarSourceEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AvatarSourceEnum
organizationDTOAvatarSource
      , Text
"info" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
organizationDTOInfo
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationDTOId
      , Text
"created" Text -> DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DateTime
organizationDTOCreated
      ]


-- | Construct a value of type 'OrganizationDTO' (by applying it's required fields, if any)
mkOrganizationDTO
  :: Text -- ^ 'organizationDTOName'
  -> Text -- ^ 'organizationDTOPaymentStatus'
  -> Text -- ^ 'organizationDTOAvatarUrl'
  -> OrganizationTypeDTO -- ^ 'organizationDTOOrganizationType'
  -> AvatarSourceEnum -- ^ 'organizationDTOAvatarSource'
  -> Text -- ^ 'organizationDTOId'
  -> DateTime -- ^ 'organizationDTOCreated'
  -> OrganizationDTO
mkOrganizationDTO :: Text
-> Text
-> Text
-> OrganizationTypeDTO
-> AvatarSourceEnum
-> Text
-> DateTime
-> OrganizationDTO
mkOrganizationDTO Text
organizationDTOName Text
organizationDTOPaymentStatus Text
organizationDTOAvatarUrl OrganizationTypeDTO
organizationDTOOrganizationType AvatarSourceEnum
organizationDTOAvatarSource Text
organizationDTOId DateTime
organizationDTOCreated =
  OrganizationDTO :: Text
-> Text
-> Text
-> OrganizationTypeDTO
-> AvatarSourceEnum
-> Maybe Text
-> Text
-> DateTime
-> OrganizationDTO
OrganizationDTO
  { Text
organizationDTOName :: Text
organizationDTOName :: Text
organizationDTOName
  , Text
organizationDTOPaymentStatus :: Text
organizationDTOPaymentStatus :: Text
organizationDTOPaymentStatus
  , Text
organizationDTOAvatarUrl :: Text
organizationDTOAvatarUrl :: Text
organizationDTOAvatarUrl
  , OrganizationTypeDTO
organizationDTOOrganizationType :: OrganizationTypeDTO
organizationDTOOrganizationType :: OrganizationTypeDTO
organizationDTOOrganizationType
  , AvatarSourceEnum
organizationDTOAvatarSource :: AvatarSourceEnum
organizationDTOAvatarSource :: AvatarSourceEnum
organizationDTOAvatarSource
  , organizationDTOInfo :: Maybe Text
organizationDTOInfo = Maybe Text
forall a. Maybe a
Nothing
  , Text
organizationDTOId :: Text
organizationDTOId :: Text
organizationDTOId
  , DateTime
organizationDTOCreated :: DateTime
organizationDTOCreated :: DateTime
organizationDTOCreated
  }

-- ** OrganizationInvitationDTO
-- | OrganizationInvitationDTO
data OrganizationInvitationDTO = OrganizationInvitationDTO
    { OrganizationInvitationDTO -> OrganizationRoleDTO
organizationInvitationDTORoleGrant        :: !(OrganizationRoleDTO) -- ^ /Required/ "roleGrant"
    -- ^ /Required/ "invitedBy"
    , OrganizationInvitationDTO -> Text
organizationInvitationDTOInvitedBy        :: !(Text) -- ^ /Required/ "invitedBy"
    -- ^ /Required/ "organizationName"
    , OrganizationInvitationDTO -> Text
organizationInvitationDTOOrganizationName :: !(Text) -- ^ /Required/ "organizationName"
    -- ^ /Required/ "id"
    , OrganizationInvitationDTO -> Text
organizationInvitationDTOId               :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "invitee"
    , OrganizationInvitationDTO -> Text
organizationInvitationDTOInvitee          :: !(Text) -- ^ /Required/ "invitee"
    -- ^ /Required/ "status"
    , OrganizationInvitationDTO -> InvitationStatusEnumDTO
organizationInvitationDTOStatus           :: !(InvitationStatusEnumDTO) -- ^ /Required/ "status"
    -- ^ /Required/ "invitationType"
    , OrganizationInvitationDTO -> InvitationTypeEnumDTO
organizationInvitationDTOInvitationType   :: !(InvitationTypeEnumDTO) -- ^ /Required/ "invitationType"
    }
    deriving (Int -> OrganizationInvitationDTO -> ShowS
[OrganizationInvitationDTO] -> ShowS
OrganizationInvitationDTO -> FilePath
(Int -> OrganizationInvitationDTO -> ShowS)
-> (OrganizationInvitationDTO -> FilePath)
-> ([OrganizationInvitationDTO] -> ShowS)
-> Show OrganizationInvitationDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationInvitationDTO] -> ShowS
$cshowList :: [OrganizationInvitationDTO] -> ShowS
show :: OrganizationInvitationDTO -> FilePath
$cshow :: OrganizationInvitationDTO -> FilePath
showsPrec :: Int -> OrganizationInvitationDTO -> ShowS
$cshowsPrec :: Int -> OrganizationInvitationDTO -> ShowS
P.Show, OrganizationInvitationDTO -> OrganizationInvitationDTO -> Bool
(OrganizationInvitationDTO -> OrganizationInvitationDTO -> Bool)
-> (OrganizationInvitationDTO -> OrganizationInvitationDTO -> Bool)
-> Eq OrganizationInvitationDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationInvitationDTO -> OrganizationInvitationDTO -> Bool
$c/= :: OrganizationInvitationDTO -> OrganizationInvitationDTO -> Bool
== :: OrganizationInvitationDTO -> OrganizationInvitationDTO -> Bool
$c== :: OrganizationInvitationDTO -> OrganizationInvitationDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationInvitationDTO
instance A.FromJSON OrganizationInvitationDTO where
  parseJSON :: Value -> Parser OrganizationInvitationDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationInvitationDTO)
-> Value
-> Parser OrganizationInvitationDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationInvitationDTO" ((Object -> Parser OrganizationInvitationDTO)
 -> Value -> Parser OrganizationInvitationDTO)
-> (Object -> Parser OrganizationInvitationDTO)
-> Value
-> Parser OrganizationInvitationDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    OrganizationRoleDTO
-> Text
-> Text
-> Text
-> Text
-> InvitationStatusEnumDTO
-> InvitationTypeEnumDTO
-> OrganizationInvitationDTO
OrganizationInvitationDTO
      (OrganizationRoleDTO
 -> Text
 -> Text
 -> Text
 -> Text
 -> InvitationStatusEnumDTO
 -> InvitationTypeEnumDTO
 -> OrganizationInvitationDTO)
-> Parser OrganizationRoleDTO
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO
      -> OrganizationInvitationDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser OrganizationRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"roleGrant")
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO
   -> OrganizationInvitationDTO)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO
      -> OrganizationInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitedBy")
      Parser
  (Text
   -> Text
   -> Text
   -> InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO
   -> OrganizationInvitationDTO)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO
      -> OrganizationInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationName")
      Parser
  (Text
   -> Text
   -> InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO
   -> OrganizationInvitationDTO)
-> Parser Text
-> Parser
     (Text
      -> InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO
      -> OrganizationInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser
  (Text
   -> InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO
   -> OrganizationInvitationDTO)
-> Parser Text
-> Parser
     (InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO -> OrganizationInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitee")
      Parser
  (InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO -> OrganizationInvitationDTO)
-> Parser InvitationStatusEnumDTO
-> Parser (InvitationTypeEnumDTO -> OrganizationInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser InvitationStatusEnumDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"status")
      Parser (InvitationTypeEnumDTO -> OrganizationInvitationDTO)
-> Parser InvitationTypeEnumDTO -> Parser OrganizationInvitationDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser InvitationTypeEnumDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitationType")

-- | ToJSON OrganizationInvitationDTO
instance A.ToJSON OrganizationInvitationDTO where
  toJSON :: OrganizationInvitationDTO -> Value
toJSON OrganizationInvitationDTO {Text
OrganizationRoleDTO
InvitationTypeEnumDTO
InvitationStatusEnumDTO
organizationInvitationDTOInvitationType :: InvitationTypeEnumDTO
organizationInvitationDTOStatus :: InvitationStatusEnumDTO
organizationInvitationDTOInvitee :: Text
organizationInvitationDTOId :: Text
organizationInvitationDTOOrganizationName :: Text
organizationInvitationDTOInvitedBy :: Text
organizationInvitationDTORoleGrant :: OrganizationRoleDTO
organizationInvitationDTOInvitationType :: OrganizationInvitationDTO -> InvitationTypeEnumDTO
organizationInvitationDTOStatus :: OrganizationInvitationDTO -> InvitationStatusEnumDTO
organizationInvitationDTOInvitee :: OrganizationInvitationDTO -> Text
organizationInvitationDTOId :: OrganizationInvitationDTO -> Text
organizationInvitationDTOOrganizationName :: OrganizationInvitationDTO -> Text
organizationInvitationDTOInvitedBy :: OrganizationInvitationDTO -> Text
organizationInvitationDTORoleGrant :: OrganizationInvitationDTO -> OrganizationRoleDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"roleGrant" Text -> OrganizationRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationRoleDTO
organizationInvitationDTORoleGrant
      , Text
"invitedBy" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationInvitationDTOInvitedBy
      , Text
"organizationName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationInvitationDTOOrganizationName
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationInvitationDTOId
      , Text
"invitee" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationInvitationDTOInvitee
      , Text
"status" Text -> InvitationStatusEnumDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InvitationStatusEnumDTO
organizationInvitationDTOStatus
      , Text
"invitationType" Text -> InvitationTypeEnumDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InvitationTypeEnumDTO
organizationInvitationDTOInvitationType
      ]


-- | Construct a value of type 'OrganizationInvitationDTO' (by applying it's required fields, if any)
mkOrganizationInvitationDTO
  :: OrganizationRoleDTO -- ^ 'organizationInvitationDTORoleGrant'
  -> Text -- ^ 'organizationInvitationDTOInvitedBy'
  -> Text -- ^ 'organizationInvitationDTOOrganizationName'
  -> Text -- ^ 'organizationInvitationDTOId'
  -> Text -- ^ 'organizationInvitationDTOInvitee'
  -> InvitationStatusEnumDTO -- ^ 'organizationInvitationDTOStatus'
  -> InvitationTypeEnumDTO -- ^ 'organizationInvitationDTOInvitationType'
  -> OrganizationInvitationDTO
mkOrganizationInvitationDTO :: OrganizationRoleDTO
-> Text
-> Text
-> Text
-> Text
-> InvitationStatusEnumDTO
-> InvitationTypeEnumDTO
-> OrganizationInvitationDTO
mkOrganizationInvitationDTO OrganizationRoleDTO
organizationInvitationDTORoleGrant Text
organizationInvitationDTOInvitedBy Text
organizationInvitationDTOOrganizationName Text
organizationInvitationDTOId Text
organizationInvitationDTOInvitee InvitationStatusEnumDTO
organizationInvitationDTOStatus InvitationTypeEnumDTO
organizationInvitationDTOInvitationType =
  OrganizationInvitationDTO :: OrganizationRoleDTO
-> Text
-> Text
-> Text
-> Text
-> InvitationStatusEnumDTO
-> InvitationTypeEnumDTO
-> OrganizationInvitationDTO
OrganizationInvitationDTO
  { OrganizationRoleDTO
organizationInvitationDTORoleGrant :: OrganizationRoleDTO
organizationInvitationDTORoleGrant :: OrganizationRoleDTO
organizationInvitationDTORoleGrant
  , Text
organizationInvitationDTOInvitedBy :: Text
organizationInvitationDTOInvitedBy :: Text
organizationInvitationDTOInvitedBy
  , Text
organizationInvitationDTOOrganizationName :: Text
organizationInvitationDTOOrganizationName :: Text
organizationInvitationDTOOrganizationName
  , Text
organizationInvitationDTOId :: Text
organizationInvitationDTOId :: Text
organizationInvitationDTOId
  , Text
organizationInvitationDTOInvitee :: Text
organizationInvitationDTOInvitee :: Text
organizationInvitationDTOInvitee
  , InvitationStatusEnumDTO
organizationInvitationDTOStatus :: InvitationStatusEnumDTO
organizationInvitationDTOStatus :: InvitationStatusEnumDTO
organizationInvitationDTOStatus
  , InvitationTypeEnumDTO
organizationInvitationDTOInvitationType :: InvitationTypeEnumDTO
organizationInvitationDTOInvitationType :: InvitationTypeEnumDTO
organizationInvitationDTOInvitationType
  }

-- ** OrganizationInvitationUpdateDTO
-- | OrganizationInvitationUpdateDTO
data OrganizationInvitationUpdateDTO = OrganizationInvitationUpdateDTO
    { OrganizationInvitationUpdateDTO -> OrganizationRoleDTO
organizationInvitationUpdateDTORoleGrant :: !(OrganizationRoleDTO) -- ^ /Required/ "roleGrant"
    }
    deriving (Int -> OrganizationInvitationUpdateDTO -> ShowS
[OrganizationInvitationUpdateDTO] -> ShowS
OrganizationInvitationUpdateDTO -> FilePath
(Int -> OrganizationInvitationUpdateDTO -> ShowS)
-> (OrganizationInvitationUpdateDTO -> FilePath)
-> ([OrganizationInvitationUpdateDTO] -> ShowS)
-> Show OrganizationInvitationUpdateDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationInvitationUpdateDTO] -> ShowS
$cshowList :: [OrganizationInvitationUpdateDTO] -> ShowS
show :: OrganizationInvitationUpdateDTO -> FilePath
$cshow :: OrganizationInvitationUpdateDTO -> FilePath
showsPrec :: Int -> OrganizationInvitationUpdateDTO -> ShowS
$cshowsPrec :: Int -> OrganizationInvitationUpdateDTO -> ShowS
P.Show, OrganizationInvitationUpdateDTO
-> OrganizationInvitationUpdateDTO -> Bool
(OrganizationInvitationUpdateDTO
 -> OrganizationInvitationUpdateDTO -> Bool)
-> (OrganizationInvitationUpdateDTO
    -> OrganizationInvitationUpdateDTO -> Bool)
-> Eq OrganizationInvitationUpdateDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationInvitationUpdateDTO
-> OrganizationInvitationUpdateDTO -> Bool
$c/= :: OrganizationInvitationUpdateDTO
-> OrganizationInvitationUpdateDTO -> Bool
== :: OrganizationInvitationUpdateDTO
-> OrganizationInvitationUpdateDTO -> Bool
$c== :: OrganizationInvitationUpdateDTO
-> OrganizationInvitationUpdateDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationInvitationUpdateDTO
instance A.FromJSON OrganizationInvitationUpdateDTO where
  parseJSON :: Value -> Parser OrganizationInvitationUpdateDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationInvitationUpdateDTO)
-> Value
-> Parser OrganizationInvitationUpdateDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationInvitationUpdateDTO" ((Object -> Parser OrganizationInvitationUpdateDTO)
 -> Value -> Parser OrganizationInvitationUpdateDTO)
-> (Object -> Parser OrganizationInvitationUpdateDTO)
-> Value
-> Parser OrganizationInvitationUpdateDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    OrganizationRoleDTO -> OrganizationInvitationUpdateDTO
OrganizationInvitationUpdateDTO
      (OrganizationRoleDTO -> OrganizationInvitationUpdateDTO)
-> Parser OrganizationRoleDTO
-> Parser OrganizationInvitationUpdateDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser OrganizationRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"roleGrant")

-- | ToJSON OrganizationInvitationUpdateDTO
instance A.ToJSON OrganizationInvitationUpdateDTO where
  toJSON :: OrganizationInvitationUpdateDTO -> Value
toJSON OrganizationInvitationUpdateDTO {OrganizationRoleDTO
organizationInvitationUpdateDTORoleGrant :: OrganizationRoleDTO
organizationInvitationUpdateDTORoleGrant :: OrganizationInvitationUpdateDTO -> OrganizationRoleDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"roleGrant" Text -> OrganizationRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationRoleDTO
organizationInvitationUpdateDTORoleGrant
      ]


-- | Construct a value of type 'OrganizationInvitationUpdateDTO' (by applying it's required fields, if any)
mkOrganizationInvitationUpdateDTO
  :: OrganizationRoleDTO -- ^ 'organizationInvitationUpdateDTORoleGrant'
  -> OrganizationInvitationUpdateDTO
mkOrganizationInvitationUpdateDTO :: OrganizationRoleDTO -> OrganizationInvitationUpdateDTO
mkOrganizationInvitationUpdateDTO OrganizationRoleDTO
organizationInvitationUpdateDTORoleGrant =
  OrganizationInvitationUpdateDTO :: OrganizationRoleDTO -> OrganizationInvitationUpdateDTO
OrganizationInvitationUpdateDTO
  { OrganizationRoleDTO
organizationInvitationUpdateDTORoleGrant :: OrganizationRoleDTO
organizationInvitationUpdateDTORoleGrant :: OrganizationRoleDTO
organizationInvitationUpdateDTORoleGrant
  }

-- ** OrganizationLimitsDTO
-- | OrganizationLimitsDTO
data OrganizationLimitsDTO = OrganizationLimitsDTO
    { OrganizationLimitsDTO -> Maybe Integer
organizationLimitsDTOStorageSize           :: !(Maybe Integer) -- ^ "storageSize"
    -- ^ "privateProjectMembers"
    , OrganizationLimitsDTO -> Maybe Integer
organizationLimitsDTOPrivateProjectMembers :: !(Maybe Integer) -- ^ "privateProjectMembers"
    -- ^ "projectsLimit"
    , OrganizationLimitsDTO -> Maybe Integer
organizationLimitsDTOProjectsLimit         :: !(Maybe Integer) -- ^ "projectsLimit"
    -- ^ "membersLimit"
    , OrganizationLimitsDTO -> Maybe Integer
organizationLimitsDTOMembersLimit          :: !(Maybe Integer) -- ^ "membersLimit"
    }
    deriving (Int -> OrganizationLimitsDTO -> ShowS
[OrganizationLimitsDTO] -> ShowS
OrganizationLimitsDTO -> FilePath
(Int -> OrganizationLimitsDTO -> ShowS)
-> (OrganizationLimitsDTO -> FilePath)
-> ([OrganizationLimitsDTO] -> ShowS)
-> Show OrganizationLimitsDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationLimitsDTO] -> ShowS
$cshowList :: [OrganizationLimitsDTO] -> ShowS
show :: OrganizationLimitsDTO -> FilePath
$cshow :: OrganizationLimitsDTO -> FilePath
showsPrec :: Int -> OrganizationLimitsDTO -> ShowS
$cshowsPrec :: Int -> OrganizationLimitsDTO -> ShowS
P.Show, OrganizationLimitsDTO -> OrganizationLimitsDTO -> Bool
(OrganizationLimitsDTO -> OrganizationLimitsDTO -> Bool)
-> (OrganizationLimitsDTO -> OrganizationLimitsDTO -> Bool)
-> Eq OrganizationLimitsDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationLimitsDTO -> OrganizationLimitsDTO -> Bool
$c/= :: OrganizationLimitsDTO -> OrganizationLimitsDTO -> Bool
== :: OrganizationLimitsDTO -> OrganizationLimitsDTO -> Bool
$c== :: OrganizationLimitsDTO -> OrganizationLimitsDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationLimitsDTO
instance A.FromJSON OrganizationLimitsDTO where
  parseJSON :: Value -> Parser OrganizationLimitsDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationLimitsDTO)
-> Value
-> Parser OrganizationLimitsDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationLimitsDTO" ((Object -> Parser OrganizationLimitsDTO)
 -> Value -> Parser OrganizationLimitsDTO)
-> (Object -> Parser OrganizationLimitsDTO)
-> Value
-> Parser OrganizationLimitsDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> OrganizationLimitsDTO
OrganizationLimitsDTO
      (Maybe Integer
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Integer
 -> OrganizationLimitsDTO)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Integer -> Maybe Integer -> OrganizationLimitsDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"storageSize")
      Parser
  (Maybe Integer
   -> Maybe Integer -> Maybe Integer -> OrganizationLimitsDTO)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Maybe Integer -> OrganizationLimitsDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"privateProjectMembers")
      Parser (Maybe Integer -> Maybe Integer -> OrganizationLimitsDTO)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> OrganizationLimitsDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"projectsLimit")
      Parser (Maybe Integer -> OrganizationLimitsDTO)
-> Parser (Maybe Integer) -> Parser OrganizationLimitsDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"membersLimit")

-- | ToJSON OrganizationLimitsDTO
instance A.ToJSON OrganizationLimitsDTO where
  toJSON :: OrganizationLimitsDTO -> Value
toJSON OrganizationLimitsDTO {Maybe Integer
organizationLimitsDTOMembersLimit :: Maybe Integer
organizationLimitsDTOProjectsLimit :: Maybe Integer
organizationLimitsDTOPrivateProjectMembers :: Maybe Integer
organizationLimitsDTOStorageSize :: Maybe Integer
organizationLimitsDTOMembersLimit :: OrganizationLimitsDTO -> Maybe Integer
organizationLimitsDTOProjectsLimit :: OrganizationLimitsDTO -> Maybe Integer
organizationLimitsDTOPrivateProjectMembers :: OrganizationLimitsDTO -> Maybe Integer
organizationLimitsDTOStorageSize :: OrganizationLimitsDTO -> Maybe Integer
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"storageSize" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
organizationLimitsDTOStorageSize
      , Text
"privateProjectMembers" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
organizationLimitsDTOPrivateProjectMembers
      , Text
"projectsLimit" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
organizationLimitsDTOProjectsLimit
      , Text
"membersLimit" Text -> Maybe Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
organizationLimitsDTOMembersLimit
      ]


-- | Construct a value of type 'OrganizationLimitsDTO' (by applying it's required fields, if any)
mkOrganizationLimitsDTO
  :: OrganizationLimitsDTO
mkOrganizationLimitsDTO :: OrganizationLimitsDTO
mkOrganizationLimitsDTO =
  OrganizationLimitsDTO :: Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> OrganizationLimitsDTO
OrganizationLimitsDTO
  { organizationLimitsDTOStorageSize :: Maybe Integer
organizationLimitsDTOStorageSize = Maybe Integer
forall a. Maybe a
Nothing
  , organizationLimitsDTOPrivateProjectMembers :: Maybe Integer
organizationLimitsDTOPrivateProjectMembers = Maybe Integer
forall a. Maybe a
Nothing
  , organizationLimitsDTOProjectsLimit :: Maybe Integer
organizationLimitsDTOProjectsLimit = Maybe Integer
forall a. Maybe a
Nothing
  , organizationLimitsDTOMembersLimit :: Maybe Integer
organizationLimitsDTOMembersLimit = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** OrganizationMemberDTO
-- | OrganizationMemberDTO
data OrganizationMemberDTO = OrganizationMemberDTO
    { OrganizationMemberDTO -> OrganizationRoleDTO
organizationMemberDTORole :: !(OrganizationRoleDTO) -- ^ /Required/ "role"
    -- ^ /Required/ "editableRole"
    , OrganizationMemberDTO -> Bool
organizationMemberDTOEditableRole :: !(Bool) -- ^ /Required/ "editableRole"
    -- ^ "registeredMemberInfo"
    , OrganizationMemberDTO -> Maybe RegisteredMemberInfoDTO
organizationMemberDTORegisteredMemberInfo :: !(Maybe RegisteredMemberInfoDTO) -- ^ "registeredMemberInfo"
    -- ^ "invitationInfo"
    , OrganizationMemberDTO -> Maybe OrganizationInvitationDTO
organizationMemberDTOInvitationInfo :: !(Maybe OrganizationInvitationDTO) -- ^ "invitationInfo"
    -- ^ "totalNumberOfProjects"
    , OrganizationMemberDTO -> Maybe Int
organizationMemberDTOTotalNumberOfProjects :: !(Maybe Int) -- ^ "totalNumberOfProjects"
    -- ^ "numberOfProjects"
    , OrganizationMemberDTO -> Maybe Int
organizationMemberDTONumberOfProjects :: !(Maybe Int) -- ^ "numberOfProjects"
    }
    deriving (Int -> OrganizationMemberDTO -> ShowS
[OrganizationMemberDTO] -> ShowS
OrganizationMemberDTO -> FilePath
(Int -> OrganizationMemberDTO -> ShowS)
-> (OrganizationMemberDTO -> FilePath)
-> ([OrganizationMemberDTO] -> ShowS)
-> Show OrganizationMemberDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationMemberDTO] -> ShowS
$cshowList :: [OrganizationMemberDTO] -> ShowS
show :: OrganizationMemberDTO -> FilePath
$cshow :: OrganizationMemberDTO -> FilePath
showsPrec :: Int -> OrganizationMemberDTO -> ShowS
$cshowsPrec :: Int -> OrganizationMemberDTO -> ShowS
P.Show, OrganizationMemberDTO -> OrganizationMemberDTO -> Bool
(OrganizationMemberDTO -> OrganizationMemberDTO -> Bool)
-> (OrganizationMemberDTO -> OrganizationMemberDTO -> Bool)
-> Eq OrganizationMemberDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationMemberDTO -> OrganizationMemberDTO -> Bool
$c/= :: OrganizationMemberDTO -> OrganizationMemberDTO -> Bool
== :: OrganizationMemberDTO -> OrganizationMemberDTO -> Bool
$c== :: OrganizationMemberDTO -> OrganizationMemberDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationMemberDTO
instance A.FromJSON OrganizationMemberDTO where
  parseJSON :: Value -> Parser OrganizationMemberDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationMemberDTO)
-> Value
-> Parser OrganizationMemberDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationMemberDTO" ((Object -> Parser OrganizationMemberDTO)
 -> Value -> Parser OrganizationMemberDTO)
-> (Object -> Parser OrganizationMemberDTO)
-> Value
-> Parser OrganizationMemberDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    OrganizationRoleDTO
-> Bool
-> Maybe RegisteredMemberInfoDTO
-> Maybe OrganizationInvitationDTO
-> Maybe Int
-> Maybe Int
-> OrganizationMemberDTO
OrganizationMemberDTO
      (OrganizationRoleDTO
 -> Bool
 -> Maybe RegisteredMemberInfoDTO
 -> Maybe OrganizationInvitationDTO
 -> Maybe Int
 -> Maybe Int
 -> OrganizationMemberDTO)
-> Parser OrganizationRoleDTO
-> Parser
     (Bool
      -> Maybe RegisteredMemberInfoDTO
      -> Maybe OrganizationInvitationDTO
      -> Maybe Int
      -> Maybe Int
      -> OrganizationMemberDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser OrganizationRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"role")
      Parser
  (Bool
   -> Maybe RegisteredMemberInfoDTO
   -> Maybe OrganizationInvitationDTO
   -> Maybe Int
   -> Maybe Int
   -> OrganizationMemberDTO)
-> Parser Bool
-> Parser
     (Maybe RegisteredMemberInfoDTO
      -> Maybe OrganizationInvitationDTO
      -> Maybe Int
      -> Maybe Int
      -> OrganizationMemberDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"editableRole")
      Parser
  (Maybe RegisteredMemberInfoDTO
   -> Maybe OrganizationInvitationDTO
   -> Maybe Int
   -> Maybe Int
   -> OrganizationMemberDTO)
-> Parser (Maybe RegisteredMemberInfoDTO)
-> Parser
     (Maybe OrganizationInvitationDTO
      -> Maybe Int -> Maybe Int -> OrganizationMemberDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe RegisteredMemberInfoDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"registeredMemberInfo")
      Parser
  (Maybe OrganizationInvitationDTO
   -> Maybe Int -> Maybe Int -> OrganizationMemberDTO)
-> Parser (Maybe OrganizationInvitationDTO)
-> Parser (Maybe Int -> Maybe Int -> OrganizationMemberDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe OrganizationInvitationDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"invitationInfo")
      Parser (Maybe Int -> Maybe Int -> OrganizationMemberDTO)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> OrganizationMemberDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"totalNumberOfProjects")
      Parser (Maybe Int -> OrganizationMemberDTO)
-> Parser (Maybe Int) -> Parser OrganizationMemberDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"numberOfProjects")

-- | ToJSON OrganizationMemberDTO
instance A.ToJSON OrganizationMemberDTO where
  toJSON :: OrganizationMemberDTO -> Value
toJSON OrganizationMemberDTO {Bool
Maybe Int
Maybe RegisteredMemberInfoDTO
Maybe OrganizationInvitationDTO
OrganizationRoleDTO
organizationMemberDTONumberOfProjects :: Maybe Int
organizationMemberDTOTotalNumberOfProjects :: Maybe Int
organizationMemberDTOInvitationInfo :: Maybe OrganizationInvitationDTO
organizationMemberDTORegisteredMemberInfo :: Maybe RegisteredMemberInfoDTO
organizationMemberDTOEditableRole :: Bool
organizationMemberDTORole :: OrganizationRoleDTO
organizationMemberDTONumberOfProjects :: OrganizationMemberDTO -> Maybe Int
organizationMemberDTOTotalNumberOfProjects :: OrganizationMemberDTO -> Maybe Int
organizationMemberDTOInvitationInfo :: OrganizationMemberDTO -> Maybe OrganizationInvitationDTO
organizationMemberDTORegisteredMemberInfo :: OrganizationMemberDTO -> Maybe RegisteredMemberInfoDTO
organizationMemberDTOEditableRole :: OrganizationMemberDTO -> Bool
organizationMemberDTORole :: OrganizationMemberDTO -> OrganizationRoleDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"role" Text -> OrganizationRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationRoleDTO
organizationMemberDTORole
      , Text
"editableRole" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
organizationMemberDTOEditableRole
      , Text
"registeredMemberInfo" Text -> Maybe RegisteredMemberInfoDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe RegisteredMemberInfoDTO
organizationMemberDTORegisteredMemberInfo
      , Text
"invitationInfo" Text -> Maybe OrganizationInvitationDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe OrganizationInvitationDTO
organizationMemberDTOInvitationInfo
      , Text
"totalNumberOfProjects" Text -> Maybe Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Int
organizationMemberDTOTotalNumberOfProjects
      , Text
"numberOfProjects" Text -> Maybe Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Int
organizationMemberDTONumberOfProjects
      ]


-- | Construct a value of type 'OrganizationMemberDTO' (by applying it's required fields, if any)
mkOrganizationMemberDTO
  :: OrganizationRoleDTO -- ^ 'organizationMemberDTORole'
  -> Bool -- ^ 'organizationMemberDTOEditableRole'
  -> OrganizationMemberDTO
mkOrganizationMemberDTO :: OrganizationRoleDTO -> Bool -> OrganizationMemberDTO
mkOrganizationMemberDTO OrganizationRoleDTO
organizationMemberDTORole Bool
organizationMemberDTOEditableRole =
  OrganizationMemberDTO :: OrganizationRoleDTO
-> Bool
-> Maybe RegisteredMemberInfoDTO
-> Maybe OrganizationInvitationDTO
-> Maybe Int
-> Maybe Int
-> OrganizationMemberDTO
OrganizationMemberDTO
  { OrganizationRoleDTO
organizationMemberDTORole :: OrganizationRoleDTO
organizationMemberDTORole :: OrganizationRoleDTO
organizationMemberDTORole
  , Bool
organizationMemberDTOEditableRole :: Bool
organizationMemberDTOEditableRole :: Bool
organizationMemberDTOEditableRole
  , organizationMemberDTORegisteredMemberInfo :: Maybe RegisteredMemberInfoDTO
organizationMemberDTORegisteredMemberInfo = Maybe RegisteredMemberInfoDTO
forall a. Maybe a
Nothing
  , organizationMemberDTOInvitationInfo :: Maybe OrganizationInvitationDTO
organizationMemberDTOInvitationInfo = Maybe OrganizationInvitationDTO
forall a. Maybe a
Nothing
  , organizationMemberDTOTotalNumberOfProjects :: Maybe Int
organizationMemberDTOTotalNumberOfProjects = Maybe Int
forall a. Maybe a
Nothing
  , organizationMemberDTONumberOfProjects :: Maybe Int
organizationMemberDTONumberOfProjects = Maybe Int
forall a. Maybe a
Nothing
  }

-- ** OrganizationMemberUpdateDTO
-- | OrganizationMemberUpdateDTO
data OrganizationMemberUpdateDTO = OrganizationMemberUpdateDTO
    { OrganizationMemberUpdateDTO -> OrganizationRoleDTO
organizationMemberUpdateDTORole :: !(OrganizationRoleDTO) -- ^ /Required/ "role"
    }
    deriving (Int -> OrganizationMemberUpdateDTO -> ShowS
[OrganizationMemberUpdateDTO] -> ShowS
OrganizationMemberUpdateDTO -> FilePath
(Int -> OrganizationMemberUpdateDTO -> ShowS)
-> (OrganizationMemberUpdateDTO -> FilePath)
-> ([OrganizationMemberUpdateDTO] -> ShowS)
-> Show OrganizationMemberUpdateDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationMemberUpdateDTO] -> ShowS
$cshowList :: [OrganizationMemberUpdateDTO] -> ShowS
show :: OrganizationMemberUpdateDTO -> FilePath
$cshow :: OrganizationMemberUpdateDTO -> FilePath
showsPrec :: Int -> OrganizationMemberUpdateDTO -> ShowS
$cshowsPrec :: Int -> OrganizationMemberUpdateDTO -> ShowS
P.Show, OrganizationMemberUpdateDTO -> OrganizationMemberUpdateDTO -> Bool
(OrganizationMemberUpdateDTO
 -> OrganizationMemberUpdateDTO -> Bool)
-> (OrganizationMemberUpdateDTO
    -> OrganizationMemberUpdateDTO -> Bool)
-> Eq OrganizationMemberUpdateDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationMemberUpdateDTO -> OrganizationMemberUpdateDTO -> Bool
$c/= :: OrganizationMemberUpdateDTO -> OrganizationMemberUpdateDTO -> Bool
== :: OrganizationMemberUpdateDTO -> OrganizationMemberUpdateDTO -> Bool
$c== :: OrganizationMemberUpdateDTO -> OrganizationMemberUpdateDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationMemberUpdateDTO
instance A.FromJSON OrganizationMemberUpdateDTO where
  parseJSON :: Value -> Parser OrganizationMemberUpdateDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationMemberUpdateDTO)
-> Value
-> Parser OrganizationMemberUpdateDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationMemberUpdateDTO" ((Object -> Parser OrganizationMemberUpdateDTO)
 -> Value -> Parser OrganizationMemberUpdateDTO)
-> (Object -> Parser OrganizationMemberUpdateDTO)
-> Value
-> Parser OrganizationMemberUpdateDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    OrganizationRoleDTO -> OrganizationMemberUpdateDTO
OrganizationMemberUpdateDTO
      (OrganizationRoleDTO -> OrganizationMemberUpdateDTO)
-> Parser OrganizationRoleDTO -> Parser OrganizationMemberUpdateDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser OrganizationRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"role")

-- | ToJSON OrganizationMemberUpdateDTO
instance A.ToJSON OrganizationMemberUpdateDTO where
  toJSON :: OrganizationMemberUpdateDTO -> Value
toJSON OrganizationMemberUpdateDTO {OrganizationRoleDTO
organizationMemberUpdateDTORole :: OrganizationRoleDTO
organizationMemberUpdateDTORole :: OrganizationMemberUpdateDTO -> OrganizationRoleDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"role" Text -> OrganizationRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationRoleDTO
organizationMemberUpdateDTORole
      ]


-- | Construct a value of type 'OrganizationMemberUpdateDTO' (by applying it's required fields, if any)
mkOrganizationMemberUpdateDTO
  :: OrganizationRoleDTO -- ^ 'organizationMemberUpdateDTORole'
  -> OrganizationMemberUpdateDTO
mkOrganizationMemberUpdateDTO :: OrganizationRoleDTO -> OrganizationMemberUpdateDTO
mkOrganizationMemberUpdateDTO OrganizationRoleDTO
organizationMemberUpdateDTORole =
  OrganizationMemberUpdateDTO :: OrganizationRoleDTO -> OrganizationMemberUpdateDTO
OrganizationMemberUpdateDTO
  { OrganizationRoleDTO
organizationMemberUpdateDTORole :: OrganizationRoleDTO
organizationMemberUpdateDTORole :: OrganizationRoleDTO
organizationMemberUpdateDTORole
  }

-- ** OrganizationNameAvailableDTO
-- | OrganizationNameAvailableDTO
data OrganizationNameAvailableDTO = OrganizationNameAvailableDTO
    { OrganizationNameAvailableDTO -> Bool
organizationNameAvailableDTOAvailable :: !(Bool) -- ^ /Required/ "available"
    }
    deriving (Int -> OrganizationNameAvailableDTO -> ShowS
[OrganizationNameAvailableDTO] -> ShowS
OrganizationNameAvailableDTO -> FilePath
(Int -> OrganizationNameAvailableDTO -> ShowS)
-> (OrganizationNameAvailableDTO -> FilePath)
-> ([OrganizationNameAvailableDTO] -> ShowS)
-> Show OrganizationNameAvailableDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationNameAvailableDTO] -> ShowS
$cshowList :: [OrganizationNameAvailableDTO] -> ShowS
show :: OrganizationNameAvailableDTO -> FilePath
$cshow :: OrganizationNameAvailableDTO -> FilePath
showsPrec :: Int -> OrganizationNameAvailableDTO -> ShowS
$cshowsPrec :: Int -> OrganizationNameAvailableDTO -> ShowS
P.Show, OrganizationNameAvailableDTO
-> OrganizationNameAvailableDTO -> Bool
(OrganizationNameAvailableDTO
 -> OrganizationNameAvailableDTO -> Bool)
-> (OrganizationNameAvailableDTO
    -> OrganizationNameAvailableDTO -> Bool)
-> Eq OrganizationNameAvailableDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationNameAvailableDTO
-> OrganizationNameAvailableDTO -> Bool
$c/= :: OrganizationNameAvailableDTO
-> OrganizationNameAvailableDTO -> Bool
== :: OrganizationNameAvailableDTO
-> OrganizationNameAvailableDTO -> Bool
$c== :: OrganizationNameAvailableDTO
-> OrganizationNameAvailableDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationNameAvailableDTO
instance A.FromJSON OrganizationNameAvailableDTO where
  parseJSON :: Value -> Parser OrganizationNameAvailableDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationNameAvailableDTO)
-> Value
-> Parser OrganizationNameAvailableDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationNameAvailableDTO" ((Object -> Parser OrganizationNameAvailableDTO)
 -> Value -> Parser OrganizationNameAvailableDTO)
-> (Object -> Parser OrganizationNameAvailableDTO)
-> Value
-> Parser OrganizationNameAvailableDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Bool -> OrganizationNameAvailableDTO
OrganizationNameAvailableDTO
      (Bool -> OrganizationNameAvailableDTO)
-> Parser Bool -> Parser OrganizationNameAvailableDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"available")

-- | ToJSON OrganizationNameAvailableDTO
instance A.ToJSON OrganizationNameAvailableDTO where
  toJSON :: OrganizationNameAvailableDTO -> Value
toJSON OrganizationNameAvailableDTO {Bool
organizationNameAvailableDTOAvailable :: Bool
organizationNameAvailableDTOAvailable :: OrganizationNameAvailableDTO -> Bool
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"available" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
organizationNameAvailableDTOAvailable
      ]


-- | Construct a value of type 'OrganizationNameAvailableDTO' (by applying it's required fields, if any)
mkOrganizationNameAvailableDTO
  :: Bool -- ^ 'organizationNameAvailableDTOAvailable'
  -> OrganizationNameAvailableDTO
mkOrganizationNameAvailableDTO :: Bool -> OrganizationNameAvailableDTO
mkOrganizationNameAvailableDTO Bool
organizationNameAvailableDTOAvailable =
  OrganizationNameAvailableDTO :: Bool -> OrganizationNameAvailableDTO
OrganizationNameAvailableDTO
  { Bool
organizationNameAvailableDTOAvailable :: Bool
organizationNameAvailableDTOAvailable :: Bool
organizationNameAvailableDTOAvailable
  }

-- ** OrganizationPricingPlanDTO
-- | OrganizationPricingPlanDTO
data OrganizationPricingPlanDTO = OrganizationPricingPlanDTO
    { OrganizationPricingPlanDTO -> PricingPlanDTO
organizationPricingPlanDTOPricingPlan :: !(PricingPlanDTO) -- ^ /Required/ "pricingPlan"
    }
    deriving (Int -> OrganizationPricingPlanDTO -> ShowS
[OrganizationPricingPlanDTO] -> ShowS
OrganizationPricingPlanDTO -> FilePath
(Int -> OrganizationPricingPlanDTO -> ShowS)
-> (OrganizationPricingPlanDTO -> FilePath)
-> ([OrganizationPricingPlanDTO] -> ShowS)
-> Show OrganizationPricingPlanDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationPricingPlanDTO] -> ShowS
$cshowList :: [OrganizationPricingPlanDTO] -> ShowS
show :: OrganizationPricingPlanDTO -> FilePath
$cshow :: OrganizationPricingPlanDTO -> FilePath
showsPrec :: Int -> OrganizationPricingPlanDTO -> ShowS
$cshowsPrec :: Int -> OrganizationPricingPlanDTO -> ShowS
P.Show, OrganizationPricingPlanDTO -> OrganizationPricingPlanDTO -> Bool
(OrganizationPricingPlanDTO -> OrganizationPricingPlanDTO -> Bool)
-> (OrganizationPricingPlanDTO
    -> OrganizationPricingPlanDTO -> Bool)
-> Eq OrganizationPricingPlanDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationPricingPlanDTO -> OrganizationPricingPlanDTO -> Bool
$c/= :: OrganizationPricingPlanDTO -> OrganizationPricingPlanDTO -> Bool
== :: OrganizationPricingPlanDTO -> OrganizationPricingPlanDTO -> Bool
$c== :: OrganizationPricingPlanDTO -> OrganizationPricingPlanDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationPricingPlanDTO
instance A.FromJSON OrganizationPricingPlanDTO where
  parseJSON :: Value -> Parser OrganizationPricingPlanDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationPricingPlanDTO)
-> Value
-> Parser OrganizationPricingPlanDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationPricingPlanDTO" ((Object -> Parser OrganizationPricingPlanDTO)
 -> Value -> Parser OrganizationPricingPlanDTO)
-> (Object -> Parser OrganizationPricingPlanDTO)
-> Value
-> Parser OrganizationPricingPlanDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    PricingPlanDTO -> OrganizationPricingPlanDTO
OrganizationPricingPlanDTO
      (PricingPlanDTO -> OrganizationPricingPlanDTO)
-> Parser PricingPlanDTO -> Parser OrganizationPricingPlanDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser PricingPlanDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"pricingPlan")

-- | ToJSON OrganizationPricingPlanDTO
instance A.ToJSON OrganizationPricingPlanDTO where
  toJSON :: OrganizationPricingPlanDTO -> Value
toJSON OrganizationPricingPlanDTO {PricingPlanDTO
organizationPricingPlanDTOPricingPlan :: PricingPlanDTO
organizationPricingPlanDTOPricingPlan :: OrganizationPricingPlanDTO -> PricingPlanDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"pricingPlan" Text -> PricingPlanDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PricingPlanDTO
organizationPricingPlanDTOPricingPlan
      ]


-- | Construct a value of type 'OrganizationPricingPlanDTO' (by applying it's required fields, if any)
mkOrganizationPricingPlanDTO
  :: PricingPlanDTO -- ^ 'organizationPricingPlanDTOPricingPlan'
  -> OrganizationPricingPlanDTO
mkOrganizationPricingPlanDTO :: PricingPlanDTO -> OrganizationPricingPlanDTO
mkOrganizationPricingPlanDTO PricingPlanDTO
organizationPricingPlanDTOPricingPlan =
  OrganizationPricingPlanDTO :: PricingPlanDTO -> OrganizationPricingPlanDTO
OrganizationPricingPlanDTO
  { PricingPlanDTO
organizationPricingPlanDTOPricingPlan :: PricingPlanDTO
organizationPricingPlanDTOPricingPlan :: PricingPlanDTO
organizationPricingPlanDTOPricingPlan
  }

-- ** OrganizationUpdateDTO
-- | OrganizationUpdateDTO
data OrganizationUpdateDTO = OrganizationUpdateDTO
    { OrganizationUpdateDTO -> Maybe Text
organizationUpdateDTOName :: !(Maybe Text) -- ^ "name"
    -- ^ "info"
    , OrganizationUpdateDTO -> Maybe Text
organizationUpdateDTOInfo :: !(Maybe Text) -- ^ "info"
    }
    deriving (Int -> OrganizationUpdateDTO -> ShowS
[OrganizationUpdateDTO] -> ShowS
OrganizationUpdateDTO -> FilePath
(Int -> OrganizationUpdateDTO -> ShowS)
-> (OrganizationUpdateDTO -> FilePath)
-> ([OrganizationUpdateDTO] -> ShowS)
-> Show OrganizationUpdateDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationUpdateDTO] -> ShowS
$cshowList :: [OrganizationUpdateDTO] -> ShowS
show :: OrganizationUpdateDTO -> FilePath
$cshow :: OrganizationUpdateDTO -> FilePath
showsPrec :: Int -> OrganizationUpdateDTO -> ShowS
$cshowsPrec :: Int -> OrganizationUpdateDTO -> ShowS
P.Show, OrganizationUpdateDTO -> OrganizationUpdateDTO -> Bool
(OrganizationUpdateDTO -> OrganizationUpdateDTO -> Bool)
-> (OrganizationUpdateDTO -> OrganizationUpdateDTO -> Bool)
-> Eq OrganizationUpdateDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationUpdateDTO -> OrganizationUpdateDTO -> Bool
$c/= :: OrganizationUpdateDTO -> OrganizationUpdateDTO -> Bool
== :: OrganizationUpdateDTO -> OrganizationUpdateDTO -> Bool
$c== :: OrganizationUpdateDTO -> OrganizationUpdateDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationUpdateDTO
instance A.FromJSON OrganizationUpdateDTO where
  parseJSON :: Value -> Parser OrganizationUpdateDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationUpdateDTO)
-> Value
-> Parser OrganizationUpdateDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationUpdateDTO" ((Object -> Parser OrganizationUpdateDTO)
 -> Value -> Parser OrganizationUpdateDTO)
-> (Object -> Parser OrganizationUpdateDTO)
-> Value
-> Parser OrganizationUpdateDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> OrganizationUpdateDTO
OrganizationUpdateDTO
      (Maybe Text -> Maybe Text -> OrganizationUpdateDTO)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> OrganizationUpdateDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"name")
      Parser (Maybe Text -> OrganizationUpdateDTO)
-> Parser (Maybe Text) -> Parser OrganizationUpdateDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"info")

-- | ToJSON OrganizationUpdateDTO
instance A.ToJSON OrganizationUpdateDTO where
  toJSON :: OrganizationUpdateDTO -> Value
toJSON OrganizationUpdateDTO {Maybe Text
organizationUpdateDTOInfo :: Maybe Text
organizationUpdateDTOName :: Maybe Text
organizationUpdateDTOInfo :: OrganizationUpdateDTO -> Maybe Text
organizationUpdateDTOName :: OrganizationUpdateDTO -> Maybe Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
organizationUpdateDTOName
      , Text
"info" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
organizationUpdateDTOInfo
      ]


-- | Construct a value of type 'OrganizationUpdateDTO' (by applying it's required fields, if any)
mkOrganizationUpdateDTO
  :: OrganizationUpdateDTO
mkOrganizationUpdateDTO :: OrganizationUpdateDTO
mkOrganizationUpdateDTO =
  OrganizationUpdateDTO :: Maybe Text -> Maybe Text -> OrganizationUpdateDTO
OrganizationUpdateDTO
  { organizationUpdateDTOName :: Maybe Text
organizationUpdateDTOName = Maybe Text
forall a. Maybe a
Nothing
  , organizationUpdateDTOInfo :: Maybe Text
organizationUpdateDTOInfo = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** OrganizationWithRoleDTO
-- | OrganizationWithRoleDTO
data OrganizationWithRoleDTO = OrganizationWithRoleDTO
    { OrganizationWithRoleDTO -> Text
organizationWithRoleDTOName             :: !(Text) -- ^ /Required/ "name"
    -- ^ "userRole"
    , OrganizationWithRoleDTO -> Maybe OrganizationRoleDTO
organizationWithRoleDTOUserRole         :: !(Maybe OrganizationRoleDTO) -- ^ "userRole"
    -- ^ /Required/ "paymentStatus"
    , OrganizationWithRoleDTO -> Text
organizationWithRoleDTOPaymentStatus    :: !(Text) -- ^ /Required/ "paymentStatus"
    -- ^ /Required/ "avatarUrl"
    , OrganizationWithRoleDTO -> Text
organizationWithRoleDTOAvatarUrl        :: !(Text) -- ^ /Required/ "avatarUrl"
    -- ^ /Required/ "organizationType"
    , OrganizationWithRoleDTO -> OrganizationTypeDTO
organizationWithRoleDTOOrganizationType :: !(OrganizationTypeDTO) -- ^ /Required/ "organizationType"
    -- ^ /Required/ "avatarSource"
    , OrganizationWithRoleDTO -> AvatarSourceEnum
organizationWithRoleDTOAvatarSource     :: !(AvatarSourceEnum) -- ^ /Required/ "avatarSource"
    -- ^ "info"
    , OrganizationWithRoleDTO -> Maybe Text
organizationWithRoleDTOInfo             :: !(Maybe Text) -- ^ "info"
    -- ^ /Required/ "id"
    , OrganizationWithRoleDTO -> Text
organizationWithRoleDTOId               :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "created"
    , OrganizationWithRoleDTO -> DateTime
organizationWithRoleDTOCreated          :: !(DateTime) -- ^ /Required/ "created"
    }
    deriving (Int -> OrganizationWithRoleDTO -> ShowS
[OrganizationWithRoleDTO] -> ShowS
OrganizationWithRoleDTO -> FilePath
(Int -> OrganizationWithRoleDTO -> ShowS)
-> (OrganizationWithRoleDTO -> FilePath)
-> ([OrganizationWithRoleDTO] -> ShowS)
-> Show OrganizationWithRoleDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationWithRoleDTO] -> ShowS
$cshowList :: [OrganizationWithRoleDTO] -> ShowS
show :: OrganizationWithRoleDTO -> FilePath
$cshow :: OrganizationWithRoleDTO -> FilePath
showsPrec :: Int -> OrganizationWithRoleDTO -> ShowS
$cshowsPrec :: Int -> OrganizationWithRoleDTO -> ShowS
P.Show, OrganizationWithRoleDTO -> OrganizationWithRoleDTO -> Bool
(OrganizationWithRoleDTO -> OrganizationWithRoleDTO -> Bool)
-> (OrganizationWithRoleDTO -> OrganizationWithRoleDTO -> Bool)
-> Eq OrganizationWithRoleDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationWithRoleDTO -> OrganizationWithRoleDTO -> Bool
$c/= :: OrganizationWithRoleDTO -> OrganizationWithRoleDTO -> Bool
== :: OrganizationWithRoleDTO -> OrganizationWithRoleDTO -> Bool
$c== :: OrganizationWithRoleDTO -> OrganizationWithRoleDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationWithRoleDTO
instance A.FromJSON OrganizationWithRoleDTO where
  parseJSON :: Value -> Parser OrganizationWithRoleDTO
parseJSON = FilePath
-> (Object -> Parser OrganizationWithRoleDTO)
-> Value
-> Parser OrganizationWithRoleDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OrganizationWithRoleDTO" ((Object -> Parser OrganizationWithRoleDTO)
 -> Value -> Parser OrganizationWithRoleDTO)
-> (Object -> Parser OrganizationWithRoleDTO)
-> Value
-> Parser OrganizationWithRoleDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe OrganizationRoleDTO
-> Text
-> Text
-> OrganizationTypeDTO
-> AvatarSourceEnum
-> Maybe Text
-> Text
-> DateTime
-> OrganizationWithRoleDTO
OrganizationWithRoleDTO
      (Text
 -> Maybe OrganizationRoleDTO
 -> Text
 -> Text
 -> OrganizationTypeDTO
 -> AvatarSourceEnum
 -> Maybe Text
 -> Text
 -> DateTime
 -> OrganizationWithRoleDTO)
-> Parser Text
-> Parser
     (Maybe OrganizationRoleDTO
      -> Text
      -> Text
      -> OrganizationTypeDTO
      -> AvatarSourceEnum
      -> Maybe Text
      -> Text
      -> DateTime
      -> OrganizationWithRoleDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (Maybe OrganizationRoleDTO
   -> Text
   -> Text
   -> OrganizationTypeDTO
   -> AvatarSourceEnum
   -> Maybe Text
   -> Text
   -> DateTime
   -> OrganizationWithRoleDTO)
-> Parser (Maybe OrganizationRoleDTO)
-> Parser
     (Text
      -> Text
      -> OrganizationTypeDTO
      -> AvatarSourceEnum
      -> Maybe Text
      -> Text
      -> DateTime
      -> OrganizationWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe OrganizationRoleDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"userRole")
      Parser
  (Text
   -> Text
   -> OrganizationTypeDTO
   -> AvatarSourceEnum
   -> Maybe Text
   -> Text
   -> DateTime
   -> OrganizationWithRoleDTO)
-> Parser Text
-> Parser
     (Text
      -> OrganizationTypeDTO
      -> AvatarSourceEnum
      -> Maybe Text
      -> Text
      -> DateTime
      -> OrganizationWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"paymentStatus")
      Parser
  (Text
   -> OrganizationTypeDTO
   -> AvatarSourceEnum
   -> Maybe Text
   -> Text
   -> DateTime
   -> OrganizationWithRoleDTO)
-> Parser Text
-> Parser
     (OrganizationTypeDTO
      -> AvatarSourceEnum
      -> Maybe Text
      -> Text
      -> DateTime
      -> OrganizationWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarUrl")
      Parser
  (OrganizationTypeDTO
   -> AvatarSourceEnum
   -> Maybe Text
   -> Text
   -> DateTime
   -> OrganizationWithRoleDTO)
-> Parser OrganizationTypeDTO
-> Parser
     (AvatarSourceEnum
      -> Maybe Text -> Text -> DateTime -> OrganizationWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser OrganizationTypeDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationType")
      Parser
  (AvatarSourceEnum
   -> Maybe Text -> Text -> DateTime -> OrganizationWithRoleDTO)
-> Parser AvatarSourceEnum
-> Parser
     (Maybe Text -> Text -> DateTime -> OrganizationWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser AvatarSourceEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarSource")
      Parser (Maybe Text -> Text -> DateTime -> OrganizationWithRoleDTO)
-> Parser (Maybe Text)
-> Parser (Text -> DateTime -> OrganizationWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"info")
      Parser (Text -> DateTime -> OrganizationWithRoleDTO)
-> Parser Text -> Parser (DateTime -> OrganizationWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser (DateTime -> OrganizationWithRoleDTO)
-> Parser DateTime -> Parser OrganizationWithRoleDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser DateTime
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"created")

-- | ToJSON OrganizationWithRoleDTO
instance A.ToJSON OrganizationWithRoleDTO where
  toJSON :: OrganizationWithRoleDTO -> Value
toJSON OrganizationWithRoleDTO {Maybe Text
Maybe OrganizationRoleDTO
Text
DateTime
OrganizationTypeDTO
AvatarSourceEnum
organizationWithRoleDTOCreated :: DateTime
organizationWithRoleDTOId :: Text
organizationWithRoleDTOInfo :: Maybe Text
organizationWithRoleDTOAvatarSource :: AvatarSourceEnum
organizationWithRoleDTOOrganizationType :: OrganizationTypeDTO
organizationWithRoleDTOAvatarUrl :: Text
organizationWithRoleDTOPaymentStatus :: Text
organizationWithRoleDTOUserRole :: Maybe OrganizationRoleDTO
organizationWithRoleDTOName :: Text
organizationWithRoleDTOCreated :: OrganizationWithRoleDTO -> DateTime
organizationWithRoleDTOId :: OrganizationWithRoleDTO -> Text
organizationWithRoleDTOInfo :: OrganizationWithRoleDTO -> Maybe Text
organizationWithRoleDTOAvatarSource :: OrganizationWithRoleDTO -> AvatarSourceEnum
organizationWithRoleDTOOrganizationType :: OrganizationWithRoleDTO -> OrganizationTypeDTO
organizationWithRoleDTOAvatarUrl :: OrganizationWithRoleDTO -> Text
organizationWithRoleDTOPaymentStatus :: OrganizationWithRoleDTO -> Text
organizationWithRoleDTOUserRole :: OrganizationWithRoleDTO -> Maybe OrganizationRoleDTO
organizationWithRoleDTOName :: OrganizationWithRoleDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationWithRoleDTOName
      , Text
"userRole" Text -> Maybe OrganizationRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe OrganizationRoleDTO
organizationWithRoleDTOUserRole
      , Text
"paymentStatus" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationWithRoleDTOPaymentStatus
      , Text
"avatarUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationWithRoleDTOAvatarUrl
      , Text
"organizationType" Text -> OrganizationTypeDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationTypeDTO
organizationWithRoleDTOOrganizationType
      , Text
"avatarSource" Text -> AvatarSourceEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AvatarSourceEnum
organizationWithRoleDTOAvatarSource
      , Text
"info" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
organizationWithRoleDTOInfo
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
organizationWithRoleDTOId
      , Text
"created" Text -> DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DateTime
organizationWithRoleDTOCreated
      ]


-- | Construct a value of type 'OrganizationWithRoleDTO' (by applying it's required fields, if any)
mkOrganizationWithRoleDTO
  :: Text -- ^ 'organizationWithRoleDTOName'
  -> Text -- ^ 'organizationWithRoleDTOPaymentStatus'
  -> Text -- ^ 'organizationWithRoleDTOAvatarUrl'
  -> OrganizationTypeDTO -- ^ 'organizationWithRoleDTOOrganizationType'
  -> AvatarSourceEnum -- ^ 'organizationWithRoleDTOAvatarSource'
  -> Text -- ^ 'organizationWithRoleDTOId'
  -> DateTime -- ^ 'organizationWithRoleDTOCreated'
  -> OrganizationWithRoleDTO
mkOrganizationWithRoleDTO :: Text
-> Text
-> Text
-> OrganizationTypeDTO
-> AvatarSourceEnum
-> Text
-> DateTime
-> OrganizationWithRoleDTO
mkOrganizationWithRoleDTO Text
organizationWithRoleDTOName Text
organizationWithRoleDTOPaymentStatus Text
organizationWithRoleDTOAvatarUrl OrganizationTypeDTO
organizationWithRoleDTOOrganizationType AvatarSourceEnum
organizationWithRoleDTOAvatarSource Text
organizationWithRoleDTOId DateTime
organizationWithRoleDTOCreated =
  OrganizationWithRoleDTO :: Text
-> Maybe OrganizationRoleDTO
-> Text
-> Text
-> OrganizationTypeDTO
-> AvatarSourceEnum
-> Maybe Text
-> Text
-> DateTime
-> OrganizationWithRoleDTO
OrganizationWithRoleDTO
  { Text
organizationWithRoleDTOName :: Text
organizationWithRoleDTOName :: Text
organizationWithRoleDTOName
  , organizationWithRoleDTOUserRole :: Maybe OrganizationRoleDTO
organizationWithRoleDTOUserRole = Maybe OrganizationRoleDTO
forall a. Maybe a
Nothing
  , Text
organizationWithRoleDTOPaymentStatus :: Text
organizationWithRoleDTOPaymentStatus :: Text
organizationWithRoleDTOPaymentStatus
  , Text
organizationWithRoleDTOAvatarUrl :: Text
organizationWithRoleDTOAvatarUrl :: Text
organizationWithRoleDTOAvatarUrl
  , OrganizationTypeDTO
organizationWithRoleDTOOrganizationType :: OrganizationTypeDTO
organizationWithRoleDTOOrganizationType :: OrganizationTypeDTO
organizationWithRoleDTOOrganizationType
  , AvatarSourceEnum
organizationWithRoleDTOAvatarSource :: AvatarSourceEnum
organizationWithRoleDTOAvatarSource :: AvatarSourceEnum
organizationWithRoleDTOAvatarSource
  , organizationWithRoleDTOInfo :: Maybe Text
organizationWithRoleDTOInfo = Maybe Text
forall a. Maybe a
Nothing
  , Text
organizationWithRoleDTOId :: Text
organizationWithRoleDTOId :: Text
organizationWithRoleDTOId
  , DateTime
organizationWithRoleDTOCreated :: DateTime
organizationWithRoleDTOCreated :: DateTime
organizationWithRoleDTOCreated
  }

-- ** OutputImageDTO
-- | OutputImageDTO
data OutputImageDTO = OutputImageDTO
    { OutputImageDTO -> Maybe Text
outputImageDTOName         :: !(Maybe Text) -- ^ "name"
    -- ^ "description"
    , OutputImageDTO -> Maybe Text
outputImageDTODescription  :: !(Maybe Text) -- ^ "description"
    -- ^ "imageUrl"
    , OutputImageDTO -> Maybe Text
outputImageDTOImageUrl     :: !(Maybe Text) -- ^ "imageUrl"
    -- ^ "thumbnailUrl"
    , OutputImageDTO -> Maybe Text
outputImageDTOThumbnailUrl :: !(Maybe Text) -- ^ "thumbnailUrl"
    }
    deriving (Int -> OutputImageDTO -> ShowS
[OutputImageDTO] -> ShowS
OutputImageDTO -> FilePath
(Int -> OutputImageDTO -> ShowS)
-> (OutputImageDTO -> FilePath)
-> ([OutputImageDTO] -> ShowS)
-> Show OutputImageDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OutputImageDTO] -> ShowS
$cshowList :: [OutputImageDTO] -> ShowS
show :: OutputImageDTO -> FilePath
$cshow :: OutputImageDTO -> FilePath
showsPrec :: Int -> OutputImageDTO -> ShowS
$cshowsPrec :: Int -> OutputImageDTO -> ShowS
P.Show, OutputImageDTO -> OutputImageDTO -> Bool
(OutputImageDTO -> OutputImageDTO -> Bool)
-> (OutputImageDTO -> OutputImageDTO -> Bool) -> Eq OutputImageDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputImageDTO -> OutputImageDTO -> Bool
$c/= :: OutputImageDTO -> OutputImageDTO -> Bool
== :: OutputImageDTO -> OutputImageDTO -> Bool
$c== :: OutputImageDTO -> OutputImageDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON OutputImageDTO
instance A.FromJSON OutputImageDTO where
  parseJSON :: Value -> Parser OutputImageDTO
parseJSON = FilePath
-> (Object -> Parser OutputImageDTO)
-> Value
-> Parser OutputImageDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"OutputImageDTO" ((Object -> Parser OutputImageDTO)
 -> Value -> Parser OutputImageDTO)
-> (Object -> Parser OutputImageDTO)
-> Value
-> Parser OutputImageDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> OutputImageDTO
OutputImageDTO
      (Maybe Text
 -> Maybe Text -> Maybe Text -> Maybe Text -> OutputImageDTO)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> OutputImageDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"name")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> OutputImageDTO)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> OutputImageDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")
      Parser (Maybe Text -> Maybe Text -> OutputImageDTO)
-> Parser (Maybe Text) -> Parser (Maybe Text -> OutputImageDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"imageUrl")
      Parser (Maybe Text -> OutputImageDTO)
-> Parser (Maybe Text) -> Parser OutputImageDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"thumbnailUrl")

-- | ToJSON OutputImageDTO
instance A.ToJSON OutputImageDTO where
  toJSON :: OutputImageDTO -> Value
toJSON OutputImageDTO {Maybe Text
outputImageDTOThumbnailUrl :: Maybe Text
outputImageDTOImageUrl :: Maybe Text
outputImageDTODescription :: Maybe Text
outputImageDTOName :: Maybe Text
outputImageDTOThumbnailUrl :: OutputImageDTO -> Maybe Text
outputImageDTOImageUrl :: OutputImageDTO -> Maybe Text
outputImageDTODescription :: OutputImageDTO -> Maybe Text
outputImageDTOName :: OutputImageDTO -> Maybe Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
outputImageDTOName
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
outputImageDTODescription
      , Text
"imageUrl" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
outputImageDTOImageUrl
      , Text
"thumbnailUrl" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
outputImageDTOThumbnailUrl
      ]


-- | Construct a value of type 'OutputImageDTO' (by applying it's required fields, if any)
mkOutputImageDTO
  :: OutputImageDTO
mkOutputImageDTO :: OutputImageDTO
mkOutputImageDTO =
  OutputImageDTO :: Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> OutputImageDTO
OutputImageDTO
  { outputImageDTOName :: Maybe Text
outputImageDTOName = Maybe Text
forall a. Maybe a
Nothing
  , outputImageDTODescription :: Maybe Text
outputImageDTODescription = Maybe Text
forall a. Maybe a
Nothing
  , outputImageDTOImageUrl :: Maybe Text
outputImageDTOImageUrl = Maybe Text
forall a. Maybe a
Nothing
  , outputImageDTOThumbnailUrl :: Maybe Text
outputImageDTOThumbnailUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Parameter
-- | Parameter
data Parameter = Parameter
    { Parameter -> Text
parameterName          :: !(Text) -- ^ /Required/ "name"
    -- ^ "description"
    , Parameter -> Maybe Text
parameterDescription   :: !(Maybe Text) -- ^ "description"
    -- ^ /Required/ "parameterType"
    , Parameter -> ParameterTypeEnum
parameterParameterType :: !(ParameterTypeEnum) -- ^ /Required/ "parameterType"
    -- ^ /Required/ "id"
    , Parameter -> Text
parameterId            :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "value"
    , Parameter -> Text
parameterValue         :: !(Text) -- ^ /Required/ "value"
    }
    deriving (Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> FilePath
(Int -> Parameter -> ShowS)
-> (Parameter -> FilePath)
-> ([Parameter] -> ShowS)
-> Show Parameter
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Parameter] -> ShowS
$cshowList :: [Parameter] -> ShowS
show :: Parameter -> FilePath
$cshow :: Parameter -> FilePath
showsPrec :: Int -> Parameter -> ShowS
$cshowsPrec :: Int -> Parameter -> ShowS
P.Show, Parameter -> Parameter -> Bool
(Parameter -> Parameter -> Bool)
-> (Parameter -> Parameter -> Bool) -> Eq Parameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameter -> Parameter -> Bool
$c/= :: Parameter -> Parameter -> Bool
== :: Parameter -> Parameter -> Bool
$c== :: Parameter -> Parameter -> Bool
P.Eq, P.Typeable)

-- | FromJSON Parameter
instance A.FromJSON Parameter where
  parseJSON :: Value -> Parser Parameter
parseJSON = FilePath
-> (Object -> Parser Parameter) -> Value -> Parser Parameter
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Parameter" ((Object -> Parser Parameter) -> Value -> Parser Parameter)
-> (Object -> Parser Parameter) -> Value -> Parser Parameter
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe Text -> ParameterTypeEnum -> Text -> Text -> Parameter
Parameter
      (Text
 -> Maybe Text -> ParameterTypeEnum -> Text -> Text -> Parameter)
-> Parser Text
-> Parser
     (Maybe Text -> ParameterTypeEnum -> Text -> Text -> Parameter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (Maybe Text -> ParameterTypeEnum -> Text -> Text -> Parameter)
-> Parser (Maybe Text)
-> Parser (ParameterTypeEnum -> Text -> Text -> Parameter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")
      Parser (ParameterTypeEnum -> Text -> Text -> Parameter)
-> Parser ParameterTypeEnum -> Parser (Text -> Text -> Parameter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ParameterTypeEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"parameterType")
      Parser (Text -> Text -> Parameter)
-> Parser Text -> Parser (Text -> Parameter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser (Text -> Parameter) -> Parser Text -> Parser Parameter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"value")

-- | ToJSON Parameter
instance A.ToJSON Parameter where
  toJSON :: Parameter -> Value
toJSON Parameter {Maybe Text
Text
ParameterTypeEnum
parameterValue :: Text
parameterId :: Text
parameterParameterType :: ParameterTypeEnum
parameterDescription :: Maybe Text
parameterName :: Text
parameterValue :: Parameter -> Text
parameterId :: Parameter -> Text
parameterParameterType :: Parameter -> ParameterTypeEnum
parameterDescription :: Parameter -> Maybe Text
parameterName :: Parameter -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
parameterName
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
parameterDescription
      , Text
"parameterType" Text -> ParameterTypeEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ParameterTypeEnum
parameterParameterType
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
parameterId
      , Text
"value" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
parameterValue
      ]


-- | Construct a value of type 'Parameter' (by applying it's required fields, if any)
mkParameter
  :: Text -- ^ 'parameterName'
  -> ParameterTypeEnum -- ^ 'parameterParameterType'
  -> Text -- ^ 'parameterId'
  -> Text -- ^ 'parameterValue'
  -> Parameter
mkParameter :: Text -> ParameterTypeEnum -> Text -> Text -> Parameter
mkParameter Text
parameterName ParameterTypeEnum
parameterParameterType Text
parameterId Text
parameterValue =
  Parameter :: Text
-> Maybe Text -> ParameterTypeEnum -> Text -> Text -> Parameter
Parameter
  { Text
parameterName :: Text
parameterName :: Text
parameterName
  , parameterDescription :: Maybe Text
parameterDescription = Maybe Text
forall a. Maybe a
Nothing
  , ParameterTypeEnum
parameterParameterType :: ParameterTypeEnum
parameterParameterType :: ParameterTypeEnum
parameterParameterType
  , Text
parameterId :: Text
parameterId :: Text
parameterId
  , Text
parameterValue :: Text
parameterValue :: Text
parameterValue
  }

-- ** PasswordChangeDTO
-- | PasswordChangeDTO
data PasswordChangeDTO = PasswordChangeDTO
    { PasswordChangeDTO -> Text
passwordChangeDTOCurrentPassword :: !(Text) -- ^ /Required/ "currentPassword"
    -- ^ /Required/ "newPassword"
    , PasswordChangeDTO -> Text
passwordChangeDTONewPassword     :: !(Text) -- ^ /Required/ "newPassword"
    }
    deriving (Int -> PasswordChangeDTO -> ShowS
[PasswordChangeDTO] -> ShowS
PasswordChangeDTO -> FilePath
(Int -> PasswordChangeDTO -> ShowS)
-> (PasswordChangeDTO -> FilePath)
-> ([PasswordChangeDTO] -> ShowS)
-> Show PasswordChangeDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PasswordChangeDTO] -> ShowS
$cshowList :: [PasswordChangeDTO] -> ShowS
show :: PasswordChangeDTO -> FilePath
$cshow :: PasswordChangeDTO -> FilePath
showsPrec :: Int -> PasswordChangeDTO -> ShowS
$cshowsPrec :: Int -> PasswordChangeDTO -> ShowS
P.Show, PasswordChangeDTO -> PasswordChangeDTO -> Bool
(PasswordChangeDTO -> PasswordChangeDTO -> Bool)
-> (PasswordChangeDTO -> PasswordChangeDTO -> Bool)
-> Eq PasswordChangeDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasswordChangeDTO -> PasswordChangeDTO -> Bool
$c/= :: PasswordChangeDTO -> PasswordChangeDTO -> Bool
== :: PasswordChangeDTO -> PasswordChangeDTO -> Bool
$c== :: PasswordChangeDTO -> PasswordChangeDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON PasswordChangeDTO
instance A.FromJSON PasswordChangeDTO where
  parseJSON :: Value -> Parser PasswordChangeDTO
parseJSON = FilePath
-> (Object -> Parser PasswordChangeDTO)
-> Value
-> Parser PasswordChangeDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"PasswordChangeDTO" ((Object -> Parser PasswordChangeDTO)
 -> Value -> Parser PasswordChangeDTO)
-> (Object -> Parser PasswordChangeDTO)
-> Value
-> Parser PasswordChangeDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> PasswordChangeDTO
PasswordChangeDTO
      (Text -> Text -> PasswordChangeDTO)
-> Parser Text -> Parser (Text -> PasswordChangeDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"currentPassword")
      Parser (Text -> PasswordChangeDTO)
-> Parser Text -> Parser PasswordChangeDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"newPassword")

-- | ToJSON PasswordChangeDTO
instance A.ToJSON PasswordChangeDTO where
  toJSON :: PasswordChangeDTO -> Value
toJSON PasswordChangeDTO {Text
passwordChangeDTONewPassword :: Text
passwordChangeDTOCurrentPassword :: Text
passwordChangeDTONewPassword :: PasswordChangeDTO -> Text
passwordChangeDTOCurrentPassword :: PasswordChangeDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"currentPassword" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
passwordChangeDTOCurrentPassword
      , Text
"newPassword" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
passwordChangeDTONewPassword
      ]


-- | Construct a value of type 'PasswordChangeDTO' (by applying it's required fields, if any)
mkPasswordChangeDTO
  :: Text -- ^ 'passwordChangeDTOCurrentPassword'
  -> Text -- ^ 'passwordChangeDTONewPassword'
  -> PasswordChangeDTO
mkPasswordChangeDTO :: Text -> Text -> PasswordChangeDTO
mkPasswordChangeDTO Text
passwordChangeDTOCurrentPassword Text
passwordChangeDTONewPassword =
  PasswordChangeDTO :: Text -> Text -> PasswordChangeDTO
PasswordChangeDTO
  { Text
passwordChangeDTOCurrentPassword :: Text
passwordChangeDTOCurrentPassword :: Text
passwordChangeDTOCurrentPassword
  , Text
passwordChangeDTONewPassword :: Text
passwordChangeDTONewPassword :: Text
passwordChangeDTONewPassword
  }

-- ** Point
-- | Point
data Point = Point
    { Point -> Integer
pointTimestampMillis :: !(Integer) -- ^ /Required/ "timestampMillis"
    -- ^ "x"
    , Point -> Maybe Double
pointX               :: !(Maybe Double) -- ^ "x"
    -- ^ /Required/ "y"
    , Point -> Y
pointY               :: !(Y) -- ^ /Required/ "y"
    }
    deriving (Int -> Point -> ShowS
[Point] -> ShowS
Point -> FilePath
(Int -> Point -> ShowS)
-> (Point -> FilePath) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> FilePath
$cshow :: Point -> FilePath
showsPrec :: Int -> Point -> ShowS
$cshowsPrec :: Int -> Point -> ShowS
P.Show, Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
P.Eq, P.Typeable)

-- | FromJSON Point
instance A.FromJSON Point where
  parseJSON :: Value -> Parser Point
parseJSON = FilePath -> (Object -> Parser Point) -> Value -> Parser Point
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Point" ((Object -> Parser Point) -> Value -> Parser Point)
-> (Object -> Parser Point) -> Value -> Parser Point
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Integer -> Maybe Double -> Y -> Point
Point
      (Integer -> Maybe Double -> Y -> Point)
-> Parser Integer -> Parser (Maybe Double -> Y -> Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"timestampMillis")
      Parser (Maybe Double -> Y -> Point)
-> Parser (Maybe Double) -> Parser (Y -> Point)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"x")
      Parser (Y -> Point) -> Parser Y -> Parser Point
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Y
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"y")

-- | ToJSON Point
instance A.ToJSON Point where
  toJSON :: Point -> Value
toJSON Point {Integer
Maybe Double
Y
pointY :: Y
pointX :: Maybe Double
pointTimestampMillis :: Integer
pointY :: Point -> Y
pointX :: Point -> Maybe Double
pointTimestampMillis :: Point -> Integer
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"timestampMillis" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
pointTimestampMillis
      , Text
"x" Text -> Maybe Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Double
pointX
      , Text
"y" Text -> Y -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Y
pointY
      ]


-- | Construct a value of type 'Point' (by applying it's required fields, if any)
mkPoint
  :: Integer -- ^ 'pointTimestampMillis'
  -> Y -- ^ 'pointY'
  -> Point
mkPoint :: Integer -> Y -> Point
mkPoint Integer
pointTimestampMillis Y
pointY =
  Point :: Integer -> Maybe Double -> Y -> Point
Point
  { Integer
pointTimestampMillis :: Integer
pointTimestampMillis :: Integer
pointTimestampMillis
  , pointX :: Maybe Double
pointX = Maybe Double
forall a. Maybe a
Nothing
  , Y
pointY :: Y
pointY :: Y
pointY
  }

-- ** PointValueDTO
-- | PointValueDTO
data PointValueDTO = PointValueDTO
    { PointValueDTO -> Integer
pointValueDTOTimestampMillis :: !(Integer) -- ^ /Required/ "timestampMillis"
    -- ^ /Required/ "x"
    , PointValueDTO -> Double
pointValueDTOX               :: !(Double) -- ^ /Required/ "x"
    -- ^ /Required/ "y"
    , PointValueDTO -> Y
pointValueDTOY               :: !(Y) -- ^ /Required/ "y"
    }
    deriving (Int -> PointValueDTO -> ShowS
[PointValueDTO] -> ShowS
PointValueDTO -> FilePath
(Int -> PointValueDTO -> ShowS)
-> (PointValueDTO -> FilePath)
-> ([PointValueDTO] -> ShowS)
-> Show PointValueDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PointValueDTO] -> ShowS
$cshowList :: [PointValueDTO] -> ShowS
show :: PointValueDTO -> FilePath
$cshow :: PointValueDTO -> FilePath
showsPrec :: Int -> PointValueDTO -> ShowS
$cshowsPrec :: Int -> PointValueDTO -> ShowS
P.Show, PointValueDTO -> PointValueDTO -> Bool
(PointValueDTO -> PointValueDTO -> Bool)
-> (PointValueDTO -> PointValueDTO -> Bool) -> Eq PointValueDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointValueDTO -> PointValueDTO -> Bool
$c/= :: PointValueDTO -> PointValueDTO -> Bool
== :: PointValueDTO -> PointValueDTO -> Bool
$c== :: PointValueDTO -> PointValueDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON PointValueDTO
instance A.FromJSON PointValueDTO where
  parseJSON :: Value -> Parser PointValueDTO
parseJSON = FilePath
-> (Object -> Parser PointValueDTO)
-> Value
-> Parser PointValueDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"PointValueDTO" ((Object -> Parser PointValueDTO) -> Value -> Parser PointValueDTO)
-> (Object -> Parser PointValueDTO)
-> Value
-> Parser PointValueDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Integer -> Double -> Y -> PointValueDTO
PointValueDTO
      (Integer -> Double -> Y -> PointValueDTO)
-> Parser Integer -> Parser (Double -> Y -> PointValueDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"timestampMillis")
      Parser (Double -> Y -> PointValueDTO)
-> Parser Double -> Parser (Y -> PointValueDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"x")
      Parser (Y -> PointValueDTO) -> Parser Y -> Parser PointValueDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Y
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"y")

-- | ToJSON PointValueDTO
instance A.ToJSON PointValueDTO where
  toJSON :: PointValueDTO -> Value
toJSON PointValueDTO {Double
Integer
Y
pointValueDTOY :: Y
pointValueDTOX :: Double
pointValueDTOTimestampMillis :: Integer
pointValueDTOY :: PointValueDTO -> Y
pointValueDTOX :: PointValueDTO -> Double
pointValueDTOTimestampMillis :: PointValueDTO -> Integer
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"timestampMillis" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
pointValueDTOTimestampMillis
      , Text
"x" Text -> Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
pointValueDTOX
      , Text
"y" Text -> Y -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Y
pointValueDTOY
      ]


-- | Construct a value of type 'PointValueDTO' (by applying it's required fields, if any)
mkPointValueDTO
  :: Integer -- ^ 'pointValueDTOTimestampMillis'
  -> Double -- ^ 'pointValueDTOX'
  -> Y -- ^ 'pointValueDTOY'
  -> PointValueDTO
mkPointValueDTO :: Integer -> Double -> Y -> PointValueDTO
mkPointValueDTO Integer
pointValueDTOTimestampMillis Double
pointValueDTOX Y
pointValueDTOY =
  PointValueDTO :: Integer -> Double -> Y -> PointValueDTO
PointValueDTO
  { Integer
pointValueDTOTimestampMillis :: Integer
pointValueDTOTimestampMillis :: Integer
pointValueDTOTimestampMillis
  , Double
pointValueDTOX :: Double
pointValueDTOX :: Double
pointValueDTOX
  , Y
pointValueDTOY :: Y
pointValueDTOY :: Y
pointValueDTOY
  }

-- ** ProjectInvitationDTO
-- | ProjectInvitationDTO
data ProjectInvitationDTO = ProjectInvitationDTO
    { ProjectInvitationDTO -> ProjectRoleDTO
projectInvitationDTORoleGrant        :: !(ProjectRoleDTO) -- ^ /Required/ "roleGrant"
    -- ^ /Required/ "projectName"
    , ProjectInvitationDTO -> Text
projectInvitationDTOProjectName      :: !(Text) -- ^ /Required/ "projectName"
    -- ^ /Required/ "invitedBy"
    , ProjectInvitationDTO -> Text
projectInvitationDTOInvitedBy        :: !(Text) -- ^ /Required/ "invitedBy"
    -- ^ /Required/ "organizationName"
    , ProjectInvitationDTO -> Text
projectInvitationDTOOrganizationName :: !(Text) -- ^ /Required/ "organizationName"
    -- ^ /Required/ "id"
    , ProjectInvitationDTO -> Text
projectInvitationDTOId               :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "invitee"
    , ProjectInvitationDTO -> Text
projectInvitationDTOInvitee          :: !(Text) -- ^ /Required/ "invitee"
    -- ^ /Required/ "status"
    , ProjectInvitationDTO -> InvitationStatusEnumDTO
projectInvitationDTOStatus           :: !(InvitationStatusEnumDTO) -- ^ /Required/ "status"
    -- ^ /Required/ "invitationType"
    , ProjectInvitationDTO -> InvitationTypeEnumDTO
projectInvitationDTOInvitationType   :: !(InvitationTypeEnumDTO) -- ^ /Required/ "invitationType"
    }
    deriving (Int -> ProjectInvitationDTO -> ShowS
[ProjectInvitationDTO] -> ShowS
ProjectInvitationDTO -> FilePath
(Int -> ProjectInvitationDTO -> ShowS)
-> (ProjectInvitationDTO -> FilePath)
-> ([ProjectInvitationDTO] -> ShowS)
-> Show ProjectInvitationDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectInvitationDTO] -> ShowS
$cshowList :: [ProjectInvitationDTO] -> ShowS
show :: ProjectInvitationDTO -> FilePath
$cshow :: ProjectInvitationDTO -> FilePath
showsPrec :: Int -> ProjectInvitationDTO -> ShowS
$cshowsPrec :: Int -> ProjectInvitationDTO -> ShowS
P.Show, ProjectInvitationDTO -> ProjectInvitationDTO -> Bool
(ProjectInvitationDTO -> ProjectInvitationDTO -> Bool)
-> (ProjectInvitationDTO -> ProjectInvitationDTO -> Bool)
-> Eq ProjectInvitationDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectInvitationDTO -> ProjectInvitationDTO -> Bool
$c/= :: ProjectInvitationDTO -> ProjectInvitationDTO -> Bool
== :: ProjectInvitationDTO -> ProjectInvitationDTO -> Bool
$c== :: ProjectInvitationDTO -> ProjectInvitationDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectInvitationDTO
instance A.FromJSON ProjectInvitationDTO where
  parseJSON :: Value -> Parser ProjectInvitationDTO
parseJSON = FilePath
-> (Object -> Parser ProjectInvitationDTO)
-> Value
-> Parser ProjectInvitationDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectInvitationDTO" ((Object -> Parser ProjectInvitationDTO)
 -> Value -> Parser ProjectInvitationDTO)
-> (Object -> Parser ProjectInvitationDTO)
-> Value
-> Parser ProjectInvitationDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ProjectRoleDTO
-> Text
-> Text
-> Text
-> Text
-> Text
-> InvitationStatusEnumDTO
-> InvitationTypeEnumDTO
-> ProjectInvitationDTO
ProjectInvitationDTO
      (ProjectRoleDTO
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> InvitationStatusEnumDTO
 -> InvitationTypeEnumDTO
 -> ProjectInvitationDTO)
-> Parser ProjectRoleDTO
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO
      -> ProjectInvitationDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser ProjectRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"roleGrant")
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO
   -> ProjectInvitationDTO)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO
      -> ProjectInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"projectName")
      Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO
   -> ProjectInvitationDTO)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO
      -> ProjectInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitedBy")
      Parser
  (Text
   -> Text
   -> Text
   -> InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO
   -> ProjectInvitationDTO)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO
      -> ProjectInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationName")
      Parser
  (Text
   -> Text
   -> InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO
   -> ProjectInvitationDTO)
-> Parser Text
-> Parser
     (Text
      -> InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO
      -> ProjectInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser
  (Text
   -> InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO
   -> ProjectInvitationDTO)
-> Parser Text
-> Parser
     (InvitationStatusEnumDTO
      -> InvitationTypeEnumDTO -> ProjectInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitee")
      Parser
  (InvitationStatusEnumDTO
   -> InvitationTypeEnumDTO -> ProjectInvitationDTO)
-> Parser InvitationStatusEnumDTO
-> Parser (InvitationTypeEnumDTO -> ProjectInvitationDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser InvitationStatusEnumDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"status")
      Parser (InvitationTypeEnumDTO -> ProjectInvitationDTO)
-> Parser InvitationTypeEnumDTO -> Parser ProjectInvitationDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser InvitationTypeEnumDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"invitationType")

-- | ToJSON ProjectInvitationDTO
instance A.ToJSON ProjectInvitationDTO where
  toJSON :: ProjectInvitationDTO -> Value
toJSON ProjectInvitationDTO {Text
ProjectRoleDTO
InvitationTypeEnumDTO
InvitationStatusEnumDTO
projectInvitationDTOInvitationType :: InvitationTypeEnumDTO
projectInvitationDTOStatus :: InvitationStatusEnumDTO
projectInvitationDTOInvitee :: Text
projectInvitationDTOId :: Text
projectInvitationDTOOrganizationName :: Text
projectInvitationDTOInvitedBy :: Text
projectInvitationDTOProjectName :: Text
projectInvitationDTORoleGrant :: ProjectRoleDTO
projectInvitationDTOInvitationType :: ProjectInvitationDTO -> InvitationTypeEnumDTO
projectInvitationDTOStatus :: ProjectInvitationDTO -> InvitationStatusEnumDTO
projectInvitationDTOInvitee :: ProjectInvitationDTO -> Text
projectInvitationDTOId :: ProjectInvitationDTO -> Text
projectInvitationDTOOrganizationName :: ProjectInvitationDTO -> Text
projectInvitationDTOInvitedBy :: ProjectInvitationDTO -> Text
projectInvitationDTOProjectName :: ProjectInvitationDTO -> Text
projectInvitationDTORoleGrant :: ProjectInvitationDTO -> ProjectRoleDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"roleGrant" Text -> ProjectRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProjectRoleDTO
projectInvitationDTORoleGrant
      , Text
"projectName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectInvitationDTOProjectName
      , Text
"invitedBy" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectInvitationDTOInvitedBy
      , Text
"organizationName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectInvitationDTOOrganizationName
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectInvitationDTOId
      , Text
"invitee" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectInvitationDTOInvitee
      , Text
"status" Text -> InvitationStatusEnumDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InvitationStatusEnumDTO
projectInvitationDTOStatus
      , Text
"invitationType" Text -> InvitationTypeEnumDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InvitationTypeEnumDTO
projectInvitationDTOInvitationType
      ]


-- | Construct a value of type 'ProjectInvitationDTO' (by applying it's required fields, if any)
mkProjectInvitationDTO
  :: ProjectRoleDTO -- ^ 'projectInvitationDTORoleGrant'
  -> Text -- ^ 'projectInvitationDTOProjectName'
  -> Text -- ^ 'projectInvitationDTOInvitedBy'
  -> Text -- ^ 'projectInvitationDTOOrganizationName'
  -> Text -- ^ 'projectInvitationDTOId'
  -> Text -- ^ 'projectInvitationDTOInvitee'
  -> InvitationStatusEnumDTO -- ^ 'projectInvitationDTOStatus'
  -> InvitationTypeEnumDTO -- ^ 'projectInvitationDTOInvitationType'
  -> ProjectInvitationDTO
mkProjectInvitationDTO :: ProjectRoleDTO
-> Text
-> Text
-> Text
-> Text
-> Text
-> InvitationStatusEnumDTO
-> InvitationTypeEnumDTO
-> ProjectInvitationDTO
mkProjectInvitationDTO ProjectRoleDTO
projectInvitationDTORoleGrant Text
projectInvitationDTOProjectName Text
projectInvitationDTOInvitedBy Text
projectInvitationDTOOrganizationName Text
projectInvitationDTOId Text
projectInvitationDTOInvitee InvitationStatusEnumDTO
projectInvitationDTOStatus InvitationTypeEnumDTO
projectInvitationDTOInvitationType =
  ProjectInvitationDTO :: ProjectRoleDTO
-> Text
-> Text
-> Text
-> Text
-> Text
-> InvitationStatusEnumDTO
-> InvitationTypeEnumDTO
-> ProjectInvitationDTO
ProjectInvitationDTO
  { ProjectRoleDTO
projectInvitationDTORoleGrant :: ProjectRoleDTO
projectInvitationDTORoleGrant :: ProjectRoleDTO
projectInvitationDTORoleGrant
  , Text
projectInvitationDTOProjectName :: Text
projectInvitationDTOProjectName :: Text
projectInvitationDTOProjectName
  , Text
projectInvitationDTOInvitedBy :: Text
projectInvitationDTOInvitedBy :: Text
projectInvitationDTOInvitedBy
  , Text
projectInvitationDTOOrganizationName :: Text
projectInvitationDTOOrganizationName :: Text
projectInvitationDTOOrganizationName
  , Text
projectInvitationDTOId :: Text
projectInvitationDTOId :: Text
projectInvitationDTOId
  , Text
projectInvitationDTOInvitee :: Text
projectInvitationDTOInvitee :: Text
projectInvitationDTOInvitee
  , InvitationStatusEnumDTO
projectInvitationDTOStatus :: InvitationStatusEnumDTO
projectInvitationDTOStatus :: InvitationStatusEnumDTO
projectInvitationDTOStatus
  , InvitationTypeEnumDTO
projectInvitationDTOInvitationType :: InvitationTypeEnumDTO
projectInvitationDTOInvitationType :: InvitationTypeEnumDTO
projectInvitationDTOInvitationType
  }

-- ** ProjectInvitationUpdateDTO
-- | ProjectInvitationUpdateDTO
data ProjectInvitationUpdateDTO = ProjectInvitationUpdateDTO
    { ProjectInvitationUpdateDTO -> ProjectRoleDTO
projectInvitationUpdateDTORoleGrant :: !(ProjectRoleDTO) -- ^ /Required/ "roleGrant"
    }
    deriving (Int -> ProjectInvitationUpdateDTO -> ShowS
[ProjectInvitationUpdateDTO] -> ShowS
ProjectInvitationUpdateDTO -> FilePath
(Int -> ProjectInvitationUpdateDTO -> ShowS)
-> (ProjectInvitationUpdateDTO -> FilePath)
-> ([ProjectInvitationUpdateDTO] -> ShowS)
-> Show ProjectInvitationUpdateDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectInvitationUpdateDTO] -> ShowS
$cshowList :: [ProjectInvitationUpdateDTO] -> ShowS
show :: ProjectInvitationUpdateDTO -> FilePath
$cshow :: ProjectInvitationUpdateDTO -> FilePath
showsPrec :: Int -> ProjectInvitationUpdateDTO -> ShowS
$cshowsPrec :: Int -> ProjectInvitationUpdateDTO -> ShowS
P.Show, ProjectInvitationUpdateDTO -> ProjectInvitationUpdateDTO -> Bool
(ProjectInvitationUpdateDTO -> ProjectInvitationUpdateDTO -> Bool)
-> (ProjectInvitationUpdateDTO
    -> ProjectInvitationUpdateDTO -> Bool)
-> Eq ProjectInvitationUpdateDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectInvitationUpdateDTO -> ProjectInvitationUpdateDTO -> Bool
$c/= :: ProjectInvitationUpdateDTO -> ProjectInvitationUpdateDTO -> Bool
== :: ProjectInvitationUpdateDTO -> ProjectInvitationUpdateDTO -> Bool
$c== :: ProjectInvitationUpdateDTO -> ProjectInvitationUpdateDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectInvitationUpdateDTO
instance A.FromJSON ProjectInvitationUpdateDTO where
  parseJSON :: Value -> Parser ProjectInvitationUpdateDTO
parseJSON = FilePath
-> (Object -> Parser ProjectInvitationUpdateDTO)
-> Value
-> Parser ProjectInvitationUpdateDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectInvitationUpdateDTO" ((Object -> Parser ProjectInvitationUpdateDTO)
 -> Value -> Parser ProjectInvitationUpdateDTO)
-> (Object -> Parser ProjectInvitationUpdateDTO)
-> Value
-> Parser ProjectInvitationUpdateDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ProjectRoleDTO -> ProjectInvitationUpdateDTO
ProjectInvitationUpdateDTO
      (ProjectRoleDTO -> ProjectInvitationUpdateDTO)
-> Parser ProjectRoleDTO -> Parser ProjectInvitationUpdateDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser ProjectRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"roleGrant")

-- | ToJSON ProjectInvitationUpdateDTO
instance A.ToJSON ProjectInvitationUpdateDTO where
  toJSON :: ProjectInvitationUpdateDTO -> Value
toJSON ProjectInvitationUpdateDTO {ProjectRoleDTO
projectInvitationUpdateDTORoleGrant :: ProjectRoleDTO
projectInvitationUpdateDTORoleGrant :: ProjectInvitationUpdateDTO -> ProjectRoleDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"roleGrant" Text -> ProjectRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProjectRoleDTO
projectInvitationUpdateDTORoleGrant
      ]


-- | Construct a value of type 'ProjectInvitationUpdateDTO' (by applying it's required fields, if any)
mkProjectInvitationUpdateDTO
  :: ProjectRoleDTO -- ^ 'projectInvitationUpdateDTORoleGrant'
  -> ProjectInvitationUpdateDTO
mkProjectInvitationUpdateDTO :: ProjectRoleDTO -> ProjectInvitationUpdateDTO
mkProjectInvitationUpdateDTO ProjectRoleDTO
projectInvitationUpdateDTORoleGrant =
  ProjectInvitationUpdateDTO :: ProjectRoleDTO -> ProjectInvitationUpdateDTO
ProjectInvitationUpdateDTO
  { ProjectRoleDTO
projectInvitationUpdateDTORoleGrant :: ProjectRoleDTO
projectInvitationUpdateDTORoleGrant :: ProjectRoleDTO
projectInvitationUpdateDTORoleGrant
  }

-- ** ProjectKeyDTO
-- | ProjectKeyDTO
data ProjectKeyDTO = ProjectKeyDTO
    { ProjectKeyDTO -> Text
projectKeyDTOProposal :: !(Text) -- ^ /Required/ "proposal"
    }
    deriving (Int -> ProjectKeyDTO -> ShowS
[ProjectKeyDTO] -> ShowS
ProjectKeyDTO -> FilePath
(Int -> ProjectKeyDTO -> ShowS)
-> (ProjectKeyDTO -> FilePath)
-> ([ProjectKeyDTO] -> ShowS)
-> Show ProjectKeyDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectKeyDTO] -> ShowS
$cshowList :: [ProjectKeyDTO] -> ShowS
show :: ProjectKeyDTO -> FilePath
$cshow :: ProjectKeyDTO -> FilePath
showsPrec :: Int -> ProjectKeyDTO -> ShowS
$cshowsPrec :: Int -> ProjectKeyDTO -> ShowS
P.Show, ProjectKeyDTO -> ProjectKeyDTO -> Bool
(ProjectKeyDTO -> ProjectKeyDTO -> Bool)
-> (ProjectKeyDTO -> ProjectKeyDTO -> Bool) -> Eq ProjectKeyDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectKeyDTO -> ProjectKeyDTO -> Bool
$c/= :: ProjectKeyDTO -> ProjectKeyDTO -> Bool
== :: ProjectKeyDTO -> ProjectKeyDTO -> Bool
$c== :: ProjectKeyDTO -> ProjectKeyDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectKeyDTO
instance A.FromJSON ProjectKeyDTO where
  parseJSON :: Value -> Parser ProjectKeyDTO
parseJSON = FilePath
-> (Object -> Parser ProjectKeyDTO)
-> Value
-> Parser ProjectKeyDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectKeyDTO" ((Object -> Parser ProjectKeyDTO) -> Value -> Parser ProjectKeyDTO)
-> (Object -> Parser ProjectKeyDTO)
-> Value
-> Parser ProjectKeyDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> ProjectKeyDTO
ProjectKeyDTO
      (Text -> ProjectKeyDTO) -> Parser Text -> Parser ProjectKeyDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"proposal")

-- | ToJSON ProjectKeyDTO
instance A.ToJSON ProjectKeyDTO where
  toJSON :: ProjectKeyDTO -> Value
toJSON ProjectKeyDTO {Text
projectKeyDTOProposal :: Text
projectKeyDTOProposal :: ProjectKeyDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"proposal" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectKeyDTOProposal
      ]


-- | Construct a value of type 'ProjectKeyDTO' (by applying it's required fields, if any)
mkProjectKeyDTO
  :: Text -- ^ 'projectKeyDTOProposal'
  -> ProjectKeyDTO
mkProjectKeyDTO :: Text -> ProjectKeyDTO
mkProjectKeyDTO Text
projectKeyDTOProposal =
  ProjectKeyDTO :: Text -> ProjectKeyDTO
ProjectKeyDTO
  { Text
projectKeyDTOProposal :: Text
projectKeyDTOProposal :: Text
projectKeyDTOProposal
  }

-- ** ProjectListDTO
-- | ProjectListDTO
data ProjectListDTO = ProjectListDTO
    { ProjectListDTO -> [ProjectWithRoleDTO]
projectListDTOEntries           :: !([ProjectWithRoleDTO]) -- ^ /Required/ "entries"
    -- ^ /Required/ "matchingItemCount"
    , ProjectListDTO -> Int
projectListDTOMatchingItemCount :: !(Int) -- ^ /Required/ "matchingItemCount"
    -- ^ /Required/ "totalItemCount"
    , ProjectListDTO -> Int
projectListDTOTotalItemCount    :: !(Int) -- ^ /Required/ "totalItemCount"
    }
    deriving (Int -> ProjectListDTO -> ShowS
[ProjectListDTO] -> ShowS
ProjectListDTO -> FilePath
(Int -> ProjectListDTO -> ShowS)
-> (ProjectListDTO -> FilePath)
-> ([ProjectListDTO] -> ShowS)
-> Show ProjectListDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectListDTO] -> ShowS
$cshowList :: [ProjectListDTO] -> ShowS
show :: ProjectListDTO -> FilePath
$cshow :: ProjectListDTO -> FilePath
showsPrec :: Int -> ProjectListDTO -> ShowS
$cshowsPrec :: Int -> ProjectListDTO -> ShowS
P.Show, ProjectListDTO -> ProjectListDTO -> Bool
(ProjectListDTO -> ProjectListDTO -> Bool)
-> (ProjectListDTO -> ProjectListDTO -> Bool) -> Eq ProjectListDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectListDTO -> ProjectListDTO -> Bool
$c/= :: ProjectListDTO -> ProjectListDTO -> Bool
== :: ProjectListDTO -> ProjectListDTO -> Bool
$c== :: ProjectListDTO -> ProjectListDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectListDTO
instance A.FromJSON ProjectListDTO where
  parseJSON :: Value -> Parser ProjectListDTO
parseJSON = FilePath
-> (Object -> Parser ProjectListDTO)
-> Value
-> Parser ProjectListDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectListDTO" ((Object -> Parser ProjectListDTO)
 -> Value -> Parser ProjectListDTO)
-> (Object -> Parser ProjectListDTO)
-> Value
-> Parser ProjectListDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [ProjectWithRoleDTO] -> Int -> Int -> ProjectListDTO
ProjectListDTO
      ([ProjectWithRoleDTO] -> Int -> Int -> ProjectListDTO)
-> Parser [ProjectWithRoleDTO]
-> Parser (Int -> Int -> ProjectListDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [ProjectWithRoleDTO]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"entries")
      Parser (Int -> Int -> ProjectListDTO)
-> Parser Int -> Parser (Int -> ProjectListDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"matchingItemCount")
      Parser (Int -> ProjectListDTO)
-> Parser Int -> Parser ProjectListDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"totalItemCount")

-- | ToJSON ProjectListDTO
instance A.ToJSON ProjectListDTO where
  toJSON :: ProjectListDTO -> Value
toJSON ProjectListDTO {Int
[ProjectWithRoleDTO]
projectListDTOTotalItemCount :: Int
projectListDTOMatchingItemCount :: Int
projectListDTOEntries :: [ProjectWithRoleDTO]
projectListDTOTotalItemCount :: ProjectListDTO -> Int
projectListDTOMatchingItemCount :: ProjectListDTO -> Int
projectListDTOEntries :: ProjectListDTO -> [ProjectWithRoleDTO]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"entries" Text -> [ProjectWithRoleDTO] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [ProjectWithRoleDTO]
projectListDTOEntries
      , Text
"matchingItemCount" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
projectListDTOMatchingItemCount
      , Text
"totalItemCount" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
projectListDTOTotalItemCount
      ]


-- | Construct a value of type 'ProjectListDTO' (by applying it's required fields, if any)
mkProjectListDTO
  :: [ProjectWithRoleDTO] -- ^ 'projectListDTOEntries'
  -> Int -- ^ 'projectListDTOMatchingItemCount'
  -> Int -- ^ 'projectListDTOTotalItemCount'
  -> ProjectListDTO
mkProjectListDTO :: [ProjectWithRoleDTO] -> Int -> Int -> ProjectListDTO
mkProjectListDTO [ProjectWithRoleDTO]
projectListDTOEntries Int
projectListDTOMatchingItemCount Int
projectListDTOTotalItemCount =
  ProjectListDTO :: [ProjectWithRoleDTO] -> Int -> Int -> ProjectListDTO
ProjectListDTO
  { [ProjectWithRoleDTO]
projectListDTOEntries :: [ProjectWithRoleDTO]
projectListDTOEntries :: [ProjectWithRoleDTO]
projectListDTOEntries
  , Int
projectListDTOMatchingItemCount :: Int
projectListDTOMatchingItemCount :: Int
projectListDTOMatchingItemCount
  , Int
projectListDTOTotalItemCount :: Int
projectListDTOTotalItemCount :: Int
projectListDTOTotalItemCount
  }

-- ** ProjectMemberDTO
-- | ProjectMemberDTO
data ProjectMemberDTO = ProjectMemberDTO
    { ProjectMemberDTO -> ProjectRoleDTO
projectMemberDTORole                 :: !(ProjectRoleDTO) -- ^ /Required/ "role"
    -- ^ "registeredMemberInfo"
    , ProjectMemberDTO -> Maybe RegisteredMemberInfoDTO
projectMemberDTORegisteredMemberInfo :: !(Maybe RegisteredMemberInfoDTO) -- ^ "registeredMemberInfo"
    -- ^ "invitationInfo"
    , ProjectMemberDTO -> Maybe ProjectInvitationDTO
projectMemberDTOInvitationInfo       :: !(Maybe ProjectInvitationDTO) -- ^ "invitationInfo"
    -- ^ /Required/ "editableRole"
    , ProjectMemberDTO -> Bool
projectMemberDTOEditableRole         :: !(Bool) -- ^ /Required/ "editableRole"
    -- ^ /Required/ "canLeaveProject"
    , ProjectMemberDTO -> Bool
projectMemberDTOCanLeaveProject      :: !(Bool) -- ^ /Required/ "canLeaveProject"
    }
    deriving (Int -> ProjectMemberDTO -> ShowS
[ProjectMemberDTO] -> ShowS
ProjectMemberDTO -> FilePath
(Int -> ProjectMemberDTO -> ShowS)
-> (ProjectMemberDTO -> FilePath)
-> ([ProjectMemberDTO] -> ShowS)
-> Show ProjectMemberDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectMemberDTO] -> ShowS
$cshowList :: [ProjectMemberDTO] -> ShowS
show :: ProjectMemberDTO -> FilePath
$cshow :: ProjectMemberDTO -> FilePath
showsPrec :: Int -> ProjectMemberDTO -> ShowS
$cshowsPrec :: Int -> ProjectMemberDTO -> ShowS
P.Show, ProjectMemberDTO -> ProjectMemberDTO -> Bool
(ProjectMemberDTO -> ProjectMemberDTO -> Bool)
-> (ProjectMemberDTO -> ProjectMemberDTO -> Bool)
-> Eq ProjectMemberDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectMemberDTO -> ProjectMemberDTO -> Bool
$c/= :: ProjectMemberDTO -> ProjectMemberDTO -> Bool
== :: ProjectMemberDTO -> ProjectMemberDTO -> Bool
$c== :: ProjectMemberDTO -> ProjectMemberDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectMemberDTO
instance A.FromJSON ProjectMemberDTO where
  parseJSON :: Value -> Parser ProjectMemberDTO
parseJSON = FilePath
-> (Object -> Parser ProjectMemberDTO)
-> Value
-> Parser ProjectMemberDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectMemberDTO" ((Object -> Parser ProjectMemberDTO)
 -> Value -> Parser ProjectMemberDTO)
-> (Object -> Parser ProjectMemberDTO)
-> Value
-> Parser ProjectMemberDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ProjectRoleDTO
-> Maybe RegisteredMemberInfoDTO
-> Maybe ProjectInvitationDTO
-> Bool
-> Bool
-> ProjectMemberDTO
ProjectMemberDTO
      (ProjectRoleDTO
 -> Maybe RegisteredMemberInfoDTO
 -> Maybe ProjectInvitationDTO
 -> Bool
 -> Bool
 -> ProjectMemberDTO)
-> Parser ProjectRoleDTO
-> Parser
     (Maybe RegisteredMemberInfoDTO
      -> Maybe ProjectInvitationDTO -> Bool -> Bool -> ProjectMemberDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser ProjectRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"role")
      Parser
  (Maybe RegisteredMemberInfoDTO
   -> Maybe ProjectInvitationDTO -> Bool -> Bool -> ProjectMemberDTO)
-> Parser (Maybe RegisteredMemberInfoDTO)
-> Parser
     (Maybe ProjectInvitationDTO -> Bool -> Bool -> ProjectMemberDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe RegisteredMemberInfoDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"registeredMemberInfo")
      Parser
  (Maybe ProjectInvitationDTO -> Bool -> Bool -> ProjectMemberDTO)
-> Parser (Maybe ProjectInvitationDTO)
-> Parser (Bool -> Bool -> ProjectMemberDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe ProjectInvitationDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"invitationInfo")
      Parser (Bool -> Bool -> ProjectMemberDTO)
-> Parser Bool -> Parser (Bool -> ProjectMemberDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"editableRole")
      Parser (Bool -> ProjectMemberDTO)
-> Parser Bool -> Parser ProjectMemberDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"canLeaveProject")

-- | ToJSON ProjectMemberDTO
instance A.ToJSON ProjectMemberDTO where
  toJSON :: ProjectMemberDTO -> Value
toJSON ProjectMemberDTO {Bool
Maybe RegisteredMemberInfoDTO
Maybe ProjectInvitationDTO
ProjectRoleDTO
projectMemberDTOCanLeaveProject :: Bool
projectMemberDTOEditableRole :: Bool
projectMemberDTOInvitationInfo :: Maybe ProjectInvitationDTO
projectMemberDTORegisteredMemberInfo :: Maybe RegisteredMemberInfoDTO
projectMemberDTORole :: ProjectRoleDTO
projectMemberDTOCanLeaveProject :: ProjectMemberDTO -> Bool
projectMemberDTOEditableRole :: ProjectMemberDTO -> Bool
projectMemberDTOInvitationInfo :: ProjectMemberDTO -> Maybe ProjectInvitationDTO
projectMemberDTORegisteredMemberInfo :: ProjectMemberDTO -> Maybe RegisteredMemberInfoDTO
projectMemberDTORole :: ProjectMemberDTO -> ProjectRoleDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"role" Text -> ProjectRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProjectRoleDTO
projectMemberDTORole
      , Text
"registeredMemberInfo" Text -> Maybe RegisteredMemberInfoDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe RegisteredMemberInfoDTO
projectMemberDTORegisteredMemberInfo
      , Text
"invitationInfo" Text -> Maybe ProjectInvitationDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ProjectInvitationDTO
projectMemberDTOInvitationInfo
      , Text
"editableRole" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
projectMemberDTOEditableRole
      , Text
"canLeaveProject" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
projectMemberDTOCanLeaveProject
      ]


-- | Construct a value of type 'ProjectMemberDTO' (by applying it's required fields, if any)
mkProjectMemberDTO
  :: ProjectRoleDTO -- ^ 'projectMemberDTORole'
  -> Bool -- ^ 'projectMemberDTOEditableRole'
  -> Bool -- ^ 'projectMemberDTOCanLeaveProject'
  -> ProjectMemberDTO
mkProjectMemberDTO :: ProjectRoleDTO -> Bool -> Bool -> ProjectMemberDTO
mkProjectMemberDTO ProjectRoleDTO
projectMemberDTORole Bool
projectMemberDTOEditableRole Bool
projectMemberDTOCanLeaveProject =
  ProjectMemberDTO :: ProjectRoleDTO
-> Maybe RegisteredMemberInfoDTO
-> Maybe ProjectInvitationDTO
-> Bool
-> Bool
-> ProjectMemberDTO
ProjectMemberDTO
  { ProjectRoleDTO
projectMemberDTORole :: ProjectRoleDTO
projectMemberDTORole :: ProjectRoleDTO
projectMemberDTORole
  , projectMemberDTORegisteredMemberInfo :: Maybe RegisteredMemberInfoDTO
projectMemberDTORegisteredMemberInfo = Maybe RegisteredMemberInfoDTO
forall a. Maybe a
Nothing
  , projectMemberDTOInvitationInfo :: Maybe ProjectInvitationDTO
projectMemberDTOInvitationInfo = Maybe ProjectInvitationDTO
forall a. Maybe a
Nothing
  , Bool
projectMemberDTOEditableRole :: Bool
projectMemberDTOEditableRole :: Bool
projectMemberDTOEditableRole
  , Bool
projectMemberDTOCanLeaveProject :: Bool
projectMemberDTOCanLeaveProject :: Bool
projectMemberDTOCanLeaveProject
  }

-- ** ProjectMemberUpdateDTO
-- | ProjectMemberUpdateDTO
data ProjectMemberUpdateDTO = ProjectMemberUpdateDTO
    { ProjectMemberUpdateDTO -> ProjectRoleDTO
projectMemberUpdateDTORole :: !(ProjectRoleDTO) -- ^ /Required/ "role"
    }
    deriving (Int -> ProjectMemberUpdateDTO -> ShowS
[ProjectMemberUpdateDTO] -> ShowS
ProjectMemberUpdateDTO -> FilePath
(Int -> ProjectMemberUpdateDTO -> ShowS)
-> (ProjectMemberUpdateDTO -> FilePath)
-> ([ProjectMemberUpdateDTO] -> ShowS)
-> Show ProjectMemberUpdateDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectMemberUpdateDTO] -> ShowS
$cshowList :: [ProjectMemberUpdateDTO] -> ShowS
show :: ProjectMemberUpdateDTO -> FilePath
$cshow :: ProjectMemberUpdateDTO -> FilePath
showsPrec :: Int -> ProjectMemberUpdateDTO -> ShowS
$cshowsPrec :: Int -> ProjectMemberUpdateDTO -> ShowS
P.Show, ProjectMemberUpdateDTO -> ProjectMemberUpdateDTO -> Bool
(ProjectMemberUpdateDTO -> ProjectMemberUpdateDTO -> Bool)
-> (ProjectMemberUpdateDTO -> ProjectMemberUpdateDTO -> Bool)
-> Eq ProjectMemberUpdateDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectMemberUpdateDTO -> ProjectMemberUpdateDTO -> Bool
$c/= :: ProjectMemberUpdateDTO -> ProjectMemberUpdateDTO -> Bool
== :: ProjectMemberUpdateDTO -> ProjectMemberUpdateDTO -> Bool
$c== :: ProjectMemberUpdateDTO -> ProjectMemberUpdateDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectMemberUpdateDTO
instance A.FromJSON ProjectMemberUpdateDTO where
  parseJSON :: Value -> Parser ProjectMemberUpdateDTO
parseJSON = FilePath
-> (Object -> Parser ProjectMemberUpdateDTO)
-> Value
-> Parser ProjectMemberUpdateDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectMemberUpdateDTO" ((Object -> Parser ProjectMemberUpdateDTO)
 -> Value -> Parser ProjectMemberUpdateDTO)
-> (Object -> Parser ProjectMemberUpdateDTO)
-> Value
-> Parser ProjectMemberUpdateDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ProjectRoleDTO -> ProjectMemberUpdateDTO
ProjectMemberUpdateDTO
      (ProjectRoleDTO -> ProjectMemberUpdateDTO)
-> Parser ProjectRoleDTO -> Parser ProjectMemberUpdateDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser ProjectRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"role")

-- | ToJSON ProjectMemberUpdateDTO
instance A.ToJSON ProjectMemberUpdateDTO where
  toJSON :: ProjectMemberUpdateDTO -> Value
toJSON ProjectMemberUpdateDTO {ProjectRoleDTO
projectMemberUpdateDTORole :: ProjectRoleDTO
projectMemberUpdateDTORole :: ProjectMemberUpdateDTO -> ProjectRoleDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"role" Text -> ProjectRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProjectRoleDTO
projectMemberUpdateDTORole
      ]


-- | Construct a value of type 'ProjectMemberUpdateDTO' (by applying it's required fields, if any)
mkProjectMemberUpdateDTO
  :: ProjectRoleDTO -- ^ 'projectMemberUpdateDTORole'
  -> ProjectMemberUpdateDTO
mkProjectMemberUpdateDTO :: ProjectRoleDTO -> ProjectMemberUpdateDTO
mkProjectMemberUpdateDTO ProjectRoleDTO
projectMemberUpdateDTORole =
  ProjectMemberUpdateDTO :: ProjectRoleDTO -> ProjectMemberUpdateDTO
ProjectMemberUpdateDTO
  { ProjectRoleDTO
projectMemberUpdateDTORole :: ProjectRoleDTO
projectMemberUpdateDTORole :: ProjectRoleDTO
projectMemberUpdateDTORole
  }

-- ** ProjectMembersDTO
-- | ProjectMembersDTO
data ProjectMembersDTO = ProjectMembersDTO
    { ProjectMembersDTO -> Text
projectMembersDTOProjectName      :: !(Text) -- ^ /Required/ "projectName"
    -- ^ /Required/ "projectId"
    , ProjectMembersDTO -> Text
projectMembersDTOProjectId        :: !(Text) -- ^ /Required/ "projectId"
    -- ^ /Required/ "organizationName"
    , ProjectMembersDTO -> Text
projectMembersDTOOrganizationName :: !(Text) -- ^ /Required/ "organizationName"
    -- ^ /Required/ "members"
    , ProjectMembersDTO -> [ProjectMemberDTO]
projectMembersDTOMembers          :: !([ProjectMemberDTO]) -- ^ /Required/ "members"
    -- ^ /Required/ "organizationId"
    , ProjectMembersDTO -> Text
projectMembersDTOOrganizationId   :: !(Text) -- ^ /Required/ "organizationId"
    }
    deriving (Int -> ProjectMembersDTO -> ShowS
[ProjectMembersDTO] -> ShowS
ProjectMembersDTO -> FilePath
(Int -> ProjectMembersDTO -> ShowS)
-> (ProjectMembersDTO -> FilePath)
-> ([ProjectMembersDTO] -> ShowS)
-> Show ProjectMembersDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectMembersDTO] -> ShowS
$cshowList :: [ProjectMembersDTO] -> ShowS
show :: ProjectMembersDTO -> FilePath
$cshow :: ProjectMembersDTO -> FilePath
showsPrec :: Int -> ProjectMembersDTO -> ShowS
$cshowsPrec :: Int -> ProjectMembersDTO -> ShowS
P.Show, ProjectMembersDTO -> ProjectMembersDTO -> Bool
(ProjectMembersDTO -> ProjectMembersDTO -> Bool)
-> (ProjectMembersDTO -> ProjectMembersDTO -> Bool)
-> Eq ProjectMembersDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectMembersDTO -> ProjectMembersDTO -> Bool
$c/= :: ProjectMembersDTO -> ProjectMembersDTO -> Bool
== :: ProjectMembersDTO -> ProjectMembersDTO -> Bool
$c== :: ProjectMembersDTO -> ProjectMembersDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectMembersDTO
instance A.FromJSON ProjectMembersDTO where
  parseJSON :: Value -> Parser ProjectMembersDTO
parseJSON = FilePath
-> (Object -> Parser ProjectMembersDTO)
-> Value
-> Parser ProjectMembersDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectMembersDTO" ((Object -> Parser ProjectMembersDTO)
 -> Value -> Parser ProjectMembersDTO)
-> (Object -> Parser ProjectMembersDTO)
-> Value
-> Parser ProjectMembersDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text -> Text -> [ProjectMemberDTO] -> Text -> ProjectMembersDTO
ProjectMembersDTO
      (Text
 -> Text -> Text -> [ProjectMemberDTO] -> Text -> ProjectMembersDTO)
-> Parser Text
-> Parser
     (Text -> Text -> [ProjectMemberDTO] -> Text -> ProjectMembersDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"projectName")
      Parser
  (Text -> Text -> [ProjectMemberDTO] -> Text -> ProjectMembersDTO)
-> Parser Text
-> Parser (Text -> [ProjectMemberDTO] -> Text -> ProjectMembersDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"projectId")
      Parser (Text -> [ProjectMemberDTO] -> Text -> ProjectMembersDTO)
-> Parser Text
-> Parser ([ProjectMemberDTO] -> Text -> ProjectMembersDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationName")
      Parser ([ProjectMemberDTO] -> Text -> ProjectMembersDTO)
-> Parser [ProjectMemberDTO] -> Parser (Text -> ProjectMembersDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [ProjectMemberDTO]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"members")
      Parser (Text -> ProjectMembersDTO)
-> Parser Text -> Parser ProjectMembersDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationId")

-- | ToJSON ProjectMembersDTO
instance A.ToJSON ProjectMembersDTO where
  toJSON :: ProjectMembersDTO -> Value
toJSON ProjectMembersDTO {[ProjectMemberDTO]
Text
projectMembersDTOOrganizationId :: Text
projectMembersDTOMembers :: [ProjectMemberDTO]
projectMembersDTOOrganizationName :: Text
projectMembersDTOProjectId :: Text
projectMembersDTOProjectName :: Text
projectMembersDTOOrganizationId :: ProjectMembersDTO -> Text
projectMembersDTOMembers :: ProjectMembersDTO -> [ProjectMemberDTO]
projectMembersDTOOrganizationName :: ProjectMembersDTO -> Text
projectMembersDTOProjectId :: ProjectMembersDTO -> Text
projectMembersDTOProjectName :: ProjectMembersDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"projectName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectMembersDTOProjectName
      , Text
"projectId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectMembersDTOProjectId
      , Text
"organizationName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectMembersDTOOrganizationName
      , Text
"members" Text -> [ProjectMemberDTO] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [ProjectMemberDTO]
projectMembersDTOMembers
      , Text
"organizationId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectMembersDTOOrganizationId
      ]


-- | Construct a value of type 'ProjectMembersDTO' (by applying it's required fields, if any)
mkProjectMembersDTO
  :: Text -- ^ 'projectMembersDTOProjectName'
  -> Text -- ^ 'projectMembersDTOProjectId'
  -> Text -- ^ 'projectMembersDTOOrganizationName'
  -> [ProjectMemberDTO] -- ^ 'projectMembersDTOMembers'
  -> Text -- ^ 'projectMembersDTOOrganizationId'
  -> ProjectMembersDTO
mkProjectMembersDTO :: Text
-> Text -> Text -> [ProjectMemberDTO] -> Text -> ProjectMembersDTO
mkProjectMembersDTO Text
projectMembersDTOProjectName Text
projectMembersDTOProjectId Text
projectMembersDTOOrganizationName [ProjectMemberDTO]
projectMembersDTOMembers Text
projectMembersDTOOrganizationId =
  ProjectMembersDTO :: Text
-> Text -> Text -> [ProjectMemberDTO] -> Text -> ProjectMembersDTO
ProjectMembersDTO
  { Text
projectMembersDTOProjectName :: Text
projectMembersDTOProjectName :: Text
projectMembersDTOProjectName
  , Text
projectMembersDTOProjectId :: Text
projectMembersDTOProjectId :: Text
projectMembersDTOProjectId
  , Text
projectMembersDTOOrganizationName :: Text
projectMembersDTOOrganizationName :: Text
projectMembersDTOOrganizationName
  , [ProjectMemberDTO]
projectMembersDTOMembers :: [ProjectMemberDTO]
projectMembersDTOMembers :: [ProjectMemberDTO]
projectMembersDTOMembers
  , Text
projectMembersDTOOrganizationId :: Text
projectMembersDTOOrganizationId :: Text
projectMembersDTOOrganizationId
  }

-- ** ProjectMetadataDTO
-- | ProjectMetadataDTO
data ProjectMetadataDTO = ProjectMetadataDTO
    { ProjectMetadataDTO -> Text
projectMetadataDTOName             :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "organizationType"
    , ProjectMetadataDTO -> OrganizationTypeDTO
projectMetadataDTOOrganizationType :: !(OrganizationTypeDTO) -- ^ /Required/ "organizationType"
    -- ^ /Required/ "timeOfCreation"
    , ProjectMetadataDTO -> DateTime
projectMetadataDTOTimeOfCreation   :: !(DateTime) -- ^ /Required/ "timeOfCreation"
    -- ^ /Required/ "organizationName"
    , ProjectMetadataDTO -> Text
projectMetadataDTOOrganizationName :: !(Text) -- ^ /Required/ "organizationName"
    -- ^ /Required/ "version"
    , ProjectMetadataDTO -> Int
projectMetadataDTOVersion          :: !(Int) -- ^ /Required/ "version"
    -- ^ /Required/ "id"
    , ProjectMetadataDTO -> Text
projectMetadataDTOId               :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "projectKey"
    , ProjectMetadataDTO -> Text
projectMetadataDTOProjectKey       :: !(Text) -- ^ /Required/ "projectKey"
    -- ^ /Required/ "organizationId"
    , ProjectMetadataDTO -> Text
projectMetadataDTOOrganizationId   :: !(Text) -- ^ /Required/ "organizationId"
    }
    deriving (Int -> ProjectMetadataDTO -> ShowS
[ProjectMetadataDTO] -> ShowS
ProjectMetadataDTO -> FilePath
(Int -> ProjectMetadataDTO -> ShowS)
-> (ProjectMetadataDTO -> FilePath)
-> ([ProjectMetadataDTO] -> ShowS)
-> Show ProjectMetadataDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectMetadataDTO] -> ShowS
$cshowList :: [ProjectMetadataDTO] -> ShowS
show :: ProjectMetadataDTO -> FilePath
$cshow :: ProjectMetadataDTO -> FilePath
showsPrec :: Int -> ProjectMetadataDTO -> ShowS
$cshowsPrec :: Int -> ProjectMetadataDTO -> ShowS
P.Show, ProjectMetadataDTO -> ProjectMetadataDTO -> Bool
(ProjectMetadataDTO -> ProjectMetadataDTO -> Bool)
-> (ProjectMetadataDTO -> ProjectMetadataDTO -> Bool)
-> Eq ProjectMetadataDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectMetadataDTO -> ProjectMetadataDTO -> Bool
$c/= :: ProjectMetadataDTO -> ProjectMetadataDTO -> Bool
== :: ProjectMetadataDTO -> ProjectMetadataDTO -> Bool
$c== :: ProjectMetadataDTO -> ProjectMetadataDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectMetadataDTO
instance A.FromJSON ProjectMetadataDTO where
  parseJSON :: Value -> Parser ProjectMetadataDTO
parseJSON = FilePath
-> (Object -> Parser ProjectMetadataDTO)
-> Value
-> Parser ProjectMetadataDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectMetadataDTO" ((Object -> Parser ProjectMetadataDTO)
 -> Value -> Parser ProjectMetadataDTO)
-> (Object -> Parser ProjectMetadataDTO)
-> Value
-> Parser ProjectMetadataDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> OrganizationTypeDTO
-> DateTime
-> Text
-> Int
-> Text
-> Text
-> Text
-> ProjectMetadataDTO
ProjectMetadataDTO
      (Text
 -> OrganizationTypeDTO
 -> DateTime
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> ProjectMetadataDTO)
-> Parser Text
-> Parser
     (OrganizationTypeDTO
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> ProjectMetadataDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (OrganizationTypeDTO
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> ProjectMetadataDTO)
-> Parser OrganizationTypeDTO
-> Parser
     (DateTime
      -> Text -> Int -> Text -> Text -> Text -> ProjectMetadataDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser OrganizationTypeDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationType")
      Parser
  (DateTime
   -> Text -> Int -> Text -> Text -> Text -> ProjectMetadataDTO)
-> Parser DateTime
-> Parser
     (Text -> Int -> Text -> Text -> Text -> ProjectMetadataDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser DateTime
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"timeOfCreation")
      Parser (Text -> Int -> Text -> Text -> Text -> ProjectMetadataDTO)
-> Parser Text
-> Parser (Int -> Text -> Text -> Text -> ProjectMetadataDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationName")
      Parser (Int -> Text -> Text -> Text -> ProjectMetadataDTO)
-> Parser Int
-> Parser (Text -> Text -> Text -> ProjectMetadataDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"version")
      Parser (Text -> Text -> Text -> ProjectMetadataDTO)
-> Parser Text -> Parser (Text -> Text -> ProjectMetadataDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser (Text -> Text -> ProjectMetadataDTO)
-> Parser Text -> Parser (Text -> ProjectMetadataDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"projectKey")
      Parser (Text -> ProjectMetadataDTO)
-> Parser Text -> Parser ProjectMetadataDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationId")

-- | ToJSON ProjectMetadataDTO
instance A.ToJSON ProjectMetadataDTO where
  toJSON :: ProjectMetadataDTO -> Value
toJSON ProjectMetadataDTO {Int
Text
DateTime
OrganizationTypeDTO
projectMetadataDTOOrganizationId :: Text
projectMetadataDTOProjectKey :: Text
projectMetadataDTOId :: Text
projectMetadataDTOVersion :: Int
projectMetadataDTOOrganizationName :: Text
projectMetadataDTOTimeOfCreation :: DateTime
projectMetadataDTOOrganizationType :: OrganizationTypeDTO
projectMetadataDTOName :: Text
projectMetadataDTOOrganizationId :: ProjectMetadataDTO -> Text
projectMetadataDTOProjectKey :: ProjectMetadataDTO -> Text
projectMetadataDTOId :: ProjectMetadataDTO -> Text
projectMetadataDTOVersion :: ProjectMetadataDTO -> Int
projectMetadataDTOOrganizationName :: ProjectMetadataDTO -> Text
projectMetadataDTOTimeOfCreation :: ProjectMetadataDTO -> DateTime
projectMetadataDTOOrganizationType :: ProjectMetadataDTO -> OrganizationTypeDTO
projectMetadataDTOName :: ProjectMetadataDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectMetadataDTOName
      , Text
"organizationType" Text -> OrganizationTypeDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationTypeDTO
projectMetadataDTOOrganizationType
      , Text
"timeOfCreation" Text -> DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DateTime
projectMetadataDTOTimeOfCreation
      , Text
"organizationName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectMetadataDTOOrganizationName
      , Text
"version" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
projectMetadataDTOVersion
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectMetadataDTOId
      , Text
"projectKey" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectMetadataDTOProjectKey
      , Text
"organizationId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectMetadataDTOOrganizationId
      ]


-- | Construct a value of type 'ProjectMetadataDTO' (by applying it's required fields, if any)
mkProjectMetadataDTO
  :: Text -- ^ 'projectMetadataDTOName'
  -> OrganizationTypeDTO -- ^ 'projectMetadataDTOOrganizationType'
  -> DateTime -- ^ 'projectMetadataDTOTimeOfCreation'
  -> Text -- ^ 'projectMetadataDTOOrganizationName'
  -> Int -- ^ 'projectMetadataDTOVersion'
  -> Text -- ^ 'projectMetadataDTOId'
  -> Text -- ^ 'projectMetadataDTOProjectKey'
  -> Text -- ^ 'projectMetadataDTOOrganizationId'
  -> ProjectMetadataDTO
mkProjectMetadataDTO :: Text
-> OrganizationTypeDTO
-> DateTime
-> Text
-> Int
-> Text
-> Text
-> Text
-> ProjectMetadataDTO
mkProjectMetadataDTO Text
projectMetadataDTOName OrganizationTypeDTO
projectMetadataDTOOrganizationType DateTime
projectMetadataDTOTimeOfCreation Text
projectMetadataDTOOrganizationName Int
projectMetadataDTOVersion Text
projectMetadataDTOId Text
projectMetadataDTOProjectKey Text
projectMetadataDTOOrganizationId =
  ProjectMetadataDTO :: Text
-> OrganizationTypeDTO
-> DateTime
-> Text
-> Int
-> Text
-> Text
-> Text
-> ProjectMetadataDTO
ProjectMetadataDTO
  { Text
projectMetadataDTOName :: Text
projectMetadataDTOName :: Text
projectMetadataDTOName
  , OrganizationTypeDTO
projectMetadataDTOOrganizationType :: OrganizationTypeDTO
projectMetadataDTOOrganizationType :: OrganizationTypeDTO
projectMetadataDTOOrganizationType
  , DateTime
projectMetadataDTOTimeOfCreation :: DateTime
projectMetadataDTOTimeOfCreation :: DateTime
projectMetadataDTOTimeOfCreation
  , Text
projectMetadataDTOOrganizationName :: Text
projectMetadataDTOOrganizationName :: Text
projectMetadataDTOOrganizationName
  , Int
projectMetadataDTOVersion :: Int
projectMetadataDTOVersion :: Int
projectMetadataDTOVersion
  , Text
projectMetadataDTOId :: Text
projectMetadataDTOId :: Text
projectMetadataDTOId
  , Text
projectMetadataDTOProjectKey :: Text
projectMetadataDTOProjectKey :: Text
projectMetadataDTOProjectKey
  , Text
projectMetadataDTOOrganizationId :: Text
projectMetadataDTOOrganizationId :: Text
projectMetadataDTOOrganizationId
  }

-- ** ProjectUpdateDTO
-- | ProjectUpdateDTO
data ProjectUpdateDTO = ProjectUpdateDTO
    { ProjectUpdateDTO -> Maybe ProjectCodeAccessDTO
projectUpdateDTOCodeAccess   :: !(Maybe ProjectCodeAccessDTO) -- ^ "codeAccess"
    -- ^ "name"
    , ProjectUpdateDTO -> Maybe Text
projectUpdateDTOName         :: !(Maybe Text) -- ^ "name"
    -- ^ "description"
    , ProjectUpdateDTO -> Maybe Text
projectUpdateDTODescription  :: !(Maybe Text) -- ^ "description"
    -- ^ "visibility"
    , ProjectUpdateDTO -> Maybe ProjectVisibilityDTO
projectUpdateDTOVisibility   :: !(Maybe ProjectVisibilityDTO) -- ^ "visibility"
    -- ^ "displayClass"
    , ProjectUpdateDTO -> Maybe Text
projectUpdateDTODisplayClass :: !(Maybe Text) -- ^ "displayClass"
    }
    deriving (Int -> ProjectUpdateDTO -> ShowS
[ProjectUpdateDTO] -> ShowS
ProjectUpdateDTO -> FilePath
(Int -> ProjectUpdateDTO -> ShowS)
-> (ProjectUpdateDTO -> FilePath)
-> ([ProjectUpdateDTO] -> ShowS)
-> Show ProjectUpdateDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectUpdateDTO] -> ShowS
$cshowList :: [ProjectUpdateDTO] -> ShowS
show :: ProjectUpdateDTO -> FilePath
$cshow :: ProjectUpdateDTO -> FilePath
showsPrec :: Int -> ProjectUpdateDTO -> ShowS
$cshowsPrec :: Int -> ProjectUpdateDTO -> ShowS
P.Show, ProjectUpdateDTO -> ProjectUpdateDTO -> Bool
(ProjectUpdateDTO -> ProjectUpdateDTO -> Bool)
-> (ProjectUpdateDTO -> ProjectUpdateDTO -> Bool)
-> Eq ProjectUpdateDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectUpdateDTO -> ProjectUpdateDTO -> Bool
$c/= :: ProjectUpdateDTO -> ProjectUpdateDTO -> Bool
== :: ProjectUpdateDTO -> ProjectUpdateDTO -> Bool
$c== :: ProjectUpdateDTO -> ProjectUpdateDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectUpdateDTO
instance A.FromJSON ProjectUpdateDTO where
  parseJSON :: Value -> Parser ProjectUpdateDTO
parseJSON = FilePath
-> (Object -> Parser ProjectUpdateDTO)
-> Value
-> Parser ProjectUpdateDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectUpdateDTO" ((Object -> Parser ProjectUpdateDTO)
 -> Value -> Parser ProjectUpdateDTO)
-> (Object -> Parser ProjectUpdateDTO)
-> Value
-> Parser ProjectUpdateDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe ProjectCodeAccessDTO
-> Maybe Text
-> Maybe Text
-> Maybe ProjectVisibilityDTO
-> Maybe Text
-> ProjectUpdateDTO
ProjectUpdateDTO
      (Maybe ProjectCodeAccessDTO
 -> Maybe Text
 -> Maybe Text
 -> Maybe ProjectVisibilityDTO
 -> Maybe Text
 -> ProjectUpdateDTO)
-> Parser (Maybe ProjectCodeAccessDTO)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe ProjectVisibilityDTO
      -> Maybe Text
      -> ProjectUpdateDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe ProjectCodeAccessDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"codeAccess")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe ProjectVisibilityDTO
   -> Maybe Text
   -> ProjectUpdateDTO)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe ProjectVisibilityDTO -> Maybe Text -> ProjectUpdateDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"name")
      Parser
  (Maybe Text
   -> Maybe ProjectVisibilityDTO -> Maybe Text -> ProjectUpdateDTO)
-> Parser (Maybe Text)
-> Parser
     (Maybe ProjectVisibilityDTO -> Maybe Text -> ProjectUpdateDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")
      Parser
  (Maybe ProjectVisibilityDTO -> Maybe Text -> ProjectUpdateDTO)
-> Parser (Maybe ProjectVisibilityDTO)
-> Parser (Maybe Text -> ProjectUpdateDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe ProjectVisibilityDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"visibility")
      Parser (Maybe Text -> ProjectUpdateDTO)
-> Parser (Maybe Text) -> Parser ProjectUpdateDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"displayClass")

-- | ToJSON ProjectUpdateDTO
instance A.ToJSON ProjectUpdateDTO where
  toJSON :: ProjectUpdateDTO -> Value
toJSON ProjectUpdateDTO {Maybe Text
Maybe ProjectVisibilityDTO
Maybe ProjectCodeAccessDTO
projectUpdateDTODisplayClass :: Maybe Text
projectUpdateDTOVisibility :: Maybe ProjectVisibilityDTO
projectUpdateDTODescription :: Maybe Text
projectUpdateDTOName :: Maybe Text
projectUpdateDTOCodeAccess :: Maybe ProjectCodeAccessDTO
projectUpdateDTODisplayClass :: ProjectUpdateDTO -> Maybe Text
projectUpdateDTOVisibility :: ProjectUpdateDTO -> Maybe ProjectVisibilityDTO
projectUpdateDTODescription :: ProjectUpdateDTO -> Maybe Text
projectUpdateDTOName :: ProjectUpdateDTO -> Maybe Text
projectUpdateDTOCodeAccess :: ProjectUpdateDTO -> Maybe ProjectCodeAccessDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"codeAccess" Text -> Maybe ProjectCodeAccessDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ProjectCodeAccessDTO
projectUpdateDTOCodeAccess
      , Text
"name" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
projectUpdateDTOName
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
projectUpdateDTODescription
      , Text
"visibility" Text -> Maybe ProjectVisibilityDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ProjectVisibilityDTO
projectUpdateDTOVisibility
      , Text
"displayClass" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
projectUpdateDTODisplayClass
      ]


-- | Construct a value of type 'ProjectUpdateDTO' (by applying it's required fields, if any)
mkProjectUpdateDTO
  :: ProjectUpdateDTO
mkProjectUpdateDTO :: ProjectUpdateDTO
mkProjectUpdateDTO =
  ProjectUpdateDTO :: Maybe ProjectCodeAccessDTO
-> Maybe Text
-> Maybe Text
-> Maybe ProjectVisibilityDTO
-> Maybe Text
-> ProjectUpdateDTO
ProjectUpdateDTO
  { projectUpdateDTOCodeAccess :: Maybe ProjectCodeAccessDTO
projectUpdateDTOCodeAccess = Maybe ProjectCodeAccessDTO
forall a. Maybe a
Nothing
  , projectUpdateDTOName :: Maybe Text
projectUpdateDTOName = Maybe Text
forall a. Maybe a
Nothing
  , projectUpdateDTODescription :: Maybe Text
projectUpdateDTODescription = Maybe Text
forall a. Maybe a
Nothing
  , projectUpdateDTOVisibility :: Maybe ProjectVisibilityDTO
projectUpdateDTOVisibility = Maybe ProjectVisibilityDTO
forall a. Maybe a
Nothing
  , projectUpdateDTODisplayClass :: Maybe Text
projectUpdateDTODisplayClass = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ProjectWithRoleDTO
-- | ProjectWithRoleDTO
data ProjectWithRoleDTO = ProjectWithRoleDTO
    { ProjectWithRoleDTO -> ProjectCodeAccessDTO
projectWithRoleDTOCodeAccess             :: !(ProjectCodeAccessDTO) -- ^ /Required/ "codeAccess"
    -- ^ /Required/ "avatarUrl"
    , ProjectWithRoleDTO -> Text
projectWithRoleDTOAvatarUrl              :: !(Text) -- ^ /Required/ "avatarUrl"
    -- ^ "description"
    , ProjectWithRoleDTO -> Maybe Text
projectWithRoleDTODescription            :: !(Maybe Text) -- ^ "description"
    -- ^ /Required/ "organizationType"
    , ProjectWithRoleDTO -> OrganizationTypeDTO
projectWithRoleDTOOrganizationType       :: !(OrganizationTypeDTO) -- ^ /Required/ "organizationType"
    -- ^ /Required/ "featured"
    , ProjectWithRoleDTO -> Bool
projectWithRoleDTOFeatured               :: !(Bool) -- ^ /Required/ "featured"
    -- ^ /Required/ "organizationName"
    , ProjectWithRoleDTO -> Text
projectWithRoleDTOOrganizationName       :: !(Text) -- ^ /Required/ "organizationName"
    -- ^ /Required/ "version"
    , ProjectWithRoleDTO -> Int
projectWithRoleDTOVersion                :: !(Int) -- ^ /Required/ "version"
    -- ^ /Required/ "id"
    , ProjectWithRoleDTO -> Text
projectWithRoleDTOId                     :: !(Text) -- ^ /Required/ "id"
    -- ^ /Required/ "projectKey"
    , ProjectWithRoleDTO -> Text
projectWithRoleDTOProjectKey             :: !(Text) -- ^ /Required/ "projectKey"
    -- ^ /Required/ "organizationId"
    , ProjectWithRoleDTO -> Text
projectWithRoleDTOOrganizationId         :: !(Text) -- ^ /Required/ "organizationId"
    -- ^ /Required/ "userCount"
    , ProjectWithRoleDTO -> Int
projectWithRoleDTOUserCount              :: !(Int) -- ^ /Required/ "userCount"
    -- ^ /Required/ "visibility"
    , ProjectWithRoleDTO -> ProjectVisibilityDTO
projectWithRoleDTOVisibility             :: !(ProjectVisibilityDTO) -- ^ /Required/ "visibility"
    -- ^ "displayClass"
    , ProjectWithRoleDTO -> Maybe Text
projectWithRoleDTODisplayClass           :: !(Maybe Text) -- ^ "displayClass"
    -- ^ /Required/ "name"
    , ProjectWithRoleDTO -> Text
projectWithRoleDTOName                   :: !(Text) -- ^ /Required/ "name"
    -- ^ /Required/ "lastActivity"
    , ProjectWithRoleDTO -> DateTime
projectWithRoleDTOLastActivity           :: !(DateTime) -- ^ /Required/ "lastActivity"
    -- ^ /Required/ "timeOfCreation"
    , ProjectWithRoleDTO -> DateTime
projectWithRoleDTOTimeOfCreation         :: !(DateTime) -- ^ /Required/ "timeOfCreation"
    -- ^ "userRoleInOrganization"
    , ProjectWithRoleDTO -> Maybe OrganizationRoleDTO
projectWithRoleDTOUserRoleInOrganization :: !(Maybe OrganizationRoleDTO) -- ^ "userRoleInOrganization"
    -- ^ /Required/ "avatarSource"
    , ProjectWithRoleDTO -> AvatarSourceEnum
projectWithRoleDTOAvatarSource           :: !(AvatarSourceEnum) -- ^ /Required/ "avatarSource"
    -- ^ /Required/ "leaderboardEntryCount"
    , ProjectWithRoleDTO -> Int
projectWithRoleDTOLeaderboardEntryCount  :: !(Int) -- ^ /Required/ "leaderboardEntryCount"
    -- ^ /Required/ "userRoleInProject"
    , ProjectWithRoleDTO -> ProjectRoleDTO
projectWithRoleDTOUserRoleInProject      :: !(ProjectRoleDTO) -- ^ /Required/ "userRoleInProject"
    -- ^ "backgroundUrl"
    , ProjectWithRoleDTO -> Maybe Text
projectWithRoleDTOBackgroundUrl          :: !(Maybe Text) -- ^ "backgroundUrl"
    }
    deriving (Int -> ProjectWithRoleDTO -> ShowS
[ProjectWithRoleDTO] -> ShowS
ProjectWithRoleDTO -> FilePath
(Int -> ProjectWithRoleDTO -> ShowS)
-> (ProjectWithRoleDTO -> FilePath)
-> ([ProjectWithRoleDTO] -> ShowS)
-> Show ProjectWithRoleDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectWithRoleDTO] -> ShowS
$cshowList :: [ProjectWithRoleDTO] -> ShowS
show :: ProjectWithRoleDTO -> FilePath
$cshow :: ProjectWithRoleDTO -> FilePath
showsPrec :: Int -> ProjectWithRoleDTO -> ShowS
$cshowsPrec :: Int -> ProjectWithRoleDTO -> ShowS
P.Show, ProjectWithRoleDTO -> ProjectWithRoleDTO -> Bool
(ProjectWithRoleDTO -> ProjectWithRoleDTO -> Bool)
-> (ProjectWithRoleDTO -> ProjectWithRoleDTO -> Bool)
-> Eq ProjectWithRoleDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectWithRoleDTO -> ProjectWithRoleDTO -> Bool
$c/= :: ProjectWithRoleDTO -> ProjectWithRoleDTO -> Bool
== :: ProjectWithRoleDTO -> ProjectWithRoleDTO -> Bool
$c== :: ProjectWithRoleDTO -> ProjectWithRoleDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON ProjectWithRoleDTO
instance A.FromJSON ProjectWithRoleDTO where
  parseJSON :: Value -> Parser ProjectWithRoleDTO
parseJSON = FilePath
-> (Object -> Parser ProjectWithRoleDTO)
-> Value
-> Parser ProjectWithRoleDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"ProjectWithRoleDTO" ((Object -> Parser ProjectWithRoleDTO)
 -> Value -> Parser ProjectWithRoleDTO)
-> (Object -> Parser ProjectWithRoleDTO)
-> Value
-> Parser ProjectWithRoleDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ProjectCodeAccessDTO
-> Text
-> Maybe Text
-> OrganizationTypeDTO
-> Bool
-> Text
-> Int
-> Text
-> Text
-> Text
-> Int
-> ProjectVisibilityDTO
-> Maybe Text
-> Text
-> DateTime
-> DateTime
-> Maybe OrganizationRoleDTO
-> AvatarSourceEnum
-> Int
-> ProjectRoleDTO
-> Maybe Text
-> ProjectWithRoleDTO
ProjectWithRoleDTO
      (ProjectCodeAccessDTO
 -> Text
 -> Maybe Text
 -> OrganizationTypeDTO
 -> Bool
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Int
 -> ProjectVisibilityDTO
 -> Maybe Text
 -> Text
 -> DateTime
 -> DateTime
 -> Maybe OrganizationRoleDTO
 -> AvatarSourceEnum
 -> Int
 -> ProjectRoleDTO
 -> Maybe Text
 -> ProjectWithRoleDTO)
-> Parser ProjectCodeAccessDTO
-> Parser
     (Text
      -> Maybe Text
      -> OrganizationTypeDTO
      -> Bool
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser ProjectCodeAccessDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"codeAccess")
      Parser
  (Text
   -> Maybe Text
   -> OrganizationTypeDTO
   -> Bool
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser Text
-> Parser
     (Maybe Text
      -> OrganizationTypeDTO
      -> Bool
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarUrl")
      Parser
  (Maybe Text
   -> OrganizationTypeDTO
   -> Bool
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser (Maybe Text)
-> Parser
     (OrganizationTypeDTO
      -> Bool
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")
      Parser
  (OrganizationTypeDTO
   -> Bool
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser OrganizationTypeDTO
-> Parser
     (Bool
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser OrganizationTypeDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationType")
      Parser
  (Bool
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser Bool
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"featured")
      Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationName")
      Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Text
      -> Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"version")
      Parser
  (Text
   -> Text
   -> Text
   -> Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")
      Parser
  (Text
   -> Text
   -> Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"projectKey")
      Parser
  (Text
   -> Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser Text
-> Parser
     (Int
      -> ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"organizationId")
      Parser
  (Int
   -> ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser Int
-> Parser
     (ProjectVisibilityDTO
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"userCount")
      Parser
  (ProjectVisibilityDTO
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser ProjectVisibilityDTO
-> Parser
     (Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ProjectVisibilityDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"visibility")
      Parser
  (Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"displayClass")
      Parser
  (Text
   -> DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser Text
-> Parser
     (DateTime
      -> DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (DateTime
   -> DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser DateTime
-> Parser
     (DateTime
      -> Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser DateTime
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"lastActivity")
      Parser
  (DateTime
   -> Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser DateTime
-> Parser
     (Maybe OrganizationRoleDTO
      -> AvatarSourceEnum
      -> Int
      -> ProjectRoleDTO
      -> Maybe Text
      -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser DateTime
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"timeOfCreation")
      Parser
  (Maybe OrganizationRoleDTO
   -> AvatarSourceEnum
   -> Int
   -> ProjectRoleDTO
   -> Maybe Text
   -> ProjectWithRoleDTO)
-> Parser (Maybe OrganizationRoleDTO)
-> Parser
     (AvatarSourceEnum
      -> Int -> ProjectRoleDTO -> Maybe Text -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe OrganizationRoleDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"userRoleInOrganization")
      Parser
  (AvatarSourceEnum
   -> Int -> ProjectRoleDTO -> Maybe Text -> ProjectWithRoleDTO)
-> Parser AvatarSourceEnum
-> Parser
     (Int -> ProjectRoleDTO -> Maybe Text -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser AvatarSourceEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarSource")
      Parser (Int -> ProjectRoleDTO -> Maybe Text -> ProjectWithRoleDTO)
-> Parser Int
-> Parser (ProjectRoleDTO -> Maybe Text -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"leaderboardEntryCount")
      Parser (ProjectRoleDTO -> Maybe Text -> ProjectWithRoleDTO)
-> Parser ProjectRoleDTO
-> Parser (Maybe Text -> ProjectWithRoleDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ProjectRoleDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"userRoleInProject")
      Parser (Maybe Text -> ProjectWithRoleDTO)
-> Parser (Maybe Text) -> Parser ProjectWithRoleDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"backgroundUrl")

-- | ToJSON ProjectWithRoleDTO
instance A.ToJSON ProjectWithRoleDTO where
  toJSON :: ProjectWithRoleDTO -> Value
toJSON ProjectWithRoleDTO {Bool
Int
Maybe Text
Maybe OrganizationRoleDTO
Text
DateTime
ProjectVisibilityDTO
ProjectRoleDTO
ProjectCodeAccessDTO
OrganizationTypeDTO
AvatarSourceEnum
projectWithRoleDTOBackgroundUrl :: Maybe Text
projectWithRoleDTOUserRoleInProject :: ProjectRoleDTO
projectWithRoleDTOLeaderboardEntryCount :: Int
projectWithRoleDTOAvatarSource :: AvatarSourceEnum
projectWithRoleDTOUserRoleInOrganization :: Maybe OrganizationRoleDTO
projectWithRoleDTOTimeOfCreation :: DateTime
projectWithRoleDTOLastActivity :: DateTime
projectWithRoleDTOName :: Text
projectWithRoleDTODisplayClass :: Maybe Text
projectWithRoleDTOVisibility :: ProjectVisibilityDTO
projectWithRoleDTOUserCount :: Int
projectWithRoleDTOOrganizationId :: Text
projectWithRoleDTOProjectKey :: Text
projectWithRoleDTOId :: Text
projectWithRoleDTOVersion :: Int
projectWithRoleDTOOrganizationName :: Text
projectWithRoleDTOFeatured :: Bool
projectWithRoleDTOOrganizationType :: OrganizationTypeDTO
projectWithRoleDTODescription :: Maybe Text
projectWithRoleDTOAvatarUrl :: Text
projectWithRoleDTOCodeAccess :: ProjectCodeAccessDTO
projectWithRoleDTOBackgroundUrl :: ProjectWithRoleDTO -> Maybe Text
projectWithRoleDTOUserRoleInProject :: ProjectWithRoleDTO -> ProjectRoleDTO
projectWithRoleDTOLeaderboardEntryCount :: ProjectWithRoleDTO -> Int
projectWithRoleDTOAvatarSource :: ProjectWithRoleDTO -> AvatarSourceEnum
projectWithRoleDTOUserRoleInOrganization :: ProjectWithRoleDTO -> Maybe OrganizationRoleDTO
projectWithRoleDTOTimeOfCreation :: ProjectWithRoleDTO -> DateTime
projectWithRoleDTOLastActivity :: ProjectWithRoleDTO -> DateTime
projectWithRoleDTOName :: ProjectWithRoleDTO -> Text
projectWithRoleDTODisplayClass :: ProjectWithRoleDTO -> Maybe Text
projectWithRoleDTOVisibility :: ProjectWithRoleDTO -> ProjectVisibilityDTO
projectWithRoleDTOUserCount :: ProjectWithRoleDTO -> Int
projectWithRoleDTOOrganizationId :: ProjectWithRoleDTO -> Text
projectWithRoleDTOProjectKey :: ProjectWithRoleDTO -> Text
projectWithRoleDTOId :: ProjectWithRoleDTO -> Text
projectWithRoleDTOVersion :: ProjectWithRoleDTO -> Int
projectWithRoleDTOOrganizationName :: ProjectWithRoleDTO -> Text
projectWithRoleDTOFeatured :: ProjectWithRoleDTO -> Bool
projectWithRoleDTOOrganizationType :: ProjectWithRoleDTO -> OrganizationTypeDTO
projectWithRoleDTODescription :: ProjectWithRoleDTO -> Maybe Text
projectWithRoleDTOAvatarUrl :: ProjectWithRoleDTO -> Text
projectWithRoleDTOCodeAccess :: ProjectWithRoleDTO -> ProjectCodeAccessDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"codeAccess" Text -> ProjectCodeAccessDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProjectCodeAccessDTO
projectWithRoleDTOCodeAccess
      , Text
"avatarUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectWithRoleDTOAvatarUrl
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
projectWithRoleDTODescription
      , Text
"organizationType" Text -> OrganizationTypeDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OrganizationTypeDTO
projectWithRoleDTOOrganizationType
      , Text
"featured" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
projectWithRoleDTOFeatured
      , Text
"organizationName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectWithRoleDTOOrganizationName
      , Text
"version" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
projectWithRoleDTOVersion
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectWithRoleDTOId
      , Text
"projectKey" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectWithRoleDTOProjectKey
      , Text
"organizationId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectWithRoleDTOOrganizationId
      , Text
"userCount" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
projectWithRoleDTOUserCount
      , Text
"visibility" Text -> ProjectVisibilityDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProjectVisibilityDTO
projectWithRoleDTOVisibility
      , Text
"displayClass" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
projectWithRoleDTODisplayClass
      , Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
projectWithRoleDTOName
      , Text
"lastActivity" Text -> DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DateTime
projectWithRoleDTOLastActivity
      , Text
"timeOfCreation" Text -> DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DateTime
projectWithRoleDTOTimeOfCreation
      , Text
"userRoleInOrganization" Text -> Maybe OrganizationRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe OrganizationRoleDTO
projectWithRoleDTOUserRoleInOrganization
      , Text
"avatarSource" Text -> AvatarSourceEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AvatarSourceEnum
projectWithRoleDTOAvatarSource
      , Text
"leaderboardEntryCount" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
projectWithRoleDTOLeaderboardEntryCount
      , Text
"userRoleInProject" Text -> ProjectRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProjectRoleDTO
projectWithRoleDTOUserRoleInProject
      , Text
"backgroundUrl" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
projectWithRoleDTOBackgroundUrl
      ]


-- | Construct a value of type 'ProjectWithRoleDTO' (by applying it's required fields, if any)
mkProjectWithRoleDTO
  :: ProjectCodeAccessDTO -- ^ 'projectWithRoleDTOCodeAccess'
  -> Text -- ^ 'projectWithRoleDTOAvatarUrl'
  -> OrganizationTypeDTO -- ^ 'projectWithRoleDTOOrganizationType'
  -> Bool -- ^ 'projectWithRoleDTOFeatured'
  -> Text -- ^ 'projectWithRoleDTOOrganizationName'
  -> Int -- ^ 'projectWithRoleDTOVersion'
  -> Text -- ^ 'projectWithRoleDTOId'
  -> Text -- ^ 'projectWithRoleDTOProjectKey'
  -> Text -- ^ 'projectWithRoleDTOOrganizationId'
  -> Int -- ^ 'projectWithRoleDTOUserCount'
  -> ProjectVisibilityDTO -- ^ 'projectWithRoleDTOVisibility'
  -> Text -- ^ 'projectWithRoleDTOName'
  -> DateTime -- ^ 'projectWithRoleDTOLastActivity'
  -> DateTime -- ^ 'projectWithRoleDTOTimeOfCreation'
  -> AvatarSourceEnum -- ^ 'projectWithRoleDTOAvatarSource'
  -> Int -- ^ 'projectWithRoleDTOLeaderboardEntryCount'
  -> ProjectRoleDTO -- ^ 'projectWithRoleDTOUserRoleInProject'
  -> ProjectWithRoleDTO
mkProjectWithRoleDTO :: ProjectCodeAccessDTO
-> Text
-> OrganizationTypeDTO
-> Bool
-> Text
-> Int
-> Text
-> Text
-> Text
-> Int
-> ProjectVisibilityDTO
-> Text
-> DateTime
-> DateTime
-> AvatarSourceEnum
-> Int
-> ProjectRoleDTO
-> ProjectWithRoleDTO
mkProjectWithRoleDTO ProjectCodeAccessDTO
projectWithRoleDTOCodeAccess Text
projectWithRoleDTOAvatarUrl OrganizationTypeDTO
projectWithRoleDTOOrganizationType Bool
projectWithRoleDTOFeatured Text
projectWithRoleDTOOrganizationName Int
projectWithRoleDTOVersion Text
projectWithRoleDTOId Text
projectWithRoleDTOProjectKey Text
projectWithRoleDTOOrganizationId Int
projectWithRoleDTOUserCount ProjectVisibilityDTO
projectWithRoleDTOVisibility Text
projectWithRoleDTOName DateTime
projectWithRoleDTOLastActivity DateTime
projectWithRoleDTOTimeOfCreation AvatarSourceEnum
projectWithRoleDTOAvatarSource Int
projectWithRoleDTOLeaderboardEntryCount ProjectRoleDTO
projectWithRoleDTOUserRoleInProject =
  ProjectWithRoleDTO :: ProjectCodeAccessDTO
-> Text
-> Maybe Text
-> OrganizationTypeDTO
-> Bool
-> Text
-> Int
-> Text
-> Text
-> Text
-> Int
-> ProjectVisibilityDTO
-> Maybe Text
-> Text
-> DateTime
-> DateTime
-> Maybe OrganizationRoleDTO
-> AvatarSourceEnum
-> Int
-> ProjectRoleDTO
-> Maybe Text
-> ProjectWithRoleDTO
ProjectWithRoleDTO
  { ProjectCodeAccessDTO
projectWithRoleDTOCodeAccess :: ProjectCodeAccessDTO
projectWithRoleDTOCodeAccess :: ProjectCodeAccessDTO
projectWithRoleDTOCodeAccess
  , Text
projectWithRoleDTOAvatarUrl :: Text
projectWithRoleDTOAvatarUrl :: Text
projectWithRoleDTOAvatarUrl
  , projectWithRoleDTODescription :: Maybe Text
projectWithRoleDTODescription = Maybe Text
forall a. Maybe a
Nothing
  , OrganizationTypeDTO
projectWithRoleDTOOrganizationType :: OrganizationTypeDTO
projectWithRoleDTOOrganizationType :: OrganizationTypeDTO
projectWithRoleDTOOrganizationType
  , Bool
projectWithRoleDTOFeatured :: Bool
projectWithRoleDTOFeatured :: Bool
projectWithRoleDTOFeatured
  , Text
projectWithRoleDTOOrganizationName :: Text
projectWithRoleDTOOrganizationName :: Text
projectWithRoleDTOOrganizationName
  , Int
projectWithRoleDTOVersion :: Int
projectWithRoleDTOVersion :: Int
projectWithRoleDTOVersion
  , Text
projectWithRoleDTOId :: Text
projectWithRoleDTOId :: Text
projectWithRoleDTOId
  , Text
projectWithRoleDTOProjectKey :: Text
projectWithRoleDTOProjectKey :: Text
projectWithRoleDTOProjectKey
  , Text
projectWithRoleDTOOrganizationId :: Text
projectWithRoleDTOOrganizationId :: Text
projectWithRoleDTOOrganizationId
  , Int
projectWithRoleDTOUserCount :: Int
projectWithRoleDTOUserCount :: Int
projectWithRoleDTOUserCount
  , ProjectVisibilityDTO
projectWithRoleDTOVisibility :: ProjectVisibilityDTO
projectWithRoleDTOVisibility :: ProjectVisibilityDTO
projectWithRoleDTOVisibility
  , projectWithRoleDTODisplayClass :: Maybe Text
projectWithRoleDTODisplayClass = Maybe Text
forall a. Maybe a
Nothing
  , Text
projectWithRoleDTOName :: Text
projectWithRoleDTOName :: Text
projectWithRoleDTOName
  , DateTime
projectWithRoleDTOLastActivity :: DateTime
projectWithRoleDTOLastActivity :: DateTime
projectWithRoleDTOLastActivity
  , DateTime
projectWithRoleDTOTimeOfCreation :: DateTime
projectWithRoleDTOTimeOfCreation :: DateTime
projectWithRoleDTOTimeOfCreation
  , projectWithRoleDTOUserRoleInOrganization :: Maybe OrganizationRoleDTO
projectWithRoleDTOUserRoleInOrganization = Maybe OrganizationRoleDTO
forall a. Maybe a
Nothing
  , AvatarSourceEnum
projectWithRoleDTOAvatarSource :: AvatarSourceEnum
projectWithRoleDTOAvatarSource :: AvatarSourceEnum
projectWithRoleDTOAvatarSource
  , Int
projectWithRoleDTOLeaderboardEntryCount :: Int
projectWithRoleDTOLeaderboardEntryCount :: Int
projectWithRoleDTOLeaderboardEntryCount
  , ProjectRoleDTO
projectWithRoleDTOUserRoleInProject :: ProjectRoleDTO
projectWithRoleDTOUserRoleInProject :: ProjectRoleDTO
projectWithRoleDTOUserRoleInProject
  , projectWithRoleDTOBackgroundUrl :: Maybe Text
projectWithRoleDTOBackgroundUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** PublicUserProfileDTO
-- | PublicUserProfileDTO
data PublicUserProfileDTO = PublicUserProfileDTO
    { PublicUserProfileDTO -> Text
publicUserProfileDTOBiography    :: !(Text) -- ^ /Required/ "biography"
    -- ^ "email"
    , PublicUserProfileDTO -> Maybe Text
publicUserProfileDTOEmail        :: !(Maybe Text) -- ^ "email"
    -- ^ /Required/ "avatarSource"
    , PublicUserProfileDTO -> AvatarSourceEnum
publicUserProfileDTOAvatarSource :: !(AvatarSourceEnum) -- ^ /Required/ "avatarSource"
    -- ^ "firstName"
    , PublicUserProfileDTO -> Maybe Text
publicUserProfileDTOFirstName    :: !(Maybe Text) -- ^ "firstName"
    -- ^ /Required/ "shortInfo"
    , PublicUserProfileDTO -> Text
publicUserProfileDTOShortInfo    :: !(Text) -- ^ /Required/ "shortInfo"
    -- ^ /Required/ "username"
    , PublicUserProfileDTO -> Text
publicUserProfileDTOUsername     :: !(Text) -- ^ /Required/ "username"
    -- ^ /Required/ "avatarUrl"
    , PublicUserProfileDTO -> Text
publicUserProfileDTOAvatarUrl    :: !(Text) -- ^ /Required/ "avatarUrl"
    -- ^ "lastName"
    , PublicUserProfileDTO -> Maybe Text
publicUserProfileDTOLastName     :: !(Maybe Text) -- ^ "lastName"
    -- ^ /Required/ "links"
    , PublicUserProfileDTO -> UserProfileLinksDTO
publicUserProfileDTOLinks        :: !(UserProfileLinksDTO) -- ^ /Required/ "links"
    }
    deriving (Int -> PublicUserProfileDTO -> ShowS
[PublicUserProfileDTO] -> ShowS
PublicUserProfileDTO -> FilePath
(Int -> PublicUserProfileDTO -> ShowS)
-> (PublicUserProfileDTO -> FilePath)
-> ([PublicUserProfileDTO] -> ShowS)
-> Show PublicUserProfileDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PublicUserProfileDTO] -> ShowS
$cshowList :: [PublicUserProfileDTO] -> ShowS
show :: PublicUserProfileDTO -> FilePath
$cshow :: PublicUserProfileDTO -> FilePath
showsPrec :: Int -> PublicUserProfileDTO -> ShowS
$cshowsPrec :: Int -> PublicUserProfileDTO -> ShowS
P.Show, PublicUserProfileDTO -> PublicUserProfileDTO -> Bool
(PublicUserProfileDTO -> PublicUserProfileDTO -> Bool)
-> (PublicUserProfileDTO -> PublicUserProfileDTO -> Bool)
-> Eq PublicUserProfileDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicUserProfileDTO -> PublicUserProfileDTO -> Bool
$c/= :: PublicUserProfileDTO -> PublicUserProfileDTO -> Bool
== :: PublicUserProfileDTO -> PublicUserProfileDTO -> Bool
$c== :: PublicUserProfileDTO -> PublicUserProfileDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON PublicUserProfileDTO
instance A.FromJSON PublicUserProfileDTO where
  parseJSON :: Value -> Parser PublicUserProfileDTO
parseJSON = FilePath
-> (Object -> Parser PublicUserProfileDTO)
-> Value
-> Parser PublicUserProfileDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"PublicUserProfileDTO" ((Object -> Parser PublicUserProfileDTO)
 -> Value -> Parser PublicUserProfileDTO)
-> (Object -> Parser PublicUserProfileDTO)
-> Value
-> Parser PublicUserProfileDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe Text
-> AvatarSourceEnum
-> Maybe Text
-> Text
-> Text
-> Text
-> Maybe Text
-> UserProfileLinksDTO
-> PublicUserProfileDTO
PublicUserProfileDTO
      (Text
 -> Maybe Text
 -> AvatarSourceEnum
 -> Maybe Text
 -> Text
 -> Text
 -> Text
 -> Maybe Text
 -> UserProfileLinksDTO
 -> PublicUserProfileDTO)
-> Parser Text
-> Parser
     (Maybe Text
      -> AvatarSourceEnum
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> UserProfileLinksDTO
      -> PublicUserProfileDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"biography")
      Parser
  (Maybe Text
   -> AvatarSourceEnum
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> UserProfileLinksDTO
   -> PublicUserProfileDTO)
-> Parser (Maybe Text)
-> Parser
     (AvatarSourceEnum
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> UserProfileLinksDTO
      -> PublicUserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"email")
      Parser
  (AvatarSourceEnum
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> UserProfileLinksDTO
   -> PublicUserProfileDTO)
-> Parser AvatarSourceEnum
-> Parser
     (Maybe Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> UserProfileLinksDTO
      -> PublicUserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser AvatarSourceEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarSource")
      Parser
  (Maybe Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> UserProfileLinksDTO
   -> PublicUserProfileDTO)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Text
      -> Text
      -> Maybe Text
      -> UserProfileLinksDTO
      -> PublicUserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"firstName")
      Parser
  (Text
   -> Text
   -> Text
   -> Maybe Text
   -> UserProfileLinksDTO
   -> PublicUserProfileDTO)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> UserProfileLinksDTO
      -> PublicUserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"shortInfo")
      Parser
  (Text
   -> Text
   -> Maybe Text
   -> UserProfileLinksDTO
   -> PublicUserProfileDTO)
-> Parser Text
-> Parser
     (Text -> Maybe Text -> UserProfileLinksDTO -> PublicUserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"username")
      Parser
  (Text -> Maybe Text -> UserProfileLinksDTO -> PublicUserProfileDTO)
-> Parser Text
-> Parser
     (Maybe Text -> UserProfileLinksDTO -> PublicUserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarUrl")
      Parser (Maybe Text -> UserProfileLinksDTO -> PublicUserProfileDTO)
-> Parser (Maybe Text)
-> Parser (UserProfileLinksDTO -> PublicUserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"lastName")
      Parser (UserProfileLinksDTO -> PublicUserProfileDTO)
-> Parser UserProfileLinksDTO -> Parser PublicUserProfileDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser UserProfileLinksDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"links")

-- | ToJSON PublicUserProfileDTO
instance A.ToJSON PublicUserProfileDTO where
  toJSON :: PublicUserProfileDTO -> Value
toJSON PublicUserProfileDTO {Maybe Text
Text
AvatarSourceEnum
UserProfileLinksDTO
publicUserProfileDTOLinks :: UserProfileLinksDTO
publicUserProfileDTOLastName :: Maybe Text
publicUserProfileDTOAvatarUrl :: Text
publicUserProfileDTOUsername :: Text
publicUserProfileDTOShortInfo :: Text
publicUserProfileDTOFirstName :: Maybe Text
publicUserProfileDTOAvatarSource :: AvatarSourceEnum
publicUserProfileDTOEmail :: Maybe Text
publicUserProfileDTOBiography :: Text
publicUserProfileDTOLinks :: PublicUserProfileDTO -> UserProfileLinksDTO
publicUserProfileDTOLastName :: PublicUserProfileDTO -> Maybe Text
publicUserProfileDTOAvatarUrl :: PublicUserProfileDTO -> Text
publicUserProfileDTOUsername :: PublicUserProfileDTO -> Text
publicUserProfileDTOShortInfo :: PublicUserProfileDTO -> Text
publicUserProfileDTOFirstName :: PublicUserProfileDTO -> Maybe Text
publicUserProfileDTOAvatarSource :: PublicUserProfileDTO -> AvatarSourceEnum
publicUserProfileDTOEmail :: PublicUserProfileDTO -> Maybe Text
publicUserProfileDTOBiography :: PublicUserProfileDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"biography" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
publicUserProfileDTOBiography
      , Text
"email" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
publicUserProfileDTOEmail
      , Text
"avatarSource" Text -> AvatarSourceEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AvatarSourceEnum
publicUserProfileDTOAvatarSource
      , Text
"firstName" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
publicUserProfileDTOFirstName
      , Text
"shortInfo" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
publicUserProfileDTOShortInfo
      , Text
"username" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
publicUserProfileDTOUsername
      , Text
"avatarUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
publicUserProfileDTOAvatarUrl
      , Text
"lastName" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
publicUserProfileDTOLastName
      , Text
"links" Text -> UserProfileLinksDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UserProfileLinksDTO
publicUserProfileDTOLinks
      ]


-- | Construct a value of type 'PublicUserProfileDTO' (by applying it's required fields, if any)
mkPublicUserProfileDTO
  :: Text -- ^ 'publicUserProfileDTOBiography'
  -> AvatarSourceEnum -- ^ 'publicUserProfileDTOAvatarSource'
  -> Text -- ^ 'publicUserProfileDTOShortInfo'
  -> Text -- ^ 'publicUserProfileDTOUsername'
  -> Text -- ^ 'publicUserProfileDTOAvatarUrl'
  -> UserProfileLinksDTO -- ^ 'publicUserProfileDTOLinks'
  -> PublicUserProfileDTO
mkPublicUserProfileDTO :: Text
-> AvatarSourceEnum
-> Text
-> Text
-> Text
-> UserProfileLinksDTO
-> PublicUserProfileDTO
mkPublicUserProfileDTO Text
publicUserProfileDTOBiography AvatarSourceEnum
publicUserProfileDTOAvatarSource Text
publicUserProfileDTOShortInfo Text
publicUserProfileDTOUsername Text
publicUserProfileDTOAvatarUrl UserProfileLinksDTO
publicUserProfileDTOLinks =
  PublicUserProfileDTO :: Text
-> Maybe Text
-> AvatarSourceEnum
-> Maybe Text
-> Text
-> Text
-> Text
-> Maybe Text
-> UserProfileLinksDTO
-> PublicUserProfileDTO
PublicUserProfileDTO
  { Text
publicUserProfileDTOBiography :: Text
publicUserProfileDTOBiography :: Text
publicUserProfileDTOBiography
  , publicUserProfileDTOEmail :: Maybe Text
publicUserProfileDTOEmail = Maybe Text
forall a. Maybe a
Nothing
  , AvatarSourceEnum
publicUserProfileDTOAvatarSource :: AvatarSourceEnum
publicUserProfileDTOAvatarSource :: AvatarSourceEnum
publicUserProfileDTOAvatarSource
  , publicUserProfileDTOFirstName :: Maybe Text
publicUserProfileDTOFirstName = Maybe Text
forall a. Maybe a
Nothing
  , Text
publicUserProfileDTOShortInfo :: Text
publicUserProfileDTOShortInfo :: Text
publicUserProfileDTOShortInfo
  , Text
publicUserProfileDTOUsername :: Text
publicUserProfileDTOUsername :: Text
publicUserProfileDTOUsername
  , Text
publicUserProfileDTOAvatarUrl :: Text
publicUserProfileDTOAvatarUrl :: Text
publicUserProfileDTOAvatarUrl
  , publicUserProfileDTOLastName :: Maybe Text
publicUserProfileDTOLastName = Maybe Text
forall a. Maybe a
Nothing
  , UserProfileLinksDTO
publicUserProfileDTOLinks :: UserProfileLinksDTO
publicUserProfileDTOLinks :: UserProfileLinksDTO
publicUserProfileDTOLinks
  }

-- ** QuestionnaireDTO
-- | QuestionnaireDTO
data QuestionnaireDTO = QuestionnaireDTO
    { QuestionnaireDTO -> Text
questionnaireDTOAnswers :: !(Text) -- ^ /Required/ "answers"
    }
    deriving (Int -> QuestionnaireDTO -> ShowS
[QuestionnaireDTO] -> ShowS
QuestionnaireDTO -> FilePath
(Int -> QuestionnaireDTO -> ShowS)
-> (QuestionnaireDTO -> FilePath)
-> ([QuestionnaireDTO] -> ShowS)
-> Show QuestionnaireDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [QuestionnaireDTO] -> ShowS
$cshowList :: [QuestionnaireDTO] -> ShowS
show :: QuestionnaireDTO -> FilePath
$cshow :: QuestionnaireDTO -> FilePath
showsPrec :: Int -> QuestionnaireDTO -> ShowS
$cshowsPrec :: Int -> QuestionnaireDTO -> ShowS
P.Show, QuestionnaireDTO -> QuestionnaireDTO -> Bool
(QuestionnaireDTO -> QuestionnaireDTO -> Bool)
-> (QuestionnaireDTO -> QuestionnaireDTO -> Bool)
-> Eq QuestionnaireDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuestionnaireDTO -> QuestionnaireDTO -> Bool
$c/= :: QuestionnaireDTO -> QuestionnaireDTO -> Bool
== :: QuestionnaireDTO -> QuestionnaireDTO -> Bool
$c== :: QuestionnaireDTO -> QuestionnaireDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON QuestionnaireDTO
instance A.FromJSON QuestionnaireDTO where
  parseJSON :: Value -> Parser QuestionnaireDTO
parseJSON = FilePath
-> (Object -> Parser QuestionnaireDTO)
-> Value
-> Parser QuestionnaireDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"QuestionnaireDTO" ((Object -> Parser QuestionnaireDTO)
 -> Value -> Parser QuestionnaireDTO)
-> (Object -> Parser QuestionnaireDTO)
-> Value
-> Parser QuestionnaireDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> QuestionnaireDTO
QuestionnaireDTO
      (Text -> QuestionnaireDTO)
-> Parser Text -> Parser QuestionnaireDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"answers")

-- | ToJSON QuestionnaireDTO
instance A.ToJSON QuestionnaireDTO where
  toJSON :: QuestionnaireDTO -> Value
toJSON QuestionnaireDTO {Text
questionnaireDTOAnswers :: Text
questionnaireDTOAnswers :: QuestionnaireDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"answers" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
questionnaireDTOAnswers
      ]


-- | Construct a value of type 'QuestionnaireDTO' (by applying it's required fields, if any)
mkQuestionnaireDTO
  :: Text -- ^ 'questionnaireDTOAnswers'
  -> QuestionnaireDTO
mkQuestionnaireDTO :: Text -> QuestionnaireDTO
mkQuestionnaireDTO Text
questionnaireDTOAnswers =
  QuestionnaireDTO :: Text -> QuestionnaireDTO
QuestionnaireDTO
  { Text
questionnaireDTOAnswers :: Text
questionnaireDTOAnswers :: Text
questionnaireDTOAnswers
  }

-- ** RegisteredMemberInfoDTO
-- | RegisteredMemberInfoDTO
data RegisteredMemberInfoDTO = RegisteredMemberInfoDTO
    { RegisteredMemberInfoDTO -> AvatarSourceEnum
registeredMemberInfoDTOAvatarSource :: !(AvatarSourceEnum) -- ^ /Required/ "avatarSource"
    -- ^ /Required/ "lastName"
    , RegisteredMemberInfoDTO -> Text
registeredMemberInfoDTOLastName     :: !(Text) -- ^ /Required/ "lastName"
    -- ^ /Required/ "firstName"
    , RegisteredMemberInfoDTO -> Text
registeredMemberInfoDTOFirstName    :: !(Text) -- ^ /Required/ "firstName"
    -- ^ /Required/ "username"
    , RegisteredMemberInfoDTO -> Text
registeredMemberInfoDTOUsername     :: !(Text) -- ^ /Required/ "username"
    -- ^ /Required/ "avatarUrl"
    , RegisteredMemberInfoDTO -> Text
registeredMemberInfoDTOAvatarUrl    :: !(Text) -- ^ /Required/ "avatarUrl"
    }
    deriving (Int -> RegisteredMemberInfoDTO -> ShowS
[RegisteredMemberInfoDTO] -> ShowS
RegisteredMemberInfoDTO -> FilePath
(Int -> RegisteredMemberInfoDTO -> ShowS)
-> (RegisteredMemberInfoDTO -> FilePath)
-> ([RegisteredMemberInfoDTO] -> ShowS)
-> Show RegisteredMemberInfoDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RegisteredMemberInfoDTO] -> ShowS
$cshowList :: [RegisteredMemberInfoDTO] -> ShowS
show :: RegisteredMemberInfoDTO -> FilePath
$cshow :: RegisteredMemberInfoDTO -> FilePath
showsPrec :: Int -> RegisteredMemberInfoDTO -> ShowS
$cshowsPrec :: Int -> RegisteredMemberInfoDTO -> ShowS
P.Show, RegisteredMemberInfoDTO -> RegisteredMemberInfoDTO -> Bool
(RegisteredMemberInfoDTO -> RegisteredMemberInfoDTO -> Bool)
-> (RegisteredMemberInfoDTO -> RegisteredMemberInfoDTO -> Bool)
-> Eq RegisteredMemberInfoDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisteredMemberInfoDTO -> RegisteredMemberInfoDTO -> Bool
$c/= :: RegisteredMemberInfoDTO -> RegisteredMemberInfoDTO -> Bool
== :: RegisteredMemberInfoDTO -> RegisteredMemberInfoDTO -> Bool
$c== :: RegisteredMemberInfoDTO -> RegisteredMemberInfoDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON RegisteredMemberInfoDTO
instance A.FromJSON RegisteredMemberInfoDTO where
  parseJSON :: Value -> Parser RegisteredMemberInfoDTO
parseJSON = FilePath
-> (Object -> Parser RegisteredMemberInfoDTO)
-> Value
-> Parser RegisteredMemberInfoDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"RegisteredMemberInfoDTO" ((Object -> Parser RegisteredMemberInfoDTO)
 -> Value -> Parser RegisteredMemberInfoDTO)
-> (Object -> Parser RegisteredMemberInfoDTO)
-> Value
-> Parser RegisteredMemberInfoDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    AvatarSourceEnum
-> Text -> Text -> Text -> Text -> RegisteredMemberInfoDTO
RegisteredMemberInfoDTO
      (AvatarSourceEnum
 -> Text -> Text -> Text -> Text -> RegisteredMemberInfoDTO)
-> Parser AvatarSourceEnum
-> Parser (Text -> Text -> Text -> Text -> RegisteredMemberInfoDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser AvatarSourceEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarSource")
      Parser (Text -> Text -> Text -> Text -> RegisteredMemberInfoDTO)
-> Parser Text
-> Parser (Text -> Text -> Text -> RegisteredMemberInfoDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"lastName")
      Parser (Text -> Text -> Text -> RegisteredMemberInfoDTO)
-> Parser Text -> Parser (Text -> Text -> RegisteredMemberInfoDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"firstName")
      Parser (Text -> Text -> RegisteredMemberInfoDTO)
-> Parser Text -> Parser (Text -> RegisteredMemberInfoDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"username")
      Parser (Text -> RegisteredMemberInfoDTO)
-> Parser Text -> Parser RegisteredMemberInfoDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarUrl")

-- | ToJSON RegisteredMemberInfoDTO
instance A.ToJSON RegisteredMemberInfoDTO where
  toJSON :: RegisteredMemberInfoDTO -> Value
toJSON RegisteredMemberInfoDTO {Text
AvatarSourceEnum
registeredMemberInfoDTOAvatarUrl :: Text
registeredMemberInfoDTOUsername :: Text
registeredMemberInfoDTOFirstName :: Text
registeredMemberInfoDTOLastName :: Text
registeredMemberInfoDTOAvatarSource :: AvatarSourceEnum
registeredMemberInfoDTOAvatarUrl :: RegisteredMemberInfoDTO -> Text
registeredMemberInfoDTOUsername :: RegisteredMemberInfoDTO -> Text
registeredMemberInfoDTOFirstName :: RegisteredMemberInfoDTO -> Text
registeredMemberInfoDTOLastName :: RegisteredMemberInfoDTO -> Text
registeredMemberInfoDTOAvatarSource :: RegisteredMemberInfoDTO -> AvatarSourceEnum
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"avatarSource" Text -> AvatarSourceEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AvatarSourceEnum
registeredMemberInfoDTOAvatarSource
      , Text
"lastName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
registeredMemberInfoDTOLastName
      , Text
"firstName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
registeredMemberInfoDTOFirstName
      , Text
"username" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
registeredMemberInfoDTOUsername
      , Text
"avatarUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
registeredMemberInfoDTOAvatarUrl
      ]


-- | Construct a value of type 'RegisteredMemberInfoDTO' (by applying it's required fields, if any)
mkRegisteredMemberInfoDTO
  :: AvatarSourceEnum -- ^ 'registeredMemberInfoDTOAvatarSource'
  -> Text -- ^ 'registeredMemberInfoDTOLastName'
  -> Text -- ^ 'registeredMemberInfoDTOFirstName'
  -> Text -- ^ 'registeredMemberInfoDTOUsername'
  -> Text -- ^ 'registeredMemberInfoDTOAvatarUrl'
  -> RegisteredMemberInfoDTO
mkRegisteredMemberInfoDTO :: AvatarSourceEnum
-> Text -> Text -> Text -> Text -> RegisteredMemberInfoDTO
mkRegisteredMemberInfoDTO AvatarSourceEnum
registeredMemberInfoDTOAvatarSource Text
registeredMemberInfoDTOLastName Text
registeredMemberInfoDTOFirstName Text
registeredMemberInfoDTOUsername Text
registeredMemberInfoDTOAvatarUrl =
  RegisteredMemberInfoDTO :: AvatarSourceEnum
-> Text -> Text -> Text -> Text -> RegisteredMemberInfoDTO
RegisteredMemberInfoDTO
  { AvatarSourceEnum
registeredMemberInfoDTOAvatarSource :: AvatarSourceEnum
registeredMemberInfoDTOAvatarSource :: AvatarSourceEnum
registeredMemberInfoDTOAvatarSource
  , Text
registeredMemberInfoDTOLastName :: Text
registeredMemberInfoDTOLastName :: Text
registeredMemberInfoDTOLastName
  , Text
registeredMemberInfoDTOFirstName :: Text
registeredMemberInfoDTOFirstName :: Text
registeredMemberInfoDTOFirstName
  , Text
registeredMemberInfoDTOUsername :: Text
registeredMemberInfoDTOUsername :: Text
registeredMemberInfoDTOUsername
  , Text
registeredMemberInfoDTOAvatarUrl :: Text
registeredMemberInfoDTOAvatarUrl :: Text
registeredMemberInfoDTOAvatarUrl
  }

-- ** RegistrationSurveyDTO
-- | RegistrationSurveyDTO
data RegistrationSurveyDTO = RegistrationSurveyDTO
    { RegistrationSurveyDTO -> Text
registrationSurveyDTOSurvey :: !(Text) -- ^ /Required/ "survey"
    }
    deriving (Int -> RegistrationSurveyDTO -> ShowS
[RegistrationSurveyDTO] -> ShowS
RegistrationSurveyDTO -> FilePath
(Int -> RegistrationSurveyDTO -> ShowS)
-> (RegistrationSurveyDTO -> FilePath)
-> ([RegistrationSurveyDTO] -> ShowS)
-> Show RegistrationSurveyDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RegistrationSurveyDTO] -> ShowS
$cshowList :: [RegistrationSurveyDTO] -> ShowS
show :: RegistrationSurveyDTO -> FilePath
$cshow :: RegistrationSurveyDTO -> FilePath
showsPrec :: Int -> RegistrationSurveyDTO -> ShowS
$cshowsPrec :: Int -> RegistrationSurveyDTO -> ShowS
P.Show, RegistrationSurveyDTO -> RegistrationSurveyDTO -> Bool
(RegistrationSurveyDTO -> RegistrationSurveyDTO -> Bool)
-> (RegistrationSurveyDTO -> RegistrationSurveyDTO -> Bool)
-> Eq RegistrationSurveyDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegistrationSurveyDTO -> RegistrationSurveyDTO -> Bool
$c/= :: RegistrationSurveyDTO -> RegistrationSurveyDTO -> Bool
== :: RegistrationSurveyDTO -> RegistrationSurveyDTO -> Bool
$c== :: RegistrationSurveyDTO -> RegistrationSurveyDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON RegistrationSurveyDTO
instance A.FromJSON RegistrationSurveyDTO where
  parseJSON :: Value -> Parser RegistrationSurveyDTO
parseJSON = FilePath
-> (Object -> Parser RegistrationSurveyDTO)
-> Value
-> Parser RegistrationSurveyDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"RegistrationSurveyDTO" ((Object -> Parser RegistrationSurveyDTO)
 -> Value -> Parser RegistrationSurveyDTO)
-> (Object -> Parser RegistrationSurveyDTO)
-> Value
-> Parser RegistrationSurveyDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> RegistrationSurveyDTO
RegistrationSurveyDTO
      (Text -> RegistrationSurveyDTO)
-> Parser Text -> Parser RegistrationSurveyDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"survey")

-- | ToJSON RegistrationSurveyDTO
instance A.ToJSON RegistrationSurveyDTO where
  toJSON :: RegistrationSurveyDTO -> Value
toJSON RegistrationSurveyDTO {Text
registrationSurveyDTOSurvey :: Text
registrationSurveyDTOSurvey :: RegistrationSurveyDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"survey" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
registrationSurveyDTOSurvey
      ]


-- | Construct a value of type 'RegistrationSurveyDTO' (by applying it's required fields, if any)
mkRegistrationSurveyDTO
  :: Text -- ^ 'registrationSurveyDTOSurvey'
  -> RegistrationSurveyDTO
mkRegistrationSurveyDTO :: Text -> RegistrationSurveyDTO
mkRegistrationSurveyDTO Text
registrationSurveyDTOSurvey =
  RegistrationSurveyDTO :: Text -> RegistrationSurveyDTO
RegistrationSurveyDTO
  { Text
registrationSurveyDTOSurvey :: Text
registrationSurveyDTOSurvey :: Text
registrationSurveyDTOSurvey
  }

-- ** Series
-- | Series
data Series = Series
    { Series -> SeriesType
seriesSeriesType  :: !(SeriesType) -- ^ /Required/ "seriesType"
    -- ^ "channelName"
    , Series -> Maybe Text
seriesChannelName :: !(Maybe Text) -- ^ "channelName"
    -- ^ "channelId"
    , Series -> Maybe Text
seriesChannelId   :: !(Maybe Text) -- ^ "channelId"
    -- ^ "aliasId"
    , Series -> Maybe Text
seriesAliasId     :: !(Maybe Text) -- ^ "aliasId"
    -- ^ /Required/ "label"
    , Series -> Text
seriesLabel       :: !(Text) -- ^ /Required/ "label"
    }
    deriving (Int -> Series -> ShowS
[Series] -> ShowS
Series -> FilePath
(Int -> Series -> ShowS)
-> (Series -> FilePath) -> ([Series] -> ShowS) -> Show Series
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Series] -> ShowS
$cshowList :: [Series] -> ShowS
show :: Series -> FilePath
$cshow :: Series -> FilePath
showsPrec :: Int -> Series -> ShowS
$cshowsPrec :: Int -> Series -> ShowS
P.Show, Series -> Series -> Bool
(Series -> Series -> Bool)
-> (Series -> Series -> Bool) -> Eq Series
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Series -> Series -> Bool
$c/= :: Series -> Series -> Bool
== :: Series -> Series -> Bool
$c== :: Series -> Series -> Bool
P.Eq, P.Typeable)

-- | FromJSON Series
instance A.FromJSON Series where
  parseJSON :: Value -> Parser Series
parseJSON = FilePath -> (Object -> Parser Series) -> Value -> Parser Series
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Series" ((Object -> Parser Series) -> Value -> Parser Series)
-> (Object -> Parser Series) -> Value -> Parser Series
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SeriesType
-> Maybe Text -> Maybe Text -> Maybe Text -> Text -> Series
Series
      (SeriesType
 -> Maybe Text -> Maybe Text -> Maybe Text -> Text -> Series)
-> Parser SeriesType
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> Text -> Series)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser SeriesType
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"seriesType")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> Text -> Series)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Text -> Series)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channelName")
      Parser (Maybe Text -> Maybe Text -> Text -> Series)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Text -> Series)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channelId")
      Parser (Maybe Text -> Text -> Series)
-> Parser (Maybe Text) -> Parser (Text -> Series)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"aliasId")
      Parser (Text -> Series) -> Parser Text -> Parser Series
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"label")

-- | ToJSON Series
instance A.ToJSON Series where
  toJSON :: Series -> Value
toJSON Series {Maybe Text
Text
SeriesType
seriesLabel :: Text
seriesAliasId :: Maybe Text
seriesChannelId :: Maybe Text
seriesChannelName :: Maybe Text
seriesSeriesType :: SeriesType
seriesLabel :: Series -> Text
seriesAliasId :: Series -> Maybe Text
seriesChannelId :: Series -> Maybe Text
seriesChannelName :: Series -> Maybe Text
seriesSeriesType :: Series -> SeriesType
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"seriesType" Text -> SeriesType -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SeriesType
seriesSeriesType
      , Text
"channelName" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
seriesChannelName
      , Text
"channelId" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
seriesChannelId
      , Text
"aliasId" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
seriesAliasId
      , Text
"label" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
seriesLabel
      ]


-- | Construct a value of type 'Series' (by applying it's required fields, if any)
mkSeries
  :: SeriesType -- ^ 'seriesSeriesType'
  -> Text -- ^ 'seriesLabel'
  -> Series
mkSeries :: SeriesType -> Text -> Series
mkSeries SeriesType
seriesSeriesType Text
seriesLabel =
  Series :: SeriesType
-> Maybe Text -> Maybe Text -> Maybe Text -> Text -> Series
Series
  { SeriesType
seriesSeriesType :: SeriesType
seriesSeriesType :: SeriesType
seriesSeriesType
  , seriesChannelName :: Maybe Text
seriesChannelName = Maybe Text
forall a. Maybe a
Nothing
  , seriesChannelId :: Maybe Text
seriesChannelId = Maybe Text
forall a. Maybe a
Nothing
  , seriesAliasId :: Maybe Text
seriesAliasId = Maybe Text
forall a. Maybe a
Nothing
  , Text
seriesLabel :: Text
seriesLabel :: Text
seriesLabel
  }

-- ** SeriesDefinition
-- | SeriesDefinition
data SeriesDefinition = SeriesDefinition
    { SeriesDefinition -> Text
seriesDefinitionLabel       :: !(Text) -- ^ /Required/ "label"
    -- ^ "channelName"
    , SeriesDefinition -> Maybe Text
seriesDefinitionChannelName :: !(Maybe Text) -- ^ "channelName"
    -- ^ "aliasId"
    , SeriesDefinition -> Maybe Text
seriesDefinitionAliasId     :: !(Maybe Text) -- ^ "aliasId"
    -- ^ /Required/ "seriesType"
    , SeriesDefinition -> SeriesType
seriesDefinitionSeriesType  :: !(SeriesType) -- ^ /Required/ "seriesType"
    }
    deriving (Int -> SeriesDefinition -> ShowS
[SeriesDefinition] -> ShowS
SeriesDefinition -> FilePath
(Int -> SeriesDefinition -> ShowS)
-> (SeriesDefinition -> FilePath)
-> ([SeriesDefinition] -> ShowS)
-> Show SeriesDefinition
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SeriesDefinition] -> ShowS
$cshowList :: [SeriesDefinition] -> ShowS
show :: SeriesDefinition -> FilePath
$cshow :: SeriesDefinition -> FilePath
showsPrec :: Int -> SeriesDefinition -> ShowS
$cshowsPrec :: Int -> SeriesDefinition -> ShowS
P.Show, SeriesDefinition -> SeriesDefinition -> Bool
(SeriesDefinition -> SeriesDefinition -> Bool)
-> (SeriesDefinition -> SeriesDefinition -> Bool)
-> Eq SeriesDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeriesDefinition -> SeriesDefinition -> Bool
$c/= :: SeriesDefinition -> SeriesDefinition -> Bool
== :: SeriesDefinition -> SeriesDefinition -> Bool
$c== :: SeriesDefinition -> SeriesDefinition -> Bool
P.Eq, P.Typeable)

-- | FromJSON SeriesDefinition
instance A.FromJSON SeriesDefinition where
  parseJSON :: Value -> Parser SeriesDefinition
parseJSON = FilePath
-> (Object -> Parser SeriesDefinition)
-> Value
-> Parser SeriesDefinition
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"SeriesDefinition" ((Object -> Parser SeriesDefinition)
 -> Value -> Parser SeriesDefinition)
-> (Object -> Parser SeriesDefinition)
-> Value
-> Parser SeriesDefinition
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe Text -> Maybe Text -> SeriesType -> SeriesDefinition
SeriesDefinition
      (Text
 -> Maybe Text -> Maybe Text -> SeriesType -> SeriesDefinition)
-> Parser Text
-> Parser
     (Maybe Text -> Maybe Text -> SeriesType -> SeriesDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"label")
      Parser (Maybe Text -> Maybe Text -> SeriesType -> SeriesDefinition)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> SeriesType -> SeriesDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channelName")
      Parser (Maybe Text -> SeriesType -> SeriesDefinition)
-> Parser (Maybe Text) -> Parser (SeriesType -> SeriesDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"aliasId")
      Parser (SeriesType -> SeriesDefinition)
-> Parser SeriesType -> Parser SeriesDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser SeriesType
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"seriesType")

-- | ToJSON SeriesDefinition
instance A.ToJSON SeriesDefinition where
  toJSON :: SeriesDefinition -> Value
toJSON SeriesDefinition {Maybe Text
Text
SeriesType
seriesDefinitionSeriesType :: SeriesType
seriesDefinitionAliasId :: Maybe Text
seriesDefinitionChannelName :: Maybe Text
seriesDefinitionLabel :: Text
seriesDefinitionSeriesType :: SeriesDefinition -> SeriesType
seriesDefinitionAliasId :: SeriesDefinition -> Maybe Text
seriesDefinitionChannelName :: SeriesDefinition -> Maybe Text
seriesDefinitionLabel :: SeriesDefinition -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"label" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
seriesDefinitionLabel
      , Text
"channelName" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
seriesDefinitionChannelName
      , Text
"aliasId" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
seriesDefinitionAliasId
      , Text
"seriesType" Text -> SeriesType -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SeriesType
seriesDefinitionSeriesType
      ]


-- | Construct a value of type 'SeriesDefinition' (by applying it's required fields, if any)
mkSeriesDefinition
  :: Text -- ^ 'seriesDefinitionLabel'
  -> SeriesType -- ^ 'seriesDefinitionSeriesType'
  -> SeriesDefinition
mkSeriesDefinition :: Text -> SeriesType -> SeriesDefinition
mkSeriesDefinition Text
seriesDefinitionLabel SeriesType
seriesDefinitionSeriesType =
  SeriesDefinition :: Text -> Maybe Text -> Maybe Text -> SeriesType -> SeriesDefinition
SeriesDefinition
  { Text
seriesDefinitionLabel :: Text
seriesDefinitionLabel :: Text
seriesDefinitionLabel
  , seriesDefinitionChannelName :: Maybe Text
seriesDefinitionChannelName = Maybe Text
forall a. Maybe a
Nothing
  , seriesDefinitionAliasId :: Maybe Text
seriesDefinitionAliasId = Maybe Text
forall a. Maybe a
Nothing
  , SeriesType
seriesDefinitionSeriesType :: SeriesType
seriesDefinitionSeriesType :: SeriesType
seriesDefinitionSeriesType
  }

-- ** SessionDTO
-- | SessionDTO
data SessionDTO = SessionDTO
    { SessionDTO -> Text
sessionDTOSessionId :: !(Text) -- ^ /Required/ "sessionId"
    }
    deriving (Int -> SessionDTO -> ShowS
[SessionDTO] -> ShowS
SessionDTO -> FilePath
(Int -> SessionDTO -> ShowS)
-> (SessionDTO -> FilePath)
-> ([SessionDTO] -> ShowS)
-> Show SessionDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SessionDTO] -> ShowS
$cshowList :: [SessionDTO] -> ShowS
show :: SessionDTO -> FilePath
$cshow :: SessionDTO -> FilePath
showsPrec :: Int -> SessionDTO -> ShowS
$cshowsPrec :: Int -> SessionDTO -> ShowS
P.Show, SessionDTO -> SessionDTO -> Bool
(SessionDTO -> SessionDTO -> Bool)
-> (SessionDTO -> SessionDTO -> Bool) -> Eq SessionDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionDTO -> SessionDTO -> Bool
$c/= :: SessionDTO -> SessionDTO -> Bool
== :: SessionDTO -> SessionDTO -> Bool
$c== :: SessionDTO -> SessionDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON SessionDTO
instance A.FromJSON SessionDTO where
  parseJSON :: Value -> Parser SessionDTO
parseJSON = FilePath
-> (Object -> Parser SessionDTO) -> Value -> Parser SessionDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"SessionDTO" ((Object -> Parser SessionDTO) -> Value -> Parser SessionDTO)
-> (Object -> Parser SessionDTO) -> Value -> Parser SessionDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> SessionDTO
SessionDTO
      (Text -> SessionDTO) -> Parser Text -> Parser SessionDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"sessionId")

-- | ToJSON SessionDTO
instance A.ToJSON SessionDTO where
  toJSON :: SessionDTO -> Value
toJSON SessionDTO {Text
sessionDTOSessionId :: Text
sessionDTOSessionId :: SessionDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"sessionId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
sessionDTOSessionId
      ]


-- | Construct a value of type 'SessionDTO' (by applying it's required fields, if any)
mkSessionDTO
  :: Text -- ^ 'sessionDTOSessionId'
  -> SessionDTO
mkSessionDTO :: Text -> SessionDTO
mkSessionDTO Text
sessionDTOSessionId =
  SessionDTO :: Text -> SessionDTO
SessionDTO
  { Text
sessionDTOSessionId :: Text
sessionDTOSessionId :: Text
sessionDTOSessionId
  }

-- ** StateTransitions
-- | StateTransitions
data StateTransitions = StateTransitions
    { StateTransitions -> Maybe DateTime
stateTransitionsRunning   :: !(Maybe DateTime) -- ^ "running"
    -- ^ "succeeded"
    , StateTransitions -> Maybe DateTime
stateTransitionsSucceeded :: !(Maybe DateTime) -- ^ "succeeded"
    -- ^ "failed"
    , StateTransitions -> Maybe DateTime
stateTransitionsFailed    :: !(Maybe DateTime) -- ^ "failed"
    -- ^ "aborted"
    , StateTransitions -> Maybe DateTime
stateTransitionsAborted   :: !(Maybe DateTime) -- ^ "aborted"
    }
    deriving (Int -> StateTransitions -> ShowS
[StateTransitions] -> ShowS
StateTransitions -> FilePath
(Int -> StateTransitions -> ShowS)
-> (StateTransitions -> FilePath)
-> ([StateTransitions] -> ShowS)
-> Show StateTransitions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StateTransitions] -> ShowS
$cshowList :: [StateTransitions] -> ShowS
show :: StateTransitions -> FilePath
$cshow :: StateTransitions -> FilePath
showsPrec :: Int -> StateTransitions -> ShowS
$cshowsPrec :: Int -> StateTransitions -> ShowS
P.Show, StateTransitions -> StateTransitions -> Bool
(StateTransitions -> StateTransitions -> Bool)
-> (StateTransitions -> StateTransitions -> Bool)
-> Eq StateTransitions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateTransitions -> StateTransitions -> Bool
$c/= :: StateTransitions -> StateTransitions -> Bool
== :: StateTransitions -> StateTransitions -> Bool
$c== :: StateTransitions -> StateTransitions -> Bool
P.Eq, P.Typeable)

-- | FromJSON StateTransitions
instance A.FromJSON StateTransitions where
  parseJSON :: Value -> Parser StateTransitions
parseJSON = FilePath
-> (Object -> Parser StateTransitions)
-> Value
-> Parser StateTransitions
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"StateTransitions" ((Object -> Parser StateTransitions)
 -> Value -> Parser StateTransitions)
-> (Object -> Parser StateTransitions)
-> Value
-> Parser StateTransitions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe DateTime
-> Maybe DateTime
-> Maybe DateTime
-> StateTransitions
StateTransitions
      (Maybe DateTime
 -> Maybe DateTime
 -> Maybe DateTime
 -> Maybe DateTime
 -> StateTransitions)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe DateTime
      -> Maybe DateTime -> Maybe DateTime -> StateTransitions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"running")
      Parser
  (Maybe DateTime
   -> Maybe DateTime -> Maybe DateTime -> StateTransitions)
-> Parser (Maybe DateTime)
-> Parser (Maybe DateTime -> Maybe DateTime -> StateTransitions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"succeeded")
      Parser (Maybe DateTime -> Maybe DateTime -> StateTransitions)
-> Parser (Maybe DateTime)
-> Parser (Maybe DateTime -> StateTransitions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"failed")
      Parser (Maybe DateTime -> StateTransitions)
-> Parser (Maybe DateTime) -> Parser StateTransitions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"aborted")

-- | ToJSON StateTransitions
instance A.ToJSON StateTransitions where
  toJSON :: StateTransitions -> Value
toJSON StateTransitions {Maybe DateTime
stateTransitionsAborted :: Maybe DateTime
stateTransitionsFailed :: Maybe DateTime
stateTransitionsSucceeded :: Maybe DateTime
stateTransitionsRunning :: Maybe DateTime
stateTransitionsAborted :: StateTransitions -> Maybe DateTime
stateTransitionsFailed :: StateTransitions -> Maybe DateTime
stateTransitionsSucceeded :: StateTransitions -> Maybe DateTime
stateTransitionsRunning :: StateTransitions -> Maybe DateTime
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"running" Text -> Maybe DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe DateTime
stateTransitionsRunning
      , Text
"succeeded" Text -> Maybe DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe DateTime
stateTransitionsSucceeded
      , Text
"failed" Text -> Maybe DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe DateTime
stateTransitionsFailed
      , Text
"aborted" Text -> Maybe DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe DateTime
stateTransitionsAborted
      ]


-- | Construct a value of type 'StateTransitions' (by applying it's required fields, if any)
mkStateTransitions
  :: StateTransitions
mkStateTransitions :: StateTransitions
mkStateTransitions =
  StateTransitions :: Maybe DateTime
-> Maybe DateTime
-> Maybe DateTime
-> Maybe DateTime
-> StateTransitions
StateTransitions
  { stateTransitionsRunning :: Maybe DateTime
stateTransitionsRunning = Maybe DateTime
forall a. Maybe a
Nothing
  , stateTransitionsSucceeded :: Maybe DateTime
stateTransitionsSucceeded = Maybe DateTime
forall a. Maybe a
Nothing
  , stateTransitionsFailed :: Maybe DateTime
stateTransitionsFailed = Maybe DateTime
forall a. Maybe a
Nothing
  , stateTransitionsAborted :: Maybe DateTime
stateTransitionsAborted = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** StorageUsage
-- | StorageUsage
data StorageUsage = StorageUsage
    { StorageUsage -> Integer
storageUsageUsage :: !(Integer) -- ^ /Required/ "usage"
    }
    deriving (Int -> StorageUsage -> ShowS
[StorageUsage] -> ShowS
StorageUsage -> FilePath
(Int -> StorageUsage -> ShowS)
-> (StorageUsage -> FilePath)
-> ([StorageUsage] -> ShowS)
-> Show StorageUsage
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StorageUsage] -> ShowS
$cshowList :: [StorageUsage] -> ShowS
show :: StorageUsage -> FilePath
$cshow :: StorageUsage -> FilePath
showsPrec :: Int -> StorageUsage -> ShowS
$cshowsPrec :: Int -> StorageUsage -> ShowS
P.Show, StorageUsage -> StorageUsage -> Bool
(StorageUsage -> StorageUsage -> Bool)
-> (StorageUsage -> StorageUsage -> Bool) -> Eq StorageUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageUsage -> StorageUsage -> Bool
$c/= :: StorageUsage -> StorageUsage -> Bool
== :: StorageUsage -> StorageUsage -> Bool
$c== :: StorageUsage -> StorageUsage -> Bool
P.Eq, P.Typeable)

-- | FromJSON StorageUsage
instance A.FromJSON StorageUsage where
  parseJSON :: Value -> Parser StorageUsage
parseJSON = FilePath
-> (Object -> Parser StorageUsage) -> Value -> Parser StorageUsage
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"StorageUsage" ((Object -> Parser StorageUsage) -> Value -> Parser StorageUsage)
-> (Object -> Parser StorageUsage) -> Value -> Parser StorageUsage
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Integer -> StorageUsage
StorageUsage
      (Integer -> StorageUsage) -> Parser Integer -> Parser StorageUsage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"usage")

-- | ToJSON StorageUsage
instance A.ToJSON StorageUsage where
  toJSON :: StorageUsage -> Value
toJSON StorageUsage {Integer
storageUsageUsage :: Integer
storageUsageUsage :: StorageUsage -> Integer
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"usage" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
storageUsageUsage
      ]


-- | Construct a value of type 'StorageUsage' (by applying it's required fields, if any)
mkStorageUsage
  :: Integer -- ^ 'storageUsageUsage'
  -> StorageUsage
mkStorageUsage :: Integer -> StorageUsage
mkStorageUsage Integer
storageUsageUsage =
  StorageUsage :: Integer -> StorageUsage
StorageUsage
  { Integer
storageUsageUsage :: Integer
storageUsageUsage :: Integer
storageUsageUsage
  }

-- ** SubscriptionCancelInfoDTO
-- | SubscriptionCancelInfoDTO
data SubscriptionCancelInfoDTO = SubscriptionCancelInfoDTO
    { SubscriptionCancelInfoDTO -> [Text]
subscriptionCancelInfoDTOReasons     :: !([Text]) -- ^ /Required/ "reasons"
    -- ^ "description"
    , SubscriptionCancelInfoDTO -> Maybe Text
subscriptionCancelInfoDTODescription :: !(Maybe Text) -- ^ "description"
    }
    deriving (Int -> SubscriptionCancelInfoDTO -> ShowS
[SubscriptionCancelInfoDTO] -> ShowS
SubscriptionCancelInfoDTO -> FilePath
(Int -> SubscriptionCancelInfoDTO -> ShowS)
-> (SubscriptionCancelInfoDTO -> FilePath)
-> ([SubscriptionCancelInfoDTO] -> ShowS)
-> Show SubscriptionCancelInfoDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SubscriptionCancelInfoDTO] -> ShowS
$cshowList :: [SubscriptionCancelInfoDTO] -> ShowS
show :: SubscriptionCancelInfoDTO -> FilePath
$cshow :: SubscriptionCancelInfoDTO -> FilePath
showsPrec :: Int -> SubscriptionCancelInfoDTO -> ShowS
$cshowsPrec :: Int -> SubscriptionCancelInfoDTO -> ShowS
P.Show, SubscriptionCancelInfoDTO -> SubscriptionCancelInfoDTO -> Bool
(SubscriptionCancelInfoDTO -> SubscriptionCancelInfoDTO -> Bool)
-> (SubscriptionCancelInfoDTO -> SubscriptionCancelInfoDTO -> Bool)
-> Eq SubscriptionCancelInfoDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubscriptionCancelInfoDTO -> SubscriptionCancelInfoDTO -> Bool
$c/= :: SubscriptionCancelInfoDTO -> SubscriptionCancelInfoDTO -> Bool
== :: SubscriptionCancelInfoDTO -> SubscriptionCancelInfoDTO -> Bool
$c== :: SubscriptionCancelInfoDTO -> SubscriptionCancelInfoDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON SubscriptionCancelInfoDTO
instance A.FromJSON SubscriptionCancelInfoDTO where
  parseJSON :: Value -> Parser SubscriptionCancelInfoDTO
parseJSON = FilePath
-> (Object -> Parser SubscriptionCancelInfoDTO)
-> Value
-> Parser SubscriptionCancelInfoDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"SubscriptionCancelInfoDTO" ((Object -> Parser SubscriptionCancelInfoDTO)
 -> Value -> Parser SubscriptionCancelInfoDTO)
-> (Object -> Parser SubscriptionCancelInfoDTO)
-> Value
-> Parser SubscriptionCancelInfoDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Text] -> Maybe Text -> SubscriptionCancelInfoDTO
SubscriptionCancelInfoDTO
      ([Text] -> Maybe Text -> SubscriptionCancelInfoDTO)
-> Parser [Text]
-> Parser (Maybe Text -> SubscriptionCancelInfoDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"reasons")
      Parser (Maybe Text -> SubscriptionCancelInfoDTO)
-> Parser (Maybe Text) -> Parser SubscriptionCancelInfoDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description")

-- | ToJSON SubscriptionCancelInfoDTO
instance A.ToJSON SubscriptionCancelInfoDTO where
  toJSON :: SubscriptionCancelInfoDTO -> Value
toJSON SubscriptionCancelInfoDTO {[Text]
Maybe Text
subscriptionCancelInfoDTODescription :: Maybe Text
subscriptionCancelInfoDTOReasons :: [Text]
subscriptionCancelInfoDTODescription :: SubscriptionCancelInfoDTO -> Maybe Text
subscriptionCancelInfoDTOReasons :: SubscriptionCancelInfoDTO -> [Text]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"reasons" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
subscriptionCancelInfoDTOReasons
      , Text
"description" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
subscriptionCancelInfoDTODescription
      ]


-- | Construct a value of type 'SubscriptionCancelInfoDTO' (by applying it's required fields, if any)
mkSubscriptionCancelInfoDTO
  :: [Text] -- ^ 'subscriptionCancelInfoDTOReasons'
  -> SubscriptionCancelInfoDTO
mkSubscriptionCancelInfoDTO :: [Text] -> SubscriptionCancelInfoDTO
mkSubscriptionCancelInfoDTO [Text]
subscriptionCancelInfoDTOReasons =
  SubscriptionCancelInfoDTO :: [Text] -> Maybe Text -> SubscriptionCancelInfoDTO
SubscriptionCancelInfoDTO
  { [Text]
subscriptionCancelInfoDTOReasons :: [Text]
subscriptionCancelInfoDTOReasons :: [Text]
subscriptionCancelInfoDTOReasons
  , subscriptionCancelInfoDTODescription :: Maybe Text
subscriptionCancelInfoDTODescription = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** SystemMetric
-- | SystemMetric
data SystemMetric = SystemMetric
    { SystemMetric -> [Text]
systemMetricSeries       :: !([Text]) -- ^ /Required/ "series"
    -- ^ /Required/ "name"
    , SystemMetric -> Text
systemMetricName         :: !(Text) -- ^ /Required/ "name"
    -- ^ "min"
    , SystemMetric -> Maybe Double
systemMetricMin          :: !(Maybe Double) -- ^ "min"
    -- ^ "max"
    , SystemMetric -> Maybe Double
systemMetricMax          :: !(Maybe Double) -- ^ "max"
    -- ^ "unit"
    , SystemMetric -> Maybe Text
systemMetricUnit         :: !(Maybe Text) -- ^ "unit"
    -- ^ /Required/ "description"
    , SystemMetric -> Text
systemMetricDescription  :: !(Text) -- ^ /Required/ "description"
    -- ^ /Required/ "resourceType"
    , SystemMetric -> SystemMetricResourceType
systemMetricResourceType :: !(SystemMetricResourceType) -- ^ /Required/ "resourceType"
    -- ^ /Required/ "experimentId"
    , SystemMetric -> Text
systemMetricExperimentId :: !(Text) -- ^ /Required/ "experimentId"
    -- ^ /Required/ "id"
    , SystemMetric -> Text
systemMetricId           :: !(Text) -- ^ /Required/ "id"
    }
    deriving (Int -> SystemMetric -> ShowS
[SystemMetric] -> ShowS
SystemMetric -> FilePath
(Int -> SystemMetric -> ShowS)
-> (SystemMetric -> FilePath)
-> ([SystemMetric] -> ShowS)
-> Show SystemMetric
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SystemMetric] -> ShowS
$cshowList :: [SystemMetric] -> ShowS
show :: SystemMetric -> FilePath
$cshow :: SystemMetric -> FilePath
showsPrec :: Int -> SystemMetric -> ShowS
$cshowsPrec :: Int -> SystemMetric -> ShowS
P.Show, SystemMetric -> SystemMetric -> Bool
(SystemMetric -> SystemMetric -> Bool)
-> (SystemMetric -> SystemMetric -> Bool) -> Eq SystemMetric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemMetric -> SystemMetric -> Bool
$c/= :: SystemMetric -> SystemMetric -> Bool
== :: SystemMetric -> SystemMetric -> Bool
$c== :: SystemMetric -> SystemMetric -> Bool
P.Eq, P.Typeable)

-- | FromJSON SystemMetric
instance A.FromJSON SystemMetric where
  parseJSON :: Value -> Parser SystemMetric
parseJSON = FilePath
-> (Object -> Parser SystemMetric) -> Value -> Parser SystemMetric
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"SystemMetric" ((Object -> Parser SystemMetric) -> Value -> Parser SystemMetric)
-> (Object -> Parser SystemMetric) -> Value -> Parser SystemMetric
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Text]
-> Text
-> Maybe Double
-> Maybe Double
-> Maybe Text
-> Text
-> SystemMetricResourceType
-> Text
-> Text
-> SystemMetric
SystemMetric
      ([Text]
 -> Text
 -> Maybe Double
 -> Maybe Double
 -> Maybe Text
 -> Text
 -> SystemMetricResourceType
 -> Text
 -> Text
 -> SystemMetric)
-> Parser [Text]
-> Parser
     (Text
      -> Maybe Double
      -> Maybe Double
      -> Maybe Text
      -> Text
      -> SystemMetricResourceType
      -> Text
      -> Text
      -> SystemMetric)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"series")
      Parser
  (Text
   -> Maybe Double
   -> Maybe Double
   -> Maybe Text
   -> Text
   -> SystemMetricResourceType
   -> Text
   -> Text
   -> SystemMetric)
-> Parser Text
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Maybe Text
      -> Text
      -> SystemMetricResourceType
      -> Text
      -> Text
      -> SystemMetric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (Maybe Double
   -> Maybe Double
   -> Maybe Text
   -> Text
   -> SystemMetricResourceType
   -> Text
   -> Text
   -> SystemMetric)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Maybe Text
      -> Text
      -> SystemMetricResourceType
      -> Text
      -> Text
      -> SystemMetric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"min")
      Parser
  (Maybe Double
   -> Maybe Text
   -> Text
   -> SystemMetricResourceType
   -> Text
   -> Text
   -> SystemMetric)
-> Parser (Maybe Double)
-> Parser
     (Maybe Text
      -> Text
      -> SystemMetricResourceType
      -> Text
      -> Text
      -> SystemMetric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"max")
      Parser
  (Maybe Text
   -> Text
   -> SystemMetricResourceType
   -> Text
   -> Text
   -> SystemMetric)
-> Parser (Maybe Text)
-> Parser
     (Text -> SystemMetricResourceType -> Text -> Text -> SystemMetric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"unit")
      Parser
  (Text -> SystemMetricResourceType -> Text -> Text -> SystemMetric)
-> Parser Text
-> Parser
     (SystemMetricResourceType -> Text -> Text -> SystemMetric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"description")
      Parser (SystemMetricResourceType -> Text -> Text -> SystemMetric)
-> Parser SystemMetricResourceType
-> Parser (Text -> Text -> SystemMetric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser SystemMetricResourceType
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"resourceType")
      Parser (Text -> Text -> SystemMetric)
-> Parser Text -> Parser (Text -> SystemMetric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"experimentId")
      Parser (Text -> SystemMetric) -> Parser Text -> Parser SystemMetric
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id")

-- | ToJSON SystemMetric
instance A.ToJSON SystemMetric where
  toJSON :: SystemMetric -> Value
toJSON SystemMetric {[Text]
Maybe Double
Maybe Text
Text
SystemMetricResourceType
systemMetricId :: Text
systemMetricExperimentId :: Text
systemMetricResourceType :: SystemMetricResourceType
systemMetricDescription :: Text
systemMetricUnit :: Maybe Text
systemMetricMax :: Maybe Double
systemMetricMin :: Maybe Double
systemMetricName :: Text
systemMetricSeries :: [Text]
systemMetricId :: SystemMetric -> Text
systemMetricExperimentId :: SystemMetric -> Text
systemMetricResourceType :: SystemMetric -> SystemMetricResourceType
systemMetricDescription :: SystemMetric -> Text
systemMetricUnit :: SystemMetric -> Maybe Text
systemMetricMax :: SystemMetric -> Maybe Double
systemMetricMin :: SystemMetric -> Maybe Double
systemMetricName :: SystemMetric -> Text
systemMetricSeries :: SystemMetric -> [Text]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"series" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
systemMetricSeries
      , Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
systemMetricName
      , Text
"min" Text -> Maybe Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Double
systemMetricMin
      , Text
"max" Text -> Maybe Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Double
systemMetricMax
      , Text
"unit" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
systemMetricUnit
      , Text
"description" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
systemMetricDescription
      , Text
"resourceType" Text -> SystemMetricResourceType -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SystemMetricResourceType
systemMetricResourceType
      , Text
"experimentId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
systemMetricExperimentId
      , Text
"id" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
systemMetricId
      ]


-- | Construct a value of type 'SystemMetric' (by applying it's required fields, if any)
mkSystemMetric
  :: [Text] -- ^ 'systemMetricSeries'
  -> Text -- ^ 'systemMetricName'
  -> Text -- ^ 'systemMetricDescription'
  -> SystemMetricResourceType -- ^ 'systemMetricResourceType'
  -> Text -- ^ 'systemMetricExperimentId'
  -> Text -- ^ 'systemMetricId'
  -> SystemMetric
mkSystemMetric :: [Text]
-> Text
-> Text
-> SystemMetricResourceType
-> Text
-> Text
-> SystemMetric
mkSystemMetric [Text]
systemMetricSeries Text
systemMetricName Text
systemMetricDescription SystemMetricResourceType
systemMetricResourceType Text
systemMetricExperimentId Text
systemMetricId =
  SystemMetric :: [Text]
-> Text
-> Maybe Double
-> Maybe Double
-> Maybe Text
-> Text
-> SystemMetricResourceType
-> Text
-> Text
-> SystemMetric
SystemMetric
  { [Text]
systemMetricSeries :: [Text]
systemMetricSeries :: [Text]
systemMetricSeries
  , Text
systemMetricName :: Text
systemMetricName :: Text
systemMetricName
  , systemMetricMin :: Maybe Double
systemMetricMin = Maybe Double
forall a. Maybe a
Nothing
  , systemMetricMax :: Maybe Double
systemMetricMax = Maybe Double
forall a. Maybe a
Nothing
  , systemMetricUnit :: Maybe Text
systemMetricUnit = Maybe Text
forall a. Maybe a
Nothing
  , Text
systemMetricDescription :: Text
systemMetricDescription :: Text
systemMetricDescription
  , SystemMetricResourceType
systemMetricResourceType :: SystemMetricResourceType
systemMetricResourceType :: SystemMetricResourceType
systemMetricResourceType
  , Text
systemMetricExperimentId :: Text
systemMetricExperimentId :: Text
systemMetricExperimentId
  , Text
systemMetricId :: Text
systemMetricId :: Text
systemMetricId
  }

-- ** SystemMetricParams
-- | SystemMetricParams
data SystemMetricParams = SystemMetricParams
    { SystemMetricParams -> [Text]
systemMetricParamsSeries       :: !([Text]) -- ^ /Required/ "series"
    -- ^ /Required/ "name"
    , SystemMetricParams -> Text
systemMetricParamsName         :: !(Text) -- ^ /Required/ "name"
    -- ^ "min"
    , SystemMetricParams -> Maybe Double
systemMetricParamsMin          :: !(Maybe Double) -- ^ "min"
    -- ^ "max"
    , SystemMetricParams -> Maybe Double
systemMetricParamsMax          :: !(Maybe Double) -- ^ "max"
    -- ^ "unit"
    , SystemMetricParams -> Maybe Text
systemMetricParamsUnit         :: !(Maybe Text) -- ^ "unit"
    -- ^ /Required/ "description"
    , SystemMetricParams -> Text
systemMetricParamsDescription  :: !(Text) -- ^ /Required/ "description"
    -- ^ /Required/ "resourceType"
    , SystemMetricParams -> SystemMetricResourceType
systemMetricParamsResourceType :: !(SystemMetricResourceType) -- ^ /Required/ "resourceType"
    }
    deriving (Int -> SystemMetricParams -> ShowS
[SystemMetricParams] -> ShowS
SystemMetricParams -> FilePath
(Int -> SystemMetricParams -> ShowS)
-> (SystemMetricParams -> FilePath)
-> ([SystemMetricParams] -> ShowS)
-> Show SystemMetricParams
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SystemMetricParams] -> ShowS
$cshowList :: [SystemMetricParams] -> ShowS
show :: SystemMetricParams -> FilePath
$cshow :: SystemMetricParams -> FilePath
showsPrec :: Int -> SystemMetricParams -> ShowS
$cshowsPrec :: Int -> SystemMetricParams -> ShowS
P.Show, SystemMetricParams -> SystemMetricParams -> Bool
(SystemMetricParams -> SystemMetricParams -> Bool)
-> (SystemMetricParams -> SystemMetricParams -> Bool)
-> Eq SystemMetricParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemMetricParams -> SystemMetricParams -> Bool
$c/= :: SystemMetricParams -> SystemMetricParams -> Bool
== :: SystemMetricParams -> SystemMetricParams -> Bool
$c== :: SystemMetricParams -> SystemMetricParams -> Bool
P.Eq, P.Typeable)

-- | FromJSON SystemMetricParams
instance A.FromJSON SystemMetricParams where
  parseJSON :: Value -> Parser SystemMetricParams
parseJSON = FilePath
-> (Object -> Parser SystemMetricParams)
-> Value
-> Parser SystemMetricParams
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"SystemMetricParams" ((Object -> Parser SystemMetricParams)
 -> Value -> Parser SystemMetricParams)
-> (Object -> Parser SystemMetricParams)
-> Value
-> Parser SystemMetricParams
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Text]
-> Text
-> Maybe Double
-> Maybe Double
-> Maybe Text
-> Text
-> SystemMetricResourceType
-> SystemMetricParams
SystemMetricParams
      ([Text]
 -> Text
 -> Maybe Double
 -> Maybe Double
 -> Maybe Text
 -> Text
 -> SystemMetricResourceType
 -> SystemMetricParams)
-> Parser [Text]
-> Parser
     (Text
      -> Maybe Double
      -> Maybe Double
      -> Maybe Text
      -> Text
      -> SystemMetricResourceType
      -> SystemMetricParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"series")
      Parser
  (Text
   -> Maybe Double
   -> Maybe Double
   -> Maybe Text
   -> Text
   -> SystemMetricResourceType
   -> SystemMetricParams)
-> Parser Text
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Maybe Text
      -> Text
      -> SystemMetricResourceType
      -> SystemMetricParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name")
      Parser
  (Maybe Double
   -> Maybe Double
   -> Maybe Text
   -> Text
   -> SystemMetricResourceType
   -> SystemMetricParams)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Maybe Text
      -> Text
      -> SystemMetricResourceType
      -> SystemMetricParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"min")
      Parser
  (Maybe Double
   -> Maybe Text
   -> Text
   -> SystemMetricResourceType
   -> SystemMetricParams)
-> Parser (Maybe Double)
-> Parser
     (Maybe Text
      -> Text -> SystemMetricResourceType -> SystemMetricParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"max")
      Parser
  (Maybe Text
   -> Text -> SystemMetricResourceType -> SystemMetricParams)
-> Parser (Maybe Text)
-> Parser (Text -> SystemMetricResourceType -> SystemMetricParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"unit")
      Parser (Text -> SystemMetricResourceType -> SystemMetricParams)
-> Parser Text
-> Parser (SystemMetricResourceType -> SystemMetricParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"description")
      Parser (SystemMetricResourceType -> SystemMetricParams)
-> Parser SystemMetricResourceType -> Parser SystemMetricParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser SystemMetricResourceType
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"resourceType")

-- | ToJSON SystemMetricParams
instance A.ToJSON SystemMetricParams where
  toJSON :: SystemMetricParams -> Value
toJSON SystemMetricParams {[Text]
Maybe Double
Maybe Text
Text
SystemMetricResourceType
systemMetricParamsResourceType :: SystemMetricResourceType
systemMetricParamsDescription :: Text
systemMetricParamsUnit :: Maybe Text
systemMetricParamsMax :: Maybe Double
systemMetricParamsMin :: Maybe Double
systemMetricParamsName :: Text
systemMetricParamsSeries :: [Text]
systemMetricParamsResourceType :: SystemMetricParams -> SystemMetricResourceType
systemMetricParamsDescription :: SystemMetricParams -> Text
systemMetricParamsUnit :: SystemMetricParams -> Maybe Text
systemMetricParamsMax :: SystemMetricParams -> Maybe Double
systemMetricParamsMin :: SystemMetricParams -> Maybe Double
systemMetricParamsName :: SystemMetricParams -> Text
systemMetricParamsSeries :: SystemMetricParams -> [Text]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"series" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
systemMetricParamsSeries
      , Text
"name" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
systemMetricParamsName
      , Text
"min" Text -> Maybe Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Double
systemMetricParamsMin
      , Text
"max" Text -> Maybe Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Double
systemMetricParamsMax
      , Text
"unit" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
systemMetricParamsUnit
      , Text
"description" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
systemMetricParamsDescription
      , Text
"resourceType" Text -> SystemMetricResourceType -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SystemMetricResourceType
systemMetricParamsResourceType
      ]


-- | Construct a value of type 'SystemMetricParams' (by applying it's required fields, if any)
mkSystemMetricParams
  :: [Text] -- ^ 'systemMetricParamsSeries'
  -> Text -- ^ 'systemMetricParamsName'
  -> Text -- ^ 'systemMetricParamsDescription'
  -> SystemMetricResourceType -- ^ 'systemMetricParamsResourceType'
  -> SystemMetricParams
mkSystemMetricParams :: [Text]
-> Text -> Text -> SystemMetricResourceType -> SystemMetricParams
mkSystemMetricParams [Text]
systemMetricParamsSeries Text
systemMetricParamsName Text
systemMetricParamsDescription SystemMetricResourceType
systemMetricParamsResourceType =
  SystemMetricParams :: [Text]
-> Text
-> Maybe Double
-> Maybe Double
-> Maybe Text
-> Text
-> SystemMetricResourceType
-> SystemMetricParams
SystemMetricParams
  { [Text]
systemMetricParamsSeries :: [Text]
systemMetricParamsSeries :: [Text]
systemMetricParamsSeries
  , Text
systemMetricParamsName :: Text
systemMetricParamsName :: Text
systemMetricParamsName
  , systemMetricParamsMin :: Maybe Double
systemMetricParamsMin = Maybe Double
forall a. Maybe a
Nothing
  , systemMetricParamsMax :: Maybe Double
systemMetricParamsMax = Maybe Double
forall a. Maybe a
Nothing
  , systemMetricParamsUnit :: Maybe Text
systemMetricParamsUnit = Maybe Text
forall a. Maybe a
Nothing
  , Text
systemMetricParamsDescription :: Text
systemMetricParamsDescription :: Text
systemMetricParamsDescription
  , SystemMetricResourceType
systemMetricParamsResourceType :: SystemMetricResourceType
systemMetricParamsResourceType :: SystemMetricResourceType
systemMetricParamsResourceType
  }

-- ** SystemMetricPoint
-- | SystemMetricPoint
data SystemMetricPoint = SystemMetricPoint
    { SystemMetricPoint -> Integer
systemMetricPointTimestampMillis :: !(Integer) -- ^ /Required/ "timestampMillis"
    -- ^ /Required/ "x"
    , SystemMetricPoint -> Integer
systemMetricPointX               :: !(Integer) -- ^ /Required/ "x"
    -- ^ /Required/ "y"
    , SystemMetricPoint -> Double
systemMetricPointY               :: !(Double) -- ^ /Required/ "y"
    }
    deriving (Int -> SystemMetricPoint -> ShowS
[SystemMetricPoint] -> ShowS
SystemMetricPoint -> FilePath
(Int -> SystemMetricPoint -> ShowS)
-> (SystemMetricPoint -> FilePath)
-> ([SystemMetricPoint] -> ShowS)
-> Show SystemMetricPoint
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SystemMetricPoint] -> ShowS
$cshowList :: [SystemMetricPoint] -> ShowS
show :: SystemMetricPoint -> FilePath
$cshow :: SystemMetricPoint -> FilePath
showsPrec :: Int -> SystemMetricPoint -> ShowS
$cshowsPrec :: Int -> SystemMetricPoint -> ShowS
P.Show, SystemMetricPoint -> SystemMetricPoint -> Bool
(SystemMetricPoint -> SystemMetricPoint -> Bool)
-> (SystemMetricPoint -> SystemMetricPoint -> Bool)
-> Eq SystemMetricPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemMetricPoint -> SystemMetricPoint -> Bool
$c/= :: SystemMetricPoint -> SystemMetricPoint -> Bool
== :: SystemMetricPoint -> SystemMetricPoint -> Bool
$c== :: SystemMetricPoint -> SystemMetricPoint -> Bool
P.Eq, P.Typeable)

-- | FromJSON SystemMetricPoint
instance A.FromJSON SystemMetricPoint where
  parseJSON :: Value -> Parser SystemMetricPoint
parseJSON = FilePath
-> (Object -> Parser SystemMetricPoint)
-> Value
-> Parser SystemMetricPoint
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"SystemMetricPoint" ((Object -> Parser SystemMetricPoint)
 -> Value -> Parser SystemMetricPoint)
-> (Object -> Parser SystemMetricPoint)
-> Value
-> Parser SystemMetricPoint
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Integer -> Integer -> Double -> SystemMetricPoint
SystemMetricPoint
      (Integer -> Integer -> Double -> SystemMetricPoint)
-> Parser Integer
-> Parser (Integer -> Double -> SystemMetricPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"timestampMillis")
      Parser (Integer -> Double -> SystemMetricPoint)
-> Parser Integer -> Parser (Double -> SystemMetricPoint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"x")
      Parser (Double -> SystemMetricPoint)
-> Parser Double -> Parser SystemMetricPoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"y")

-- | ToJSON SystemMetricPoint
instance A.ToJSON SystemMetricPoint where
  toJSON :: SystemMetricPoint -> Value
toJSON SystemMetricPoint {Double
Integer
systemMetricPointY :: Double
systemMetricPointX :: Integer
systemMetricPointTimestampMillis :: Integer
systemMetricPointY :: SystemMetricPoint -> Double
systemMetricPointX :: SystemMetricPoint -> Integer
systemMetricPointTimestampMillis :: SystemMetricPoint -> Integer
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"timestampMillis" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
systemMetricPointTimestampMillis
      , Text
"x" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
systemMetricPointX
      , Text
"y" Text -> Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
systemMetricPointY
      ]


-- | Construct a value of type 'SystemMetricPoint' (by applying it's required fields, if any)
mkSystemMetricPoint
  :: Integer -- ^ 'systemMetricPointTimestampMillis'
  -> Integer -- ^ 'systemMetricPointX'
  -> Double -- ^ 'systemMetricPointY'
  -> SystemMetricPoint
mkSystemMetricPoint :: Integer -> Integer -> Double -> SystemMetricPoint
mkSystemMetricPoint Integer
systemMetricPointTimestampMillis Integer
systemMetricPointX Double
systemMetricPointY =
  SystemMetricPoint :: Integer -> Integer -> Double -> SystemMetricPoint
SystemMetricPoint
  { Integer
systemMetricPointTimestampMillis :: Integer
systemMetricPointTimestampMillis :: Integer
systemMetricPointTimestampMillis
  , Integer
systemMetricPointX :: Integer
systemMetricPointX :: Integer
systemMetricPointX
  , Double
systemMetricPointY :: Double
systemMetricPointY :: Double
systemMetricPointY
  }

-- ** SystemMetricValues
-- | SystemMetricValues
data SystemMetricValues = SystemMetricValues
    { SystemMetricValues -> Text
systemMetricValuesMetricId   :: !(Text) -- ^ /Required/ "metricId"
    -- ^ /Required/ "seriesName"
    , SystemMetricValues -> Text
systemMetricValuesSeriesName :: !(Text) -- ^ /Required/ "seriesName"
    -- ^ "level"
    , SystemMetricValues -> Maybe Int
systemMetricValuesLevel      :: !(Maybe Int) -- ^ "level"
    -- ^ /Required/ "values"
    , SystemMetricValues -> [SystemMetricPoint]
systemMetricValuesValues     :: !([SystemMetricPoint]) -- ^ /Required/ "values"
    }
    deriving (Int -> SystemMetricValues -> ShowS
[SystemMetricValues] -> ShowS
SystemMetricValues -> FilePath
(Int -> SystemMetricValues -> ShowS)
-> (SystemMetricValues -> FilePath)
-> ([SystemMetricValues] -> ShowS)
-> Show SystemMetricValues
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SystemMetricValues] -> ShowS
$cshowList :: [SystemMetricValues] -> ShowS
show :: SystemMetricValues -> FilePath
$cshow :: SystemMetricValues -> FilePath
showsPrec :: Int -> SystemMetricValues -> ShowS
$cshowsPrec :: Int -> SystemMetricValues -> ShowS
P.Show, SystemMetricValues -> SystemMetricValues -> Bool
(SystemMetricValues -> SystemMetricValues -> Bool)
-> (SystemMetricValues -> SystemMetricValues -> Bool)
-> Eq SystemMetricValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemMetricValues -> SystemMetricValues -> Bool
$c/= :: SystemMetricValues -> SystemMetricValues -> Bool
== :: SystemMetricValues -> SystemMetricValues -> Bool
$c== :: SystemMetricValues -> SystemMetricValues -> Bool
P.Eq, P.Typeable)

-- | FromJSON SystemMetricValues
instance A.FromJSON SystemMetricValues where
  parseJSON :: Value -> Parser SystemMetricValues
parseJSON = FilePath
-> (Object -> Parser SystemMetricValues)
-> Value
-> Parser SystemMetricValues
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"SystemMetricValues" ((Object -> Parser SystemMetricValues)
 -> Value -> Parser SystemMetricValues)
-> (Object -> Parser SystemMetricValues)
-> Value
-> Parser SystemMetricValues
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text -> Maybe Int -> [SystemMetricPoint] -> SystemMetricValues
SystemMetricValues
      (Text
 -> Text -> Maybe Int -> [SystemMetricPoint] -> SystemMetricValues)
-> Parser Text
-> Parser
     (Text -> Maybe Int -> [SystemMetricPoint] -> SystemMetricValues)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"metricId")
      Parser
  (Text -> Maybe Int -> [SystemMetricPoint] -> SystemMetricValues)
-> Parser Text
-> Parser (Maybe Int -> [SystemMetricPoint] -> SystemMetricValues)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"seriesName")
      Parser (Maybe Int -> [SystemMetricPoint] -> SystemMetricValues)
-> Parser (Maybe Int)
-> Parser ([SystemMetricPoint] -> SystemMetricValues)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"level")
      Parser ([SystemMetricPoint] -> SystemMetricValues)
-> Parser [SystemMetricPoint] -> Parser SystemMetricValues
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [SystemMetricPoint]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"values")

-- | ToJSON SystemMetricValues
instance A.ToJSON SystemMetricValues where
  toJSON :: SystemMetricValues -> Value
toJSON SystemMetricValues {[SystemMetricPoint]
Maybe Int
Text
systemMetricValuesValues :: [SystemMetricPoint]
systemMetricValuesLevel :: Maybe Int
systemMetricValuesSeriesName :: Text
systemMetricValuesMetricId :: Text
systemMetricValuesValues :: SystemMetricValues -> [SystemMetricPoint]
systemMetricValuesLevel :: SystemMetricValues -> Maybe Int
systemMetricValuesSeriesName :: SystemMetricValues -> Text
systemMetricValuesMetricId :: SystemMetricValues -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"metricId" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
systemMetricValuesMetricId
      , Text
"seriesName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
systemMetricValuesSeriesName
      , Text
"level" Text -> Maybe Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Int
systemMetricValuesLevel
      , Text
"values" Text -> [SystemMetricPoint] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [SystemMetricPoint]
systemMetricValuesValues
      ]


-- | Construct a value of type 'SystemMetricValues' (by applying it's required fields, if any)
mkSystemMetricValues
  :: Text -- ^ 'systemMetricValuesMetricId'
  -> Text -- ^ 'systemMetricValuesSeriesName'
  -> [SystemMetricPoint] -- ^ 'systemMetricValuesValues'
  -> SystemMetricValues
mkSystemMetricValues :: Text -> Text -> [SystemMetricPoint] -> SystemMetricValues
mkSystemMetricValues Text
systemMetricValuesMetricId Text
systemMetricValuesSeriesName [SystemMetricPoint]
systemMetricValuesValues =
  SystemMetricValues :: Text
-> Text -> Maybe Int -> [SystemMetricPoint] -> SystemMetricValues
SystemMetricValues
  { Text
systemMetricValuesMetricId :: Text
systemMetricValuesMetricId :: Text
systemMetricValuesMetricId
  , Text
systemMetricValuesSeriesName :: Text
systemMetricValuesSeriesName :: Text
systemMetricValuesSeriesName
  , systemMetricValuesLevel :: Maybe Int
systemMetricValuesLevel = Maybe Int
forall a. Maybe a
Nothing
  , [SystemMetricPoint]
systemMetricValuesValues :: [SystemMetricPoint]
systemMetricValuesValues :: [SystemMetricPoint]
systemMetricValuesValues
  }

-- ** UUID
-- | UUID
data UUID = UUID
    { UUID -> Integer
uUIDMostSigBits  :: !(Integer) -- ^ /Required/ "mostSigBits"
    -- ^ /Required/ "leastSigBits"
    , UUID -> Integer
uUIDLeastSigBits :: !(Integer) -- ^ /Required/ "leastSigBits"
    }
    deriving (Int -> UUID -> ShowS
[UUID] -> ShowS
UUID -> FilePath
(Int -> UUID -> ShowS)
-> (UUID -> FilePath) -> ([UUID] -> ShowS) -> Show UUID
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UUID] -> ShowS
$cshowList :: [UUID] -> ShowS
show :: UUID -> FilePath
$cshow :: UUID -> FilePath
showsPrec :: Int -> UUID -> ShowS
$cshowsPrec :: Int -> UUID -> ShowS
P.Show, UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c== :: UUID -> UUID -> Bool
P.Eq, P.Typeable)

-- | FromJSON UUID
instance A.FromJSON UUID where
  parseJSON :: Value -> Parser UUID
parseJSON = FilePath -> (Object -> Parser UUID) -> Value -> Parser UUID
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UUID" ((Object -> Parser UUID) -> Value -> Parser UUID)
-> (Object -> Parser UUID) -> Value -> Parser UUID
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Integer -> Integer -> UUID
UUID
      (Integer -> Integer -> UUID)
-> Parser Integer -> Parser (Integer -> UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"mostSigBits")
      Parser (Integer -> UUID) -> Parser Integer -> Parser UUID
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"leastSigBits")

-- | ToJSON UUID
instance A.ToJSON UUID where
  toJSON :: UUID -> Value
toJSON UUID {Integer
uUIDLeastSigBits :: Integer
uUIDMostSigBits :: Integer
uUIDLeastSigBits :: UUID -> Integer
uUIDMostSigBits :: UUID -> Integer
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"mostSigBits" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
uUIDMostSigBits
      , Text
"leastSigBits" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
uUIDLeastSigBits
      ]


-- | Construct a value of type 'UUID' (by applying it's required fields, if any)
mkUUID
  :: Integer -- ^ 'uUIDMostSigBits'
  -> Integer -- ^ 'uUIDLeastSigBits'
  -> UUID
mkUUID :: Integer -> Integer -> UUID
mkUUID Integer
uUIDMostSigBits Integer
uUIDLeastSigBits =
  UUID :: Integer -> Integer -> UUID
UUID
  { Integer
uUIDMostSigBits :: Integer
uUIDMostSigBits :: Integer
uUIDMostSigBits
  , Integer
uUIDLeastSigBits :: Integer
uUIDLeastSigBits :: Integer
uUIDLeastSigBits
  }

-- ** UpdateTagsParams
-- | UpdateTagsParams
data UpdateTagsParams = UpdateTagsParams
    { UpdateTagsParams -> [Text]
updateTagsParamsExperimentIds :: !([Text]) -- ^ /Required/ "experimentIds"
    -- ^ /Required/ "tagsToAdd"
    , UpdateTagsParams -> [Text]
updateTagsParamsTagsToAdd     :: !([Text]) -- ^ /Required/ "tagsToAdd"
    -- ^ /Required/ "tagsToDelete"
    , UpdateTagsParams -> [Text]
updateTagsParamsTagsToDelete  :: !([Text]) -- ^ /Required/ "tagsToDelete"
    }
    deriving (Int -> UpdateTagsParams -> ShowS
[UpdateTagsParams] -> ShowS
UpdateTagsParams -> FilePath
(Int -> UpdateTagsParams -> ShowS)
-> (UpdateTagsParams -> FilePath)
-> ([UpdateTagsParams] -> ShowS)
-> Show UpdateTagsParams
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTagsParams] -> ShowS
$cshowList :: [UpdateTagsParams] -> ShowS
show :: UpdateTagsParams -> FilePath
$cshow :: UpdateTagsParams -> FilePath
showsPrec :: Int -> UpdateTagsParams -> ShowS
$cshowsPrec :: Int -> UpdateTagsParams -> ShowS
P.Show, UpdateTagsParams -> UpdateTagsParams -> Bool
(UpdateTagsParams -> UpdateTagsParams -> Bool)
-> (UpdateTagsParams -> UpdateTagsParams -> Bool)
-> Eq UpdateTagsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTagsParams -> UpdateTagsParams -> Bool
$c/= :: UpdateTagsParams -> UpdateTagsParams -> Bool
== :: UpdateTagsParams -> UpdateTagsParams -> Bool
$c== :: UpdateTagsParams -> UpdateTagsParams -> Bool
P.Eq, P.Typeable)

-- | FromJSON UpdateTagsParams
instance A.FromJSON UpdateTagsParams where
  parseJSON :: Value -> Parser UpdateTagsParams
parseJSON = FilePath
-> (Object -> Parser UpdateTagsParams)
-> Value
-> Parser UpdateTagsParams
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UpdateTagsParams" ((Object -> Parser UpdateTagsParams)
 -> Value -> Parser UpdateTagsParams)
-> (Object -> Parser UpdateTagsParams)
-> Value
-> Parser UpdateTagsParams
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Text] -> [Text] -> [Text] -> UpdateTagsParams
UpdateTagsParams
      ([Text] -> [Text] -> [Text] -> UpdateTagsParams)
-> Parser [Text] -> Parser ([Text] -> [Text] -> UpdateTagsParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"experimentIds")
      Parser ([Text] -> [Text] -> UpdateTagsParams)
-> Parser [Text] -> Parser ([Text] -> UpdateTagsParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"tagsToAdd")
      Parser ([Text] -> UpdateTagsParams)
-> Parser [Text] -> Parser UpdateTagsParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"tagsToDelete")

-- | ToJSON UpdateTagsParams
instance A.ToJSON UpdateTagsParams where
  toJSON :: UpdateTagsParams -> Value
toJSON UpdateTagsParams {[Text]
updateTagsParamsTagsToDelete :: [Text]
updateTagsParamsTagsToAdd :: [Text]
updateTagsParamsExperimentIds :: [Text]
updateTagsParamsTagsToDelete :: UpdateTagsParams -> [Text]
updateTagsParamsTagsToAdd :: UpdateTagsParams -> [Text]
updateTagsParamsExperimentIds :: UpdateTagsParams -> [Text]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"experimentIds" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
updateTagsParamsExperimentIds
      , Text
"tagsToAdd" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
updateTagsParamsTagsToAdd
      , Text
"tagsToDelete" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
updateTagsParamsTagsToDelete
      ]


-- | Construct a value of type 'UpdateTagsParams' (by applying it's required fields, if any)
mkUpdateTagsParams
  :: [Text] -- ^ 'updateTagsParamsExperimentIds'
  -> [Text] -- ^ 'updateTagsParamsTagsToAdd'
  -> [Text] -- ^ 'updateTagsParamsTagsToDelete'
  -> UpdateTagsParams
mkUpdateTagsParams :: [Text] -> [Text] -> [Text] -> UpdateTagsParams
mkUpdateTagsParams [Text]
updateTagsParamsExperimentIds [Text]
updateTagsParamsTagsToAdd [Text]
updateTagsParamsTagsToDelete =
  UpdateTagsParams :: [Text] -> [Text] -> [Text] -> UpdateTagsParams
UpdateTagsParams
  { [Text]
updateTagsParamsExperimentIds :: [Text]
updateTagsParamsExperimentIds :: [Text]
updateTagsParamsExperimentIds
  , [Text]
updateTagsParamsTagsToAdd :: [Text]
updateTagsParamsTagsToAdd :: [Text]
updateTagsParamsTagsToAdd
  , [Text]
updateTagsParamsTagsToDelete :: [Text]
updateTagsParamsTagsToDelete :: [Text]
updateTagsParamsTagsToDelete
  }

-- ** UserListDTO
-- | UserListDTO
data UserListDTO = UserListDTO
    { UserListDTO -> [UserListItemDTO]
userListDTOEntries           :: !([UserListItemDTO]) -- ^ /Required/ "entries"
    -- ^ /Required/ "matchingItemCount"
    , UserListDTO -> Int
userListDTOMatchingItemCount :: !(Int) -- ^ /Required/ "matchingItemCount"
    -- ^ /Required/ "totalItemCount"
    , UserListDTO -> Int
userListDTOTotalItemCount    :: !(Int) -- ^ /Required/ "totalItemCount"
    }
    deriving (Int -> UserListDTO -> ShowS
[UserListDTO] -> ShowS
UserListDTO -> FilePath
(Int -> UserListDTO -> ShowS)
-> (UserListDTO -> FilePath)
-> ([UserListDTO] -> ShowS)
-> Show UserListDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserListDTO] -> ShowS
$cshowList :: [UserListDTO] -> ShowS
show :: UserListDTO -> FilePath
$cshow :: UserListDTO -> FilePath
showsPrec :: Int -> UserListDTO -> ShowS
$cshowsPrec :: Int -> UserListDTO -> ShowS
P.Show, UserListDTO -> UserListDTO -> Bool
(UserListDTO -> UserListDTO -> Bool)
-> (UserListDTO -> UserListDTO -> Bool) -> Eq UserListDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserListDTO -> UserListDTO -> Bool
$c/= :: UserListDTO -> UserListDTO -> Bool
== :: UserListDTO -> UserListDTO -> Bool
$c== :: UserListDTO -> UserListDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserListDTO
instance A.FromJSON UserListDTO where
  parseJSON :: Value -> Parser UserListDTO
parseJSON = FilePath
-> (Object -> Parser UserListDTO) -> Value -> Parser UserListDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UserListDTO" ((Object -> Parser UserListDTO) -> Value -> Parser UserListDTO)
-> (Object -> Parser UserListDTO) -> Value -> Parser UserListDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [UserListItemDTO] -> Int -> Int -> UserListDTO
UserListDTO
      ([UserListItemDTO] -> Int -> Int -> UserListDTO)
-> Parser [UserListItemDTO] -> Parser (Int -> Int -> UserListDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser [UserListItemDTO]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"entries")
      Parser (Int -> Int -> UserListDTO)
-> Parser Int -> Parser (Int -> UserListDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"matchingItemCount")
      Parser (Int -> UserListDTO) -> Parser Int -> Parser UserListDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"totalItemCount")

-- | ToJSON UserListDTO
instance A.ToJSON UserListDTO where
  toJSON :: UserListDTO -> Value
toJSON UserListDTO {Int
[UserListItemDTO]
userListDTOTotalItemCount :: Int
userListDTOMatchingItemCount :: Int
userListDTOEntries :: [UserListItemDTO]
userListDTOTotalItemCount :: UserListDTO -> Int
userListDTOMatchingItemCount :: UserListDTO -> Int
userListDTOEntries :: UserListDTO -> [UserListItemDTO]
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"entries" Text -> [UserListItemDTO] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [UserListItemDTO]
userListDTOEntries
      , Text
"matchingItemCount" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
userListDTOMatchingItemCount
      , Text
"totalItemCount" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
userListDTOTotalItemCount
      ]


-- | Construct a value of type 'UserListDTO' (by applying it's required fields, if any)
mkUserListDTO
  :: [UserListItemDTO] -- ^ 'userListDTOEntries'
  -> Int -- ^ 'userListDTOMatchingItemCount'
  -> Int -- ^ 'userListDTOTotalItemCount'
  -> UserListDTO
mkUserListDTO :: [UserListItemDTO] -> Int -> Int -> UserListDTO
mkUserListDTO [UserListItemDTO]
userListDTOEntries Int
userListDTOMatchingItemCount Int
userListDTOTotalItemCount =
  UserListDTO :: [UserListItemDTO] -> Int -> Int -> UserListDTO
UserListDTO
  { [UserListItemDTO]
userListDTOEntries :: [UserListItemDTO]
userListDTOEntries :: [UserListItemDTO]
userListDTOEntries
  , Int
userListDTOMatchingItemCount :: Int
userListDTOMatchingItemCount :: Int
userListDTOMatchingItemCount
  , Int
userListDTOTotalItemCount :: Int
userListDTOTotalItemCount :: Int
userListDTOTotalItemCount
  }

-- ** UserListItemDTO
-- | UserListItemDTO
data UserListItemDTO = UserListItemDTO
    { UserListItemDTO -> AvatarSourceEnum
userListItemDTOAvatarSource :: !(AvatarSourceEnum) -- ^ /Required/ "avatarSource"
    -- ^ /Required/ "lastName"
    , UserListItemDTO -> Text
userListItemDTOLastName     :: !(Text) -- ^ /Required/ "lastName"
    -- ^ /Required/ "firstName"
    , UserListItemDTO -> Text
userListItemDTOFirstName    :: !(Text) -- ^ /Required/ "firstName"
    -- ^ /Required/ "username"
    , UserListItemDTO -> Text
userListItemDTOUsername     :: !(Text) -- ^ /Required/ "username"
    -- ^ /Required/ "avatarUrl"
    , UserListItemDTO -> Text
userListItemDTOAvatarUrl    :: !(Text) -- ^ /Required/ "avatarUrl"
    }
    deriving (Int -> UserListItemDTO -> ShowS
[UserListItemDTO] -> ShowS
UserListItemDTO -> FilePath
(Int -> UserListItemDTO -> ShowS)
-> (UserListItemDTO -> FilePath)
-> ([UserListItemDTO] -> ShowS)
-> Show UserListItemDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserListItemDTO] -> ShowS
$cshowList :: [UserListItemDTO] -> ShowS
show :: UserListItemDTO -> FilePath
$cshow :: UserListItemDTO -> FilePath
showsPrec :: Int -> UserListItemDTO -> ShowS
$cshowsPrec :: Int -> UserListItemDTO -> ShowS
P.Show, UserListItemDTO -> UserListItemDTO -> Bool
(UserListItemDTO -> UserListItemDTO -> Bool)
-> (UserListItemDTO -> UserListItemDTO -> Bool)
-> Eq UserListItemDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserListItemDTO -> UserListItemDTO -> Bool
$c/= :: UserListItemDTO -> UserListItemDTO -> Bool
== :: UserListItemDTO -> UserListItemDTO -> Bool
$c== :: UserListItemDTO -> UserListItemDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserListItemDTO
instance A.FromJSON UserListItemDTO where
  parseJSON :: Value -> Parser UserListItemDTO
parseJSON = FilePath
-> (Object -> Parser UserListItemDTO)
-> Value
-> Parser UserListItemDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UserListItemDTO" ((Object -> Parser UserListItemDTO)
 -> Value -> Parser UserListItemDTO)
-> (Object -> Parser UserListItemDTO)
-> Value
-> Parser UserListItemDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    AvatarSourceEnum -> Text -> Text -> Text -> Text -> UserListItemDTO
UserListItemDTO
      (AvatarSourceEnum
 -> Text -> Text -> Text -> Text -> UserListItemDTO)
-> Parser AvatarSourceEnum
-> Parser (Text -> Text -> Text -> Text -> UserListItemDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser AvatarSourceEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarSource")
      Parser (Text -> Text -> Text -> Text -> UserListItemDTO)
-> Parser Text -> Parser (Text -> Text -> Text -> UserListItemDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"lastName")
      Parser (Text -> Text -> Text -> UserListItemDTO)
-> Parser Text -> Parser (Text -> Text -> UserListItemDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"firstName")
      Parser (Text -> Text -> UserListItemDTO)
-> Parser Text -> Parser (Text -> UserListItemDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"username")
      Parser (Text -> UserListItemDTO)
-> Parser Text -> Parser UserListItemDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarUrl")

-- | ToJSON UserListItemDTO
instance A.ToJSON UserListItemDTO where
  toJSON :: UserListItemDTO -> Value
toJSON UserListItemDTO {Text
AvatarSourceEnum
userListItemDTOAvatarUrl :: Text
userListItemDTOUsername :: Text
userListItemDTOFirstName :: Text
userListItemDTOLastName :: Text
userListItemDTOAvatarSource :: AvatarSourceEnum
userListItemDTOAvatarUrl :: UserListItemDTO -> Text
userListItemDTOUsername :: UserListItemDTO -> Text
userListItemDTOFirstName :: UserListItemDTO -> Text
userListItemDTOLastName :: UserListItemDTO -> Text
userListItemDTOAvatarSource :: UserListItemDTO -> AvatarSourceEnum
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"avatarSource" Text -> AvatarSourceEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AvatarSourceEnum
userListItemDTOAvatarSource
      , Text
"lastName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userListItemDTOLastName
      , Text
"firstName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userListItemDTOFirstName
      , Text
"username" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userListItemDTOUsername
      , Text
"avatarUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userListItemDTOAvatarUrl
      ]


-- | Construct a value of type 'UserListItemDTO' (by applying it's required fields, if any)
mkUserListItemDTO
  :: AvatarSourceEnum -- ^ 'userListItemDTOAvatarSource'
  -> Text -- ^ 'userListItemDTOLastName'
  -> Text -- ^ 'userListItemDTOFirstName'
  -> Text -- ^ 'userListItemDTOUsername'
  -> Text -- ^ 'userListItemDTOAvatarUrl'
  -> UserListItemDTO
mkUserListItemDTO :: AvatarSourceEnum -> Text -> Text -> Text -> Text -> UserListItemDTO
mkUserListItemDTO AvatarSourceEnum
userListItemDTOAvatarSource Text
userListItemDTOLastName Text
userListItemDTOFirstName Text
userListItemDTOUsername Text
userListItemDTOAvatarUrl =
  UserListItemDTO :: AvatarSourceEnum -> Text -> Text -> Text -> Text -> UserListItemDTO
UserListItemDTO
  { AvatarSourceEnum
userListItemDTOAvatarSource :: AvatarSourceEnum
userListItemDTOAvatarSource :: AvatarSourceEnum
userListItemDTOAvatarSource
  , Text
userListItemDTOLastName :: Text
userListItemDTOLastName :: Text
userListItemDTOLastName
  , Text
userListItemDTOFirstName :: Text
userListItemDTOFirstName :: Text
userListItemDTOFirstName
  , Text
userListItemDTOUsername :: Text
userListItemDTOUsername :: Text
userListItemDTOUsername
  , Text
userListItemDTOAvatarUrl :: Text
userListItemDTOAvatarUrl :: Text
userListItemDTOAvatarUrl
  }

-- ** UserPricingStatusDTO
-- | UserPricingStatusDTO
data UserPricingStatusDTO = UserPricingStatusDTO
    { UserPricingStatusDTO -> Bool
userPricingStatusDTOCanCreateTeamFree :: !(Bool) -- ^ /Required/ "canCreateTeamFree"
    -- ^ "anyTeamFree"
    , UserPricingStatusDTO -> Maybe OrganizationWithRoleDTO
userPricingStatusDTOAnyTeamFree       :: !(Maybe OrganizationWithRoleDTO) -- ^ "anyTeamFree"
    }
    deriving (Int -> UserPricingStatusDTO -> ShowS
[UserPricingStatusDTO] -> ShowS
UserPricingStatusDTO -> FilePath
(Int -> UserPricingStatusDTO -> ShowS)
-> (UserPricingStatusDTO -> FilePath)
-> ([UserPricingStatusDTO] -> ShowS)
-> Show UserPricingStatusDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserPricingStatusDTO] -> ShowS
$cshowList :: [UserPricingStatusDTO] -> ShowS
show :: UserPricingStatusDTO -> FilePath
$cshow :: UserPricingStatusDTO -> FilePath
showsPrec :: Int -> UserPricingStatusDTO -> ShowS
$cshowsPrec :: Int -> UserPricingStatusDTO -> ShowS
P.Show, UserPricingStatusDTO -> UserPricingStatusDTO -> Bool
(UserPricingStatusDTO -> UserPricingStatusDTO -> Bool)
-> (UserPricingStatusDTO -> UserPricingStatusDTO -> Bool)
-> Eq UserPricingStatusDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserPricingStatusDTO -> UserPricingStatusDTO -> Bool
$c/= :: UserPricingStatusDTO -> UserPricingStatusDTO -> Bool
== :: UserPricingStatusDTO -> UserPricingStatusDTO -> Bool
$c== :: UserPricingStatusDTO -> UserPricingStatusDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserPricingStatusDTO
instance A.FromJSON UserPricingStatusDTO where
  parseJSON :: Value -> Parser UserPricingStatusDTO
parseJSON = FilePath
-> (Object -> Parser UserPricingStatusDTO)
-> Value
-> Parser UserPricingStatusDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UserPricingStatusDTO" ((Object -> Parser UserPricingStatusDTO)
 -> Value -> Parser UserPricingStatusDTO)
-> (Object -> Parser UserPricingStatusDTO)
-> Value
-> Parser UserPricingStatusDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Bool -> Maybe OrganizationWithRoleDTO -> UserPricingStatusDTO
UserPricingStatusDTO
      (Bool -> Maybe OrganizationWithRoleDTO -> UserPricingStatusDTO)
-> Parser Bool
-> Parser (Maybe OrganizationWithRoleDTO -> UserPricingStatusDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"canCreateTeamFree")
      Parser (Maybe OrganizationWithRoleDTO -> UserPricingStatusDTO)
-> Parser (Maybe OrganizationWithRoleDTO)
-> Parser UserPricingStatusDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe OrganizationWithRoleDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"anyTeamFree")

-- | ToJSON UserPricingStatusDTO
instance A.ToJSON UserPricingStatusDTO where
  toJSON :: UserPricingStatusDTO -> Value
toJSON UserPricingStatusDTO {Bool
Maybe OrganizationWithRoleDTO
userPricingStatusDTOAnyTeamFree :: Maybe OrganizationWithRoleDTO
userPricingStatusDTOCanCreateTeamFree :: Bool
userPricingStatusDTOAnyTeamFree :: UserPricingStatusDTO -> Maybe OrganizationWithRoleDTO
userPricingStatusDTOCanCreateTeamFree :: UserPricingStatusDTO -> Bool
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"canCreateTeamFree" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
userPricingStatusDTOCanCreateTeamFree
      , Text
"anyTeamFree" Text -> Maybe OrganizationWithRoleDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe OrganizationWithRoleDTO
userPricingStatusDTOAnyTeamFree
      ]


-- | Construct a value of type 'UserPricingStatusDTO' (by applying it's required fields, if any)
mkUserPricingStatusDTO
  :: Bool -- ^ 'userPricingStatusDTOCanCreateTeamFree'
  -> UserPricingStatusDTO
mkUserPricingStatusDTO :: Bool -> UserPricingStatusDTO
mkUserPricingStatusDTO Bool
userPricingStatusDTOCanCreateTeamFree =
  UserPricingStatusDTO :: Bool -> Maybe OrganizationWithRoleDTO -> UserPricingStatusDTO
UserPricingStatusDTO
  { Bool
userPricingStatusDTOCanCreateTeamFree :: Bool
userPricingStatusDTOCanCreateTeamFree :: Bool
userPricingStatusDTOCanCreateTeamFree
  , userPricingStatusDTOAnyTeamFree :: Maybe OrganizationWithRoleDTO
userPricingStatusDTOAnyTeamFree = Maybe OrganizationWithRoleDTO
forall a. Maybe a
Nothing
  }

-- ** UserProfileDTO
-- | UserProfileDTO
data UserProfileDTO = UserProfileDTO
    { UserProfileDTO -> Text
userProfileDTOUsernameHash          :: !(Text) -- ^ /Required/ "usernameHash"
    -- ^ /Required/ "email"
    , UserProfileDTO -> Text
userProfileDTOEmail                 :: !(Text) -- ^ /Required/ "email"
    -- ^ /Required/ "hasLoggedToCli"
    , UserProfileDTO -> Bool
userProfileDTOHasLoggedToCli        :: !(Bool) -- ^ /Required/ "hasLoggedToCli"
    -- ^ /Required/ "avatarSource"
    , UserProfileDTO -> AvatarSourceEnum
userProfileDTOAvatarSource          :: !(AvatarSourceEnum) -- ^ /Required/ "avatarSource"
    -- ^ /Required/ "firstName"
    , UserProfileDTO -> Text
userProfileDTOFirstName             :: !(Text) -- ^ /Required/ "firstName"
    -- ^ /Required/ "shortInfo"
    , UserProfileDTO -> Text
userProfileDTOShortInfo             :: !(Text) -- ^ /Required/ "shortInfo"
    -- ^ /Required/ "created"
    , UserProfileDTO -> DateTime
userProfileDTOCreated               :: !(DateTime) -- ^ /Required/ "created"
    -- ^ /Required/ "biography"
    , UserProfileDTO -> Text
userProfileDTOBiography             :: !(Text) -- ^ /Required/ "biography"
    -- ^ /Required/ "hasCreatedExperiments"
    , UserProfileDTO -> Bool
userProfileDTOHasCreatedExperiments :: !(Bool) -- ^ /Required/ "hasCreatedExperiments"
    -- ^ /Required/ "username"
    , UserProfileDTO -> Text
userProfileDTOUsername              :: !(Text) -- ^ /Required/ "username"
    -- ^ /Required/ "avatarUrl"
    , UserProfileDTO -> Text
userProfileDTOAvatarUrl             :: !(Text) -- ^ /Required/ "avatarUrl"
    -- ^ /Required/ "lastName"
    , UserProfileDTO -> Text
userProfileDTOLastName              :: !(Text) -- ^ /Required/ "lastName"
    -- ^ /Required/ "links"
    , UserProfileDTO -> UserProfileLinksDTO
userProfileDTOLinks                 :: !(UserProfileLinksDTO) -- ^ /Required/ "links"
    }
    deriving (Int -> UserProfileDTO -> ShowS
[UserProfileDTO] -> ShowS
UserProfileDTO -> FilePath
(Int -> UserProfileDTO -> ShowS)
-> (UserProfileDTO -> FilePath)
-> ([UserProfileDTO] -> ShowS)
-> Show UserProfileDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserProfileDTO] -> ShowS
$cshowList :: [UserProfileDTO] -> ShowS
show :: UserProfileDTO -> FilePath
$cshow :: UserProfileDTO -> FilePath
showsPrec :: Int -> UserProfileDTO -> ShowS
$cshowsPrec :: Int -> UserProfileDTO -> ShowS
P.Show, UserProfileDTO -> UserProfileDTO -> Bool
(UserProfileDTO -> UserProfileDTO -> Bool)
-> (UserProfileDTO -> UserProfileDTO -> Bool) -> Eq UserProfileDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserProfileDTO -> UserProfileDTO -> Bool
$c/= :: UserProfileDTO -> UserProfileDTO -> Bool
== :: UserProfileDTO -> UserProfileDTO -> Bool
$c== :: UserProfileDTO -> UserProfileDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserProfileDTO
instance A.FromJSON UserProfileDTO where
  parseJSON :: Value -> Parser UserProfileDTO
parseJSON = FilePath
-> (Object -> Parser UserProfileDTO)
-> Value
-> Parser UserProfileDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UserProfileDTO" ((Object -> Parser UserProfileDTO)
 -> Value -> Parser UserProfileDTO)
-> (Object -> Parser UserProfileDTO)
-> Value
-> Parser UserProfileDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text
-> Bool
-> AvatarSourceEnum
-> Text
-> Text
-> DateTime
-> Text
-> Bool
-> Text
-> Text
-> Text
-> UserProfileLinksDTO
-> UserProfileDTO
UserProfileDTO
      (Text
 -> Text
 -> Bool
 -> AvatarSourceEnum
 -> Text
 -> Text
 -> DateTime
 -> Text
 -> Bool
 -> Text
 -> Text
 -> Text
 -> UserProfileLinksDTO
 -> UserProfileDTO)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> AvatarSourceEnum
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> UserProfileLinksDTO
      -> UserProfileDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"usernameHash")
      Parser
  (Text
   -> Bool
   -> AvatarSourceEnum
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> UserProfileLinksDTO
   -> UserProfileDTO)
-> Parser Text
-> Parser
     (Bool
      -> AvatarSourceEnum
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> UserProfileLinksDTO
      -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"email")
      Parser
  (Bool
   -> AvatarSourceEnum
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> UserProfileLinksDTO
   -> UserProfileDTO)
-> Parser Bool
-> Parser
     (AvatarSourceEnum
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> UserProfileLinksDTO
      -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"hasLoggedToCli")
      Parser
  (AvatarSourceEnum
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> UserProfileLinksDTO
   -> UserProfileDTO)
-> Parser AvatarSourceEnum
-> Parser
     (Text
      -> Text
      -> DateTime
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> UserProfileLinksDTO
      -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser AvatarSourceEnum
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarSource")
      Parser
  (Text
   -> Text
   -> DateTime
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> UserProfileLinksDTO
   -> UserProfileDTO)
-> Parser Text
-> Parser
     (Text
      -> DateTime
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> UserProfileLinksDTO
      -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"firstName")
      Parser
  (Text
   -> DateTime
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> UserProfileLinksDTO
   -> UserProfileDTO)
-> Parser Text
-> Parser
     (DateTime
      -> Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> UserProfileLinksDTO
      -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"shortInfo")
      Parser
  (DateTime
   -> Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> UserProfileLinksDTO
   -> UserProfileDTO)
-> Parser DateTime
-> Parser
     (Text
      -> Bool
      -> Text
      -> Text
      -> Text
      -> UserProfileLinksDTO
      -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser DateTime
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"created")
      Parser
  (Text
   -> Bool
   -> Text
   -> Text
   -> Text
   -> UserProfileLinksDTO
   -> UserProfileDTO)
-> Parser Text
-> Parser
     (Bool
      -> Text -> Text -> Text -> UserProfileLinksDTO -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"biography")
      Parser
  (Bool
   -> Text -> Text -> Text -> UserProfileLinksDTO -> UserProfileDTO)
-> Parser Bool
-> Parser
     (Text -> Text -> Text -> UserProfileLinksDTO -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"hasCreatedExperiments")
      Parser
  (Text -> Text -> Text -> UserProfileLinksDTO -> UserProfileDTO)
-> Parser Text
-> Parser (Text -> Text -> UserProfileLinksDTO -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"username")
      Parser (Text -> Text -> UserProfileLinksDTO -> UserProfileDTO)
-> Parser Text
-> Parser (Text -> UserProfileLinksDTO -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"avatarUrl")
      Parser (Text -> UserProfileLinksDTO -> UserProfileDTO)
-> Parser Text -> Parser (UserProfileLinksDTO -> UserProfileDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"lastName")
      Parser (UserProfileLinksDTO -> UserProfileDTO)
-> Parser UserProfileLinksDTO -> Parser UserProfileDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser UserProfileLinksDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"links")

-- | ToJSON UserProfileDTO
instance A.ToJSON UserProfileDTO where
  toJSON :: UserProfileDTO -> Value
toJSON UserProfileDTO {Bool
Text
DateTime
AvatarSourceEnum
UserProfileLinksDTO
userProfileDTOLinks :: UserProfileLinksDTO
userProfileDTOLastName :: Text
userProfileDTOAvatarUrl :: Text
userProfileDTOUsername :: Text
userProfileDTOHasCreatedExperiments :: Bool
userProfileDTOBiography :: Text
userProfileDTOCreated :: DateTime
userProfileDTOShortInfo :: Text
userProfileDTOFirstName :: Text
userProfileDTOAvatarSource :: AvatarSourceEnum
userProfileDTOHasLoggedToCli :: Bool
userProfileDTOEmail :: Text
userProfileDTOUsernameHash :: Text
userProfileDTOLinks :: UserProfileDTO -> UserProfileLinksDTO
userProfileDTOLastName :: UserProfileDTO -> Text
userProfileDTOAvatarUrl :: UserProfileDTO -> Text
userProfileDTOUsername :: UserProfileDTO -> Text
userProfileDTOHasCreatedExperiments :: UserProfileDTO -> Bool
userProfileDTOBiography :: UserProfileDTO -> Text
userProfileDTOCreated :: UserProfileDTO -> DateTime
userProfileDTOShortInfo :: UserProfileDTO -> Text
userProfileDTOFirstName :: UserProfileDTO -> Text
userProfileDTOAvatarSource :: UserProfileDTO -> AvatarSourceEnum
userProfileDTOHasLoggedToCli :: UserProfileDTO -> Bool
userProfileDTOEmail :: UserProfileDTO -> Text
userProfileDTOUsernameHash :: UserProfileDTO -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"usernameHash" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userProfileDTOUsernameHash
      , Text
"email" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userProfileDTOEmail
      , Text
"hasLoggedToCli" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
userProfileDTOHasLoggedToCli
      , Text
"avatarSource" Text -> AvatarSourceEnum -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AvatarSourceEnum
userProfileDTOAvatarSource
      , Text
"firstName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userProfileDTOFirstName
      , Text
"shortInfo" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userProfileDTOShortInfo
      , Text
"created" Text -> DateTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DateTime
userProfileDTOCreated
      , Text
"biography" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userProfileDTOBiography
      , Text
"hasCreatedExperiments" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
userProfileDTOHasCreatedExperiments
      , Text
"username" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userProfileDTOUsername
      , Text
"avatarUrl" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userProfileDTOAvatarUrl
      , Text
"lastName" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userProfileDTOLastName
      , Text
"links" Text -> UserProfileLinksDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UserProfileLinksDTO
userProfileDTOLinks
      ]


-- | Construct a value of type 'UserProfileDTO' (by applying it's required fields, if any)
mkUserProfileDTO
  :: Text -- ^ 'userProfileDTOUsernameHash'
  -> Text -- ^ 'userProfileDTOEmail'
  -> Bool -- ^ 'userProfileDTOHasLoggedToCli'
  -> AvatarSourceEnum -- ^ 'userProfileDTOAvatarSource'
  -> Text -- ^ 'userProfileDTOFirstName'
  -> Text -- ^ 'userProfileDTOShortInfo'
  -> DateTime -- ^ 'userProfileDTOCreated'
  -> Text -- ^ 'userProfileDTOBiography'
  -> Bool -- ^ 'userProfileDTOHasCreatedExperiments'
  -> Text -- ^ 'userProfileDTOUsername'
  -> Text -- ^ 'userProfileDTOAvatarUrl'
  -> Text -- ^ 'userProfileDTOLastName'
  -> UserProfileLinksDTO -- ^ 'userProfileDTOLinks'
  -> UserProfileDTO
mkUserProfileDTO :: Text
-> Text
-> Bool
-> AvatarSourceEnum
-> Text
-> Text
-> DateTime
-> Text
-> Bool
-> Text
-> Text
-> Text
-> UserProfileLinksDTO
-> UserProfileDTO
mkUserProfileDTO Text
userProfileDTOUsernameHash Text
userProfileDTOEmail Bool
userProfileDTOHasLoggedToCli AvatarSourceEnum
userProfileDTOAvatarSource Text
userProfileDTOFirstName Text
userProfileDTOShortInfo DateTime
userProfileDTOCreated Text
userProfileDTOBiography Bool
userProfileDTOHasCreatedExperiments Text
userProfileDTOUsername Text
userProfileDTOAvatarUrl Text
userProfileDTOLastName UserProfileLinksDTO
userProfileDTOLinks =
  UserProfileDTO :: Text
-> Text
-> Bool
-> AvatarSourceEnum
-> Text
-> Text
-> DateTime
-> Text
-> Bool
-> Text
-> Text
-> Text
-> UserProfileLinksDTO
-> UserProfileDTO
UserProfileDTO
  { Text
userProfileDTOUsernameHash :: Text
userProfileDTOUsernameHash :: Text
userProfileDTOUsernameHash
  , Text
userProfileDTOEmail :: Text
userProfileDTOEmail :: Text
userProfileDTOEmail
  , Bool
userProfileDTOHasLoggedToCli :: Bool
userProfileDTOHasLoggedToCli :: Bool
userProfileDTOHasLoggedToCli
  , AvatarSourceEnum
userProfileDTOAvatarSource :: AvatarSourceEnum
userProfileDTOAvatarSource :: AvatarSourceEnum
userProfileDTOAvatarSource
  , Text
userProfileDTOFirstName :: Text
userProfileDTOFirstName :: Text
userProfileDTOFirstName
  , Text
userProfileDTOShortInfo :: Text
userProfileDTOShortInfo :: Text
userProfileDTOShortInfo
  , DateTime
userProfileDTOCreated :: DateTime
userProfileDTOCreated :: DateTime
userProfileDTOCreated
  , Text
userProfileDTOBiography :: Text
userProfileDTOBiography :: Text
userProfileDTOBiography
  , Bool
userProfileDTOHasCreatedExperiments :: Bool
userProfileDTOHasCreatedExperiments :: Bool
userProfileDTOHasCreatedExperiments
  , Text
userProfileDTOUsername :: Text
userProfileDTOUsername :: Text
userProfileDTOUsername
  , Text
userProfileDTOAvatarUrl :: Text
userProfileDTOAvatarUrl :: Text
userProfileDTOAvatarUrl
  , Text
userProfileDTOLastName :: Text
userProfileDTOLastName :: Text
userProfileDTOLastName
  , UserProfileLinksDTO
userProfileDTOLinks :: UserProfileLinksDTO
userProfileDTOLinks :: UserProfileLinksDTO
userProfileDTOLinks
  }

-- ** UserProfileLinkDTO
-- | UserProfileLinkDTO
data UserProfileLinkDTO = UserProfileLinkDTO
    { UserProfileLinkDTO -> LinkTypeDTO
userProfileLinkDTOLinkType :: !(LinkTypeDTO) -- ^ /Required/ "linkType"
    -- ^ /Required/ "url"
    , UserProfileLinkDTO -> Text
userProfileLinkDTOUrl      :: !(Text) -- ^ /Required/ "url"
    }
    deriving (Int -> UserProfileLinkDTO -> ShowS
[UserProfileLinkDTO] -> ShowS
UserProfileLinkDTO -> FilePath
(Int -> UserProfileLinkDTO -> ShowS)
-> (UserProfileLinkDTO -> FilePath)
-> ([UserProfileLinkDTO] -> ShowS)
-> Show UserProfileLinkDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserProfileLinkDTO] -> ShowS
$cshowList :: [UserProfileLinkDTO] -> ShowS
show :: UserProfileLinkDTO -> FilePath
$cshow :: UserProfileLinkDTO -> FilePath
showsPrec :: Int -> UserProfileLinkDTO -> ShowS
$cshowsPrec :: Int -> UserProfileLinkDTO -> ShowS
P.Show, UserProfileLinkDTO -> UserProfileLinkDTO -> Bool
(UserProfileLinkDTO -> UserProfileLinkDTO -> Bool)
-> (UserProfileLinkDTO -> UserProfileLinkDTO -> Bool)
-> Eq UserProfileLinkDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserProfileLinkDTO -> UserProfileLinkDTO -> Bool
$c/= :: UserProfileLinkDTO -> UserProfileLinkDTO -> Bool
== :: UserProfileLinkDTO -> UserProfileLinkDTO -> Bool
$c== :: UserProfileLinkDTO -> UserProfileLinkDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserProfileLinkDTO
instance A.FromJSON UserProfileLinkDTO where
  parseJSON :: Value -> Parser UserProfileLinkDTO
parseJSON = FilePath
-> (Object -> Parser UserProfileLinkDTO)
-> Value
-> Parser UserProfileLinkDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UserProfileLinkDTO" ((Object -> Parser UserProfileLinkDTO)
 -> Value -> Parser UserProfileLinkDTO)
-> (Object -> Parser UserProfileLinkDTO)
-> Value
-> Parser UserProfileLinkDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    LinkTypeDTO -> Text -> UserProfileLinkDTO
UserProfileLinkDTO
      (LinkTypeDTO -> Text -> UserProfileLinkDTO)
-> Parser LinkTypeDTO -> Parser (Text -> UserProfileLinkDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser LinkTypeDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"linkType")
      Parser (Text -> UserProfileLinkDTO)
-> Parser Text -> Parser UserProfileLinkDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"url")

-- | ToJSON UserProfileLinkDTO
instance A.ToJSON UserProfileLinkDTO where
  toJSON :: UserProfileLinkDTO -> Value
toJSON UserProfileLinkDTO {Text
LinkTypeDTO
userProfileLinkDTOUrl :: Text
userProfileLinkDTOLinkType :: LinkTypeDTO
userProfileLinkDTOUrl :: UserProfileLinkDTO -> Text
userProfileLinkDTOLinkType :: UserProfileLinkDTO -> LinkTypeDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"linkType" Text -> LinkTypeDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= LinkTypeDTO
userProfileLinkDTOLinkType
      , Text
"url" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
userProfileLinkDTOUrl
      ]


-- | Construct a value of type 'UserProfileLinkDTO' (by applying it's required fields, if any)
mkUserProfileLinkDTO
  :: LinkTypeDTO -- ^ 'userProfileLinkDTOLinkType'
  -> Text -- ^ 'userProfileLinkDTOUrl'
  -> UserProfileLinkDTO
mkUserProfileLinkDTO :: LinkTypeDTO -> Text -> UserProfileLinkDTO
mkUserProfileLinkDTO LinkTypeDTO
userProfileLinkDTOLinkType Text
userProfileLinkDTOUrl =
  UserProfileLinkDTO :: LinkTypeDTO -> Text -> UserProfileLinkDTO
UserProfileLinkDTO
  { LinkTypeDTO
userProfileLinkDTOLinkType :: LinkTypeDTO
userProfileLinkDTOLinkType :: LinkTypeDTO
userProfileLinkDTOLinkType
  , Text
userProfileLinkDTOUrl :: Text
userProfileLinkDTOUrl :: Text
userProfileLinkDTOUrl
  }

-- ** UserProfileLinksDTO
-- | UserProfileLinksDTO
data UserProfileLinksDTO = UserProfileLinksDTO
    { UserProfileLinksDTO -> Maybe Text
userProfileLinksDTOGithub   :: !(Maybe Text) -- ^ "github"
    -- ^ "linkedin"
    , UserProfileLinksDTO -> Maybe Text
userProfileLinksDTOLinkedin :: !(Maybe Text) -- ^ "linkedin"
    -- ^ /Required/ "others"
    , UserProfileLinksDTO -> [Text]
userProfileLinksDTOOthers   :: !([Text]) -- ^ /Required/ "others"
    -- ^ "kaggle"
    , UserProfileLinksDTO -> Maybe Text
userProfileLinksDTOKaggle   :: !(Maybe Text) -- ^ "kaggle"
    -- ^ "twitter"
    , UserProfileLinksDTO -> Maybe Text
userProfileLinksDTOTwitter  :: !(Maybe Text) -- ^ "twitter"
    }
    deriving (Int -> UserProfileLinksDTO -> ShowS
[UserProfileLinksDTO] -> ShowS
UserProfileLinksDTO -> FilePath
(Int -> UserProfileLinksDTO -> ShowS)
-> (UserProfileLinksDTO -> FilePath)
-> ([UserProfileLinksDTO] -> ShowS)
-> Show UserProfileLinksDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserProfileLinksDTO] -> ShowS
$cshowList :: [UserProfileLinksDTO] -> ShowS
show :: UserProfileLinksDTO -> FilePath
$cshow :: UserProfileLinksDTO -> FilePath
showsPrec :: Int -> UserProfileLinksDTO -> ShowS
$cshowsPrec :: Int -> UserProfileLinksDTO -> ShowS
P.Show, UserProfileLinksDTO -> UserProfileLinksDTO -> Bool
(UserProfileLinksDTO -> UserProfileLinksDTO -> Bool)
-> (UserProfileLinksDTO -> UserProfileLinksDTO -> Bool)
-> Eq UserProfileLinksDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserProfileLinksDTO -> UserProfileLinksDTO -> Bool
$c/= :: UserProfileLinksDTO -> UserProfileLinksDTO -> Bool
== :: UserProfileLinksDTO -> UserProfileLinksDTO -> Bool
$c== :: UserProfileLinksDTO -> UserProfileLinksDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserProfileLinksDTO
instance A.FromJSON UserProfileLinksDTO where
  parseJSON :: Value -> Parser UserProfileLinksDTO
parseJSON = FilePath
-> (Object -> Parser UserProfileLinksDTO)
-> Value
-> Parser UserProfileLinksDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UserProfileLinksDTO" ((Object -> Parser UserProfileLinksDTO)
 -> Value -> Parser UserProfileLinksDTO)
-> (Object -> Parser UserProfileLinksDTO)
-> Value
-> Parser UserProfileLinksDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> [Text]
-> Maybe Text
-> Maybe Text
-> UserProfileLinksDTO
UserProfileLinksDTO
      (Maybe Text
 -> Maybe Text
 -> [Text]
 -> Maybe Text
 -> Maybe Text
 -> UserProfileLinksDTO)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> [Text] -> Maybe Text -> Maybe Text -> UserProfileLinksDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"github")
      Parser
  (Maybe Text
   -> [Text] -> Maybe Text -> Maybe Text -> UserProfileLinksDTO)
-> Parser (Maybe Text)
-> Parser
     ([Text] -> Maybe Text -> Maybe Text -> UserProfileLinksDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"linkedin")
      Parser ([Text] -> Maybe Text -> Maybe Text -> UserProfileLinksDTO)
-> Parser [Text]
-> Parser (Maybe Text -> Maybe Text -> UserProfileLinksDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"others")
      Parser (Maybe Text -> Maybe Text -> UserProfileLinksDTO)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> UserProfileLinksDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"kaggle")
      Parser (Maybe Text -> UserProfileLinksDTO)
-> Parser (Maybe Text) -> Parser UserProfileLinksDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"twitter")

-- | ToJSON UserProfileLinksDTO
instance A.ToJSON UserProfileLinksDTO where
  toJSON :: UserProfileLinksDTO -> Value
toJSON UserProfileLinksDTO {[Text]
Maybe Text
userProfileLinksDTOTwitter :: Maybe Text
userProfileLinksDTOKaggle :: Maybe Text
userProfileLinksDTOOthers :: [Text]
userProfileLinksDTOLinkedin :: Maybe Text
userProfileLinksDTOGithub :: Maybe Text
userProfileLinksDTOTwitter :: UserProfileLinksDTO -> Maybe Text
userProfileLinksDTOKaggle :: UserProfileLinksDTO -> Maybe Text
userProfileLinksDTOOthers :: UserProfileLinksDTO -> [Text]
userProfileLinksDTOLinkedin :: UserProfileLinksDTO -> Maybe Text
userProfileLinksDTOGithub :: UserProfileLinksDTO -> Maybe Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"github" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
userProfileLinksDTOGithub
      , Text
"linkedin" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
userProfileLinksDTOLinkedin
      , Text
"others" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
userProfileLinksDTOOthers
      , Text
"kaggle" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
userProfileLinksDTOKaggle
      , Text
"twitter" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
userProfileLinksDTOTwitter
      ]


-- | Construct a value of type 'UserProfileLinksDTO' (by applying it's required fields, if any)
mkUserProfileLinksDTO
  :: [Text] -- ^ 'userProfileLinksDTOOthers'
  -> UserProfileLinksDTO
mkUserProfileLinksDTO :: [Text] -> UserProfileLinksDTO
mkUserProfileLinksDTO [Text]
userProfileLinksDTOOthers =
  UserProfileLinksDTO :: Maybe Text
-> Maybe Text
-> [Text]
-> Maybe Text
-> Maybe Text
-> UserProfileLinksDTO
UserProfileLinksDTO
  { userProfileLinksDTOGithub :: Maybe Text
userProfileLinksDTOGithub = Maybe Text
forall a. Maybe a
Nothing
  , userProfileLinksDTOLinkedin :: Maybe Text
userProfileLinksDTOLinkedin = Maybe Text
forall a. Maybe a
Nothing
  , [Text]
userProfileLinksDTOOthers :: [Text]
userProfileLinksDTOOthers :: [Text]
userProfileLinksDTOOthers
  , userProfileLinksDTOKaggle :: Maybe Text
userProfileLinksDTOKaggle = Maybe Text
forall a. Maybe a
Nothing
  , userProfileLinksDTOTwitter :: Maybe Text
userProfileLinksDTOTwitter = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserProfileUpdateDTO
-- | UserProfileUpdateDTO
data UserProfileUpdateDTO = UserProfileUpdateDTO
    { UserProfileUpdateDTO -> Maybe Text
userProfileUpdateDTOBiography      :: !(Maybe Text) -- ^ "biography"
    -- ^ "hasLoggedToCli"
    , UserProfileUpdateDTO -> Maybe Bool
userProfileUpdateDTOHasLoggedToCli :: !(Maybe Bool) -- ^ "hasLoggedToCli"
    -- ^ "lastName"
    , UserProfileUpdateDTO -> Maybe Text
userProfileUpdateDTOLastName       :: !(Maybe Text) -- ^ "lastName"
    -- ^ "firstName"
    , UserProfileUpdateDTO -> Maybe Text
userProfileUpdateDTOFirstName      :: !(Maybe Text) -- ^ "firstName"
    -- ^ "shortInfo"
    , UserProfileUpdateDTO -> Maybe Text
userProfileUpdateDTOShortInfo      :: !(Maybe Text) -- ^ "shortInfo"
    }
    deriving (Int -> UserProfileUpdateDTO -> ShowS
[UserProfileUpdateDTO] -> ShowS
UserProfileUpdateDTO -> FilePath
(Int -> UserProfileUpdateDTO -> ShowS)
-> (UserProfileUpdateDTO -> FilePath)
-> ([UserProfileUpdateDTO] -> ShowS)
-> Show UserProfileUpdateDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserProfileUpdateDTO] -> ShowS
$cshowList :: [UserProfileUpdateDTO] -> ShowS
show :: UserProfileUpdateDTO -> FilePath
$cshow :: UserProfileUpdateDTO -> FilePath
showsPrec :: Int -> UserProfileUpdateDTO -> ShowS
$cshowsPrec :: Int -> UserProfileUpdateDTO -> ShowS
P.Show, UserProfileUpdateDTO -> UserProfileUpdateDTO -> Bool
(UserProfileUpdateDTO -> UserProfileUpdateDTO -> Bool)
-> (UserProfileUpdateDTO -> UserProfileUpdateDTO -> Bool)
-> Eq UserProfileUpdateDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserProfileUpdateDTO -> UserProfileUpdateDTO -> Bool
$c/= :: UserProfileUpdateDTO -> UserProfileUpdateDTO -> Bool
== :: UserProfileUpdateDTO -> UserProfileUpdateDTO -> Bool
$c== :: UserProfileUpdateDTO -> UserProfileUpdateDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserProfileUpdateDTO
instance A.FromJSON UserProfileUpdateDTO where
  parseJSON :: Value -> Parser UserProfileUpdateDTO
parseJSON = FilePath
-> (Object -> Parser UserProfileUpdateDTO)
-> Value
-> Parser UserProfileUpdateDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UserProfileUpdateDTO" ((Object -> Parser UserProfileUpdateDTO)
 -> Value -> Parser UserProfileUpdateDTO)
-> (Object -> Parser UserProfileUpdateDTO)
-> Value
-> Parser UserProfileUpdateDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> UserProfileUpdateDTO
UserProfileUpdateDTO
      (Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> UserProfileUpdateDTO)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text -> Maybe Text -> Maybe Text -> UserProfileUpdateDTO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"biography")
      Parser
  (Maybe Bool
   -> Maybe Text -> Maybe Text -> Maybe Text -> UserProfileUpdateDTO)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> UserProfileUpdateDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"hasLoggedToCli")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> UserProfileUpdateDTO)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> UserProfileUpdateDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"lastName")
      Parser (Maybe Text -> Maybe Text -> UserProfileUpdateDTO)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> UserProfileUpdateDTO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"firstName")
      Parser (Maybe Text -> UserProfileUpdateDTO)
-> Parser (Maybe Text) -> Parser UserProfileUpdateDTO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"shortInfo")

-- | ToJSON UserProfileUpdateDTO
instance A.ToJSON UserProfileUpdateDTO where
  toJSON :: UserProfileUpdateDTO -> Value
toJSON UserProfileUpdateDTO {Maybe Bool
Maybe Text
userProfileUpdateDTOShortInfo :: Maybe Text
userProfileUpdateDTOFirstName :: Maybe Text
userProfileUpdateDTOLastName :: Maybe Text
userProfileUpdateDTOHasLoggedToCli :: Maybe Bool
userProfileUpdateDTOBiography :: Maybe Text
userProfileUpdateDTOShortInfo :: UserProfileUpdateDTO -> Maybe Text
userProfileUpdateDTOFirstName :: UserProfileUpdateDTO -> Maybe Text
userProfileUpdateDTOLastName :: UserProfileUpdateDTO -> Maybe Text
userProfileUpdateDTOHasLoggedToCli :: UserProfileUpdateDTO -> Maybe Bool
userProfileUpdateDTOBiography :: UserProfileUpdateDTO -> Maybe Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"biography" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
userProfileUpdateDTOBiography
      , Text
"hasLoggedToCli" Text -> Maybe Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
userProfileUpdateDTOHasLoggedToCli
      , Text
"lastName" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
userProfileUpdateDTOLastName
      , Text
"firstName" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
userProfileUpdateDTOFirstName
      , Text
"shortInfo" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
userProfileUpdateDTOShortInfo
      ]


-- | Construct a value of type 'UserProfileUpdateDTO' (by applying it's required fields, if any)
mkUserProfileUpdateDTO
  :: UserProfileUpdateDTO
mkUserProfileUpdateDTO :: UserProfileUpdateDTO
mkUserProfileUpdateDTO =
  UserProfileUpdateDTO :: Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> UserProfileUpdateDTO
UserProfileUpdateDTO
  { userProfileUpdateDTOBiography :: Maybe Text
userProfileUpdateDTOBiography = Maybe Text
forall a. Maybe a
Nothing
  , userProfileUpdateDTOHasLoggedToCli :: Maybe Bool
userProfileUpdateDTOHasLoggedToCli = Maybe Bool
forall a. Maybe a
Nothing
  , userProfileUpdateDTOLastName :: Maybe Text
userProfileUpdateDTOLastName = Maybe Text
forall a. Maybe a
Nothing
  , userProfileUpdateDTOFirstName :: Maybe Text
userProfileUpdateDTOFirstName = Maybe Text
forall a. Maybe a
Nothing
  , userProfileUpdateDTOShortInfo :: Maybe Text
userProfileUpdateDTOShortInfo = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UsernameValidationStatusDTO
-- | UsernameValidationStatusDTO
data UsernameValidationStatusDTO = UsernameValidationStatusDTO
    { UsernameValidationStatusDTO -> UsernameValidationStatusEnumDTO
usernameValidationStatusDTOStatus :: !(UsernameValidationStatusEnumDTO) -- ^ /Required/ "status"
    }
    deriving (Int -> UsernameValidationStatusDTO -> ShowS
[UsernameValidationStatusDTO] -> ShowS
UsernameValidationStatusDTO -> FilePath
(Int -> UsernameValidationStatusDTO -> ShowS)
-> (UsernameValidationStatusDTO -> FilePath)
-> ([UsernameValidationStatusDTO] -> ShowS)
-> Show UsernameValidationStatusDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UsernameValidationStatusDTO] -> ShowS
$cshowList :: [UsernameValidationStatusDTO] -> ShowS
show :: UsernameValidationStatusDTO -> FilePath
$cshow :: UsernameValidationStatusDTO -> FilePath
showsPrec :: Int -> UsernameValidationStatusDTO -> ShowS
$cshowsPrec :: Int -> UsernameValidationStatusDTO -> ShowS
P.Show, UsernameValidationStatusDTO -> UsernameValidationStatusDTO -> Bool
(UsernameValidationStatusDTO
 -> UsernameValidationStatusDTO -> Bool)
-> (UsernameValidationStatusDTO
    -> UsernameValidationStatusDTO -> Bool)
-> Eq UsernameValidationStatusDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsernameValidationStatusDTO -> UsernameValidationStatusDTO -> Bool
$c/= :: UsernameValidationStatusDTO -> UsernameValidationStatusDTO -> Bool
== :: UsernameValidationStatusDTO -> UsernameValidationStatusDTO -> Bool
$c== :: UsernameValidationStatusDTO -> UsernameValidationStatusDTO -> Bool
P.Eq, P.Typeable)

-- | FromJSON UsernameValidationStatusDTO
instance A.FromJSON UsernameValidationStatusDTO where
  parseJSON :: Value -> Parser UsernameValidationStatusDTO
parseJSON = FilePath
-> (Object -> Parser UsernameValidationStatusDTO)
-> Value
-> Parser UsernameValidationStatusDTO
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"UsernameValidationStatusDTO" ((Object -> Parser UsernameValidationStatusDTO)
 -> Value -> Parser UsernameValidationStatusDTO)
-> (Object -> Parser UsernameValidationStatusDTO)
-> Value
-> Parser UsernameValidationStatusDTO
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    UsernameValidationStatusEnumDTO -> UsernameValidationStatusDTO
UsernameValidationStatusDTO
      (UsernameValidationStatusEnumDTO -> UsernameValidationStatusDTO)
-> Parser UsernameValidationStatusEnumDTO
-> Parser UsernameValidationStatusDTO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser UsernameValidationStatusEnumDTO
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"status")

-- | ToJSON UsernameValidationStatusDTO
instance A.ToJSON UsernameValidationStatusDTO where
  toJSON :: UsernameValidationStatusDTO -> Value
toJSON UsernameValidationStatusDTO {UsernameValidationStatusEnumDTO
usernameValidationStatusDTOStatus :: UsernameValidationStatusEnumDTO
usernameValidationStatusDTOStatus :: UsernameValidationStatusDTO -> UsernameValidationStatusEnumDTO
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"status" Text -> UsernameValidationStatusEnumDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UsernameValidationStatusEnumDTO
usernameValidationStatusDTOStatus
      ]


-- | Construct a value of type 'UsernameValidationStatusDTO' (by applying it's required fields, if any)
mkUsernameValidationStatusDTO
  :: UsernameValidationStatusEnumDTO -- ^ 'usernameValidationStatusDTOStatus'
  -> UsernameValidationStatusDTO
mkUsernameValidationStatusDTO :: UsernameValidationStatusEnumDTO -> UsernameValidationStatusDTO
mkUsernameValidationStatusDTO UsernameValidationStatusEnumDTO
usernameValidationStatusDTOStatus =
  UsernameValidationStatusDTO :: UsernameValidationStatusEnumDTO -> UsernameValidationStatusDTO
UsernameValidationStatusDTO
  { UsernameValidationStatusEnumDTO
usernameValidationStatusDTOStatus :: UsernameValidationStatusEnumDTO
usernameValidationStatusDTOStatus :: UsernameValidationStatusEnumDTO
usernameValidationStatusDTOStatus
  }

-- ** Version
-- | Version
data Version = Version
    { Version -> Text
versionVersion :: !(Text) -- ^ /Required/ "version"
    }
    deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> FilePath
(Int -> Version -> ShowS)
-> (Version -> FilePath) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> FilePath
$cshow :: Version -> FilePath
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
P.Show, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
P.Eq, P.Typeable)

-- | FromJSON Version
instance A.FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON = FilePath -> (Object -> Parser Version) -> Value -> Parser Version
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Version" ((Object -> Parser Version) -> Value -> Parser Version)
-> (Object -> Parser Version) -> Value -> Parser Version
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Version
Version
      (Text -> Version) -> Parser Text -> Parser Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"version")

-- | ToJSON Version
instance A.ToJSON Version where
  toJSON :: Version -> Value
toJSON Version {Text
versionVersion :: Text
versionVersion :: Version -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"version" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
versionVersion
      ]


-- | Construct a value of type 'Version' (by applying it's required fields, if any)
mkVersion
  :: Text -- ^ 'versionVersion'
  -> Version
mkVersion :: Text -> Version
mkVersion Text
versionVersion =
  Version :: Text -> Version
Version
  { Text
versionVersion :: Text
versionVersion :: Text
versionVersion
  }

-- ** WorkspaceConfig
-- | WorkspaceConfig
data WorkspaceConfig = WorkspaceConfig
    { WorkspaceConfig -> Text
workspaceConfigRealm   :: !(Text) -- ^ /Required/ "realm"
    -- ^ /Required/ "idpHint"
    , WorkspaceConfig -> Text
workspaceConfigIdpHint :: !(Text) -- ^ /Required/ "idpHint"
    }
    deriving (Int -> WorkspaceConfig -> ShowS
[WorkspaceConfig] -> ShowS
WorkspaceConfig -> FilePath
(Int -> WorkspaceConfig -> ShowS)
-> (WorkspaceConfig -> FilePath)
-> ([WorkspaceConfig] -> ShowS)
-> Show WorkspaceConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceConfig] -> ShowS
$cshowList :: [WorkspaceConfig] -> ShowS
show :: WorkspaceConfig -> FilePath
$cshow :: WorkspaceConfig -> FilePath
showsPrec :: Int -> WorkspaceConfig -> ShowS
$cshowsPrec :: Int -> WorkspaceConfig -> ShowS
P.Show, WorkspaceConfig -> WorkspaceConfig -> Bool
(WorkspaceConfig -> WorkspaceConfig -> Bool)
-> (WorkspaceConfig -> WorkspaceConfig -> Bool)
-> Eq WorkspaceConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceConfig -> WorkspaceConfig -> Bool
$c/= :: WorkspaceConfig -> WorkspaceConfig -> Bool
== :: WorkspaceConfig -> WorkspaceConfig -> Bool
$c== :: WorkspaceConfig -> WorkspaceConfig -> Bool
P.Eq, P.Typeable)

-- | FromJSON WorkspaceConfig
instance A.FromJSON WorkspaceConfig where
  parseJSON :: Value -> Parser WorkspaceConfig
parseJSON = FilePath
-> (Object -> Parser WorkspaceConfig)
-> Value
-> Parser WorkspaceConfig
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"WorkspaceConfig" ((Object -> Parser WorkspaceConfig)
 -> Value -> Parser WorkspaceConfig)
-> (Object -> Parser WorkspaceConfig)
-> Value
-> Parser WorkspaceConfig
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> WorkspaceConfig
WorkspaceConfig
      (Text -> Text -> WorkspaceConfig)
-> Parser Text -> Parser (Text -> WorkspaceConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"realm")
      Parser (Text -> WorkspaceConfig)
-> Parser Text -> Parser WorkspaceConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"idpHint")

-- | ToJSON WorkspaceConfig
instance A.ToJSON WorkspaceConfig where
  toJSON :: WorkspaceConfig -> Value
toJSON WorkspaceConfig {Text
workspaceConfigIdpHint :: Text
workspaceConfigRealm :: Text
workspaceConfigIdpHint :: WorkspaceConfig -> Text
workspaceConfigRealm :: WorkspaceConfig -> Text
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"realm" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
workspaceConfigRealm
      , Text
"idpHint" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
workspaceConfigIdpHint
      ]


-- | Construct a value of type 'WorkspaceConfig' (by applying it's required fields, if any)
mkWorkspaceConfig
  :: Text -- ^ 'workspaceConfigRealm'
  -> Text -- ^ 'workspaceConfigIdpHint'
  -> WorkspaceConfig
mkWorkspaceConfig :: Text -> Text -> WorkspaceConfig
mkWorkspaceConfig Text
workspaceConfigRealm Text
workspaceConfigIdpHint =
  WorkspaceConfig :: Text -> Text -> WorkspaceConfig
WorkspaceConfig
  { Text
workspaceConfigRealm :: Text
workspaceConfigRealm :: Text
workspaceConfigRealm
  , Text
workspaceConfigIdpHint :: Text
workspaceConfigIdpHint :: Text
workspaceConfigIdpHint
  }

-- ** Y
-- | Y
data Y = Y
    { Y -> Maybe Double
yNumericValue    :: !(Maybe Double) -- ^ "numericValue"
    -- ^ "textValue"
    , Y -> Maybe Text
yTextValue       :: !(Maybe Text) -- ^ "textValue"
    -- ^ "imageValue"
    , Y -> Maybe OutputImageDTO
yImageValue      :: !(Maybe OutputImageDTO) -- ^ "imageValue"
    -- ^ "inputImageValue"
    , Y -> Maybe InputImageDTO
yInputImageValue :: !(Maybe InputImageDTO) -- ^ "inputImageValue"
    }
    deriving (Int -> Y -> ShowS
[Y] -> ShowS
Y -> FilePath
(Int -> Y -> ShowS) -> (Y -> FilePath) -> ([Y] -> ShowS) -> Show Y
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Y] -> ShowS
$cshowList :: [Y] -> ShowS
show :: Y -> FilePath
$cshow :: Y -> FilePath
showsPrec :: Int -> Y -> ShowS
$cshowsPrec :: Int -> Y -> ShowS
P.Show, Y -> Y -> Bool
(Y -> Y -> Bool) -> (Y -> Y -> Bool) -> Eq Y
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Y -> Y -> Bool
$c/= :: Y -> Y -> Bool
== :: Y -> Y -> Bool
$c== :: Y -> Y -> Bool
P.Eq, P.Typeable)

-- | FromJSON Y
instance A.FromJSON Y where
  parseJSON :: Value -> Parser Y
parseJSON = FilePath -> (Object -> Parser Y) -> Value -> Parser Y
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"Y" ((Object -> Parser Y) -> Value -> Parser Y)
-> (Object -> Parser Y) -> Value -> Parser Y
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Double
-> Maybe Text -> Maybe OutputImageDTO -> Maybe InputImageDTO -> Y
Y
      (Maybe Double
 -> Maybe Text -> Maybe OutputImageDTO -> Maybe InputImageDTO -> Y)
-> Parser (Maybe Double)
-> Parser
     (Maybe Text -> Maybe OutputImageDTO -> Maybe InputImageDTO -> Y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"numericValue")
      Parser
  (Maybe Text -> Maybe OutputImageDTO -> Maybe InputImageDTO -> Y)
-> Parser (Maybe Text)
-> Parser (Maybe OutputImageDTO -> Maybe InputImageDTO -> Y)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"textValue")
      Parser (Maybe OutputImageDTO -> Maybe InputImageDTO -> Y)
-> Parser (Maybe OutputImageDTO)
-> Parser (Maybe InputImageDTO -> Y)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe OutputImageDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"imageValue")
      Parser (Maybe InputImageDTO -> Y)
-> Parser (Maybe InputImageDTO) -> Parser Y
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe InputImageDTO)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"inputImageValue")

-- | ToJSON Y
instance A.ToJSON Y where
  toJSON :: Y -> Value
toJSON Y {Maybe Double
Maybe Text
Maybe OutputImageDTO
Maybe InputImageDTO
yInputImageValue :: Maybe InputImageDTO
yImageValue :: Maybe OutputImageDTO
yTextValue :: Maybe Text
yNumericValue :: Maybe Double
yInputImageValue :: Y -> Maybe InputImageDTO
yImageValue :: Y -> Maybe OutputImageDTO
yTextValue :: Y -> Maybe Text
yNumericValue :: Y -> Maybe Double
..} =
   [(Text, Value)] -> Value
_omitNulls
      [ Text
"numericValue" Text -> Maybe Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Double
yNumericValue
      , Text
"textValue" Text -> Maybe Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
yTextValue
      , Text
"imageValue" Text -> Maybe OutputImageDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe OutputImageDTO
yImageValue
      , Text
"inputImageValue" Text -> Maybe InputImageDTO -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe InputImageDTO
yInputImageValue
      ]


-- | Construct a value of type 'Y' (by applying it's required fields, if any)
mkY
  :: Y
mkY :: Y
mkY =
  Y :: Maybe Double
-> Maybe Text -> Maybe OutputImageDTO -> Maybe InputImageDTO -> Y
Y
  { yNumericValue :: Maybe Double
yNumericValue = Maybe Double
forall a. Maybe a
Nothing
  , yTextValue :: Maybe Text
yTextValue = Maybe Text
forall a. Maybe a
Nothing
  , yImageValue :: Maybe OutputImageDTO
yImageValue = Maybe OutputImageDTO
forall a. Maybe a
Nothing
  , yInputImageValue :: Maybe InputImageDTO
yInputImageValue = Maybe InputImageDTO
forall a. Maybe a
Nothing
  }


-- * Enums


-- ** AchievementTypeDTO

-- | Enum of 'Text'
data AchievementTypeDTO = AchievementTypeDTO'ArtifactSent
    | AchievementTypeDTO'ExperimentCreated
    | AchievementTypeDTO'ImageSent
    | AchievementTypeDTO'ParameterSet
    | AchievementTypeDTO'SourceUploaded
    | AchievementTypeDTO'TagSet
    | AchievementTypeDTO'TextSent
    deriving (Int -> AchievementTypeDTO -> ShowS
[AchievementTypeDTO] -> ShowS
AchievementTypeDTO -> FilePath
(Int -> AchievementTypeDTO -> ShowS)
-> (AchievementTypeDTO -> FilePath)
-> ([AchievementTypeDTO] -> ShowS)
-> Show AchievementTypeDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AchievementTypeDTO] -> ShowS
$cshowList :: [AchievementTypeDTO] -> ShowS
show :: AchievementTypeDTO -> FilePath
$cshow :: AchievementTypeDTO -> FilePath
showsPrec :: Int -> AchievementTypeDTO -> ShowS
$cshowsPrec :: Int -> AchievementTypeDTO -> ShowS
P.Show, AchievementTypeDTO -> AchievementTypeDTO -> Bool
(AchievementTypeDTO -> AchievementTypeDTO -> Bool)
-> (AchievementTypeDTO -> AchievementTypeDTO -> Bool)
-> Eq AchievementTypeDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
$c/= :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
== :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
$c== :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
P.Eq, P.Typeable, Eq AchievementTypeDTO
Eq AchievementTypeDTO
-> (AchievementTypeDTO -> AchievementTypeDTO -> Ordering)
-> (AchievementTypeDTO -> AchievementTypeDTO -> Bool)
-> (AchievementTypeDTO -> AchievementTypeDTO -> Bool)
-> (AchievementTypeDTO -> AchievementTypeDTO -> Bool)
-> (AchievementTypeDTO -> AchievementTypeDTO -> Bool)
-> (AchievementTypeDTO -> AchievementTypeDTO -> AchievementTypeDTO)
-> (AchievementTypeDTO -> AchievementTypeDTO -> AchievementTypeDTO)
-> Ord AchievementTypeDTO
AchievementTypeDTO -> AchievementTypeDTO -> Bool
AchievementTypeDTO -> AchievementTypeDTO -> Ordering
AchievementTypeDTO -> AchievementTypeDTO -> AchievementTypeDTO
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 :: AchievementTypeDTO -> AchievementTypeDTO -> AchievementTypeDTO
$cmin :: AchievementTypeDTO -> AchievementTypeDTO -> AchievementTypeDTO
max :: AchievementTypeDTO -> AchievementTypeDTO -> AchievementTypeDTO
$cmax :: AchievementTypeDTO -> AchievementTypeDTO -> AchievementTypeDTO
>= :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
$c>= :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
> :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
$c> :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
<= :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
$c<= :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
< :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
$c< :: AchievementTypeDTO -> AchievementTypeDTO -> Bool
compare :: AchievementTypeDTO -> AchievementTypeDTO -> Ordering
$ccompare :: AchievementTypeDTO -> AchievementTypeDTO -> Ordering
$cp1Ord :: Eq AchievementTypeDTO
P.Ord, AchievementTypeDTO
AchievementTypeDTO
-> AchievementTypeDTO -> Bounded AchievementTypeDTO
forall a. a -> a -> Bounded a
maxBound :: AchievementTypeDTO
$cmaxBound :: AchievementTypeDTO
minBound :: AchievementTypeDTO
$cminBound :: AchievementTypeDTO
P.Bounded, Int -> AchievementTypeDTO
AchievementTypeDTO -> Int
AchievementTypeDTO -> [AchievementTypeDTO]
AchievementTypeDTO -> AchievementTypeDTO
AchievementTypeDTO -> AchievementTypeDTO -> [AchievementTypeDTO]
AchievementTypeDTO
-> AchievementTypeDTO -> AchievementTypeDTO -> [AchievementTypeDTO]
(AchievementTypeDTO -> AchievementTypeDTO)
-> (AchievementTypeDTO -> AchievementTypeDTO)
-> (Int -> AchievementTypeDTO)
-> (AchievementTypeDTO -> Int)
-> (AchievementTypeDTO -> [AchievementTypeDTO])
-> (AchievementTypeDTO
    -> AchievementTypeDTO -> [AchievementTypeDTO])
-> (AchievementTypeDTO
    -> AchievementTypeDTO -> [AchievementTypeDTO])
-> (AchievementTypeDTO
    -> AchievementTypeDTO
    -> AchievementTypeDTO
    -> [AchievementTypeDTO])
-> Enum AchievementTypeDTO
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 :: AchievementTypeDTO
-> AchievementTypeDTO -> AchievementTypeDTO -> [AchievementTypeDTO]
$cenumFromThenTo :: AchievementTypeDTO
-> AchievementTypeDTO -> AchievementTypeDTO -> [AchievementTypeDTO]
enumFromTo :: AchievementTypeDTO -> AchievementTypeDTO -> [AchievementTypeDTO]
$cenumFromTo :: AchievementTypeDTO -> AchievementTypeDTO -> [AchievementTypeDTO]
enumFromThen :: AchievementTypeDTO -> AchievementTypeDTO -> [AchievementTypeDTO]
$cenumFromThen :: AchievementTypeDTO -> AchievementTypeDTO -> [AchievementTypeDTO]
enumFrom :: AchievementTypeDTO -> [AchievementTypeDTO]
$cenumFrom :: AchievementTypeDTO -> [AchievementTypeDTO]
fromEnum :: AchievementTypeDTO -> Int
$cfromEnum :: AchievementTypeDTO -> Int
toEnum :: Int -> AchievementTypeDTO
$ctoEnum :: Int -> AchievementTypeDTO
pred :: AchievementTypeDTO -> AchievementTypeDTO
$cpred :: AchievementTypeDTO -> AchievementTypeDTO
succ :: AchievementTypeDTO -> AchievementTypeDTO
$csucc :: AchievementTypeDTO -> AchievementTypeDTO
P.Enum)

instance A.ToJSON AchievementTypeDTO where toJSON :: AchievementTypeDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (AchievementTypeDTO -> Text) -> AchievementTypeDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AchievementTypeDTO -> Text
fromAchievementTypeDTO
instance A.FromJSON AchievementTypeDTO where parseJSON :: Value -> Parser AchievementTypeDTO
parseJSON Value
o = (FilePath -> Parser AchievementTypeDTO)
-> (AchievementTypeDTO -> Parser AchievementTypeDTO)
-> Either FilePath AchievementTypeDTO
-> Parser AchievementTypeDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser AchievementTypeDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (AchievementTypeDTO -> Parser AchievementTypeDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AchievementTypeDTO -> Parser AchievementTypeDTO)
-> (AchievementTypeDTO -> AchievementTypeDTO)
-> AchievementTypeDTO
-> Parser AchievementTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AchievementTypeDTO -> AchievementTypeDTO
forall a. a -> a
P.id) (Either FilePath AchievementTypeDTO -> Parser AchievementTypeDTO)
-> (Text -> Either FilePath AchievementTypeDTO)
-> Text
-> Parser AchievementTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath AchievementTypeDTO
toAchievementTypeDTO (Text -> Parser AchievementTypeDTO)
-> Parser Text -> Parser AchievementTypeDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData AchievementTypeDTO where toQueryParam :: AchievementTypeDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (AchievementTypeDTO -> Text) -> AchievementTypeDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AchievementTypeDTO -> Text
fromAchievementTypeDTO
instance WH.FromHttpApiData AchievementTypeDTO where parseQueryParam :: Text -> Either Text AchievementTypeDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text AchievementTypeDTO)
-> Either Text AchievementTypeDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath AchievementTypeDTO
-> Either Text AchievementTypeDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath AchievementTypeDTO
 -> Either Text AchievementTypeDTO)
-> (Text -> Either FilePath AchievementTypeDTO)
-> Text
-> Either Text AchievementTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath AchievementTypeDTO
toAchievementTypeDTO
instance MimeRender MimeMultipartFormData AchievementTypeDTO where mimeRender :: Proxy MimeMultipartFormData -> AchievementTypeDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = AchievementTypeDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'AchievementTypeDTO' enum
fromAchievementTypeDTO :: AchievementTypeDTO -> Text
fromAchievementTypeDTO :: AchievementTypeDTO -> Text
fromAchievementTypeDTO = \case
  AchievementTypeDTO
AchievementTypeDTO'ArtifactSent      -> Text
"artifactSent"
  AchievementTypeDTO
AchievementTypeDTO'ExperimentCreated -> Text
"experimentCreated"
  AchievementTypeDTO
AchievementTypeDTO'ImageSent         -> Text
"imageSent"
  AchievementTypeDTO
AchievementTypeDTO'ParameterSet      -> Text
"parameterSet"
  AchievementTypeDTO
AchievementTypeDTO'SourceUploaded    -> Text
"sourceUploaded"
  AchievementTypeDTO
AchievementTypeDTO'TagSet            -> Text
"tagSet"
  AchievementTypeDTO
AchievementTypeDTO'TextSent          -> Text
"textSent"

-- | parse 'AchievementTypeDTO' enum
toAchievementTypeDTO :: Text -> P.Either String AchievementTypeDTO
toAchievementTypeDTO :: Text -> Either FilePath AchievementTypeDTO
toAchievementTypeDTO = \case
  Text
"artifactSent" -> AchievementTypeDTO -> Either FilePath AchievementTypeDTO
forall a b. b -> Either a b
P.Right AchievementTypeDTO
AchievementTypeDTO'ArtifactSent
  Text
"experimentCreated" -> AchievementTypeDTO -> Either FilePath AchievementTypeDTO
forall a b. b -> Either a b
P.Right AchievementTypeDTO
AchievementTypeDTO'ExperimentCreated
  Text
"imageSent" -> AchievementTypeDTO -> Either FilePath AchievementTypeDTO
forall a b. b -> Either a b
P.Right AchievementTypeDTO
AchievementTypeDTO'ImageSent
  Text
"parameterSet" -> AchievementTypeDTO -> Either FilePath AchievementTypeDTO
forall a b. b -> Either a b
P.Right AchievementTypeDTO
AchievementTypeDTO'ParameterSet
  Text
"sourceUploaded" -> AchievementTypeDTO -> Either FilePath AchievementTypeDTO
forall a b. b -> Either a b
P.Right AchievementTypeDTO
AchievementTypeDTO'SourceUploaded
  Text
"tagSet" -> AchievementTypeDTO -> Either FilePath AchievementTypeDTO
forall a b. b -> Either a b
P.Right AchievementTypeDTO
AchievementTypeDTO'TagSet
  Text
"textSent" -> AchievementTypeDTO -> Either FilePath AchievementTypeDTO
forall a b. b -> Either a b
P.Right AchievementTypeDTO
AchievementTypeDTO'TextSent
  Text
s -> FilePath -> Either FilePath AchievementTypeDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath AchievementTypeDTO)
-> FilePath -> Either FilePath AchievementTypeDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toAchievementTypeDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** ApiErrorTypeDTO

-- | Enum of 'Text'
data ApiErrorTypeDTO = ApiErrorTypeDTO'PROJECTS_REACHED
    | ApiErrorTypeDTO'STORAGE_IN_PROJECT_REACHED
    | ApiErrorTypeDTO'MEMBERS_IN_ORGANIZATION_REACHED
    | ApiErrorTypeDTO'VALUES_IN_CHANNEL_REACHED
    deriving (Int -> ApiErrorTypeDTO -> ShowS
[ApiErrorTypeDTO] -> ShowS
ApiErrorTypeDTO -> FilePath
(Int -> ApiErrorTypeDTO -> ShowS)
-> (ApiErrorTypeDTO -> FilePath)
-> ([ApiErrorTypeDTO] -> ShowS)
-> Show ApiErrorTypeDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ApiErrorTypeDTO] -> ShowS
$cshowList :: [ApiErrorTypeDTO] -> ShowS
show :: ApiErrorTypeDTO -> FilePath
$cshow :: ApiErrorTypeDTO -> FilePath
showsPrec :: Int -> ApiErrorTypeDTO -> ShowS
$cshowsPrec :: Int -> ApiErrorTypeDTO -> ShowS
P.Show, ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
(ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool)
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool)
-> Eq ApiErrorTypeDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
$c/= :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
== :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
$c== :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
P.Eq, P.Typeable, Eq ApiErrorTypeDTO
Eq ApiErrorTypeDTO
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> Ordering)
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool)
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool)
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool)
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool)
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> ApiErrorTypeDTO)
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> ApiErrorTypeDTO)
-> Ord ApiErrorTypeDTO
ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
ApiErrorTypeDTO -> ApiErrorTypeDTO -> Ordering
ApiErrorTypeDTO -> ApiErrorTypeDTO -> ApiErrorTypeDTO
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 :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> ApiErrorTypeDTO
$cmin :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> ApiErrorTypeDTO
max :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> ApiErrorTypeDTO
$cmax :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> ApiErrorTypeDTO
>= :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
$c>= :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
> :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
$c> :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
<= :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
$c<= :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
< :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
$c< :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bool
compare :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Ordering
$ccompare :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> Ordering
$cp1Ord :: Eq ApiErrorTypeDTO
P.Ord, ApiErrorTypeDTO
ApiErrorTypeDTO -> ApiErrorTypeDTO -> Bounded ApiErrorTypeDTO
forall a. a -> a -> Bounded a
maxBound :: ApiErrorTypeDTO
$cmaxBound :: ApiErrorTypeDTO
minBound :: ApiErrorTypeDTO
$cminBound :: ApiErrorTypeDTO
P.Bounded, Int -> ApiErrorTypeDTO
ApiErrorTypeDTO -> Int
ApiErrorTypeDTO -> [ApiErrorTypeDTO]
ApiErrorTypeDTO -> ApiErrorTypeDTO
ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO]
ApiErrorTypeDTO
-> ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO]
(ApiErrorTypeDTO -> ApiErrorTypeDTO)
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO)
-> (Int -> ApiErrorTypeDTO)
-> (ApiErrorTypeDTO -> Int)
-> (ApiErrorTypeDTO -> [ApiErrorTypeDTO])
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO])
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO])
-> (ApiErrorTypeDTO
    -> ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO])
-> Enum ApiErrorTypeDTO
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 :: ApiErrorTypeDTO
-> ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO]
$cenumFromThenTo :: ApiErrorTypeDTO
-> ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO]
enumFromTo :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO]
$cenumFromTo :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO]
enumFromThen :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO]
$cenumFromThen :: ApiErrorTypeDTO -> ApiErrorTypeDTO -> [ApiErrorTypeDTO]
enumFrom :: ApiErrorTypeDTO -> [ApiErrorTypeDTO]
$cenumFrom :: ApiErrorTypeDTO -> [ApiErrorTypeDTO]
fromEnum :: ApiErrorTypeDTO -> Int
$cfromEnum :: ApiErrorTypeDTO -> Int
toEnum :: Int -> ApiErrorTypeDTO
$ctoEnum :: Int -> ApiErrorTypeDTO
pred :: ApiErrorTypeDTO -> ApiErrorTypeDTO
$cpred :: ApiErrorTypeDTO -> ApiErrorTypeDTO
succ :: ApiErrorTypeDTO -> ApiErrorTypeDTO
$csucc :: ApiErrorTypeDTO -> ApiErrorTypeDTO
P.Enum)

instance A.ToJSON ApiErrorTypeDTO where toJSON :: ApiErrorTypeDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (ApiErrorTypeDTO -> Text) -> ApiErrorTypeDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiErrorTypeDTO -> Text
fromApiErrorTypeDTO
instance A.FromJSON ApiErrorTypeDTO where parseJSON :: Value -> Parser ApiErrorTypeDTO
parseJSON Value
o = (FilePath -> Parser ApiErrorTypeDTO)
-> (ApiErrorTypeDTO -> Parser ApiErrorTypeDTO)
-> Either FilePath ApiErrorTypeDTO
-> Parser ApiErrorTypeDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser ApiErrorTypeDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (ApiErrorTypeDTO -> Parser ApiErrorTypeDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiErrorTypeDTO -> Parser ApiErrorTypeDTO)
-> (ApiErrorTypeDTO -> ApiErrorTypeDTO)
-> ApiErrorTypeDTO
-> Parser ApiErrorTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiErrorTypeDTO -> ApiErrorTypeDTO
forall a. a -> a
P.id) (Either FilePath ApiErrorTypeDTO -> Parser ApiErrorTypeDTO)
-> (Text -> Either FilePath ApiErrorTypeDTO)
-> Text
-> Parser ApiErrorTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ApiErrorTypeDTO
toApiErrorTypeDTO (Text -> Parser ApiErrorTypeDTO)
-> Parser Text -> Parser ApiErrorTypeDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ApiErrorTypeDTO where toQueryParam :: ApiErrorTypeDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (ApiErrorTypeDTO -> Text) -> ApiErrorTypeDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiErrorTypeDTO -> Text
fromApiErrorTypeDTO
instance WH.FromHttpApiData ApiErrorTypeDTO where parseQueryParam :: Text -> Either Text ApiErrorTypeDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ApiErrorTypeDTO)
-> Either Text ApiErrorTypeDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath ApiErrorTypeDTO -> Either Text ApiErrorTypeDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath ApiErrorTypeDTO -> Either Text ApiErrorTypeDTO)
-> (Text -> Either FilePath ApiErrorTypeDTO)
-> Text
-> Either Text ApiErrorTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ApiErrorTypeDTO
toApiErrorTypeDTO
instance MimeRender MimeMultipartFormData ApiErrorTypeDTO where mimeRender :: Proxy MimeMultipartFormData -> ApiErrorTypeDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ApiErrorTypeDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ApiErrorTypeDTO' enum
fromApiErrorTypeDTO :: ApiErrorTypeDTO -> Text
fromApiErrorTypeDTO :: ApiErrorTypeDTO -> Text
fromApiErrorTypeDTO = \case
  ApiErrorTypeDTO
ApiErrorTypeDTO'PROJECTS_REACHED -> Text
"LIMIT_OF_PROJECTS_REACHED"
  ApiErrorTypeDTO
ApiErrorTypeDTO'STORAGE_IN_PROJECT_REACHED -> Text
"LIMIT_OF_STORAGE_IN_PROJECT_REACHED"
  ApiErrorTypeDTO
ApiErrorTypeDTO'MEMBERS_IN_ORGANIZATION_REACHED -> Text
"LIMIT_OF_MEMBERS_IN_ORGANIZATION_REACHED"
  ApiErrorTypeDTO
ApiErrorTypeDTO'VALUES_IN_CHANNEL_REACHED -> Text
"LIMIT_OF_VALUES_IN_CHANNEL_REACHED"

-- | parse 'ApiErrorTypeDTO' enum
toApiErrorTypeDTO :: Text -> P.Either String ApiErrorTypeDTO
toApiErrorTypeDTO :: Text -> Either FilePath ApiErrorTypeDTO
toApiErrorTypeDTO = \case
  Text
"LIMIT_OF_PROJECTS_REACHED" -> ApiErrorTypeDTO -> Either FilePath ApiErrorTypeDTO
forall a b. b -> Either a b
P.Right ApiErrorTypeDTO
ApiErrorTypeDTO'PROJECTS_REACHED
  Text
"LIMIT_OF_STORAGE_IN_PROJECT_REACHED" -> ApiErrorTypeDTO -> Either FilePath ApiErrorTypeDTO
forall a b. b -> Either a b
P.Right ApiErrorTypeDTO
ApiErrorTypeDTO'STORAGE_IN_PROJECT_REACHED
  Text
"LIMIT_OF_MEMBERS_IN_ORGANIZATION_REACHED" -> ApiErrorTypeDTO -> Either FilePath ApiErrorTypeDTO
forall a b. b -> Either a b
P.Right ApiErrorTypeDTO
ApiErrorTypeDTO'MEMBERS_IN_ORGANIZATION_REACHED
  Text
"LIMIT_OF_VALUES_IN_CHANNEL_REACHED" -> ApiErrorTypeDTO -> Either FilePath ApiErrorTypeDTO
forall a b. b -> Either a b
P.Right ApiErrorTypeDTO
ApiErrorTypeDTO'VALUES_IN_CHANNEL_REACHED
  Text
s -> FilePath -> Either FilePath ApiErrorTypeDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath ApiErrorTypeDTO)
-> FilePath -> Either FilePath ApiErrorTypeDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toApiErrorTypeDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** AvatarSourceEnum

-- | Enum of 'Text'
data AvatarSourceEnum = AvatarSourceEnum'Default
    | AvatarSourceEnum'ThirdParty
    | AvatarSourceEnum'User
    | AvatarSourceEnum'Inherited
    deriving (Int -> AvatarSourceEnum -> ShowS
[AvatarSourceEnum] -> ShowS
AvatarSourceEnum -> FilePath
(Int -> AvatarSourceEnum -> ShowS)
-> (AvatarSourceEnum -> FilePath)
-> ([AvatarSourceEnum] -> ShowS)
-> Show AvatarSourceEnum
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AvatarSourceEnum] -> ShowS
$cshowList :: [AvatarSourceEnum] -> ShowS
show :: AvatarSourceEnum -> FilePath
$cshow :: AvatarSourceEnum -> FilePath
showsPrec :: Int -> AvatarSourceEnum -> ShowS
$cshowsPrec :: Int -> AvatarSourceEnum -> ShowS
P.Show, AvatarSourceEnum -> AvatarSourceEnum -> Bool
(AvatarSourceEnum -> AvatarSourceEnum -> Bool)
-> (AvatarSourceEnum -> AvatarSourceEnum -> Bool)
-> Eq AvatarSourceEnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
$c/= :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
== :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
$c== :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
P.Eq, P.Typeable, Eq AvatarSourceEnum
Eq AvatarSourceEnum
-> (AvatarSourceEnum -> AvatarSourceEnum -> Ordering)
-> (AvatarSourceEnum -> AvatarSourceEnum -> Bool)
-> (AvatarSourceEnum -> AvatarSourceEnum -> Bool)
-> (AvatarSourceEnum -> AvatarSourceEnum -> Bool)
-> (AvatarSourceEnum -> AvatarSourceEnum -> Bool)
-> (AvatarSourceEnum -> AvatarSourceEnum -> AvatarSourceEnum)
-> (AvatarSourceEnum -> AvatarSourceEnum -> AvatarSourceEnum)
-> Ord AvatarSourceEnum
AvatarSourceEnum -> AvatarSourceEnum -> Bool
AvatarSourceEnum -> AvatarSourceEnum -> Ordering
AvatarSourceEnum -> AvatarSourceEnum -> AvatarSourceEnum
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 :: AvatarSourceEnum -> AvatarSourceEnum -> AvatarSourceEnum
$cmin :: AvatarSourceEnum -> AvatarSourceEnum -> AvatarSourceEnum
max :: AvatarSourceEnum -> AvatarSourceEnum -> AvatarSourceEnum
$cmax :: AvatarSourceEnum -> AvatarSourceEnum -> AvatarSourceEnum
>= :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
$c>= :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
> :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
$c> :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
<= :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
$c<= :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
< :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
$c< :: AvatarSourceEnum -> AvatarSourceEnum -> Bool
compare :: AvatarSourceEnum -> AvatarSourceEnum -> Ordering
$ccompare :: AvatarSourceEnum -> AvatarSourceEnum -> Ordering
$cp1Ord :: Eq AvatarSourceEnum
P.Ord, AvatarSourceEnum
AvatarSourceEnum -> AvatarSourceEnum -> Bounded AvatarSourceEnum
forall a. a -> a -> Bounded a
maxBound :: AvatarSourceEnum
$cmaxBound :: AvatarSourceEnum
minBound :: AvatarSourceEnum
$cminBound :: AvatarSourceEnum
P.Bounded, Int -> AvatarSourceEnum
AvatarSourceEnum -> Int
AvatarSourceEnum -> [AvatarSourceEnum]
AvatarSourceEnum -> AvatarSourceEnum
AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum]
AvatarSourceEnum
-> AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum]
(AvatarSourceEnum -> AvatarSourceEnum)
-> (AvatarSourceEnum -> AvatarSourceEnum)
-> (Int -> AvatarSourceEnum)
-> (AvatarSourceEnum -> Int)
-> (AvatarSourceEnum -> [AvatarSourceEnum])
-> (AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum])
-> (AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum])
-> (AvatarSourceEnum
    -> AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum])
-> Enum AvatarSourceEnum
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 :: AvatarSourceEnum
-> AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum]
$cenumFromThenTo :: AvatarSourceEnum
-> AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum]
enumFromTo :: AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum]
$cenumFromTo :: AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum]
enumFromThen :: AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum]
$cenumFromThen :: AvatarSourceEnum -> AvatarSourceEnum -> [AvatarSourceEnum]
enumFrom :: AvatarSourceEnum -> [AvatarSourceEnum]
$cenumFrom :: AvatarSourceEnum -> [AvatarSourceEnum]
fromEnum :: AvatarSourceEnum -> Int
$cfromEnum :: AvatarSourceEnum -> Int
toEnum :: Int -> AvatarSourceEnum
$ctoEnum :: Int -> AvatarSourceEnum
pred :: AvatarSourceEnum -> AvatarSourceEnum
$cpred :: AvatarSourceEnum -> AvatarSourceEnum
succ :: AvatarSourceEnum -> AvatarSourceEnum
$csucc :: AvatarSourceEnum -> AvatarSourceEnum
P.Enum)

instance A.ToJSON AvatarSourceEnum where toJSON :: AvatarSourceEnum -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (AvatarSourceEnum -> Text) -> AvatarSourceEnum -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvatarSourceEnum -> Text
fromAvatarSourceEnum
instance A.FromJSON AvatarSourceEnum where parseJSON :: Value -> Parser AvatarSourceEnum
parseJSON Value
o = (FilePath -> Parser AvatarSourceEnum)
-> (AvatarSourceEnum -> Parser AvatarSourceEnum)
-> Either FilePath AvatarSourceEnum
-> Parser AvatarSourceEnum
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser AvatarSourceEnum
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (AvatarSourceEnum -> Parser AvatarSourceEnum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AvatarSourceEnum -> Parser AvatarSourceEnum)
-> (AvatarSourceEnum -> AvatarSourceEnum)
-> AvatarSourceEnum
-> Parser AvatarSourceEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvatarSourceEnum -> AvatarSourceEnum
forall a. a -> a
P.id) (Either FilePath AvatarSourceEnum -> Parser AvatarSourceEnum)
-> (Text -> Either FilePath AvatarSourceEnum)
-> Text
-> Parser AvatarSourceEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath AvatarSourceEnum
toAvatarSourceEnum (Text -> Parser AvatarSourceEnum)
-> Parser Text -> Parser AvatarSourceEnum
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData AvatarSourceEnum where toQueryParam :: AvatarSourceEnum -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (AvatarSourceEnum -> Text) -> AvatarSourceEnum -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvatarSourceEnum -> Text
fromAvatarSourceEnum
instance WH.FromHttpApiData AvatarSourceEnum where parseQueryParam :: Text -> Either Text AvatarSourceEnum
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text AvatarSourceEnum)
-> Either Text AvatarSourceEnum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath AvatarSourceEnum -> Either Text AvatarSourceEnum
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath AvatarSourceEnum -> Either Text AvatarSourceEnum)
-> (Text -> Either FilePath AvatarSourceEnum)
-> Text
-> Either Text AvatarSourceEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath AvatarSourceEnum
toAvatarSourceEnum
instance MimeRender MimeMultipartFormData AvatarSourceEnum where mimeRender :: Proxy MimeMultipartFormData -> AvatarSourceEnum -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = AvatarSourceEnum -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'AvatarSourceEnum' enum
fromAvatarSourceEnum :: AvatarSourceEnum -> Text
fromAvatarSourceEnum :: AvatarSourceEnum -> Text
fromAvatarSourceEnum = \case
  AvatarSourceEnum
AvatarSourceEnum'Default    -> Text
"default"
  AvatarSourceEnum
AvatarSourceEnum'ThirdParty -> Text
"thirdParty"
  AvatarSourceEnum
AvatarSourceEnum'User       -> Text
"user"
  AvatarSourceEnum
AvatarSourceEnum'Inherited  -> Text
"inherited"

-- | parse 'AvatarSourceEnum' enum
toAvatarSourceEnum :: Text -> P.Either String AvatarSourceEnum
toAvatarSourceEnum :: Text -> Either FilePath AvatarSourceEnum
toAvatarSourceEnum = \case
  Text
"default" -> AvatarSourceEnum -> Either FilePath AvatarSourceEnum
forall a b. b -> Either a b
P.Right AvatarSourceEnum
AvatarSourceEnum'Default
  Text
"thirdParty" -> AvatarSourceEnum -> Either FilePath AvatarSourceEnum
forall a b. b -> Either a b
P.Right AvatarSourceEnum
AvatarSourceEnum'ThirdParty
  Text
"user" -> AvatarSourceEnum -> Either FilePath AvatarSourceEnum
forall a b. b -> Either a b
P.Right AvatarSourceEnum
AvatarSourceEnum'User
  Text
"inherited" -> AvatarSourceEnum -> Either FilePath AvatarSourceEnum
forall a b. b -> Either a b
P.Right AvatarSourceEnum
AvatarSourceEnum'Inherited
  Text
s -> FilePath -> Either FilePath AvatarSourceEnum
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath AvatarSourceEnum)
-> FilePath -> Either FilePath AvatarSourceEnum
forall a b. (a -> b) -> a -> b
$ FilePath
"toAvatarSourceEnum: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** ChannelType

-- | Enum of 'Text'
data ChannelType = ChannelType'Numeric
    | ChannelType'Text
    | ChannelType'Image
    deriving (Int -> ChannelType -> ShowS
[ChannelType] -> ShowS
ChannelType -> FilePath
(Int -> ChannelType -> ShowS)
-> (ChannelType -> FilePath)
-> ([ChannelType] -> ShowS)
-> Show ChannelType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChannelType] -> ShowS
$cshowList :: [ChannelType] -> ShowS
show :: ChannelType -> FilePath
$cshow :: ChannelType -> FilePath
showsPrec :: Int -> ChannelType -> ShowS
$cshowsPrec :: Int -> ChannelType -> ShowS
P.Show, ChannelType -> ChannelType -> Bool
(ChannelType -> ChannelType -> Bool)
-> (ChannelType -> ChannelType -> Bool) -> Eq ChannelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelType -> ChannelType -> Bool
$c/= :: ChannelType -> ChannelType -> Bool
== :: ChannelType -> ChannelType -> Bool
$c== :: ChannelType -> ChannelType -> Bool
P.Eq, P.Typeable, Eq ChannelType
Eq ChannelType
-> (ChannelType -> ChannelType -> Ordering)
-> (ChannelType -> ChannelType -> Bool)
-> (ChannelType -> ChannelType -> Bool)
-> (ChannelType -> ChannelType -> Bool)
-> (ChannelType -> ChannelType -> Bool)
-> (ChannelType -> ChannelType -> ChannelType)
-> (ChannelType -> ChannelType -> ChannelType)
-> Ord ChannelType
ChannelType -> ChannelType -> Bool
ChannelType -> ChannelType -> Ordering
ChannelType -> ChannelType -> ChannelType
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 :: ChannelType -> ChannelType -> ChannelType
$cmin :: ChannelType -> ChannelType -> ChannelType
max :: ChannelType -> ChannelType -> ChannelType
$cmax :: ChannelType -> ChannelType -> ChannelType
>= :: ChannelType -> ChannelType -> Bool
$c>= :: ChannelType -> ChannelType -> Bool
> :: ChannelType -> ChannelType -> Bool
$c> :: ChannelType -> ChannelType -> Bool
<= :: ChannelType -> ChannelType -> Bool
$c<= :: ChannelType -> ChannelType -> Bool
< :: ChannelType -> ChannelType -> Bool
$c< :: ChannelType -> ChannelType -> Bool
compare :: ChannelType -> ChannelType -> Ordering
$ccompare :: ChannelType -> ChannelType -> Ordering
$cp1Ord :: Eq ChannelType
P.Ord, ChannelType
ChannelType -> ChannelType -> Bounded ChannelType
forall a. a -> a -> Bounded a
maxBound :: ChannelType
$cmaxBound :: ChannelType
minBound :: ChannelType
$cminBound :: ChannelType
P.Bounded, Int -> ChannelType
ChannelType -> Int
ChannelType -> [ChannelType]
ChannelType -> ChannelType
ChannelType -> ChannelType -> [ChannelType]
ChannelType -> ChannelType -> ChannelType -> [ChannelType]
(ChannelType -> ChannelType)
-> (ChannelType -> ChannelType)
-> (Int -> ChannelType)
-> (ChannelType -> Int)
-> (ChannelType -> [ChannelType])
-> (ChannelType -> ChannelType -> [ChannelType])
-> (ChannelType -> ChannelType -> [ChannelType])
-> (ChannelType -> ChannelType -> ChannelType -> [ChannelType])
-> Enum ChannelType
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 :: ChannelType -> ChannelType -> ChannelType -> [ChannelType]
$cenumFromThenTo :: ChannelType -> ChannelType -> ChannelType -> [ChannelType]
enumFromTo :: ChannelType -> ChannelType -> [ChannelType]
$cenumFromTo :: ChannelType -> ChannelType -> [ChannelType]
enumFromThen :: ChannelType -> ChannelType -> [ChannelType]
$cenumFromThen :: ChannelType -> ChannelType -> [ChannelType]
enumFrom :: ChannelType -> [ChannelType]
$cenumFrom :: ChannelType -> [ChannelType]
fromEnum :: ChannelType -> Int
$cfromEnum :: ChannelType -> Int
toEnum :: Int -> ChannelType
$ctoEnum :: Int -> ChannelType
pred :: ChannelType -> ChannelType
$cpred :: ChannelType -> ChannelType
succ :: ChannelType -> ChannelType
$csucc :: ChannelType -> ChannelType
P.Enum)

instance A.ToJSON ChannelType where toJSON :: ChannelType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (ChannelType -> Text) -> ChannelType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelType -> Text
fromChannelType
instance A.FromJSON ChannelType where parseJSON :: Value -> Parser ChannelType
parseJSON Value
o = (FilePath -> Parser ChannelType)
-> (ChannelType -> Parser ChannelType)
-> Either FilePath ChannelType
-> Parser ChannelType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser ChannelType
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (ChannelType -> Parser ChannelType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChannelType -> Parser ChannelType)
-> (ChannelType -> ChannelType)
-> ChannelType
-> Parser ChannelType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelType -> ChannelType
forall a. a -> a
P.id) (Either FilePath ChannelType -> Parser ChannelType)
-> (Text -> Either FilePath ChannelType)
-> Text
-> Parser ChannelType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ChannelType
toChannelType (Text -> Parser ChannelType) -> Parser Text -> Parser ChannelType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ChannelType where toQueryParam :: ChannelType -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (ChannelType -> Text) -> ChannelType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelType -> Text
fromChannelType
instance WH.FromHttpApiData ChannelType where parseQueryParam :: Text -> Either Text ChannelType
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ChannelType) -> Either Text ChannelType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath ChannelType -> Either Text ChannelType
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath ChannelType -> Either Text ChannelType)
-> (Text -> Either FilePath ChannelType)
-> Text
-> Either Text ChannelType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ChannelType
toChannelType
instance MimeRender MimeMultipartFormData ChannelType where mimeRender :: Proxy MimeMultipartFormData -> ChannelType -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ChannelType -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ChannelType' enum
fromChannelType :: ChannelType -> Text
fromChannelType :: ChannelType -> Text
fromChannelType = \case
  ChannelType
ChannelType'Numeric -> Text
"numeric"
  ChannelType
ChannelType'Text    -> Text
"text"
  ChannelType
ChannelType'Image   -> Text
"image"

-- | parse 'ChannelType' enum
toChannelType :: Text -> P.Either String ChannelType
toChannelType :: Text -> Either FilePath ChannelType
toChannelType = \case
  Text
"numeric" -> ChannelType -> Either FilePath ChannelType
forall a b. b -> Either a b
P.Right ChannelType
ChannelType'Numeric
  Text
"text"    -> ChannelType -> Either FilePath ChannelType
forall a b. b -> Either a b
P.Right ChannelType
ChannelType'Text
  Text
"image"   -> ChannelType -> Either FilePath ChannelType
forall a b. b -> Either a b
P.Right ChannelType
ChannelType'Image
  Text
s         -> FilePath -> Either FilePath ChannelType
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath ChannelType)
-> FilePath -> Either FilePath ChannelType
forall a b. (a -> b) -> a -> b
$ FilePath
"toChannelType: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** ChannelTypeEnum

-- | Enum of 'Text'
data ChannelTypeEnum = ChannelTypeEnum'Numeric
    | ChannelTypeEnum'Text
    | ChannelTypeEnum'Image
    deriving (Int -> ChannelTypeEnum -> ShowS
[ChannelTypeEnum] -> ShowS
ChannelTypeEnum -> FilePath
(Int -> ChannelTypeEnum -> ShowS)
-> (ChannelTypeEnum -> FilePath)
-> ([ChannelTypeEnum] -> ShowS)
-> Show ChannelTypeEnum
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChannelTypeEnum] -> ShowS
$cshowList :: [ChannelTypeEnum] -> ShowS
show :: ChannelTypeEnum -> FilePath
$cshow :: ChannelTypeEnum -> FilePath
showsPrec :: Int -> ChannelTypeEnum -> ShowS
$cshowsPrec :: Int -> ChannelTypeEnum -> ShowS
P.Show, ChannelTypeEnum -> ChannelTypeEnum -> Bool
(ChannelTypeEnum -> ChannelTypeEnum -> Bool)
-> (ChannelTypeEnum -> ChannelTypeEnum -> Bool)
-> Eq ChannelTypeEnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
$c/= :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
== :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
$c== :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
P.Eq, P.Typeable, Eq ChannelTypeEnum
Eq ChannelTypeEnum
-> (ChannelTypeEnum -> ChannelTypeEnum -> Ordering)
-> (ChannelTypeEnum -> ChannelTypeEnum -> Bool)
-> (ChannelTypeEnum -> ChannelTypeEnum -> Bool)
-> (ChannelTypeEnum -> ChannelTypeEnum -> Bool)
-> (ChannelTypeEnum -> ChannelTypeEnum -> Bool)
-> (ChannelTypeEnum -> ChannelTypeEnum -> ChannelTypeEnum)
-> (ChannelTypeEnum -> ChannelTypeEnum -> ChannelTypeEnum)
-> Ord ChannelTypeEnum
ChannelTypeEnum -> ChannelTypeEnum -> Bool
ChannelTypeEnum -> ChannelTypeEnum -> Ordering
ChannelTypeEnum -> ChannelTypeEnum -> ChannelTypeEnum
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 :: ChannelTypeEnum -> ChannelTypeEnum -> ChannelTypeEnum
$cmin :: ChannelTypeEnum -> ChannelTypeEnum -> ChannelTypeEnum
max :: ChannelTypeEnum -> ChannelTypeEnum -> ChannelTypeEnum
$cmax :: ChannelTypeEnum -> ChannelTypeEnum -> ChannelTypeEnum
>= :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
$c>= :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
> :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
$c> :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
<= :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
$c<= :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
< :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
$c< :: ChannelTypeEnum -> ChannelTypeEnum -> Bool
compare :: ChannelTypeEnum -> ChannelTypeEnum -> Ordering
$ccompare :: ChannelTypeEnum -> ChannelTypeEnum -> Ordering
$cp1Ord :: Eq ChannelTypeEnum
P.Ord, ChannelTypeEnum
ChannelTypeEnum -> ChannelTypeEnum -> Bounded ChannelTypeEnum
forall a. a -> a -> Bounded a
maxBound :: ChannelTypeEnum
$cmaxBound :: ChannelTypeEnum
minBound :: ChannelTypeEnum
$cminBound :: ChannelTypeEnum
P.Bounded, Int -> ChannelTypeEnum
ChannelTypeEnum -> Int
ChannelTypeEnum -> [ChannelTypeEnum]
ChannelTypeEnum -> ChannelTypeEnum
ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum]
ChannelTypeEnum
-> ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum]
(ChannelTypeEnum -> ChannelTypeEnum)
-> (ChannelTypeEnum -> ChannelTypeEnum)
-> (Int -> ChannelTypeEnum)
-> (ChannelTypeEnum -> Int)
-> (ChannelTypeEnum -> [ChannelTypeEnum])
-> (ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum])
-> (ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum])
-> (ChannelTypeEnum
    -> ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum])
-> Enum ChannelTypeEnum
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 :: ChannelTypeEnum
-> ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum]
$cenumFromThenTo :: ChannelTypeEnum
-> ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum]
enumFromTo :: ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum]
$cenumFromTo :: ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum]
enumFromThen :: ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum]
$cenumFromThen :: ChannelTypeEnum -> ChannelTypeEnum -> [ChannelTypeEnum]
enumFrom :: ChannelTypeEnum -> [ChannelTypeEnum]
$cenumFrom :: ChannelTypeEnum -> [ChannelTypeEnum]
fromEnum :: ChannelTypeEnum -> Int
$cfromEnum :: ChannelTypeEnum -> Int
toEnum :: Int -> ChannelTypeEnum
$ctoEnum :: Int -> ChannelTypeEnum
pred :: ChannelTypeEnum -> ChannelTypeEnum
$cpred :: ChannelTypeEnum -> ChannelTypeEnum
succ :: ChannelTypeEnum -> ChannelTypeEnum
$csucc :: ChannelTypeEnum -> ChannelTypeEnum
P.Enum)

instance A.ToJSON ChannelTypeEnum where toJSON :: ChannelTypeEnum -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (ChannelTypeEnum -> Text) -> ChannelTypeEnum -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelTypeEnum -> Text
fromChannelTypeEnum
instance A.FromJSON ChannelTypeEnum where parseJSON :: Value -> Parser ChannelTypeEnum
parseJSON Value
o = (FilePath -> Parser ChannelTypeEnum)
-> (ChannelTypeEnum -> Parser ChannelTypeEnum)
-> Either FilePath ChannelTypeEnum
-> Parser ChannelTypeEnum
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser ChannelTypeEnum
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (ChannelTypeEnum -> Parser ChannelTypeEnum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChannelTypeEnum -> Parser ChannelTypeEnum)
-> (ChannelTypeEnum -> ChannelTypeEnum)
-> ChannelTypeEnum
-> Parser ChannelTypeEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelTypeEnum -> ChannelTypeEnum
forall a. a -> a
P.id) (Either FilePath ChannelTypeEnum -> Parser ChannelTypeEnum)
-> (Text -> Either FilePath ChannelTypeEnum)
-> Text
-> Parser ChannelTypeEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ChannelTypeEnum
toChannelTypeEnum (Text -> Parser ChannelTypeEnum)
-> Parser Text -> Parser ChannelTypeEnum
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ChannelTypeEnum where toQueryParam :: ChannelTypeEnum -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (ChannelTypeEnum -> Text) -> ChannelTypeEnum -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelTypeEnum -> Text
fromChannelTypeEnum
instance WH.FromHttpApiData ChannelTypeEnum where parseQueryParam :: Text -> Either Text ChannelTypeEnum
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ChannelTypeEnum)
-> Either Text ChannelTypeEnum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath ChannelTypeEnum -> Either Text ChannelTypeEnum
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath ChannelTypeEnum -> Either Text ChannelTypeEnum)
-> (Text -> Either FilePath ChannelTypeEnum)
-> Text
-> Either Text ChannelTypeEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ChannelTypeEnum
toChannelTypeEnum
instance MimeRender MimeMultipartFormData ChannelTypeEnum where mimeRender :: Proxy MimeMultipartFormData -> ChannelTypeEnum -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ChannelTypeEnum -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ChannelTypeEnum' enum
fromChannelTypeEnum :: ChannelTypeEnum -> Text
fromChannelTypeEnum :: ChannelTypeEnum -> Text
fromChannelTypeEnum = \case
  ChannelTypeEnum
ChannelTypeEnum'Numeric -> Text
"numeric"
  ChannelTypeEnum
ChannelTypeEnum'Text    -> Text
"text"
  ChannelTypeEnum
ChannelTypeEnum'Image   -> Text
"image"

-- | parse 'ChannelTypeEnum' enum
toChannelTypeEnum :: Text -> P.Either String ChannelTypeEnum
toChannelTypeEnum :: Text -> Either FilePath ChannelTypeEnum
toChannelTypeEnum = \case
  Text
"numeric" -> ChannelTypeEnum -> Either FilePath ChannelTypeEnum
forall a b. b -> Either a b
P.Right ChannelTypeEnum
ChannelTypeEnum'Numeric
  Text
"text"    -> ChannelTypeEnum -> Either FilePath ChannelTypeEnum
forall a b. b -> Either a b
P.Right ChannelTypeEnum
ChannelTypeEnum'Text
  Text
"image"   -> ChannelTypeEnum -> Either FilePath ChannelTypeEnum
forall a b. b -> Either a b
P.Right ChannelTypeEnum
ChannelTypeEnum'Image
  Text
s         -> FilePath -> Either FilePath ChannelTypeEnum
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath ChannelTypeEnum)
-> FilePath -> Either FilePath ChannelTypeEnum
forall a b. (a -> b) -> a -> b
$ FilePath
"toChannelTypeEnum: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** ExperimentState

-- | Enum of 'Text'
data ExperimentState = ExperimentState'Running
    | ExperimentState'Succeeded
    | ExperimentState'Failed
    | ExperimentState'Aborted
    deriving (Int -> ExperimentState -> ShowS
[ExperimentState] -> ShowS
ExperimentState -> FilePath
(Int -> ExperimentState -> ShowS)
-> (ExperimentState -> FilePath)
-> ([ExperimentState] -> ShowS)
-> Show ExperimentState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExperimentState] -> ShowS
$cshowList :: [ExperimentState] -> ShowS
show :: ExperimentState -> FilePath
$cshow :: ExperimentState -> FilePath
showsPrec :: Int -> ExperimentState -> ShowS
$cshowsPrec :: Int -> ExperimentState -> ShowS
P.Show, ExperimentState -> ExperimentState -> Bool
(ExperimentState -> ExperimentState -> Bool)
-> (ExperimentState -> ExperimentState -> Bool)
-> Eq ExperimentState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExperimentState -> ExperimentState -> Bool
$c/= :: ExperimentState -> ExperimentState -> Bool
== :: ExperimentState -> ExperimentState -> Bool
$c== :: ExperimentState -> ExperimentState -> Bool
P.Eq, P.Typeable, Eq ExperimentState
Eq ExperimentState
-> (ExperimentState -> ExperimentState -> Ordering)
-> (ExperimentState -> ExperimentState -> Bool)
-> (ExperimentState -> ExperimentState -> Bool)
-> (ExperimentState -> ExperimentState -> Bool)
-> (ExperimentState -> ExperimentState -> Bool)
-> (ExperimentState -> ExperimentState -> ExperimentState)
-> (ExperimentState -> ExperimentState -> ExperimentState)
-> Ord ExperimentState
ExperimentState -> ExperimentState -> Bool
ExperimentState -> ExperimentState -> Ordering
ExperimentState -> ExperimentState -> ExperimentState
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 :: ExperimentState -> ExperimentState -> ExperimentState
$cmin :: ExperimentState -> ExperimentState -> ExperimentState
max :: ExperimentState -> ExperimentState -> ExperimentState
$cmax :: ExperimentState -> ExperimentState -> ExperimentState
>= :: ExperimentState -> ExperimentState -> Bool
$c>= :: ExperimentState -> ExperimentState -> Bool
> :: ExperimentState -> ExperimentState -> Bool
$c> :: ExperimentState -> ExperimentState -> Bool
<= :: ExperimentState -> ExperimentState -> Bool
$c<= :: ExperimentState -> ExperimentState -> Bool
< :: ExperimentState -> ExperimentState -> Bool
$c< :: ExperimentState -> ExperimentState -> Bool
compare :: ExperimentState -> ExperimentState -> Ordering
$ccompare :: ExperimentState -> ExperimentState -> Ordering
$cp1Ord :: Eq ExperimentState
P.Ord, ExperimentState
ExperimentState -> ExperimentState -> Bounded ExperimentState
forall a. a -> a -> Bounded a
maxBound :: ExperimentState
$cmaxBound :: ExperimentState
minBound :: ExperimentState
$cminBound :: ExperimentState
P.Bounded, Int -> ExperimentState
ExperimentState -> Int
ExperimentState -> [ExperimentState]
ExperimentState -> ExperimentState
ExperimentState -> ExperimentState -> [ExperimentState]
ExperimentState
-> ExperimentState -> ExperimentState -> [ExperimentState]
(ExperimentState -> ExperimentState)
-> (ExperimentState -> ExperimentState)
-> (Int -> ExperimentState)
-> (ExperimentState -> Int)
-> (ExperimentState -> [ExperimentState])
-> (ExperimentState -> ExperimentState -> [ExperimentState])
-> (ExperimentState -> ExperimentState -> [ExperimentState])
-> (ExperimentState
    -> ExperimentState -> ExperimentState -> [ExperimentState])
-> Enum ExperimentState
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 :: ExperimentState
-> ExperimentState -> ExperimentState -> [ExperimentState]
$cenumFromThenTo :: ExperimentState
-> ExperimentState -> ExperimentState -> [ExperimentState]
enumFromTo :: ExperimentState -> ExperimentState -> [ExperimentState]
$cenumFromTo :: ExperimentState -> ExperimentState -> [ExperimentState]
enumFromThen :: ExperimentState -> ExperimentState -> [ExperimentState]
$cenumFromThen :: ExperimentState -> ExperimentState -> [ExperimentState]
enumFrom :: ExperimentState -> [ExperimentState]
$cenumFrom :: ExperimentState -> [ExperimentState]
fromEnum :: ExperimentState -> Int
$cfromEnum :: ExperimentState -> Int
toEnum :: Int -> ExperimentState
$ctoEnum :: Int -> ExperimentState
pred :: ExperimentState -> ExperimentState
$cpred :: ExperimentState -> ExperimentState
succ :: ExperimentState -> ExperimentState
$csucc :: ExperimentState -> ExperimentState
P.Enum)

instance A.ToJSON ExperimentState where toJSON :: ExperimentState -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (ExperimentState -> Text) -> ExperimentState -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExperimentState -> Text
fromExperimentState
instance A.FromJSON ExperimentState where parseJSON :: Value -> Parser ExperimentState
parseJSON Value
o = (FilePath -> Parser ExperimentState)
-> (ExperimentState -> Parser ExperimentState)
-> Either FilePath ExperimentState
-> Parser ExperimentState
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser ExperimentState
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (ExperimentState -> Parser ExperimentState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExperimentState -> Parser ExperimentState)
-> (ExperimentState -> ExperimentState)
-> ExperimentState
-> Parser ExperimentState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExperimentState -> ExperimentState
forall a. a -> a
P.id) (Either FilePath ExperimentState -> Parser ExperimentState)
-> (Text -> Either FilePath ExperimentState)
-> Text
-> Parser ExperimentState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ExperimentState
toExperimentState (Text -> Parser ExperimentState)
-> Parser Text -> Parser ExperimentState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ExperimentState where toQueryParam :: ExperimentState -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (ExperimentState -> Text) -> ExperimentState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExperimentState -> Text
fromExperimentState
instance WH.FromHttpApiData ExperimentState where parseQueryParam :: Text -> Either Text ExperimentState
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ExperimentState)
-> Either Text ExperimentState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath ExperimentState -> Either Text ExperimentState
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath ExperimentState -> Either Text ExperimentState)
-> (Text -> Either FilePath ExperimentState)
-> Text
-> Either Text ExperimentState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ExperimentState
toExperimentState
instance MimeRender MimeMultipartFormData ExperimentState where mimeRender :: Proxy MimeMultipartFormData -> ExperimentState -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ExperimentState -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ExperimentState' enum
fromExperimentState :: ExperimentState -> Text
fromExperimentState :: ExperimentState -> Text
fromExperimentState = \case
  ExperimentState
ExperimentState'Running   -> Text
"running"
  ExperimentState
ExperimentState'Succeeded -> Text
"succeeded"
  ExperimentState
ExperimentState'Failed    -> Text
"failed"
  ExperimentState
ExperimentState'Aborted   -> Text
"aborted"

-- | parse 'ExperimentState' enum
toExperimentState :: Text -> P.Either String ExperimentState
toExperimentState :: Text -> Either FilePath ExperimentState
toExperimentState = \case
  Text
"running" -> ExperimentState -> Either FilePath ExperimentState
forall a b. b -> Either a b
P.Right ExperimentState
ExperimentState'Running
  Text
"succeeded" -> ExperimentState -> Either FilePath ExperimentState
forall a b. b -> Either a b
P.Right ExperimentState
ExperimentState'Succeeded
  Text
"failed" -> ExperimentState -> Either FilePath ExperimentState
forall a b. b -> Either a b
P.Right ExperimentState
ExperimentState'Failed
  Text
"aborted" -> ExperimentState -> Either FilePath ExperimentState
forall a b. b -> Either a b
P.Right ExperimentState
ExperimentState'Aborted
  Text
s -> FilePath -> Either FilePath ExperimentState
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath ExperimentState)
-> FilePath -> Either FilePath ExperimentState
forall a b. (a -> b) -> a -> b
$ FilePath
"toExperimentState: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** InvitationStatusEnumDTO

-- | Enum of 'Text'
data InvitationStatusEnumDTO = InvitationStatusEnumDTO'Pending
    | InvitationStatusEnumDTO'Accepted
    | InvitationStatusEnumDTO'Rejected
    | InvitationStatusEnumDTO'Revoked
    deriving (Int -> InvitationStatusEnumDTO -> ShowS
[InvitationStatusEnumDTO] -> ShowS
InvitationStatusEnumDTO -> FilePath
(Int -> InvitationStatusEnumDTO -> ShowS)
-> (InvitationStatusEnumDTO -> FilePath)
-> ([InvitationStatusEnumDTO] -> ShowS)
-> Show InvitationStatusEnumDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InvitationStatusEnumDTO] -> ShowS
$cshowList :: [InvitationStatusEnumDTO] -> ShowS
show :: InvitationStatusEnumDTO -> FilePath
$cshow :: InvitationStatusEnumDTO -> FilePath
showsPrec :: Int -> InvitationStatusEnumDTO -> ShowS
$cshowsPrec :: Int -> InvitationStatusEnumDTO -> ShowS
P.Show, InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
(InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool)
-> (InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool)
-> Eq InvitationStatusEnumDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
$c/= :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
== :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
$c== :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
P.Eq, P.Typeable, Eq InvitationStatusEnumDTO
Eq InvitationStatusEnumDTO
-> (InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Ordering)
-> (InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool)
-> (InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool)
-> (InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool)
-> (InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool)
-> (InvitationStatusEnumDTO
    -> InvitationStatusEnumDTO -> InvitationStatusEnumDTO)
-> (InvitationStatusEnumDTO
    -> InvitationStatusEnumDTO -> InvitationStatusEnumDTO)
-> Ord InvitationStatusEnumDTO
InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Ordering
InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> InvitationStatusEnumDTO
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 :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> InvitationStatusEnumDTO
$cmin :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> InvitationStatusEnumDTO
max :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> InvitationStatusEnumDTO
$cmax :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> InvitationStatusEnumDTO
>= :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
$c>= :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
> :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
$c> :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
<= :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
$c<= :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
< :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
$c< :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Bool
compare :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Ordering
$ccompare :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO -> Ordering
$cp1Ord :: Eq InvitationStatusEnumDTO
P.Ord, InvitationStatusEnumDTO
InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> Bounded InvitationStatusEnumDTO
forall a. a -> a -> Bounded a
maxBound :: InvitationStatusEnumDTO
$cmaxBound :: InvitationStatusEnumDTO
minBound :: InvitationStatusEnumDTO
$cminBound :: InvitationStatusEnumDTO
P.Bounded, Int -> InvitationStatusEnumDTO
InvitationStatusEnumDTO -> Int
InvitationStatusEnumDTO -> [InvitationStatusEnumDTO]
InvitationStatusEnumDTO -> InvitationStatusEnumDTO
InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> [InvitationStatusEnumDTO]
InvitationStatusEnumDTO
-> InvitationStatusEnumDTO
-> InvitationStatusEnumDTO
-> [InvitationStatusEnumDTO]
(InvitationStatusEnumDTO -> InvitationStatusEnumDTO)
-> (InvitationStatusEnumDTO -> InvitationStatusEnumDTO)
-> (Int -> InvitationStatusEnumDTO)
-> (InvitationStatusEnumDTO -> Int)
-> (InvitationStatusEnumDTO -> [InvitationStatusEnumDTO])
-> (InvitationStatusEnumDTO
    -> InvitationStatusEnumDTO -> [InvitationStatusEnumDTO])
-> (InvitationStatusEnumDTO
    -> InvitationStatusEnumDTO -> [InvitationStatusEnumDTO])
-> (InvitationStatusEnumDTO
    -> InvitationStatusEnumDTO
    -> InvitationStatusEnumDTO
    -> [InvitationStatusEnumDTO])
-> Enum InvitationStatusEnumDTO
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 :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO
-> InvitationStatusEnumDTO
-> [InvitationStatusEnumDTO]
$cenumFromThenTo :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO
-> InvitationStatusEnumDTO
-> [InvitationStatusEnumDTO]
enumFromTo :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> [InvitationStatusEnumDTO]
$cenumFromTo :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> [InvitationStatusEnumDTO]
enumFromThen :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> [InvitationStatusEnumDTO]
$cenumFromThen :: InvitationStatusEnumDTO
-> InvitationStatusEnumDTO -> [InvitationStatusEnumDTO]
enumFrom :: InvitationStatusEnumDTO -> [InvitationStatusEnumDTO]
$cenumFrom :: InvitationStatusEnumDTO -> [InvitationStatusEnumDTO]
fromEnum :: InvitationStatusEnumDTO -> Int
$cfromEnum :: InvitationStatusEnumDTO -> Int
toEnum :: Int -> InvitationStatusEnumDTO
$ctoEnum :: Int -> InvitationStatusEnumDTO
pred :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO
$cpred :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO
succ :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO
$csucc :: InvitationStatusEnumDTO -> InvitationStatusEnumDTO
P.Enum)

instance A.ToJSON InvitationStatusEnumDTO where toJSON :: InvitationStatusEnumDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (InvitationStatusEnumDTO -> Text)
-> InvitationStatusEnumDTO
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvitationStatusEnumDTO -> Text
fromInvitationStatusEnumDTO
instance A.FromJSON InvitationStatusEnumDTO where parseJSON :: Value -> Parser InvitationStatusEnumDTO
parseJSON Value
o = (FilePath -> Parser InvitationStatusEnumDTO)
-> (InvitationStatusEnumDTO -> Parser InvitationStatusEnumDTO)
-> Either FilePath InvitationStatusEnumDTO
-> Parser InvitationStatusEnumDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser InvitationStatusEnumDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (InvitationStatusEnumDTO -> Parser InvitationStatusEnumDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InvitationStatusEnumDTO -> Parser InvitationStatusEnumDTO)
-> (InvitationStatusEnumDTO -> InvitationStatusEnumDTO)
-> InvitationStatusEnumDTO
-> Parser InvitationStatusEnumDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvitationStatusEnumDTO -> InvitationStatusEnumDTO
forall a. a -> a
P.id) (Either FilePath InvitationStatusEnumDTO
 -> Parser InvitationStatusEnumDTO)
-> (Text -> Either FilePath InvitationStatusEnumDTO)
-> Text
-> Parser InvitationStatusEnumDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath InvitationStatusEnumDTO
toInvitationStatusEnumDTO (Text -> Parser InvitationStatusEnumDTO)
-> Parser Text -> Parser InvitationStatusEnumDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData InvitationStatusEnumDTO where toQueryParam :: InvitationStatusEnumDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (InvitationStatusEnumDTO -> Text)
-> InvitationStatusEnumDTO
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvitationStatusEnumDTO -> Text
fromInvitationStatusEnumDTO
instance WH.FromHttpApiData InvitationStatusEnumDTO where parseQueryParam :: Text -> Either Text InvitationStatusEnumDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text InvitationStatusEnumDTO)
-> Either Text InvitationStatusEnumDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath InvitationStatusEnumDTO
-> Either Text InvitationStatusEnumDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath InvitationStatusEnumDTO
 -> Either Text InvitationStatusEnumDTO)
-> (Text -> Either FilePath InvitationStatusEnumDTO)
-> Text
-> Either Text InvitationStatusEnumDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath InvitationStatusEnumDTO
toInvitationStatusEnumDTO
instance MimeRender MimeMultipartFormData InvitationStatusEnumDTO where mimeRender :: Proxy MimeMultipartFormData
-> InvitationStatusEnumDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = InvitationStatusEnumDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'InvitationStatusEnumDTO' enum
fromInvitationStatusEnumDTO :: InvitationStatusEnumDTO -> Text
fromInvitationStatusEnumDTO :: InvitationStatusEnumDTO -> Text
fromInvitationStatusEnumDTO = \case
  InvitationStatusEnumDTO
InvitationStatusEnumDTO'Pending  -> Text
"pending"
  InvitationStatusEnumDTO
InvitationStatusEnumDTO'Accepted -> Text
"accepted"
  InvitationStatusEnumDTO
InvitationStatusEnumDTO'Rejected -> Text
"rejected"
  InvitationStatusEnumDTO
InvitationStatusEnumDTO'Revoked  -> Text
"revoked"

-- | parse 'InvitationStatusEnumDTO' enum
toInvitationStatusEnumDTO :: Text -> P.Either String InvitationStatusEnumDTO
toInvitationStatusEnumDTO :: Text -> Either FilePath InvitationStatusEnumDTO
toInvitationStatusEnumDTO = \case
  Text
"pending" -> InvitationStatusEnumDTO -> Either FilePath InvitationStatusEnumDTO
forall a b. b -> Either a b
P.Right InvitationStatusEnumDTO
InvitationStatusEnumDTO'Pending
  Text
"accepted" -> InvitationStatusEnumDTO -> Either FilePath InvitationStatusEnumDTO
forall a b. b -> Either a b
P.Right InvitationStatusEnumDTO
InvitationStatusEnumDTO'Accepted
  Text
"rejected" -> InvitationStatusEnumDTO -> Either FilePath InvitationStatusEnumDTO
forall a b. b -> Either a b
P.Right InvitationStatusEnumDTO
InvitationStatusEnumDTO'Rejected
  Text
"revoked" -> InvitationStatusEnumDTO -> Either FilePath InvitationStatusEnumDTO
forall a b. b -> Either a b
P.Right InvitationStatusEnumDTO
InvitationStatusEnumDTO'Revoked
  Text
s -> FilePath -> Either FilePath InvitationStatusEnumDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath InvitationStatusEnumDTO)
-> FilePath -> Either FilePath InvitationStatusEnumDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toInvitationStatusEnumDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** InvitationTypeEnumDTO

-- | Enum of 'Text'
data InvitationTypeEnumDTO = InvitationTypeEnumDTO'User
    | InvitationTypeEnumDTO'EmailRecipient
    deriving (Int -> InvitationTypeEnumDTO -> ShowS
[InvitationTypeEnumDTO] -> ShowS
InvitationTypeEnumDTO -> FilePath
(Int -> InvitationTypeEnumDTO -> ShowS)
-> (InvitationTypeEnumDTO -> FilePath)
-> ([InvitationTypeEnumDTO] -> ShowS)
-> Show InvitationTypeEnumDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InvitationTypeEnumDTO] -> ShowS
$cshowList :: [InvitationTypeEnumDTO] -> ShowS
show :: InvitationTypeEnumDTO -> FilePath
$cshow :: InvitationTypeEnumDTO -> FilePath
showsPrec :: Int -> InvitationTypeEnumDTO -> ShowS
$cshowsPrec :: Int -> InvitationTypeEnumDTO -> ShowS
P.Show, InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
(InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool)
-> (InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool)
-> Eq InvitationTypeEnumDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
$c/= :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
== :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
$c== :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
P.Eq, P.Typeable, Eq InvitationTypeEnumDTO
Eq InvitationTypeEnumDTO
-> (InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Ordering)
-> (InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool)
-> (InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool)
-> (InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool)
-> (InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool)
-> (InvitationTypeEnumDTO
    -> InvitationTypeEnumDTO -> InvitationTypeEnumDTO)
-> (InvitationTypeEnumDTO
    -> InvitationTypeEnumDTO -> InvitationTypeEnumDTO)
-> Ord InvitationTypeEnumDTO
InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Ordering
InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> InvitationTypeEnumDTO
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 :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> InvitationTypeEnumDTO
$cmin :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> InvitationTypeEnumDTO
max :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> InvitationTypeEnumDTO
$cmax :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> InvitationTypeEnumDTO
>= :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
$c>= :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
> :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
$c> :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
<= :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
$c<= :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
< :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
$c< :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Bool
compare :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Ordering
$ccompare :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO -> Ordering
$cp1Ord :: Eq InvitationTypeEnumDTO
P.Ord, InvitationTypeEnumDTO
InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> Bounded InvitationTypeEnumDTO
forall a. a -> a -> Bounded a
maxBound :: InvitationTypeEnumDTO
$cmaxBound :: InvitationTypeEnumDTO
minBound :: InvitationTypeEnumDTO
$cminBound :: InvitationTypeEnumDTO
P.Bounded, Int -> InvitationTypeEnumDTO
InvitationTypeEnumDTO -> Int
InvitationTypeEnumDTO -> [InvitationTypeEnumDTO]
InvitationTypeEnumDTO -> InvitationTypeEnumDTO
InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> [InvitationTypeEnumDTO]
InvitationTypeEnumDTO
-> InvitationTypeEnumDTO
-> InvitationTypeEnumDTO
-> [InvitationTypeEnumDTO]
(InvitationTypeEnumDTO -> InvitationTypeEnumDTO)
-> (InvitationTypeEnumDTO -> InvitationTypeEnumDTO)
-> (Int -> InvitationTypeEnumDTO)
-> (InvitationTypeEnumDTO -> Int)
-> (InvitationTypeEnumDTO -> [InvitationTypeEnumDTO])
-> (InvitationTypeEnumDTO
    -> InvitationTypeEnumDTO -> [InvitationTypeEnumDTO])
-> (InvitationTypeEnumDTO
    -> InvitationTypeEnumDTO -> [InvitationTypeEnumDTO])
-> (InvitationTypeEnumDTO
    -> InvitationTypeEnumDTO
    -> InvitationTypeEnumDTO
    -> [InvitationTypeEnumDTO])
-> Enum InvitationTypeEnumDTO
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 :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO
-> InvitationTypeEnumDTO
-> [InvitationTypeEnumDTO]
$cenumFromThenTo :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO
-> InvitationTypeEnumDTO
-> [InvitationTypeEnumDTO]
enumFromTo :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> [InvitationTypeEnumDTO]
$cenumFromTo :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> [InvitationTypeEnumDTO]
enumFromThen :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> [InvitationTypeEnumDTO]
$cenumFromThen :: InvitationTypeEnumDTO
-> InvitationTypeEnumDTO -> [InvitationTypeEnumDTO]
enumFrom :: InvitationTypeEnumDTO -> [InvitationTypeEnumDTO]
$cenumFrom :: InvitationTypeEnumDTO -> [InvitationTypeEnumDTO]
fromEnum :: InvitationTypeEnumDTO -> Int
$cfromEnum :: InvitationTypeEnumDTO -> Int
toEnum :: Int -> InvitationTypeEnumDTO
$ctoEnum :: Int -> InvitationTypeEnumDTO
pred :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO
$cpred :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO
succ :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO
$csucc :: InvitationTypeEnumDTO -> InvitationTypeEnumDTO
P.Enum)

instance A.ToJSON InvitationTypeEnumDTO where toJSON :: InvitationTypeEnumDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (InvitationTypeEnumDTO -> Text)
-> InvitationTypeEnumDTO
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvitationTypeEnumDTO -> Text
fromInvitationTypeEnumDTO
instance A.FromJSON InvitationTypeEnumDTO where parseJSON :: Value -> Parser InvitationTypeEnumDTO
parseJSON Value
o = (FilePath -> Parser InvitationTypeEnumDTO)
-> (InvitationTypeEnumDTO -> Parser InvitationTypeEnumDTO)
-> Either FilePath InvitationTypeEnumDTO
-> Parser InvitationTypeEnumDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser InvitationTypeEnumDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (InvitationTypeEnumDTO -> Parser InvitationTypeEnumDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InvitationTypeEnumDTO -> Parser InvitationTypeEnumDTO)
-> (InvitationTypeEnumDTO -> InvitationTypeEnumDTO)
-> InvitationTypeEnumDTO
-> Parser InvitationTypeEnumDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvitationTypeEnumDTO -> InvitationTypeEnumDTO
forall a. a -> a
P.id) (Either FilePath InvitationTypeEnumDTO
 -> Parser InvitationTypeEnumDTO)
-> (Text -> Either FilePath InvitationTypeEnumDTO)
-> Text
-> Parser InvitationTypeEnumDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath InvitationTypeEnumDTO
toInvitationTypeEnumDTO (Text -> Parser InvitationTypeEnumDTO)
-> Parser Text -> Parser InvitationTypeEnumDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData InvitationTypeEnumDTO where toQueryParam :: InvitationTypeEnumDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (InvitationTypeEnumDTO -> Text) -> InvitationTypeEnumDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvitationTypeEnumDTO -> Text
fromInvitationTypeEnumDTO
instance WH.FromHttpApiData InvitationTypeEnumDTO where parseQueryParam :: Text -> Either Text InvitationTypeEnumDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text InvitationTypeEnumDTO)
-> Either Text InvitationTypeEnumDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath InvitationTypeEnumDTO
-> Either Text InvitationTypeEnumDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath InvitationTypeEnumDTO
 -> Either Text InvitationTypeEnumDTO)
-> (Text -> Either FilePath InvitationTypeEnumDTO)
-> Text
-> Either Text InvitationTypeEnumDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath InvitationTypeEnumDTO
toInvitationTypeEnumDTO
instance MimeRender MimeMultipartFormData InvitationTypeEnumDTO where mimeRender :: Proxy MimeMultipartFormData -> InvitationTypeEnumDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = InvitationTypeEnumDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'InvitationTypeEnumDTO' enum
fromInvitationTypeEnumDTO :: InvitationTypeEnumDTO -> Text
fromInvitationTypeEnumDTO :: InvitationTypeEnumDTO -> Text
fromInvitationTypeEnumDTO = \case
  InvitationTypeEnumDTO
InvitationTypeEnumDTO'User           -> Text
"user"
  InvitationTypeEnumDTO
InvitationTypeEnumDTO'EmailRecipient -> Text
"emailRecipient"

-- | parse 'InvitationTypeEnumDTO' enum
toInvitationTypeEnumDTO :: Text -> P.Either String InvitationTypeEnumDTO
toInvitationTypeEnumDTO :: Text -> Either FilePath InvitationTypeEnumDTO
toInvitationTypeEnumDTO = \case
  Text
"user" -> InvitationTypeEnumDTO -> Either FilePath InvitationTypeEnumDTO
forall a b. b -> Either a b
P.Right InvitationTypeEnumDTO
InvitationTypeEnumDTO'User
  Text
"emailRecipient" -> InvitationTypeEnumDTO -> Either FilePath InvitationTypeEnumDTO
forall a b. b -> Either a b
P.Right InvitationTypeEnumDTO
InvitationTypeEnumDTO'EmailRecipient
  Text
s -> FilePath -> Either FilePath InvitationTypeEnumDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath InvitationTypeEnumDTO)
-> FilePath -> Either FilePath InvitationTypeEnumDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toInvitationTypeEnumDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** LinkTypeDTO

-- | Enum of 'Text'
data LinkTypeDTO = LinkTypeDTO'Github
    | LinkTypeDTO'Twitter
    | LinkTypeDTO'Kaggle
    | LinkTypeDTO'Linkedin
    | LinkTypeDTO'Other
    deriving (Int -> LinkTypeDTO -> ShowS
[LinkTypeDTO] -> ShowS
LinkTypeDTO -> FilePath
(Int -> LinkTypeDTO -> ShowS)
-> (LinkTypeDTO -> FilePath)
-> ([LinkTypeDTO] -> ShowS)
-> Show LinkTypeDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LinkTypeDTO] -> ShowS
$cshowList :: [LinkTypeDTO] -> ShowS
show :: LinkTypeDTO -> FilePath
$cshow :: LinkTypeDTO -> FilePath
showsPrec :: Int -> LinkTypeDTO -> ShowS
$cshowsPrec :: Int -> LinkTypeDTO -> ShowS
P.Show, LinkTypeDTO -> LinkTypeDTO -> Bool
(LinkTypeDTO -> LinkTypeDTO -> Bool)
-> (LinkTypeDTO -> LinkTypeDTO -> Bool) -> Eq LinkTypeDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkTypeDTO -> LinkTypeDTO -> Bool
$c/= :: LinkTypeDTO -> LinkTypeDTO -> Bool
== :: LinkTypeDTO -> LinkTypeDTO -> Bool
$c== :: LinkTypeDTO -> LinkTypeDTO -> Bool
P.Eq, P.Typeable, Eq LinkTypeDTO
Eq LinkTypeDTO
-> (LinkTypeDTO -> LinkTypeDTO -> Ordering)
-> (LinkTypeDTO -> LinkTypeDTO -> Bool)
-> (LinkTypeDTO -> LinkTypeDTO -> Bool)
-> (LinkTypeDTO -> LinkTypeDTO -> Bool)
-> (LinkTypeDTO -> LinkTypeDTO -> Bool)
-> (LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO)
-> (LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO)
-> Ord LinkTypeDTO
LinkTypeDTO -> LinkTypeDTO -> Bool
LinkTypeDTO -> LinkTypeDTO -> Ordering
LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO
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 :: LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO
$cmin :: LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO
max :: LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO
$cmax :: LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO
>= :: LinkTypeDTO -> LinkTypeDTO -> Bool
$c>= :: LinkTypeDTO -> LinkTypeDTO -> Bool
> :: LinkTypeDTO -> LinkTypeDTO -> Bool
$c> :: LinkTypeDTO -> LinkTypeDTO -> Bool
<= :: LinkTypeDTO -> LinkTypeDTO -> Bool
$c<= :: LinkTypeDTO -> LinkTypeDTO -> Bool
< :: LinkTypeDTO -> LinkTypeDTO -> Bool
$c< :: LinkTypeDTO -> LinkTypeDTO -> Bool
compare :: LinkTypeDTO -> LinkTypeDTO -> Ordering
$ccompare :: LinkTypeDTO -> LinkTypeDTO -> Ordering
$cp1Ord :: Eq LinkTypeDTO
P.Ord, LinkTypeDTO
LinkTypeDTO -> LinkTypeDTO -> Bounded LinkTypeDTO
forall a. a -> a -> Bounded a
maxBound :: LinkTypeDTO
$cmaxBound :: LinkTypeDTO
minBound :: LinkTypeDTO
$cminBound :: LinkTypeDTO
P.Bounded, Int -> LinkTypeDTO
LinkTypeDTO -> Int
LinkTypeDTO -> [LinkTypeDTO]
LinkTypeDTO -> LinkTypeDTO
LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO]
LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO]
(LinkTypeDTO -> LinkTypeDTO)
-> (LinkTypeDTO -> LinkTypeDTO)
-> (Int -> LinkTypeDTO)
-> (LinkTypeDTO -> Int)
-> (LinkTypeDTO -> [LinkTypeDTO])
-> (LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO])
-> (LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO])
-> (LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO])
-> Enum LinkTypeDTO
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 :: LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO]
$cenumFromThenTo :: LinkTypeDTO -> LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO]
enumFromTo :: LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO]
$cenumFromTo :: LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO]
enumFromThen :: LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO]
$cenumFromThen :: LinkTypeDTO -> LinkTypeDTO -> [LinkTypeDTO]
enumFrom :: LinkTypeDTO -> [LinkTypeDTO]
$cenumFrom :: LinkTypeDTO -> [LinkTypeDTO]
fromEnum :: LinkTypeDTO -> Int
$cfromEnum :: LinkTypeDTO -> Int
toEnum :: Int -> LinkTypeDTO
$ctoEnum :: Int -> LinkTypeDTO
pred :: LinkTypeDTO -> LinkTypeDTO
$cpred :: LinkTypeDTO -> LinkTypeDTO
succ :: LinkTypeDTO -> LinkTypeDTO
$csucc :: LinkTypeDTO -> LinkTypeDTO
P.Enum)

instance A.ToJSON LinkTypeDTO where toJSON :: LinkTypeDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (LinkTypeDTO -> Text) -> LinkTypeDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkTypeDTO -> Text
fromLinkTypeDTO
instance A.FromJSON LinkTypeDTO where parseJSON :: Value -> Parser LinkTypeDTO
parseJSON Value
o = (FilePath -> Parser LinkTypeDTO)
-> (LinkTypeDTO -> Parser LinkTypeDTO)
-> Either FilePath LinkTypeDTO
-> Parser LinkTypeDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser LinkTypeDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (LinkTypeDTO -> Parser LinkTypeDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LinkTypeDTO -> Parser LinkTypeDTO)
-> (LinkTypeDTO -> LinkTypeDTO)
-> LinkTypeDTO
-> Parser LinkTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkTypeDTO -> LinkTypeDTO
forall a. a -> a
P.id) (Either FilePath LinkTypeDTO -> Parser LinkTypeDTO)
-> (Text -> Either FilePath LinkTypeDTO)
-> Text
-> Parser LinkTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath LinkTypeDTO
toLinkTypeDTO (Text -> Parser LinkTypeDTO) -> Parser Text -> Parser LinkTypeDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData LinkTypeDTO where toQueryParam :: LinkTypeDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (LinkTypeDTO -> Text) -> LinkTypeDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkTypeDTO -> Text
fromLinkTypeDTO
instance WH.FromHttpApiData LinkTypeDTO where parseQueryParam :: Text -> Either Text LinkTypeDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text LinkTypeDTO) -> Either Text LinkTypeDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath LinkTypeDTO -> Either Text LinkTypeDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath LinkTypeDTO -> Either Text LinkTypeDTO)
-> (Text -> Either FilePath LinkTypeDTO)
-> Text
-> Either Text LinkTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath LinkTypeDTO
toLinkTypeDTO
instance MimeRender MimeMultipartFormData LinkTypeDTO where mimeRender :: Proxy MimeMultipartFormData -> LinkTypeDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = LinkTypeDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'LinkTypeDTO' enum
fromLinkTypeDTO :: LinkTypeDTO -> Text
fromLinkTypeDTO :: LinkTypeDTO -> Text
fromLinkTypeDTO = \case
  LinkTypeDTO
LinkTypeDTO'Github   -> Text
"github"
  LinkTypeDTO
LinkTypeDTO'Twitter  -> Text
"twitter"
  LinkTypeDTO
LinkTypeDTO'Kaggle   -> Text
"kaggle"
  LinkTypeDTO
LinkTypeDTO'Linkedin -> Text
"linkedin"
  LinkTypeDTO
LinkTypeDTO'Other    -> Text
"other"

-- | parse 'LinkTypeDTO' enum
toLinkTypeDTO :: Text -> P.Either String LinkTypeDTO
toLinkTypeDTO :: Text -> Either FilePath LinkTypeDTO
toLinkTypeDTO = \case
  Text
"github"   -> LinkTypeDTO -> Either FilePath LinkTypeDTO
forall a b. b -> Either a b
P.Right LinkTypeDTO
LinkTypeDTO'Github
  Text
"twitter"  -> LinkTypeDTO -> Either FilePath LinkTypeDTO
forall a b. b -> Either a b
P.Right LinkTypeDTO
LinkTypeDTO'Twitter
  Text
"kaggle"   -> LinkTypeDTO -> Either FilePath LinkTypeDTO
forall a b. b -> Either a b
P.Right LinkTypeDTO
LinkTypeDTO'Kaggle
  Text
"linkedin" -> LinkTypeDTO -> Either FilePath LinkTypeDTO
forall a b. b -> Either a b
P.Right LinkTypeDTO
LinkTypeDTO'Linkedin
  Text
"other"    -> LinkTypeDTO -> Either FilePath LinkTypeDTO
forall a b. b -> Either a b
P.Right LinkTypeDTO
LinkTypeDTO'Other
  Text
s          -> FilePath -> Either FilePath LinkTypeDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath LinkTypeDTO)
-> FilePath -> Either FilePath LinkTypeDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toLinkTypeDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** LoginActionDTO

-- | Enum of 'Text'
data LoginActionDTO = LoginActionDTO'SET_USERNAME
    | LoginActionDTO'SURVEY
    deriving (Int -> LoginActionDTO -> ShowS
[LoginActionDTO] -> ShowS
LoginActionDTO -> FilePath
(Int -> LoginActionDTO -> ShowS)
-> (LoginActionDTO -> FilePath)
-> ([LoginActionDTO] -> ShowS)
-> Show LoginActionDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LoginActionDTO] -> ShowS
$cshowList :: [LoginActionDTO] -> ShowS
show :: LoginActionDTO -> FilePath
$cshow :: LoginActionDTO -> FilePath
showsPrec :: Int -> LoginActionDTO -> ShowS
$cshowsPrec :: Int -> LoginActionDTO -> ShowS
P.Show, LoginActionDTO -> LoginActionDTO -> Bool
(LoginActionDTO -> LoginActionDTO -> Bool)
-> (LoginActionDTO -> LoginActionDTO -> Bool) -> Eq LoginActionDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginActionDTO -> LoginActionDTO -> Bool
$c/= :: LoginActionDTO -> LoginActionDTO -> Bool
== :: LoginActionDTO -> LoginActionDTO -> Bool
$c== :: LoginActionDTO -> LoginActionDTO -> Bool
P.Eq, P.Typeable, Eq LoginActionDTO
Eq LoginActionDTO
-> (LoginActionDTO -> LoginActionDTO -> Ordering)
-> (LoginActionDTO -> LoginActionDTO -> Bool)
-> (LoginActionDTO -> LoginActionDTO -> Bool)
-> (LoginActionDTO -> LoginActionDTO -> Bool)
-> (LoginActionDTO -> LoginActionDTO -> Bool)
-> (LoginActionDTO -> LoginActionDTO -> LoginActionDTO)
-> (LoginActionDTO -> LoginActionDTO -> LoginActionDTO)
-> Ord LoginActionDTO
LoginActionDTO -> LoginActionDTO -> Bool
LoginActionDTO -> LoginActionDTO -> Ordering
LoginActionDTO -> LoginActionDTO -> LoginActionDTO
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 :: LoginActionDTO -> LoginActionDTO -> LoginActionDTO
$cmin :: LoginActionDTO -> LoginActionDTO -> LoginActionDTO
max :: LoginActionDTO -> LoginActionDTO -> LoginActionDTO
$cmax :: LoginActionDTO -> LoginActionDTO -> LoginActionDTO
>= :: LoginActionDTO -> LoginActionDTO -> Bool
$c>= :: LoginActionDTO -> LoginActionDTO -> Bool
> :: LoginActionDTO -> LoginActionDTO -> Bool
$c> :: LoginActionDTO -> LoginActionDTO -> Bool
<= :: LoginActionDTO -> LoginActionDTO -> Bool
$c<= :: LoginActionDTO -> LoginActionDTO -> Bool
< :: LoginActionDTO -> LoginActionDTO -> Bool
$c< :: LoginActionDTO -> LoginActionDTO -> Bool
compare :: LoginActionDTO -> LoginActionDTO -> Ordering
$ccompare :: LoginActionDTO -> LoginActionDTO -> Ordering
$cp1Ord :: Eq LoginActionDTO
P.Ord, LoginActionDTO
LoginActionDTO -> LoginActionDTO -> Bounded LoginActionDTO
forall a. a -> a -> Bounded a
maxBound :: LoginActionDTO
$cmaxBound :: LoginActionDTO
minBound :: LoginActionDTO
$cminBound :: LoginActionDTO
P.Bounded, Int -> LoginActionDTO
LoginActionDTO -> Int
LoginActionDTO -> [LoginActionDTO]
LoginActionDTO -> LoginActionDTO
LoginActionDTO -> LoginActionDTO -> [LoginActionDTO]
LoginActionDTO
-> LoginActionDTO -> LoginActionDTO -> [LoginActionDTO]
(LoginActionDTO -> LoginActionDTO)
-> (LoginActionDTO -> LoginActionDTO)
-> (Int -> LoginActionDTO)
-> (LoginActionDTO -> Int)
-> (LoginActionDTO -> [LoginActionDTO])
-> (LoginActionDTO -> LoginActionDTO -> [LoginActionDTO])
-> (LoginActionDTO -> LoginActionDTO -> [LoginActionDTO])
-> (LoginActionDTO
    -> LoginActionDTO -> LoginActionDTO -> [LoginActionDTO])
-> Enum LoginActionDTO
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 :: LoginActionDTO
-> LoginActionDTO -> LoginActionDTO -> [LoginActionDTO]
$cenumFromThenTo :: LoginActionDTO
-> LoginActionDTO -> LoginActionDTO -> [LoginActionDTO]
enumFromTo :: LoginActionDTO -> LoginActionDTO -> [LoginActionDTO]
$cenumFromTo :: LoginActionDTO -> LoginActionDTO -> [LoginActionDTO]
enumFromThen :: LoginActionDTO -> LoginActionDTO -> [LoginActionDTO]
$cenumFromThen :: LoginActionDTO -> LoginActionDTO -> [LoginActionDTO]
enumFrom :: LoginActionDTO -> [LoginActionDTO]
$cenumFrom :: LoginActionDTO -> [LoginActionDTO]
fromEnum :: LoginActionDTO -> Int
$cfromEnum :: LoginActionDTO -> Int
toEnum :: Int -> LoginActionDTO
$ctoEnum :: Int -> LoginActionDTO
pred :: LoginActionDTO -> LoginActionDTO
$cpred :: LoginActionDTO -> LoginActionDTO
succ :: LoginActionDTO -> LoginActionDTO
$csucc :: LoginActionDTO -> LoginActionDTO
P.Enum)

instance A.ToJSON LoginActionDTO where toJSON :: LoginActionDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (LoginActionDTO -> Text) -> LoginActionDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoginActionDTO -> Text
fromLoginActionDTO
instance A.FromJSON LoginActionDTO where parseJSON :: Value -> Parser LoginActionDTO
parseJSON Value
o = (FilePath -> Parser LoginActionDTO)
-> (LoginActionDTO -> Parser LoginActionDTO)
-> Either FilePath LoginActionDTO
-> Parser LoginActionDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser LoginActionDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (LoginActionDTO -> Parser LoginActionDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoginActionDTO -> Parser LoginActionDTO)
-> (LoginActionDTO -> LoginActionDTO)
-> LoginActionDTO
-> Parser LoginActionDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoginActionDTO -> LoginActionDTO
forall a. a -> a
P.id) (Either FilePath LoginActionDTO -> Parser LoginActionDTO)
-> (Text -> Either FilePath LoginActionDTO)
-> Text
-> Parser LoginActionDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath LoginActionDTO
toLoginActionDTO (Text -> Parser LoginActionDTO)
-> Parser Text -> Parser LoginActionDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData LoginActionDTO where toQueryParam :: LoginActionDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (LoginActionDTO -> Text) -> LoginActionDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoginActionDTO -> Text
fromLoginActionDTO
instance WH.FromHttpApiData LoginActionDTO where parseQueryParam :: Text -> Either Text LoginActionDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text LoginActionDTO)
-> Either Text LoginActionDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath LoginActionDTO -> Either Text LoginActionDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath LoginActionDTO -> Either Text LoginActionDTO)
-> (Text -> Either FilePath LoginActionDTO)
-> Text
-> Either Text LoginActionDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath LoginActionDTO
toLoginActionDTO
instance MimeRender MimeMultipartFormData LoginActionDTO where mimeRender :: Proxy MimeMultipartFormData -> LoginActionDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = LoginActionDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'LoginActionDTO' enum
fromLoginActionDTO :: LoginActionDTO -> Text
fromLoginActionDTO :: LoginActionDTO -> Text
fromLoginActionDTO = \case
  LoginActionDTO
LoginActionDTO'SET_USERNAME -> Text
"SET_USERNAME"
  LoginActionDTO
LoginActionDTO'SURVEY       -> Text
"SURVEY"

-- | parse 'LoginActionDTO' enum
toLoginActionDTO :: Text -> P.Either String LoginActionDTO
toLoginActionDTO :: Text -> Either FilePath LoginActionDTO
toLoginActionDTO = \case
  Text
"SET_USERNAME" -> LoginActionDTO -> Either FilePath LoginActionDTO
forall a b. b -> Either a b
P.Right LoginActionDTO
LoginActionDTO'SET_USERNAME
  Text
"SURVEY" -> LoginActionDTO -> Either FilePath LoginActionDTO
forall a b. b -> Either a b
P.Right LoginActionDTO
LoginActionDTO'SURVEY
  Text
s -> FilePath -> Either FilePath LoginActionDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath LoginActionDTO)
-> FilePath -> Either FilePath LoginActionDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toLoginActionDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** NameEnum

-- | Enum of 'Text'
data NameEnum = NameEnum'Client
    deriving (Int -> NameEnum -> ShowS
[NameEnum] -> ShowS
NameEnum -> FilePath
(Int -> NameEnum -> ShowS)
-> (NameEnum -> FilePath) -> ([NameEnum] -> ShowS) -> Show NameEnum
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NameEnum] -> ShowS
$cshowList :: [NameEnum] -> ShowS
show :: NameEnum -> FilePath
$cshow :: NameEnum -> FilePath
showsPrec :: Int -> NameEnum -> ShowS
$cshowsPrec :: Int -> NameEnum -> ShowS
P.Show, NameEnum -> NameEnum -> Bool
(NameEnum -> NameEnum -> Bool)
-> (NameEnum -> NameEnum -> Bool) -> Eq NameEnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameEnum -> NameEnum -> Bool
$c/= :: NameEnum -> NameEnum -> Bool
== :: NameEnum -> NameEnum -> Bool
$c== :: NameEnum -> NameEnum -> Bool
P.Eq, P.Typeable, Eq NameEnum
Eq NameEnum
-> (NameEnum -> NameEnum -> Ordering)
-> (NameEnum -> NameEnum -> Bool)
-> (NameEnum -> NameEnum -> Bool)
-> (NameEnum -> NameEnum -> Bool)
-> (NameEnum -> NameEnum -> Bool)
-> (NameEnum -> NameEnum -> NameEnum)
-> (NameEnum -> NameEnum -> NameEnum)
-> Ord NameEnum
NameEnum -> NameEnum -> Bool
NameEnum -> NameEnum -> Ordering
NameEnum -> NameEnum -> NameEnum
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 :: NameEnum -> NameEnum -> NameEnum
$cmin :: NameEnum -> NameEnum -> NameEnum
max :: NameEnum -> NameEnum -> NameEnum
$cmax :: NameEnum -> NameEnum -> NameEnum
>= :: NameEnum -> NameEnum -> Bool
$c>= :: NameEnum -> NameEnum -> Bool
> :: NameEnum -> NameEnum -> Bool
$c> :: NameEnum -> NameEnum -> Bool
<= :: NameEnum -> NameEnum -> Bool
$c<= :: NameEnum -> NameEnum -> Bool
< :: NameEnum -> NameEnum -> Bool
$c< :: NameEnum -> NameEnum -> Bool
compare :: NameEnum -> NameEnum -> Ordering
$ccompare :: NameEnum -> NameEnum -> Ordering
$cp1Ord :: Eq NameEnum
P.Ord, NameEnum
NameEnum -> NameEnum -> Bounded NameEnum
forall a. a -> a -> Bounded a
maxBound :: NameEnum
$cmaxBound :: NameEnum
minBound :: NameEnum
$cminBound :: NameEnum
P.Bounded, Int -> NameEnum
NameEnum -> Int
NameEnum -> [NameEnum]
NameEnum -> NameEnum
NameEnum -> NameEnum -> [NameEnum]
NameEnum -> NameEnum -> NameEnum -> [NameEnum]
(NameEnum -> NameEnum)
-> (NameEnum -> NameEnum)
-> (Int -> NameEnum)
-> (NameEnum -> Int)
-> (NameEnum -> [NameEnum])
-> (NameEnum -> NameEnum -> [NameEnum])
-> (NameEnum -> NameEnum -> [NameEnum])
-> (NameEnum -> NameEnum -> NameEnum -> [NameEnum])
-> Enum NameEnum
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 :: NameEnum -> NameEnum -> NameEnum -> [NameEnum]
$cenumFromThenTo :: NameEnum -> NameEnum -> NameEnum -> [NameEnum]
enumFromTo :: NameEnum -> NameEnum -> [NameEnum]
$cenumFromTo :: NameEnum -> NameEnum -> [NameEnum]
enumFromThen :: NameEnum -> NameEnum -> [NameEnum]
$cenumFromThen :: NameEnum -> NameEnum -> [NameEnum]
enumFrom :: NameEnum -> [NameEnum]
$cenumFrom :: NameEnum -> [NameEnum]
fromEnum :: NameEnum -> Int
$cfromEnum :: NameEnum -> Int
toEnum :: Int -> NameEnum
$ctoEnum :: Int -> NameEnum
pred :: NameEnum -> NameEnum
$cpred :: NameEnum -> NameEnum
succ :: NameEnum -> NameEnum
$csucc :: NameEnum -> NameEnum
P.Enum)

instance A.ToJSON NameEnum where toJSON :: NameEnum -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (NameEnum -> Text) -> NameEnum -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameEnum -> Text
fromNameEnum
instance A.FromJSON NameEnum where parseJSON :: Value -> Parser NameEnum
parseJSON Value
o = (FilePath -> Parser NameEnum)
-> (NameEnum -> Parser NameEnum)
-> Either FilePath NameEnum
-> Parser NameEnum
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser NameEnum
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (NameEnum -> Parser NameEnum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NameEnum -> Parser NameEnum)
-> (NameEnum -> NameEnum) -> NameEnum -> Parser NameEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameEnum -> NameEnum
forall a. a -> a
P.id) (Either FilePath NameEnum -> Parser NameEnum)
-> (Text -> Either FilePath NameEnum) -> Text -> Parser NameEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath NameEnum
toNameEnum (Text -> Parser NameEnum) -> Parser Text -> Parser NameEnum
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData NameEnum where toQueryParam :: NameEnum -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (NameEnum -> Text) -> NameEnum -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameEnum -> Text
fromNameEnum
instance WH.FromHttpApiData NameEnum where parseQueryParam :: Text -> Either Text NameEnum
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text NameEnum) -> Either Text NameEnum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath NameEnum -> Either Text NameEnum
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath NameEnum -> Either Text NameEnum)
-> (Text -> Either FilePath NameEnum)
-> Text
-> Either Text NameEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath NameEnum
toNameEnum
instance MimeRender MimeMultipartFormData NameEnum where mimeRender :: Proxy MimeMultipartFormData -> NameEnum -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = NameEnum -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'NameEnum' enum
fromNameEnum :: NameEnum -> Text
fromNameEnum :: NameEnum -> Text
fromNameEnum = \case
  NameEnum
NameEnum'Client -> Text
"Client"

-- | parse 'NameEnum' enum
toNameEnum :: Text -> P.Either String NameEnum
toNameEnum :: Text -> Either FilePath NameEnum
toNameEnum = \case
  Text
"Client" -> NameEnum -> Either FilePath NameEnum
forall a b. b -> Either a b
P.Right NameEnum
NameEnum'Client
  Text
s        -> FilePath -> Either FilePath NameEnum
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath NameEnum)
-> FilePath -> Either FilePath NameEnum
forall a b. (a -> b) -> a -> b
$ FilePath
"toNameEnum: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** OrganizationRoleDTO

-- | Enum of 'Text'
data OrganizationRoleDTO = OrganizationRoleDTO'Member
    | OrganizationRoleDTO'Owner
    deriving (Int -> OrganizationRoleDTO -> ShowS
[OrganizationRoleDTO] -> ShowS
OrganizationRoleDTO -> FilePath
(Int -> OrganizationRoleDTO -> ShowS)
-> (OrganizationRoleDTO -> FilePath)
-> ([OrganizationRoleDTO] -> ShowS)
-> Show OrganizationRoleDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationRoleDTO] -> ShowS
$cshowList :: [OrganizationRoleDTO] -> ShowS
show :: OrganizationRoleDTO -> FilePath
$cshow :: OrganizationRoleDTO -> FilePath
showsPrec :: Int -> OrganizationRoleDTO -> ShowS
$cshowsPrec :: Int -> OrganizationRoleDTO -> ShowS
P.Show, OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
(OrganizationRoleDTO -> OrganizationRoleDTO -> Bool)
-> (OrganizationRoleDTO -> OrganizationRoleDTO -> Bool)
-> Eq OrganizationRoleDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
$c/= :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
== :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
$c== :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
P.Eq, P.Typeable, Eq OrganizationRoleDTO
Eq OrganizationRoleDTO
-> (OrganizationRoleDTO -> OrganizationRoleDTO -> Ordering)
-> (OrganizationRoleDTO -> OrganizationRoleDTO -> Bool)
-> (OrganizationRoleDTO -> OrganizationRoleDTO -> Bool)
-> (OrganizationRoleDTO -> OrganizationRoleDTO -> Bool)
-> (OrganizationRoleDTO -> OrganizationRoleDTO -> Bool)
-> (OrganizationRoleDTO
    -> OrganizationRoleDTO -> OrganizationRoleDTO)
-> (OrganizationRoleDTO
    -> OrganizationRoleDTO -> OrganizationRoleDTO)
-> Ord OrganizationRoleDTO
OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
OrganizationRoleDTO -> OrganizationRoleDTO -> Ordering
OrganizationRoleDTO -> OrganizationRoleDTO -> OrganizationRoleDTO
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 :: OrganizationRoleDTO -> OrganizationRoleDTO -> OrganizationRoleDTO
$cmin :: OrganizationRoleDTO -> OrganizationRoleDTO -> OrganizationRoleDTO
max :: OrganizationRoleDTO -> OrganizationRoleDTO -> OrganizationRoleDTO
$cmax :: OrganizationRoleDTO -> OrganizationRoleDTO -> OrganizationRoleDTO
>= :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
$c>= :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
> :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
$c> :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
<= :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
$c<= :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
< :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
$c< :: OrganizationRoleDTO -> OrganizationRoleDTO -> Bool
compare :: OrganizationRoleDTO -> OrganizationRoleDTO -> Ordering
$ccompare :: OrganizationRoleDTO -> OrganizationRoleDTO -> Ordering
$cp1Ord :: Eq OrganizationRoleDTO
P.Ord, OrganizationRoleDTO
OrganizationRoleDTO
-> OrganizationRoleDTO -> Bounded OrganizationRoleDTO
forall a. a -> a -> Bounded a
maxBound :: OrganizationRoleDTO
$cmaxBound :: OrganizationRoleDTO
minBound :: OrganizationRoleDTO
$cminBound :: OrganizationRoleDTO
P.Bounded, Int -> OrganizationRoleDTO
OrganizationRoleDTO -> Int
OrganizationRoleDTO -> [OrganizationRoleDTO]
OrganizationRoleDTO -> OrganizationRoleDTO
OrganizationRoleDTO -> OrganizationRoleDTO -> [OrganizationRoleDTO]
OrganizationRoleDTO
-> OrganizationRoleDTO
-> OrganizationRoleDTO
-> [OrganizationRoleDTO]
(OrganizationRoleDTO -> OrganizationRoleDTO)
-> (OrganizationRoleDTO -> OrganizationRoleDTO)
-> (Int -> OrganizationRoleDTO)
-> (OrganizationRoleDTO -> Int)
-> (OrganizationRoleDTO -> [OrganizationRoleDTO])
-> (OrganizationRoleDTO
    -> OrganizationRoleDTO -> [OrganizationRoleDTO])
-> (OrganizationRoleDTO
    -> OrganizationRoleDTO -> [OrganizationRoleDTO])
-> (OrganizationRoleDTO
    -> OrganizationRoleDTO
    -> OrganizationRoleDTO
    -> [OrganizationRoleDTO])
-> Enum OrganizationRoleDTO
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 :: OrganizationRoleDTO
-> OrganizationRoleDTO
-> OrganizationRoleDTO
-> [OrganizationRoleDTO]
$cenumFromThenTo :: OrganizationRoleDTO
-> OrganizationRoleDTO
-> OrganizationRoleDTO
-> [OrganizationRoleDTO]
enumFromTo :: OrganizationRoleDTO -> OrganizationRoleDTO -> [OrganizationRoleDTO]
$cenumFromTo :: OrganizationRoleDTO -> OrganizationRoleDTO -> [OrganizationRoleDTO]
enumFromThen :: OrganizationRoleDTO -> OrganizationRoleDTO -> [OrganizationRoleDTO]
$cenumFromThen :: OrganizationRoleDTO -> OrganizationRoleDTO -> [OrganizationRoleDTO]
enumFrom :: OrganizationRoleDTO -> [OrganizationRoleDTO]
$cenumFrom :: OrganizationRoleDTO -> [OrganizationRoleDTO]
fromEnum :: OrganizationRoleDTO -> Int
$cfromEnum :: OrganizationRoleDTO -> Int
toEnum :: Int -> OrganizationRoleDTO
$ctoEnum :: Int -> OrganizationRoleDTO
pred :: OrganizationRoleDTO -> OrganizationRoleDTO
$cpred :: OrganizationRoleDTO -> OrganizationRoleDTO
succ :: OrganizationRoleDTO -> OrganizationRoleDTO
$csucc :: OrganizationRoleDTO -> OrganizationRoleDTO
P.Enum)

instance A.ToJSON OrganizationRoleDTO where toJSON :: OrganizationRoleDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (OrganizationRoleDTO -> Text) -> OrganizationRoleDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrganizationRoleDTO -> Text
fromOrganizationRoleDTO
instance A.FromJSON OrganizationRoleDTO where parseJSON :: Value -> Parser OrganizationRoleDTO
parseJSON Value
o = (FilePath -> Parser OrganizationRoleDTO)
-> (OrganizationRoleDTO -> Parser OrganizationRoleDTO)
-> Either FilePath OrganizationRoleDTO
-> Parser OrganizationRoleDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser OrganizationRoleDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (OrganizationRoleDTO -> Parser OrganizationRoleDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrganizationRoleDTO -> Parser OrganizationRoleDTO)
-> (OrganizationRoleDTO -> OrganizationRoleDTO)
-> OrganizationRoleDTO
-> Parser OrganizationRoleDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrganizationRoleDTO -> OrganizationRoleDTO
forall a. a -> a
P.id) (Either FilePath OrganizationRoleDTO -> Parser OrganizationRoleDTO)
-> (Text -> Either FilePath OrganizationRoleDTO)
-> Text
-> Parser OrganizationRoleDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath OrganizationRoleDTO
toOrganizationRoleDTO (Text -> Parser OrganizationRoleDTO)
-> Parser Text -> Parser OrganizationRoleDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData OrganizationRoleDTO where toQueryParam :: OrganizationRoleDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (OrganizationRoleDTO -> Text) -> OrganizationRoleDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrganizationRoleDTO -> Text
fromOrganizationRoleDTO
instance WH.FromHttpApiData OrganizationRoleDTO where parseQueryParam :: Text -> Either Text OrganizationRoleDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text OrganizationRoleDTO)
-> Either Text OrganizationRoleDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath OrganizationRoleDTO
-> Either Text OrganizationRoleDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath OrganizationRoleDTO
 -> Either Text OrganizationRoleDTO)
-> (Text -> Either FilePath OrganizationRoleDTO)
-> Text
-> Either Text OrganizationRoleDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath OrganizationRoleDTO
toOrganizationRoleDTO
instance MimeRender MimeMultipartFormData OrganizationRoleDTO where mimeRender :: Proxy MimeMultipartFormData -> OrganizationRoleDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = OrganizationRoleDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'OrganizationRoleDTO' enum
fromOrganizationRoleDTO :: OrganizationRoleDTO -> Text
fromOrganizationRoleDTO :: OrganizationRoleDTO -> Text
fromOrganizationRoleDTO = \case
  OrganizationRoleDTO
OrganizationRoleDTO'Member -> Text
"member"
  OrganizationRoleDTO
OrganizationRoleDTO'Owner  -> Text
"owner"

-- | parse 'OrganizationRoleDTO' enum
toOrganizationRoleDTO :: Text -> P.Either String OrganizationRoleDTO
toOrganizationRoleDTO :: Text -> Either FilePath OrganizationRoleDTO
toOrganizationRoleDTO = \case
  Text
"member" -> OrganizationRoleDTO -> Either FilePath OrganizationRoleDTO
forall a b. b -> Either a b
P.Right OrganizationRoleDTO
OrganizationRoleDTO'Member
  Text
"owner" -> OrganizationRoleDTO -> Either FilePath OrganizationRoleDTO
forall a b. b -> Either a b
P.Right OrganizationRoleDTO
OrganizationRoleDTO'Owner
  Text
s -> FilePath -> Either FilePath OrganizationRoleDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath OrganizationRoleDTO)
-> FilePath -> Either FilePath OrganizationRoleDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toOrganizationRoleDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** OrganizationTypeDTO

-- | Enum of 'Text'
data OrganizationTypeDTO = OrganizationTypeDTO'Individual
    | OrganizationTypeDTO'Team
    deriving (Int -> OrganizationTypeDTO -> ShowS
[OrganizationTypeDTO] -> ShowS
OrganizationTypeDTO -> FilePath
(Int -> OrganizationTypeDTO -> ShowS)
-> (OrganizationTypeDTO -> FilePath)
-> ([OrganizationTypeDTO] -> ShowS)
-> Show OrganizationTypeDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationTypeDTO] -> ShowS
$cshowList :: [OrganizationTypeDTO] -> ShowS
show :: OrganizationTypeDTO -> FilePath
$cshow :: OrganizationTypeDTO -> FilePath
showsPrec :: Int -> OrganizationTypeDTO -> ShowS
$cshowsPrec :: Int -> OrganizationTypeDTO -> ShowS
P.Show, OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
(OrganizationTypeDTO -> OrganizationTypeDTO -> Bool)
-> (OrganizationTypeDTO -> OrganizationTypeDTO -> Bool)
-> Eq OrganizationTypeDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
$c/= :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
== :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
$c== :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
P.Eq, P.Typeable, Eq OrganizationTypeDTO
Eq OrganizationTypeDTO
-> (OrganizationTypeDTO -> OrganizationTypeDTO -> Ordering)
-> (OrganizationTypeDTO -> OrganizationTypeDTO -> Bool)
-> (OrganizationTypeDTO -> OrganizationTypeDTO -> Bool)
-> (OrganizationTypeDTO -> OrganizationTypeDTO -> Bool)
-> (OrganizationTypeDTO -> OrganizationTypeDTO -> Bool)
-> (OrganizationTypeDTO
    -> OrganizationTypeDTO -> OrganizationTypeDTO)
-> (OrganizationTypeDTO
    -> OrganizationTypeDTO -> OrganizationTypeDTO)
-> Ord OrganizationTypeDTO
OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
OrganizationTypeDTO -> OrganizationTypeDTO -> Ordering
OrganizationTypeDTO -> OrganizationTypeDTO -> OrganizationTypeDTO
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 :: OrganizationTypeDTO -> OrganizationTypeDTO -> OrganizationTypeDTO
$cmin :: OrganizationTypeDTO -> OrganizationTypeDTO -> OrganizationTypeDTO
max :: OrganizationTypeDTO -> OrganizationTypeDTO -> OrganizationTypeDTO
$cmax :: OrganizationTypeDTO -> OrganizationTypeDTO -> OrganizationTypeDTO
>= :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
$c>= :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
> :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
$c> :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
<= :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
$c<= :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
< :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
$c< :: OrganizationTypeDTO -> OrganizationTypeDTO -> Bool
compare :: OrganizationTypeDTO -> OrganizationTypeDTO -> Ordering
$ccompare :: OrganizationTypeDTO -> OrganizationTypeDTO -> Ordering
$cp1Ord :: Eq OrganizationTypeDTO
P.Ord, OrganizationTypeDTO
OrganizationTypeDTO
-> OrganizationTypeDTO -> Bounded OrganizationTypeDTO
forall a. a -> a -> Bounded a
maxBound :: OrganizationTypeDTO
$cmaxBound :: OrganizationTypeDTO
minBound :: OrganizationTypeDTO
$cminBound :: OrganizationTypeDTO
P.Bounded, Int -> OrganizationTypeDTO
OrganizationTypeDTO -> Int
OrganizationTypeDTO -> [OrganizationTypeDTO]
OrganizationTypeDTO -> OrganizationTypeDTO
OrganizationTypeDTO -> OrganizationTypeDTO -> [OrganizationTypeDTO]
OrganizationTypeDTO
-> OrganizationTypeDTO
-> OrganizationTypeDTO
-> [OrganizationTypeDTO]
(OrganizationTypeDTO -> OrganizationTypeDTO)
-> (OrganizationTypeDTO -> OrganizationTypeDTO)
-> (Int -> OrganizationTypeDTO)
-> (OrganizationTypeDTO -> Int)
-> (OrganizationTypeDTO -> [OrganizationTypeDTO])
-> (OrganizationTypeDTO
    -> OrganizationTypeDTO -> [OrganizationTypeDTO])
-> (OrganizationTypeDTO
    -> OrganizationTypeDTO -> [OrganizationTypeDTO])
-> (OrganizationTypeDTO
    -> OrganizationTypeDTO
    -> OrganizationTypeDTO
    -> [OrganizationTypeDTO])
-> Enum OrganizationTypeDTO
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 :: OrganizationTypeDTO
-> OrganizationTypeDTO
-> OrganizationTypeDTO
-> [OrganizationTypeDTO]
$cenumFromThenTo :: OrganizationTypeDTO
-> OrganizationTypeDTO
-> OrganizationTypeDTO
-> [OrganizationTypeDTO]
enumFromTo :: OrganizationTypeDTO -> OrganizationTypeDTO -> [OrganizationTypeDTO]
$cenumFromTo :: OrganizationTypeDTO -> OrganizationTypeDTO -> [OrganizationTypeDTO]
enumFromThen :: OrganizationTypeDTO -> OrganizationTypeDTO -> [OrganizationTypeDTO]
$cenumFromThen :: OrganizationTypeDTO -> OrganizationTypeDTO -> [OrganizationTypeDTO]
enumFrom :: OrganizationTypeDTO -> [OrganizationTypeDTO]
$cenumFrom :: OrganizationTypeDTO -> [OrganizationTypeDTO]
fromEnum :: OrganizationTypeDTO -> Int
$cfromEnum :: OrganizationTypeDTO -> Int
toEnum :: Int -> OrganizationTypeDTO
$ctoEnum :: Int -> OrganizationTypeDTO
pred :: OrganizationTypeDTO -> OrganizationTypeDTO
$cpred :: OrganizationTypeDTO -> OrganizationTypeDTO
succ :: OrganizationTypeDTO -> OrganizationTypeDTO
$csucc :: OrganizationTypeDTO -> OrganizationTypeDTO
P.Enum)

instance A.ToJSON OrganizationTypeDTO where toJSON :: OrganizationTypeDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (OrganizationTypeDTO -> Text) -> OrganizationTypeDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrganizationTypeDTO -> Text
fromOrganizationTypeDTO
instance A.FromJSON OrganizationTypeDTO where parseJSON :: Value -> Parser OrganizationTypeDTO
parseJSON Value
o = (FilePath -> Parser OrganizationTypeDTO)
-> (OrganizationTypeDTO -> Parser OrganizationTypeDTO)
-> Either FilePath OrganizationTypeDTO
-> Parser OrganizationTypeDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser OrganizationTypeDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (OrganizationTypeDTO -> Parser OrganizationTypeDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrganizationTypeDTO -> Parser OrganizationTypeDTO)
-> (OrganizationTypeDTO -> OrganizationTypeDTO)
-> OrganizationTypeDTO
-> Parser OrganizationTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrganizationTypeDTO -> OrganizationTypeDTO
forall a. a -> a
P.id) (Either FilePath OrganizationTypeDTO -> Parser OrganizationTypeDTO)
-> (Text -> Either FilePath OrganizationTypeDTO)
-> Text
-> Parser OrganizationTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath OrganizationTypeDTO
toOrganizationTypeDTO (Text -> Parser OrganizationTypeDTO)
-> Parser Text -> Parser OrganizationTypeDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData OrganizationTypeDTO where toQueryParam :: OrganizationTypeDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (OrganizationTypeDTO -> Text) -> OrganizationTypeDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrganizationTypeDTO -> Text
fromOrganizationTypeDTO
instance WH.FromHttpApiData OrganizationTypeDTO where parseQueryParam :: Text -> Either Text OrganizationTypeDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text OrganizationTypeDTO)
-> Either Text OrganizationTypeDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath OrganizationTypeDTO
-> Either Text OrganizationTypeDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath OrganizationTypeDTO
 -> Either Text OrganizationTypeDTO)
-> (Text -> Either FilePath OrganizationTypeDTO)
-> Text
-> Either Text OrganizationTypeDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath OrganizationTypeDTO
toOrganizationTypeDTO
instance MimeRender MimeMultipartFormData OrganizationTypeDTO where mimeRender :: Proxy MimeMultipartFormData -> OrganizationTypeDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = OrganizationTypeDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'OrganizationTypeDTO' enum
fromOrganizationTypeDTO :: OrganizationTypeDTO -> Text
fromOrganizationTypeDTO :: OrganizationTypeDTO -> Text
fromOrganizationTypeDTO = \case
  OrganizationTypeDTO
OrganizationTypeDTO'Individual -> Text
"individual"
  OrganizationTypeDTO
OrganizationTypeDTO'Team       -> Text
"team"

-- | parse 'OrganizationTypeDTO' enum
toOrganizationTypeDTO :: Text -> P.Either String OrganizationTypeDTO
toOrganizationTypeDTO :: Text -> Either FilePath OrganizationTypeDTO
toOrganizationTypeDTO = \case
  Text
"individual" -> OrganizationTypeDTO -> Either FilePath OrganizationTypeDTO
forall a b. b -> Either a b
P.Right OrganizationTypeDTO
OrganizationTypeDTO'Individual
  Text
"team" -> OrganizationTypeDTO -> Either FilePath OrganizationTypeDTO
forall a b. b -> Either a b
P.Right OrganizationTypeDTO
OrganizationTypeDTO'Team
  Text
s -> FilePath -> Either FilePath OrganizationTypeDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath OrganizationTypeDTO)
-> FilePath -> Either FilePath OrganizationTypeDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toOrganizationTypeDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** ParameterTypeEnum

-- | Enum of 'Text'
data ParameterTypeEnum = ParameterTypeEnum'Double
    | ParameterTypeEnum'String
    deriving (Int -> ParameterTypeEnum -> ShowS
[ParameterTypeEnum] -> ShowS
ParameterTypeEnum -> FilePath
(Int -> ParameterTypeEnum -> ShowS)
-> (ParameterTypeEnum -> FilePath)
-> ([ParameterTypeEnum] -> ShowS)
-> Show ParameterTypeEnum
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ParameterTypeEnum] -> ShowS
$cshowList :: [ParameterTypeEnum] -> ShowS
show :: ParameterTypeEnum -> FilePath
$cshow :: ParameterTypeEnum -> FilePath
showsPrec :: Int -> ParameterTypeEnum -> ShowS
$cshowsPrec :: Int -> ParameterTypeEnum -> ShowS
P.Show, ParameterTypeEnum -> ParameterTypeEnum -> Bool
(ParameterTypeEnum -> ParameterTypeEnum -> Bool)
-> (ParameterTypeEnum -> ParameterTypeEnum -> Bool)
-> Eq ParameterTypeEnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
$c/= :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
== :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
$c== :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
P.Eq, P.Typeable, Eq ParameterTypeEnum
Eq ParameterTypeEnum
-> (ParameterTypeEnum -> ParameterTypeEnum -> Ordering)
-> (ParameterTypeEnum -> ParameterTypeEnum -> Bool)
-> (ParameterTypeEnum -> ParameterTypeEnum -> Bool)
-> (ParameterTypeEnum -> ParameterTypeEnum -> Bool)
-> (ParameterTypeEnum -> ParameterTypeEnum -> Bool)
-> (ParameterTypeEnum -> ParameterTypeEnum -> ParameterTypeEnum)
-> (ParameterTypeEnum -> ParameterTypeEnum -> ParameterTypeEnum)
-> Ord ParameterTypeEnum
ParameterTypeEnum -> ParameterTypeEnum -> Bool
ParameterTypeEnum -> ParameterTypeEnum -> Ordering
ParameterTypeEnum -> ParameterTypeEnum -> ParameterTypeEnum
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 :: ParameterTypeEnum -> ParameterTypeEnum -> ParameterTypeEnum
$cmin :: ParameterTypeEnum -> ParameterTypeEnum -> ParameterTypeEnum
max :: ParameterTypeEnum -> ParameterTypeEnum -> ParameterTypeEnum
$cmax :: ParameterTypeEnum -> ParameterTypeEnum -> ParameterTypeEnum
>= :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
$c>= :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
> :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
$c> :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
<= :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
$c<= :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
< :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
$c< :: ParameterTypeEnum -> ParameterTypeEnum -> Bool
compare :: ParameterTypeEnum -> ParameterTypeEnum -> Ordering
$ccompare :: ParameterTypeEnum -> ParameterTypeEnum -> Ordering
$cp1Ord :: Eq ParameterTypeEnum
P.Ord, ParameterTypeEnum
ParameterTypeEnum -> ParameterTypeEnum -> Bounded ParameterTypeEnum
forall a. a -> a -> Bounded a
maxBound :: ParameterTypeEnum
$cmaxBound :: ParameterTypeEnum
minBound :: ParameterTypeEnum
$cminBound :: ParameterTypeEnum
P.Bounded, Int -> ParameterTypeEnum
ParameterTypeEnum -> Int
ParameterTypeEnum -> [ParameterTypeEnum]
ParameterTypeEnum -> ParameterTypeEnum
ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum]
ParameterTypeEnum
-> ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum]
(ParameterTypeEnum -> ParameterTypeEnum)
-> (ParameterTypeEnum -> ParameterTypeEnum)
-> (Int -> ParameterTypeEnum)
-> (ParameterTypeEnum -> Int)
-> (ParameterTypeEnum -> [ParameterTypeEnum])
-> (ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum])
-> (ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum])
-> (ParameterTypeEnum
    -> ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum])
-> Enum ParameterTypeEnum
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 :: ParameterTypeEnum
-> ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum]
$cenumFromThenTo :: ParameterTypeEnum
-> ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum]
enumFromTo :: ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum]
$cenumFromTo :: ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum]
enumFromThen :: ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum]
$cenumFromThen :: ParameterTypeEnum -> ParameterTypeEnum -> [ParameterTypeEnum]
enumFrom :: ParameterTypeEnum -> [ParameterTypeEnum]
$cenumFrom :: ParameterTypeEnum -> [ParameterTypeEnum]
fromEnum :: ParameterTypeEnum -> Int
$cfromEnum :: ParameterTypeEnum -> Int
toEnum :: Int -> ParameterTypeEnum
$ctoEnum :: Int -> ParameterTypeEnum
pred :: ParameterTypeEnum -> ParameterTypeEnum
$cpred :: ParameterTypeEnum -> ParameterTypeEnum
succ :: ParameterTypeEnum -> ParameterTypeEnum
$csucc :: ParameterTypeEnum -> ParameterTypeEnum
P.Enum)

instance A.ToJSON ParameterTypeEnum where toJSON :: ParameterTypeEnum -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (ParameterTypeEnum -> Text) -> ParameterTypeEnum -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterTypeEnum -> Text
fromParameterTypeEnum
instance A.FromJSON ParameterTypeEnum where parseJSON :: Value -> Parser ParameterTypeEnum
parseJSON Value
o = (FilePath -> Parser ParameterTypeEnum)
-> (ParameterTypeEnum -> Parser ParameterTypeEnum)
-> Either FilePath ParameterTypeEnum
-> Parser ParameterTypeEnum
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser ParameterTypeEnum
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (ParameterTypeEnum -> Parser ParameterTypeEnum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParameterTypeEnum -> Parser ParameterTypeEnum)
-> (ParameterTypeEnum -> ParameterTypeEnum)
-> ParameterTypeEnum
-> Parser ParameterTypeEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterTypeEnum -> ParameterTypeEnum
forall a. a -> a
P.id) (Either FilePath ParameterTypeEnum -> Parser ParameterTypeEnum)
-> (Text -> Either FilePath ParameterTypeEnum)
-> Text
-> Parser ParameterTypeEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ParameterTypeEnum
toParameterTypeEnum (Text -> Parser ParameterTypeEnum)
-> Parser Text -> Parser ParameterTypeEnum
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ParameterTypeEnum where toQueryParam :: ParameterTypeEnum -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (ParameterTypeEnum -> Text) -> ParameterTypeEnum -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterTypeEnum -> Text
fromParameterTypeEnum
instance WH.FromHttpApiData ParameterTypeEnum where parseQueryParam :: Text -> Either Text ParameterTypeEnum
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ParameterTypeEnum)
-> Either Text ParameterTypeEnum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath ParameterTypeEnum
-> Either Text ParameterTypeEnum
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath ParameterTypeEnum
 -> Either Text ParameterTypeEnum)
-> (Text -> Either FilePath ParameterTypeEnum)
-> Text
-> Either Text ParameterTypeEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ParameterTypeEnum
toParameterTypeEnum
instance MimeRender MimeMultipartFormData ParameterTypeEnum where mimeRender :: Proxy MimeMultipartFormData -> ParameterTypeEnum -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ParameterTypeEnum -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ParameterTypeEnum' enum
fromParameterTypeEnum :: ParameterTypeEnum -> Text
fromParameterTypeEnum :: ParameterTypeEnum -> Text
fromParameterTypeEnum = \case
  ParameterTypeEnum
ParameterTypeEnum'Double -> Text
"double"
  ParameterTypeEnum
ParameterTypeEnum'String -> Text
"string"

-- | parse 'ParameterTypeEnum' enum
toParameterTypeEnum :: Text -> P.Either String ParameterTypeEnum
toParameterTypeEnum :: Text -> Either FilePath ParameterTypeEnum
toParameterTypeEnum = \case
  Text
"double" -> ParameterTypeEnum -> Either FilePath ParameterTypeEnum
forall a b. b -> Either a b
P.Right ParameterTypeEnum
ParameterTypeEnum'Double
  Text
"string" -> ParameterTypeEnum -> Either FilePath ParameterTypeEnum
forall a b. b -> Either a b
P.Right ParameterTypeEnum
ParameterTypeEnum'String
  Text
s        -> FilePath -> Either FilePath ParameterTypeEnum
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath ParameterTypeEnum)
-> FilePath -> Either FilePath ParameterTypeEnum
forall a b. (a -> b) -> a -> b
$ FilePath
"toParameterTypeEnum: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** PricingPlanDTO

-- | Enum of 'Text'
data PricingPlanDTO = PricingPlanDTO'Free
    | PricingPlanDTO'Academia
    | PricingPlanDTO'Paid
    | PricingPlanDTO'Enterprise
    deriving (Int -> PricingPlanDTO -> ShowS
[PricingPlanDTO] -> ShowS
PricingPlanDTO -> FilePath
(Int -> PricingPlanDTO -> ShowS)
-> (PricingPlanDTO -> FilePath)
-> ([PricingPlanDTO] -> ShowS)
-> Show PricingPlanDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PricingPlanDTO] -> ShowS
$cshowList :: [PricingPlanDTO] -> ShowS
show :: PricingPlanDTO -> FilePath
$cshow :: PricingPlanDTO -> FilePath
showsPrec :: Int -> PricingPlanDTO -> ShowS
$cshowsPrec :: Int -> PricingPlanDTO -> ShowS
P.Show, PricingPlanDTO -> PricingPlanDTO -> Bool
(PricingPlanDTO -> PricingPlanDTO -> Bool)
-> (PricingPlanDTO -> PricingPlanDTO -> Bool) -> Eq PricingPlanDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PricingPlanDTO -> PricingPlanDTO -> Bool
$c/= :: PricingPlanDTO -> PricingPlanDTO -> Bool
== :: PricingPlanDTO -> PricingPlanDTO -> Bool
$c== :: PricingPlanDTO -> PricingPlanDTO -> Bool
P.Eq, P.Typeable, Eq PricingPlanDTO
Eq PricingPlanDTO
-> (PricingPlanDTO -> PricingPlanDTO -> Ordering)
-> (PricingPlanDTO -> PricingPlanDTO -> Bool)
-> (PricingPlanDTO -> PricingPlanDTO -> Bool)
-> (PricingPlanDTO -> PricingPlanDTO -> Bool)
-> (PricingPlanDTO -> PricingPlanDTO -> Bool)
-> (PricingPlanDTO -> PricingPlanDTO -> PricingPlanDTO)
-> (PricingPlanDTO -> PricingPlanDTO -> PricingPlanDTO)
-> Ord PricingPlanDTO
PricingPlanDTO -> PricingPlanDTO -> Bool
PricingPlanDTO -> PricingPlanDTO -> Ordering
PricingPlanDTO -> PricingPlanDTO -> PricingPlanDTO
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 :: PricingPlanDTO -> PricingPlanDTO -> PricingPlanDTO
$cmin :: PricingPlanDTO -> PricingPlanDTO -> PricingPlanDTO
max :: PricingPlanDTO -> PricingPlanDTO -> PricingPlanDTO
$cmax :: PricingPlanDTO -> PricingPlanDTO -> PricingPlanDTO
>= :: PricingPlanDTO -> PricingPlanDTO -> Bool
$c>= :: PricingPlanDTO -> PricingPlanDTO -> Bool
> :: PricingPlanDTO -> PricingPlanDTO -> Bool
$c> :: PricingPlanDTO -> PricingPlanDTO -> Bool
<= :: PricingPlanDTO -> PricingPlanDTO -> Bool
$c<= :: PricingPlanDTO -> PricingPlanDTO -> Bool
< :: PricingPlanDTO -> PricingPlanDTO -> Bool
$c< :: PricingPlanDTO -> PricingPlanDTO -> Bool
compare :: PricingPlanDTO -> PricingPlanDTO -> Ordering
$ccompare :: PricingPlanDTO -> PricingPlanDTO -> Ordering
$cp1Ord :: Eq PricingPlanDTO
P.Ord, PricingPlanDTO
PricingPlanDTO -> PricingPlanDTO -> Bounded PricingPlanDTO
forall a. a -> a -> Bounded a
maxBound :: PricingPlanDTO
$cmaxBound :: PricingPlanDTO
minBound :: PricingPlanDTO
$cminBound :: PricingPlanDTO
P.Bounded, Int -> PricingPlanDTO
PricingPlanDTO -> Int
PricingPlanDTO -> [PricingPlanDTO]
PricingPlanDTO -> PricingPlanDTO
PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO]
PricingPlanDTO
-> PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO]
(PricingPlanDTO -> PricingPlanDTO)
-> (PricingPlanDTO -> PricingPlanDTO)
-> (Int -> PricingPlanDTO)
-> (PricingPlanDTO -> Int)
-> (PricingPlanDTO -> [PricingPlanDTO])
-> (PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO])
-> (PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO])
-> (PricingPlanDTO
    -> PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO])
-> Enum PricingPlanDTO
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 :: PricingPlanDTO
-> PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO]
$cenumFromThenTo :: PricingPlanDTO
-> PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO]
enumFromTo :: PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO]
$cenumFromTo :: PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO]
enumFromThen :: PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO]
$cenumFromThen :: PricingPlanDTO -> PricingPlanDTO -> [PricingPlanDTO]
enumFrom :: PricingPlanDTO -> [PricingPlanDTO]
$cenumFrom :: PricingPlanDTO -> [PricingPlanDTO]
fromEnum :: PricingPlanDTO -> Int
$cfromEnum :: PricingPlanDTO -> Int
toEnum :: Int -> PricingPlanDTO
$ctoEnum :: Int -> PricingPlanDTO
pred :: PricingPlanDTO -> PricingPlanDTO
$cpred :: PricingPlanDTO -> PricingPlanDTO
succ :: PricingPlanDTO -> PricingPlanDTO
$csucc :: PricingPlanDTO -> PricingPlanDTO
P.Enum)

instance A.ToJSON PricingPlanDTO where toJSON :: PricingPlanDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (PricingPlanDTO -> Text) -> PricingPlanDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PricingPlanDTO -> Text
fromPricingPlanDTO
instance A.FromJSON PricingPlanDTO where parseJSON :: Value -> Parser PricingPlanDTO
parseJSON Value
o = (FilePath -> Parser PricingPlanDTO)
-> (PricingPlanDTO -> Parser PricingPlanDTO)
-> Either FilePath PricingPlanDTO
-> Parser PricingPlanDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser PricingPlanDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (PricingPlanDTO -> Parser PricingPlanDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PricingPlanDTO -> Parser PricingPlanDTO)
-> (PricingPlanDTO -> PricingPlanDTO)
-> PricingPlanDTO
-> Parser PricingPlanDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PricingPlanDTO -> PricingPlanDTO
forall a. a -> a
P.id) (Either FilePath PricingPlanDTO -> Parser PricingPlanDTO)
-> (Text -> Either FilePath PricingPlanDTO)
-> Text
-> Parser PricingPlanDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath PricingPlanDTO
toPricingPlanDTO (Text -> Parser PricingPlanDTO)
-> Parser Text -> Parser PricingPlanDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData PricingPlanDTO where toQueryParam :: PricingPlanDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (PricingPlanDTO -> Text) -> PricingPlanDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PricingPlanDTO -> Text
fromPricingPlanDTO
instance WH.FromHttpApiData PricingPlanDTO where parseQueryParam :: Text -> Either Text PricingPlanDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text PricingPlanDTO)
-> Either Text PricingPlanDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath PricingPlanDTO -> Either Text PricingPlanDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath PricingPlanDTO -> Either Text PricingPlanDTO)
-> (Text -> Either FilePath PricingPlanDTO)
-> Text
-> Either Text PricingPlanDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath PricingPlanDTO
toPricingPlanDTO
instance MimeRender MimeMultipartFormData PricingPlanDTO where mimeRender :: Proxy MimeMultipartFormData -> PricingPlanDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = PricingPlanDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'PricingPlanDTO' enum
fromPricingPlanDTO :: PricingPlanDTO -> Text
fromPricingPlanDTO :: PricingPlanDTO -> Text
fromPricingPlanDTO = \case
  PricingPlanDTO
PricingPlanDTO'Free       -> Text
"free"
  PricingPlanDTO
PricingPlanDTO'Academia   -> Text
"academia"
  PricingPlanDTO
PricingPlanDTO'Paid       -> Text
"paid"
  PricingPlanDTO
PricingPlanDTO'Enterprise -> Text
"enterprise"

-- | parse 'PricingPlanDTO' enum
toPricingPlanDTO :: Text -> P.Either String PricingPlanDTO
toPricingPlanDTO :: Text -> Either FilePath PricingPlanDTO
toPricingPlanDTO = \case
  Text
"free" -> PricingPlanDTO -> Either FilePath PricingPlanDTO
forall a b. b -> Either a b
P.Right PricingPlanDTO
PricingPlanDTO'Free
  Text
"academia" -> PricingPlanDTO -> Either FilePath PricingPlanDTO
forall a b. b -> Either a b
P.Right PricingPlanDTO
PricingPlanDTO'Academia
  Text
"paid" -> PricingPlanDTO -> Either FilePath PricingPlanDTO
forall a b. b -> Either a b
P.Right PricingPlanDTO
PricingPlanDTO'Paid
  Text
"enterprise" -> PricingPlanDTO -> Either FilePath PricingPlanDTO
forall a b. b -> Either a b
P.Right PricingPlanDTO
PricingPlanDTO'Enterprise
  Text
s -> FilePath -> Either FilePath PricingPlanDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath PricingPlanDTO)
-> FilePath -> Either FilePath PricingPlanDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toPricingPlanDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** ProjectCodeAccessDTO

-- | Enum of 'Text'
data ProjectCodeAccessDTO = ProjectCodeAccessDTO'Default
    | ProjectCodeAccessDTO'Restricted
    deriving (Int -> ProjectCodeAccessDTO -> ShowS
[ProjectCodeAccessDTO] -> ShowS
ProjectCodeAccessDTO -> FilePath
(Int -> ProjectCodeAccessDTO -> ShowS)
-> (ProjectCodeAccessDTO -> FilePath)
-> ([ProjectCodeAccessDTO] -> ShowS)
-> Show ProjectCodeAccessDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectCodeAccessDTO] -> ShowS
$cshowList :: [ProjectCodeAccessDTO] -> ShowS
show :: ProjectCodeAccessDTO -> FilePath
$cshow :: ProjectCodeAccessDTO -> FilePath
showsPrec :: Int -> ProjectCodeAccessDTO -> ShowS
$cshowsPrec :: Int -> ProjectCodeAccessDTO -> ShowS
P.Show, ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
(ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool)
-> (ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool)
-> Eq ProjectCodeAccessDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
$c/= :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
== :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
$c== :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
P.Eq, P.Typeable, Eq ProjectCodeAccessDTO
Eq ProjectCodeAccessDTO
-> (ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Ordering)
-> (ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool)
-> (ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool)
-> (ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool)
-> (ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool)
-> (ProjectCodeAccessDTO
    -> ProjectCodeAccessDTO -> ProjectCodeAccessDTO)
-> (ProjectCodeAccessDTO
    -> ProjectCodeAccessDTO -> ProjectCodeAccessDTO)
-> Ord ProjectCodeAccessDTO
ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Ordering
ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> ProjectCodeAccessDTO
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 :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> ProjectCodeAccessDTO
$cmin :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> ProjectCodeAccessDTO
max :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> ProjectCodeAccessDTO
$cmax :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> ProjectCodeAccessDTO
>= :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
$c>= :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
> :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
$c> :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
<= :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
$c<= :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
< :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
$c< :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Bool
compare :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Ordering
$ccompare :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO -> Ordering
$cp1Ord :: Eq ProjectCodeAccessDTO
P.Ord, ProjectCodeAccessDTO
ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> Bounded ProjectCodeAccessDTO
forall a. a -> a -> Bounded a
maxBound :: ProjectCodeAccessDTO
$cmaxBound :: ProjectCodeAccessDTO
minBound :: ProjectCodeAccessDTO
$cminBound :: ProjectCodeAccessDTO
P.Bounded, Int -> ProjectCodeAccessDTO
ProjectCodeAccessDTO -> Int
ProjectCodeAccessDTO -> [ProjectCodeAccessDTO]
ProjectCodeAccessDTO -> ProjectCodeAccessDTO
ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> [ProjectCodeAccessDTO]
ProjectCodeAccessDTO
-> ProjectCodeAccessDTO
-> ProjectCodeAccessDTO
-> [ProjectCodeAccessDTO]
(ProjectCodeAccessDTO -> ProjectCodeAccessDTO)
-> (ProjectCodeAccessDTO -> ProjectCodeAccessDTO)
-> (Int -> ProjectCodeAccessDTO)
-> (ProjectCodeAccessDTO -> Int)
-> (ProjectCodeAccessDTO -> [ProjectCodeAccessDTO])
-> (ProjectCodeAccessDTO
    -> ProjectCodeAccessDTO -> [ProjectCodeAccessDTO])
-> (ProjectCodeAccessDTO
    -> ProjectCodeAccessDTO -> [ProjectCodeAccessDTO])
-> (ProjectCodeAccessDTO
    -> ProjectCodeAccessDTO
    -> ProjectCodeAccessDTO
    -> [ProjectCodeAccessDTO])
-> Enum ProjectCodeAccessDTO
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 :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO
-> ProjectCodeAccessDTO
-> [ProjectCodeAccessDTO]
$cenumFromThenTo :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO
-> ProjectCodeAccessDTO
-> [ProjectCodeAccessDTO]
enumFromTo :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> [ProjectCodeAccessDTO]
$cenumFromTo :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> [ProjectCodeAccessDTO]
enumFromThen :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> [ProjectCodeAccessDTO]
$cenumFromThen :: ProjectCodeAccessDTO
-> ProjectCodeAccessDTO -> [ProjectCodeAccessDTO]
enumFrom :: ProjectCodeAccessDTO -> [ProjectCodeAccessDTO]
$cenumFrom :: ProjectCodeAccessDTO -> [ProjectCodeAccessDTO]
fromEnum :: ProjectCodeAccessDTO -> Int
$cfromEnum :: ProjectCodeAccessDTO -> Int
toEnum :: Int -> ProjectCodeAccessDTO
$ctoEnum :: Int -> ProjectCodeAccessDTO
pred :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO
$cpred :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO
succ :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO
$csucc :: ProjectCodeAccessDTO -> ProjectCodeAccessDTO
P.Enum)

instance A.ToJSON ProjectCodeAccessDTO where toJSON :: ProjectCodeAccessDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (ProjectCodeAccessDTO -> Text) -> ProjectCodeAccessDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectCodeAccessDTO -> Text
fromProjectCodeAccessDTO
instance A.FromJSON ProjectCodeAccessDTO where parseJSON :: Value -> Parser ProjectCodeAccessDTO
parseJSON Value
o = (FilePath -> Parser ProjectCodeAccessDTO)
-> (ProjectCodeAccessDTO -> Parser ProjectCodeAccessDTO)
-> Either FilePath ProjectCodeAccessDTO
-> Parser ProjectCodeAccessDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser ProjectCodeAccessDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (ProjectCodeAccessDTO -> Parser ProjectCodeAccessDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectCodeAccessDTO -> Parser ProjectCodeAccessDTO)
-> (ProjectCodeAccessDTO -> ProjectCodeAccessDTO)
-> ProjectCodeAccessDTO
-> Parser ProjectCodeAccessDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectCodeAccessDTO -> ProjectCodeAccessDTO
forall a. a -> a
P.id) (Either FilePath ProjectCodeAccessDTO
 -> Parser ProjectCodeAccessDTO)
-> (Text -> Either FilePath ProjectCodeAccessDTO)
-> Text
-> Parser ProjectCodeAccessDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ProjectCodeAccessDTO
toProjectCodeAccessDTO (Text -> Parser ProjectCodeAccessDTO)
-> Parser Text -> Parser ProjectCodeAccessDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ProjectCodeAccessDTO where toQueryParam :: ProjectCodeAccessDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (ProjectCodeAccessDTO -> Text) -> ProjectCodeAccessDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectCodeAccessDTO -> Text
fromProjectCodeAccessDTO
instance WH.FromHttpApiData ProjectCodeAccessDTO where parseQueryParam :: Text -> Either Text ProjectCodeAccessDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ProjectCodeAccessDTO)
-> Either Text ProjectCodeAccessDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath ProjectCodeAccessDTO
-> Either Text ProjectCodeAccessDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath ProjectCodeAccessDTO
 -> Either Text ProjectCodeAccessDTO)
-> (Text -> Either FilePath ProjectCodeAccessDTO)
-> Text
-> Either Text ProjectCodeAccessDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ProjectCodeAccessDTO
toProjectCodeAccessDTO
instance MimeRender MimeMultipartFormData ProjectCodeAccessDTO where mimeRender :: Proxy MimeMultipartFormData -> ProjectCodeAccessDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ProjectCodeAccessDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ProjectCodeAccessDTO' enum
fromProjectCodeAccessDTO :: ProjectCodeAccessDTO -> Text
fromProjectCodeAccessDTO :: ProjectCodeAccessDTO -> Text
fromProjectCodeAccessDTO = \case
  ProjectCodeAccessDTO
ProjectCodeAccessDTO'Default    -> Text
"default"
  ProjectCodeAccessDTO
ProjectCodeAccessDTO'Restricted -> Text
"restricted"

-- | parse 'ProjectCodeAccessDTO' enum
toProjectCodeAccessDTO :: Text -> P.Either String ProjectCodeAccessDTO
toProjectCodeAccessDTO :: Text -> Either FilePath ProjectCodeAccessDTO
toProjectCodeAccessDTO = \case
  Text
"default" -> ProjectCodeAccessDTO -> Either FilePath ProjectCodeAccessDTO
forall a b. b -> Either a b
P.Right ProjectCodeAccessDTO
ProjectCodeAccessDTO'Default
  Text
"restricted" -> ProjectCodeAccessDTO -> Either FilePath ProjectCodeAccessDTO
forall a b. b -> Either a b
P.Right ProjectCodeAccessDTO
ProjectCodeAccessDTO'Restricted
  Text
s -> FilePath -> Either FilePath ProjectCodeAccessDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath ProjectCodeAccessDTO)
-> FilePath -> Either FilePath ProjectCodeAccessDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toProjectCodeAccessDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** ProjectRoleDTO

-- | Enum of 'Text'
data ProjectRoleDTO = ProjectRoleDTO'Viewer
    | ProjectRoleDTO'Member
    | ProjectRoleDTO'Manager
    deriving (Int -> ProjectRoleDTO -> ShowS
[ProjectRoleDTO] -> ShowS
ProjectRoleDTO -> FilePath
(Int -> ProjectRoleDTO -> ShowS)
-> (ProjectRoleDTO -> FilePath)
-> ([ProjectRoleDTO] -> ShowS)
-> Show ProjectRoleDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectRoleDTO] -> ShowS
$cshowList :: [ProjectRoleDTO] -> ShowS
show :: ProjectRoleDTO -> FilePath
$cshow :: ProjectRoleDTO -> FilePath
showsPrec :: Int -> ProjectRoleDTO -> ShowS
$cshowsPrec :: Int -> ProjectRoleDTO -> ShowS
P.Show, ProjectRoleDTO -> ProjectRoleDTO -> Bool
(ProjectRoleDTO -> ProjectRoleDTO -> Bool)
-> (ProjectRoleDTO -> ProjectRoleDTO -> Bool) -> Eq ProjectRoleDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
$c/= :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
== :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
$c== :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
P.Eq, P.Typeable, Eq ProjectRoleDTO
Eq ProjectRoleDTO
-> (ProjectRoleDTO -> ProjectRoleDTO -> Ordering)
-> (ProjectRoleDTO -> ProjectRoleDTO -> Bool)
-> (ProjectRoleDTO -> ProjectRoleDTO -> Bool)
-> (ProjectRoleDTO -> ProjectRoleDTO -> Bool)
-> (ProjectRoleDTO -> ProjectRoleDTO -> Bool)
-> (ProjectRoleDTO -> ProjectRoleDTO -> ProjectRoleDTO)
-> (ProjectRoleDTO -> ProjectRoleDTO -> ProjectRoleDTO)
-> Ord ProjectRoleDTO
ProjectRoleDTO -> ProjectRoleDTO -> Bool
ProjectRoleDTO -> ProjectRoleDTO -> Ordering
ProjectRoleDTO -> ProjectRoleDTO -> ProjectRoleDTO
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 :: ProjectRoleDTO -> ProjectRoleDTO -> ProjectRoleDTO
$cmin :: ProjectRoleDTO -> ProjectRoleDTO -> ProjectRoleDTO
max :: ProjectRoleDTO -> ProjectRoleDTO -> ProjectRoleDTO
$cmax :: ProjectRoleDTO -> ProjectRoleDTO -> ProjectRoleDTO
>= :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
$c>= :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
> :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
$c> :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
<= :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
$c<= :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
< :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
$c< :: ProjectRoleDTO -> ProjectRoleDTO -> Bool
compare :: ProjectRoleDTO -> ProjectRoleDTO -> Ordering
$ccompare :: ProjectRoleDTO -> ProjectRoleDTO -> Ordering
$cp1Ord :: Eq ProjectRoleDTO
P.Ord, ProjectRoleDTO
ProjectRoleDTO -> ProjectRoleDTO -> Bounded ProjectRoleDTO
forall a. a -> a -> Bounded a
maxBound :: ProjectRoleDTO
$cmaxBound :: ProjectRoleDTO
minBound :: ProjectRoleDTO
$cminBound :: ProjectRoleDTO
P.Bounded, Int -> ProjectRoleDTO
ProjectRoleDTO -> Int
ProjectRoleDTO -> [ProjectRoleDTO]
ProjectRoleDTO -> ProjectRoleDTO
ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO]
ProjectRoleDTO
-> ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO]
(ProjectRoleDTO -> ProjectRoleDTO)
-> (ProjectRoleDTO -> ProjectRoleDTO)
-> (Int -> ProjectRoleDTO)
-> (ProjectRoleDTO -> Int)
-> (ProjectRoleDTO -> [ProjectRoleDTO])
-> (ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO])
-> (ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO])
-> (ProjectRoleDTO
    -> ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO])
-> Enum ProjectRoleDTO
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 :: ProjectRoleDTO
-> ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO]
$cenumFromThenTo :: ProjectRoleDTO
-> ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO]
enumFromTo :: ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO]
$cenumFromTo :: ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO]
enumFromThen :: ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO]
$cenumFromThen :: ProjectRoleDTO -> ProjectRoleDTO -> [ProjectRoleDTO]
enumFrom :: ProjectRoleDTO -> [ProjectRoleDTO]
$cenumFrom :: ProjectRoleDTO -> [ProjectRoleDTO]
fromEnum :: ProjectRoleDTO -> Int
$cfromEnum :: ProjectRoleDTO -> Int
toEnum :: Int -> ProjectRoleDTO
$ctoEnum :: Int -> ProjectRoleDTO
pred :: ProjectRoleDTO -> ProjectRoleDTO
$cpred :: ProjectRoleDTO -> ProjectRoleDTO
succ :: ProjectRoleDTO -> ProjectRoleDTO
$csucc :: ProjectRoleDTO -> ProjectRoleDTO
P.Enum)

instance A.ToJSON ProjectRoleDTO where toJSON :: ProjectRoleDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (ProjectRoleDTO -> Text) -> ProjectRoleDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectRoleDTO -> Text
fromProjectRoleDTO
instance A.FromJSON ProjectRoleDTO where parseJSON :: Value -> Parser ProjectRoleDTO
parseJSON Value
o = (FilePath -> Parser ProjectRoleDTO)
-> (ProjectRoleDTO -> Parser ProjectRoleDTO)
-> Either FilePath ProjectRoleDTO
-> Parser ProjectRoleDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser ProjectRoleDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (ProjectRoleDTO -> Parser ProjectRoleDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectRoleDTO -> Parser ProjectRoleDTO)
-> (ProjectRoleDTO -> ProjectRoleDTO)
-> ProjectRoleDTO
-> Parser ProjectRoleDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectRoleDTO -> ProjectRoleDTO
forall a. a -> a
P.id) (Either FilePath ProjectRoleDTO -> Parser ProjectRoleDTO)
-> (Text -> Either FilePath ProjectRoleDTO)
-> Text
-> Parser ProjectRoleDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ProjectRoleDTO
toProjectRoleDTO (Text -> Parser ProjectRoleDTO)
-> Parser Text -> Parser ProjectRoleDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ProjectRoleDTO where toQueryParam :: ProjectRoleDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (ProjectRoleDTO -> Text) -> ProjectRoleDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectRoleDTO -> Text
fromProjectRoleDTO
instance WH.FromHttpApiData ProjectRoleDTO where parseQueryParam :: Text -> Either Text ProjectRoleDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ProjectRoleDTO)
-> Either Text ProjectRoleDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath ProjectRoleDTO -> Either Text ProjectRoleDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath ProjectRoleDTO -> Either Text ProjectRoleDTO)
-> (Text -> Either FilePath ProjectRoleDTO)
-> Text
-> Either Text ProjectRoleDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ProjectRoleDTO
toProjectRoleDTO
instance MimeRender MimeMultipartFormData ProjectRoleDTO where mimeRender :: Proxy MimeMultipartFormData -> ProjectRoleDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ProjectRoleDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ProjectRoleDTO' enum
fromProjectRoleDTO :: ProjectRoleDTO -> Text
fromProjectRoleDTO :: ProjectRoleDTO -> Text
fromProjectRoleDTO = \case
  ProjectRoleDTO
ProjectRoleDTO'Viewer  -> Text
"viewer"
  ProjectRoleDTO
ProjectRoleDTO'Member  -> Text
"member"
  ProjectRoleDTO
ProjectRoleDTO'Manager -> Text
"manager"

-- | parse 'ProjectRoleDTO' enum
toProjectRoleDTO :: Text -> P.Either String ProjectRoleDTO
toProjectRoleDTO :: Text -> Either FilePath ProjectRoleDTO
toProjectRoleDTO = \case
  Text
"viewer"  -> ProjectRoleDTO -> Either FilePath ProjectRoleDTO
forall a b. b -> Either a b
P.Right ProjectRoleDTO
ProjectRoleDTO'Viewer
  Text
"member"  -> ProjectRoleDTO -> Either FilePath ProjectRoleDTO
forall a b. b -> Either a b
P.Right ProjectRoleDTO
ProjectRoleDTO'Member
  Text
"manager" -> ProjectRoleDTO -> Either FilePath ProjectRoleDTO
forall a b. b -> Either a b
P.Right ProjectRoleDTO
ProjectRoleDTO'Manager
  Text
s         -> FilePath -> Either FilePath ProjectRoleDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath ProjectRoleDTO)
-> FilePath -> Either FilePath ProjectRoleDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toProjectRoleDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** ProjectVisibilityDTO

-- | Enum of 'Text'
data ProjectVisibilityDTO = ProjectVisibilityDTO'Priv
    | ProjectVisibilityDTO'Pub
    deriving (Int -> ProjectVisibilityDTO -> ShowS
[ProjectVisibilityDTO] -> ShowS
ProjectVisibilityDTO -> FilePath
(Int -> ProjectVisibilityDTO -> ShowS)
-> (ProjectVisibilityDTO -> FilePath)
-> ([ProjectVisibilityDTO] -> ShowS)
-> Show ProjectVisibilityDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectVisibilityDTO] -> ShowS
$cshowList :: [ProjectVisibilityDTO] -> ShowS
show :: ProjectVisibilityDTO -> FilePath
$cshow :: ProjectVisibilityDTO -> FilePath
showsPrec :: Int -> ProjectVisibilityDTO -> ShowS
$cshowsPrec :: Int -> ProjectVisibilityDTO -> ShowS
P.Show, ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
(ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool)
-> (ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool)
-> Eq ProjectVisibilityDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
$c/= :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
== :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
$c== :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
P.Eq, P.Typeable, Eq ProjectVisibilityDTO
Eq ProjectVisibilityDTO
-> (ProjectVisibilityDTO -> ProjectVisibilityDTO -> Ordering)
-> (ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool)
-> (ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool)
-> (ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool)
-> (ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool)
-> (ProjectVisibilityDTO
    -> ProjectVisibilityDTO -> ProjectVisibilityDTO)
-> (ProjectVisibilityDTO
    -> ProjectVisibilityDTO -> ProjectVisibilityDTO)
-> Ord ProjectVisibilityDTO
ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
ProjectVisibilityDTO -> ProjectVisibilityDTO -> Ordering
ProjectVisibilityDTO
-> ProjectVisibilityDTO -> ProjectVisibilityDTO
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 :: ProjectVisibilityDTO
-> ProjectVisibilityDTO -> ProjectVisibilityDTO
$cmin :: ProjectVisibilityDTO
-> ProjectVisibilityDTO -> ProjectVisibilityDTO
max :: ProjectVisibilityDTO
-> ProjectVisibilityDTO -> ProjectVisibilityDTO
$cmax :: ProjectVisibilityDTO
-> ProjectVisibilityDTO -> ProjectVisibilityDTO
>= :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
$c>= :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
> :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
$c> :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
<= :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
$c<= :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
< :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
$c< :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Bool
compare :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Ordering
$ccompare :: ProjectVisibilityDTO -> ProjectVisibilityDTO -> Ordering
$cp1Ord :: Eq ProjectVisibilityDTO
P.Ord, ProjectVisibilityDTO
ProjectVisibilityDTO
-> ProjectVisibilityDTO -> Bounded ProjectVisibilityDTO
forall a. a -> a -> Bounded a
maxBound :: ProjectVisibilityDTO
$cmaxBound :: ProjectVisibilityDTO
minBound :: ProjectVisibilityDTO
$cminBound :: ProjectVisibilityDTO
P.Bounded, Int -> ProjectVisibilityDTO
ProjectVisibilityDTO -> Int
ProjectVisibilityDTO -> [ProjectVisibilityDTO]
ProjectVisibilityDTO -> ProjectVisibilityDTO
ProjectVisibilityDTO
-> ProjectVisibilityDTO -> [ProjectVisibilityDTO]
ProjectVisibilityDTO
-> ProjectVisibilityDTO
-> ProjectVisibilityDTO
-> [ProjectVisibilityDTO]
(ProjectVisibilityDTO -> ProjectVisibilityDTO)
-> (ProjectVisibilityDTO -> ProjectVisibilityDTO)
-> (Int -> ProjectVisibilityDTO)
-> (ProjectVisibilityDTO -> Int)
-> (ProjectVisibilityDTO -> [ProjectVisibilityDTO])
-> (ProjectVisibilityDTO
    -> ProjectVisibilityDTO -> [ProjectVisibilityDTO])
-> (ProjectVisibilityDTO
    -> ProjectVisibilityDTO -> [ProjectVisibilityDTO])
-> (ProjectVisibilityDTO
    -> ProjectVisibilityDTO
    -> ProjectVisibilityDTO
    -> [ProjectVisibilityDTO])
-> Enum ProjectVisibilityDTO
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 :: ProjectVisibilityDTO
-> ProjectVisibilityDTO
-> ProjectVisibilityDTO
-> [ProjectVisibilityDTO]
$cenumFromThenTo :: ProjectVisibilityDTO
-> ProjectVisibilityDTO
-> ProjectVisibilityDTO
-> [ProjectVisibilityDTO]
enumFromTo :: ProjectVisibilityDTO
-> ProjectVisibilityDTO -> [ProjectVisibilityDTO]
$cenumFromTo :: ProjectVisibilityDTO
-> ProjectVisibilityDTO -> [ProjectVisibilityDTO]
enumFromThen :: ProjectVisibilityDTO
-> ProjectVisibilityDTO -> [ProjectVisibilityDTO]
$cenumFromThen :: ProjectVisibilityDTO
-> ProjectVisibilityDTO -> [ProjectVisibilityDTO]
enumFrom :: ProjectVisibilityDTO -> [ProjectVisibilityDTO]
$cenumFrom :: ProjectVisibilityDTO -> [ProjectVisibilityDTO]
fromEnum :: ProjectVisibilityDTO -> Int
$cfromEnum :: ProjectVisibilityDTO -> Int
toEnum :: Int -> ProjectVisibilityDTO
$ctoEnum :: Int -> ProjectVisibilityDTO
pred :: ProjectVisibilityDTO -> ProjectVisibilityDTO
$cpred :: ProjectVisibilityDTO -> ProjectVisibilityDTO
succ :: ProjectVisibilityDTO -> ProjectVisibilityDTO
$csucc :: ProjectVisibilityDTO -> ProjectVisibilityDTO
P.Enum)

instance A.ToJSON ProjectVisibilityDTO where toJSON :: ProjectVisibilityDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (ProjectVisibilityDTO -> Text) -> ProjectVisibilityDTO -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectVisibilityDTO -> Text
fromProjectVisibilityDTO
instance A.FromJSON ProjectVisibilityDTO where parseJSON :: Value -> Parser ProjectVisibilityDTO
parseJSON Value
o = (FilePath -> Parser ProjectVisibilityDTO)
-> (ProjectVisibilityDTO -> Parser ProjectVisibilityDTO)
-> Either FilePath ProjectVisibilityDTO
-> Parser ProjectVisibilityDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser ProjectVisibilityDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (ProjectVisibilityDTO -> Parser ProjectVisibilityDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectVisibilityDTO -> Parser ProjectVisibilityDTO)
-> (ProjectVisibilityDTO -> ProjectVisibilityDTO)
-> ProjectVisibilityDTO
-> Parser ProjectVisibilityDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectVisibilityDTO -> ProjectVisibilityDTO
forall a. a -> a
P.id) (Either FilePath ProjectVisibilityDTO
 -> Parser ProjectVisibilityDTO)
-> (Text -> Either FilePath ProjectVisibilityDTO)
-> Text
-> Parser ProjectVisibilityDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ProjectVisibilityDTO
toProjectVisibilityDTO (Text -> Parser ProjectVisibilityDTO)
-> Parser Text -> Parser ProjectVisibilityDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData ProjectVisibilityDTO where toQueryParam :: ProjectVisibilityDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (ProjectVisibilityDTO -> Text) -> ProjectVisibilityDTO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectVisibilityDTO -> Text
fromProjectVisibilityDTO
instance WH.FromHttpApiData ProjectVisibilityDTO where parseQueryParam :: Text -> Either Text ProjectVisibilityDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text ProjectVisibilityDTO)
-> Either Text ProjectVisibilityDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath ProjectVisibilityDTO
-> Either Text ProjectVisibilityDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath ProjectVisibilityDTO
 -> Either Text ProjectVisibilityDTO)
-> (Text -> Either FilePath ProjectVisibilityDTO)
-> Text
-> Either Text ProjectVisibilityDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath ProjectVisibilityDTO
toProjectVisibilityDTO
instance MimeRender MimeMultipartFormData ProjectVisibilityDTO where mimeRender :: Proxy MimeMultipartFormData -> ProjectVisibilityDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ProjectVisibilityDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'ProjectVisibilityDTO' enum
fromProjectVisibilityDTO :: ProjectVisibilityDTO -> Text
fromProjectVisibilityDTO :: ProjectVisibilityDTO -> Text
fromProjectVisibilityDTO = \case
  ProjectVisibilityDTO
ProjectVisibilityDTO'Priv -> Text
"priv"
  ProjectVisibilityDTO
ProjectVisibilityDTO'Pub  -> Text
"pub"

-- | parse 'ProjectVisibilityDTO' enum
toProjectVisibilityDTO :: Text -> P.Either String ProjectVisibilityDTO
toProjectVisibilityDTO :: Text -> Either FilePath ProjectVisibilityDTO
toProjectVisibilityDTO = \case
  Text
"priv" -> ProjectVisibilityDTO -> Either FilePath ProjectVisibilityDTO
forall a b. b -> Either a b
P.Right ProjectVisibilityDTO
ProjectVisibilityDTO'Priv
  Text
"pub" -> ProjectVisibilityDTO -> Either FilePath ProjectVisibilityDTO
forall a b. b -> Either a b
P.Right ProjectVisibilityDTO
ProjectVisibilityDTO'Pub
  Text
s -> FilePath -> Either FilePath ProjectVisibilityDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath ProjectVisibilityDTO)
-> FilePath -> Either FilePath ProjectVisibilityDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toProjectVisibilityDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** SeriesType

-- | Enum of 'Text'
data SeriesType = SeriesType'Line
    | SeriesType'Dot
    deriving (Int -> SeriesType -> ShowS
[SeriesType] -> ShowS
SeriesType -> FilePath
(Int -> SeriesType -> ShowS)
-> (SeriesType -> FilePath)
-> ([SeriesType] -> ShowS)
-> Show SeriesType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SeriesType] -> ShowS
$cshowList :: [SeriesType] -> ShowS
show :: SeriesType -> FilePath
$cshow :: SeriesType -> FilePath
showsPrec :: Int -> SeriesType -> ShowS
$cshowsPrec :: Int -> SeriesType -> ShowS
P.Show, SeriesType -> SeriesType -> Bool
(SeriesType -> SeriesType -> Bool)
-> (SeriesType -> SeriesType -> Bool) -> Eq SeriesType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeriesType -> SeriesType -> Bool
$c/= :: SeriesType -> SeriesType -> Bool
== :: SeriesType -> SeriesType -> Bool
$c== :: SeriesType -> SeriesType -> Bool
P.Eq, P.Typeable, Eq SeriesType
Eq SeriesType
-> (SeriesType -> SeriesType -> Ordering)
-> (SeriesType -> SeriesType -> Bool)
-> (SeriesType -> SeriesType -> Bool)
-> (SeriesType -> SeriesType -> Bool)
-> (SeriesType -> SeriesType -> Bool)
-> (SeriesType -> SeriesType -> SeriesType)
-> (SeriesType -> SeriesType -> SeriesType)
-> Ord SeriesType
SeriesType -> SeriesType -> Bool
SeriesType -> SeriesType -> Ordering
SeriesType -> SeriesType -> SeriesType
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 :: SeriesType -> SeriesType -> SeriesType
$cmin :: SeriesType -> SeriesType -> SeriesType
max :: SeriesType -> SeriesType -> SeriesType
$cmax :: SeriesType -> SeriesType -> SeriesType
>= :: SeriesType -> SeriesType -> Bool
$c>= :: SeriesType -> SeriesType -> Bool
> :: SeriesType -> SeriesType -> Bool
$c> :: SeriesType -> SeriesType -> Bool
<= :: SeriesType -> SeriesType -> Bool
$c<= :: SeriesType -> SeriesType -> Bool
< :: SeriesType -> SeriesType -> Bool
$c< :: SeriesType -> SeriesType -> Bool
compare :: SeriesType -> SeriesType -> Ordering
$ccompare :: SeriesType -> SeriesType -> Ordering
$cp1Ord :: Eq SeriesType
P.Ord, SeriesType
SeriesType -> SeriesType -> Bounded SeriesType
forall a. a -> a -> Bounded a
maxBound :: SeriesType
$cmaxBound :: SeriesType
minBound :: SeriesType
$cminBound :: SeriesType
P.Bounded, Int -> SeriesType
SeriesType -> Int
SeriesType -> [SeriesType]
SeriesType -> SeriesType
SeriesType -> SeriesType -> [SeriesType]
SeriesType -> SeriesType -> SeriesType -> [SeriesType]
(SeriesType -> SeriesType)
-> (SeriesType -> SeriesType)
-> (Int -> SeriesType)
-> (SeriesType -> Int)
-> (SeriesType -> [SeriesType])
-> (SeriesType -> SeriesType -> [SeriesType])
-> (SeriesType -> SeriesType -> [SeriesType])
-> (SeriesType -> SeriesType -> SeriesType -> [SeriesType])
-> Enum SeriesType
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 :: SeriesType -> SeriesType -> SeriesType -> [SeriesType]
$cenumFromThenTo :: SeriesType -> SeriesType -> SeriesType -> [SeriesType]
enumFromTo :: SeriesType -> SeriesType -> [SeriesType]
$cenumFromTo :: SeriesType -> SeriesType -> [SeriesType]
enumFromThen :: SeriesType -> SeriesType -> [SeriesType]
$cenumFromThen :: SeriesType -> SeriesType -> [SeriesType]
enumFrom :: SeriesType -> [SeriesType]
$cenumFrom :: SeriesType -> [SeriesType]
fromEnum :: SeriesType -> Int
$cfromEnum :: SeriesType -> Int
toEnum :: Int -> SeriesType
$ctoEnum :: Int -> SeriesType
pred :: SeriesType -> SeriesType
$cpred :: SeriesType -> SeriesType
succ :: SeriesType -> SeriesType
$csucc :: SeriesType -> SeriesType
P.Enum)

instance A.ToJSON SeriesType where toJSON :: SeriesType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (SeriesType -> Text) -> SeriesType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeriesType -> Text
fromSeriesType
instance A.FromJSON SeriesType where parseJSON :: Value -> Parser SeriesType
parseJSON Value
o = (FilePath -> Parser SeriesType)
-> (SeriesType -> Parser SeriesType)
-> Either FilePath SeriesType
-> Parser SeriesType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser SeriesType
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (SeriesType -> Parser SeriesType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SeriesType -> Parser SeriesType)
-> (SeriesType -> SeriesType) -> SeriesType -> Parser SeriesType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeriesType -> SeriesType
forall a. a -> a
P.id) (Either FilePath SeriesType -> Parser SeriesType)
-> (Text -> Either FilePath SeriesType)
-> Text
-> Parser SeriesType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath SeriesType
toSeriesType (Text -> Parser SeriesType) -> Parser Text -> Parser SeriesType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData SeriesType where toQueryParam :: SeriesType -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (SeriesType -> Text) -> SeriesType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeriesType -> Text
fromSeriesType
instance WH.FromHttpApiData SeriesType where parseQueryParam :: Text -> Either Text SeriesType
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text SeriesType) -> Either Text SeriesType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath SeriesType -> Either Text SeriesType
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath SeriesType -> Either Text SeriesType)
-> (Text -> Either FilePath SeriesType)
-> Text
-> Either Text SeriesType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath SeriesType
toSeriesType
instance MimeRender MimeMultipartFormData SeriesType where mimeRender :: Proxy MimeMultipartFormData -> SeriesType -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = SeriesType -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'SeriesType' enum
fromSeriesType :: SeriesType -> Text
fromSeriesType :: SeriesType -> Text
fromSeriesType = \case
  SeriesType
SeriesType'Line -> Text
"line"
  SeriesType
SeriesType'Dot  -> Text
"dot"

-- | parse 'SeriesType' enum
toSeriesType :: Text -> P.Either String SeriesType
toSeriesType :: Text -> Either FilePath SeriesType
toSeriesType = \case
  Text
"line" -> SeriesType -> Either FilePath SeriesType
forall a b. b -> Either a b
P.Right SeriesType
SeriesType'Line
  Text
"dot"  -> SeriesType -> Either FilePath SeriesType
forall a b. b -> Either a b
P.Right SeriesType
SeriesType'Dot
  Text
s      -> FilePath -> Either FilePath SeriesType
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath SeriesType)
-> FilePath -> Either FilePath SeriesType
forall a b. (a -> b) -> a -> b
$ FilePath
"toSeriesType: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** SystemMetricResourceType

-- | Enum of 'Text'
data SystemMetricResourceType = SystemMetricResourceType'CPU
    | SystemMetricResourceType'RAM
    | SystemMetricResourceType'GPU
    | SystemMetricResourceType'GPU_RAM
    | SystemMetricResourceType'OTHER
    deriving (Int -> SystemMetricResourceType -> ShowS
[SystemMetricResourceType] -> ShowS
SystemMetricResourceType -> FilePath
(Int -> SystemMetricResourceType -> ShowS)
-> (SystemMetricResourceType -> FilePath)
-> ([SystemMetricResourceType] -> ShowS)
-> Show SystemMetricResourceType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SystemMetricResourceType] -> ShowS
$cshowList :: [SystemMetricResourceType] -> ShowS
show :: SystemMetricResourceType -> FilePath
$cshow :: SystemMetricResourceType -> FilePath
showsPrec :: Int -> SystemMetricResourceType -> ShowS
$cshowsPrec :: Int -> SystemMetricResourceType -> ShowS
P.Show, SystemMetricResourceType -> SystemMetricResourceType -> Bool
(SystemMetricResourceType -> SystemMetricResourceType -> Bool)
-> (SystemMetricResourceType -> SystemMetricResourceType -> Bool)
-> Eq SystemMetricResourceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
$c/= :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
== :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
$c== :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
P.Eq, P.Typeable, Eq SystemMetricResourceType
Eq SystemMetricResourceType
-> (SystemMetricResourceType
    -> SystemMetricResourceType -> Ordering)
-> (SystemMetricResourceType -> SystemMetricResourceType -> Bool)
-> (SystemMetricResourceType -> SystemMetricResourceType -> Bool)
-> (SystemMetricResourceType -> SystemMetricResourceType -> Bool)
-> (SystemMetricResourceType -> SystemMetricResourceType -> Bool)
-> (SystemMetricResourceType
    -> SystemMetricResourceType -> SystemMetricResourceType)
-> (SystemMetricResourceType
    -> SystemMetricResourceType -> SystemMetricResourceType)
-> Ord SystemMetricResourceType
SystemMetricResourceType -> SystemMetricResourceType -> Bool
SystemMetricResourceType -> SystemMetricResourceType -> Ordering
SystemMetricResourceType
-> SystemMetricResourceType -> SystemMetricResourceType
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 :: SystemMetricResourceType
-> SystemMetricResourceType -> SystemMetricResourceType
$cmin :: SystemMetricResourceType
-> SystemMetricResourceType -> SystemMetricResourceType
max :: SystemMetricResourceType
-> SystemMetricResourceType -> SystemMetricResourceType
$cmax :: SystemMetricResourceType
-> SystemMetricResourceType -> SystemMetricResourceType
>= :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
$c>= :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
> :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
$c> :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
<= :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
$c<= :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
< :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
$c< :: SystemMetricResourceType -> SystemMetricResourceType -> Bool
compare :: SystemMetricResourceType -> SystemMetricResourceType -> Ordering
$ccompare :: SystemMetricResourceType -> SystemMetricResourceType -> Ordering
$cp1Ord :: Eq SystemMetricResourceType
P.Ord, SystemMetricResourceType
SystemMetricResourceType
-> SystemMetricResourceType -> Bounded SystemMetricResourceType
forall a. a -> a -> Bounded a
maxBound :: SystemMetricResourceType
$cmaxBound :: SystemMetricResourceType
minBound :: SystemMetricResourceType
$cminBound :: SystemMetricResourceType
P.Bounded, Int -> SystemMetricResourceType
SystemMetricResourceType -> Int
SystemMetricResourceType -> [SystemMetricResourceType]
SystemMetricResourceType -> SystemMetricResourceType
SystemMetricResourceType
-> SystemMetricResourceType -> [SystemMetricResourceType]
SystemMetricResourceType
-> SystemMetricResourceType
-> SystemMetricResourceType
-> [SystemMetricResourceType]
(SystemMetricResourceType -> SystemMetricResourceType)
-> (SystemMetricResourceType -> SystemMetricResourceType)
-> (Int -> SystemMetricResourceType)
-> (SystemMetricResourceType -> Int)
-> (SystemMetricResourceType -> [SystemMetricResourceType])
-> (SystemMetricResourceType
    -> SystemMetricResourceType -> [SystemMetricResourceType])
-> (SystemMetricResourceType
    -> SystemMetricResourceType -> [SystemMetricResourceType])
-> (SystemMetricResourceType
    -> SystemMetricResourceType
    -> SystemMetricResourceType
    -> [SystemMetricResourceType])
-> Enum SystemMetricResourceType
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 :: SystemMetricResourceType
-> SystemMetricResourceType
-> SystemMetricResourceType
-> [SystemMetricResourceType]
$cenumFromThenTo :: SystemMetricResourceType
-> SystemMetricResourceType
-> SystemMetricResourceType
-> [SystemMetricResourceType]
enumFromTo :: SystemMetricResourceType
-> SystemMetricResourceType -> [SystemMetricResourceType]
$cenumFromTo :: SystemMetricResourceType
-> SystemMetricResourceType -> [SystemMetricResourceType]
enumFromThen :: SystemMetricResourceType
-> SystemMetricResourceType -> [SystemMetricResourceType]
$cenumFromThen :: SystemMetricResourceType
-> SystemMetricResourceType -> [SystemMetricResourceType]
enumFrom :: SystemMetricResourceType -> [SystemMetricResourceType]
$cenumFrom :: SystemMetricResourceType -> [SystemMetricResourceType]
fromEnum :: SystemMetricResourceType -> Int
$cfromEnum :: SystemMetricResourceType -> Int
toEnum :: Int -> SystemMetricResourceType
$ctoEnum :: Int -> SystemMetricResourceType
pred :: SystemMetricResourceType -> SystemMetricResourceType
$cpred :: SystemMetricResourceType -> SystemMetricResourceType
succ :: SystemMetricResourceType -> SystemMetricResourceType
$csucc :: SystemMetricResourceType -> SystemMetricResourceType
P.Enum)

instance A.ToJSON SystemMetricResourceType where toJSON :: SystemMetricResourceType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (SystemMetricResourceType -> Text)
-> SystemMetricResourceType
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemMetricResourceType -> Text
fromSystemMetricResourceType
instance A.FromJSON SystemMetricResourceType where parseJSON :: Value -> Parser SystemMetricResourceType
parseJSON Value
o = (FilePath -> Parser SystemMetricResourceType)
-> (SystemMetricResourceType -> Parser SystemMetricResourceType)
-> Either FilePath SystemMetricResourceType
-> Parser SystemMetricResourceType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser SystemMetricResourceType
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (SystemMetricResourceType -> Parser SystemMetricResourceType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SystemMetricResourceType -> Parser SystemMetricResourceType)
-> (SystemMetricResourceType -> SystemMetricResourceType)
-> SystemMetricResourceType
-> Parser SystemMetricResourceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemMetricResourceType -> SystemMetricResourceType
forall a. a -> a
P.id) (Either FilePath SystemMetricResourceType
 -> Parser SystemMetricResourceType)
-> (Text -> Either FilePath SystemMetricResourceType)
-> Text
-> Parser SystemMetricResourceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath SystemMetricResourceType
toSystemMetricResourceType (Text -> Parser SystemMetricResourceType)
-> Parser Text -> Parser SystemMetricResourceType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData SystemMetricResourceType where toQueryParam :: SystemMetricResourceType -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (SystemMetricResourceType -> Text)
-> SystemMetricResourceType
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemMetricResourceType -> Text
fromSystemMetricResourceType
instance WH.FromHttpApiData SystemMetricResourceType where parseQueryParam :: Text -> Either Text SystemMetricResourceType
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text SystemMetricResourceType)
-> Either Text SystemMetricResourceType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath SystemMetricResourceType
-> Either Text SystemMetricResourceType
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath SystemMetricResourceType
 -> Either Text SystemMetricResourceType)
-> (Text -> Either FilePath SystemMetricResourceType)
-> Text
-> Either Text SystemMetricResourceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath SystemMetricResourceType
toSystemMetricResourceType
instance MimeRender MimeMultipartFormData SystemMetricResourceType where mimeRender :: Proxy MimeMultipartFormData
-> SystemMetricResourceType -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = SystemMetricResourceType -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'SystemMetricResourceType' enum
fromSystemMetricResourceType :: SystemMetricResourceType -> Text
fromSystemMetricResourceType :: SystemMetricResourceType -> Text
fromSystemMetricResourceType = \case
  SystemMetricResourceType
SystemMetricResourceType'CPU     -> Text
"CPU"
  SystemMetricResourceType
SystemMetricResourceType'RAM     -> Text
"RAM"
  SystemMetricResourceType
SystemMetricResourceType'GPU     -> Text
"GPU"
  SystemMetricResourceType
SystemMetricResourceType'GPU_RAM -> Text
"GPU_RAM"
  SystemMetricResourceType
SystemMetricResourceType'OTHER   -> Text
"OTHER"

-- | parse 'SystemMetricResourceType' enum
toSystemMetricResourceType :: Text -> P.Either String SystemMetricResourceType
toSystemMetricResourceType :: Text -> Either FilePath SystemMetricResourceType
toSystemMetricResourceType = \case
  Text
"CPU" -> SystemMetricResourceType
-> Either FilePath SystemMetricResourceType
forall a b. b -> Either a b
P.Right SystemMetricResourceType
SystemMetricResourceType'CPU
  Text
"RAM" -> SystemMetricResourceType
-> Either FilePath SystemMetricResourceType
forall a b. b -> Either a b
P.Right SystemMetricResourceType
SystemMetricResourceType'RAM
  Text
"GPU" -> SystemMetricResourceType
-> Either FilePath SystemMetricResourceType
forall a b. b -> Either a b
P.Right SystemMetricResourceType
SystemMetricResourceType'GPU
  Text
"GPU_RAM" -> SystemMetricResourceType
-> Either FilePath SystemMetricResourceType
forall a b. b -> Either a b
P.Right SystemMetricResourceType
SystemMetricResourceType'GPU_RAM
  Text
"OTHER" -> SystemMetricResourceType
-> Either FilePath SystemMetricResourceType
forall a b. b -> Either a b
P.Right SystemMetricResourceType
SystemMetricResourceType'OTHER
  Text
s -> FilePath -> Either FilePath SystemMetricResourceType
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath SystemMetricResourceType)
-> FilePath -> Either FilePath SystemMetricResourceType
forall a b. (a -> b) -> a -> b
$ FilePath
"toSystemMetricResourceType: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- ** UsernameValidationStatusEnumDTO

-- | Enum of 'Text'
data UsernameValidationStatusEnumDTO = UsernameValidationStatusEnumDTO'Available
    | UsernameValidationStatusEnumDTO'Invalid
    | UsernameValidationStatusEnumDTO'Unavailable
    deriving (Int -> UsernameValidationStatusEnumDTO -> ShowS
[UsernameValidationStatusEnumDTO] -> ShowS
UsernameValidationStatusEnumDTO -> FilePath
(Int -> UsernameValidationStatusEnumDTO -> ShowS)
-> (UsernameValidationStatusEnumDTO -> FilePath)
-> ([UsernameValidationStatusEnumDTO] -> ShowS)
-> Show UsernameValidationStatusEnumDTO
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UsernameValidationStatusEnumDTO] -> ShowS
$cshowList :: [UsernameValidationStatusEnumDTO] -> ShowS
show :: UsernameValidationStatusEnumDTO -> FilePath
$cshow :: UsernameValidationStatusEnumDTO -> FilePath
showsPrec :: Int -> UsernameValidationStatusEnumDTO -> ShowS
$cshowsPrec :: Int -> UsernameValidationStatusEnumDTO -> ShowS
P.Show, UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
(UsernameValidationStatusEnumDTO
 -> UsernameValidationStatusEnumDTO -> Bool)
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO -> Bool)
-> Eq UsernameValidationStatusEnumDTO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
$c/= :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
== :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
$c== :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
P.Eq, P.Typeable, Eq UsernameValidationStatusEnumDTO
Eq UsernameValidationStatusEnumDTO
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO -> Ordering)
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO -> Bool)
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO -> Bool)
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO -> Bool)
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO -> Bool)
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO)
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO)
-> Ord UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Ordering
UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
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 :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
$cmin :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
max :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
$cmax :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
>= :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
$c>= :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
> :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
$c> :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
<= :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
$c<= :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
< :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
$c< :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Bool
compare :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Ordering
$ccompare :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO -> Ordering
$cp1Ord :: Eq UsernameValidationStatusEnumDTO
P.Ord, UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> Bounded UsernameValidationStatusEnumDTO
forall a. a -> a -> Bounded a
maxBound :: UsernameValidationStatusEnumDTO
$cmaxBound :: UsernameValidationStatusEnumDTO
minBound :: UsernameValidationStatusEnumDTO
$cminBound :: UsernameValidationStatusEnumDTO
P.Bounded, Int -> UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO -> Int
UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
UsernameValidationStatusEnumDTO -> UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
(UsernameValidationStatusEnumDTO
 -> UsernameValidationStatusEnumDTO)
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO)
-> (Int -> UsernameValidationStatusEnumDTO)
-> (UsernameValidationStatusEnumDTO -> Int)
-> (UsernameValidationStatusEnumDTO
    -> [UsernameValidationStatusEnumDTO])
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO
    -> [UsernameValidationStatusEnumDTO])
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO
    -> [UsernameValidationStatusEnumDTO])
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO
    -> [UsernameValidationStatusEnumDTO])
-> Enum UsernameValidationStatusEnumDTO
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 :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
$cenumFromThenTo :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
enumFromTo :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
$cenumFromTo :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
enumFromThen :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
$cenumFromThen :: UsernameValidationStatusEnumDTO
-> UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
enumFrom :: UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
$cenumFrom :: UsernameValidationStatusEnumDTO
-> [UsernameValidationStatusEnumDTO]
fromEnum :: UsernameValidationStatusEnumDTO -> Int
$cfromEnum :: UsernameValidationStatusEnumDTO -> Int
toEnum :: Int -> UsernameValidationStatusEnumDTO
$ctoEnum :: Int -> UsernameValidationStatusEnumDTO
pred :: UsernameValidationStatusEnumDTO -> UsernameValidationStatusEnumDTO
$cpred :: UsernameValidationStatusEnumDTO -> UsernameValidationStatusEnumDTO
succ :: UsernameValidationStatusEnumDTO -> UsernameValidationStatusEnumDTO
$csucc :: UsernameValidationStatusEnumDTO -> UsernameValidationStatusEnumDTO
P.Enum)

instance A.ToJSON UsernameValidationStatusEnumDTO where toJSON :: UsernameValidationStatusEnumDTO -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (UsernameValidationStatusEnumDTO -> Text)
-> UsernameValidationStatusEnumDTO
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UsernameValidationStatusEnumDTO -> Text
fromUsernameValidationStatusEnumDTO
instance A.FromJSON UsernameValidationStatusEnumDTO where parseJSON :: Value -> Parser UsernameValidationStatusEnumDTO
parseJSON Value
o = (FilePath -> Parser UsernameValidationStatusEnumDTO)
-> (UsernameValidationStatusEnumDTO
    -> Parser UsernameValidationStatusEnumDTO)
-> Either FilePath UsernameValidationStatusEnumDTO
-> Parser UsernameValidationStatusEnumDTO
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either FilePath -> Parser UsernameValidationStatusEnumDTO
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
P.fail (UsernameValidationStatusEnumDTO
-> Parser UsernameValidationStatusEnumDTO
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UsernameValidationStatusEnumDTO
 -> Parser UsernameValidationStatusEnumDTO)
-> (UsernameValidationStatusEnumDTO
    -> UsernameValidationStatusEnumDTO)
-> UsernameValidationStatusEnumDTO
-> Parser UsernameValidationStatusEnumDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UsernameValidationStatusEnumDTO -> UsernameValidationStatusEnumDTO
forall a. a -> a
P.id) (Either FilePath UsernameValidationStatusEnumDTO
 -> Parser UsernameValidationStatusEnumDTO)
-> (Text -> Either FilePath UsernameValidationStatusEnumDTO)
-> Text
-> Parser UsernameValidationStatusEnumDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath UsernameValidationStatusEnumDTO
toUsernameValidationStatusEnumDTO (Text -> Parser UsernameValidationStatusEnumDTO)
-> Parser Text -> Parser UsernameValidationStatusEnumDTO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData UsernameValidationStatusEnumDTO where toQueryParam :: UsernameValidationStatusEnumDTO -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (UsernameValidationStatusEnumDTO -> Text)
-> UsernameValidationStatusEnumDTO
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UsernameValidationStatusEnumDTO -> Text
fromUsernameValidationStatusEnumDTO
instance WH.FromHttpApiData UsernameValidationStatusEnumDTO where parseQueryParam :: Text -> Either Text UsernameValidationStatusEnumDTO
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text UsernameValidationStatusEnumDTO)
-> Either Text UsernameValidationStatusEnumDTO
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Text)
-> Either FilePath UsernameValidationStatusEnumDTO
-> Either Text UsernameValidationStatusEnumDTO
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left FilePath -> Text
T.pack (Either FilePath UsernameValidationStatusEnumDTO
 -> Either Text UsernameValidationStatusEnumDTO)
-> (Text -> Either FilePath UsernameValidationStatusEnumDTO)
-> Text
-> Either Text UsernameValidationStatusEnumDTO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath UsernameValidationStatusEnumDTO
toUsernameValidationStatusEnumDTO
instance MimeRender MimeMultipartFormData UsernameValidationStatusEnumDTO where mimeRender :: Proxy MimeMultipartFormData
-> UsernameValidationStatusEnumDTO -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = UsernameValidationStatusEnumDTO -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'UsernameValidationStatusEnumDTO' enum
fromUsernameValidationStatusEnumDTO :: UsernameValidationStatusEnumDTO -> Text
fromUsernameValidationStatusEnumDTO :: UsernameValidationStatusEnumDTO -> Text
fromUsernameValidationStatusEnumDTO = \case
  UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO'Available   -> Text
"available"
  UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO'Invalid     -> Text
"invalid"
  UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO'Unavailable -> Text
"unavailable"

-- | parse 'UsernameValidationStatusEnumDTO' enum
toUsernameValidationStatusEnumDTO :: Text -> P.Either String UsernameValidationStatusEnumDTO
toUsernameValidationStatusEnumDTO :: Text -> Either FilePath UsernameValidationStatusEnumDTO
toUsernameValidationStatusEnumDTO = \case
  Text
"available" -> UsernameValidationStatusEnumDTO
-> Either FilePath UsernameValidationStatusEnumDTO
forall a b. b -> Either a b
P.Right UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO'Available
  Text
"invalid" -> UsernameValidationStatusEnumDTO
-> Either FilePath UsernameValidationStatusEnumDTO
forall a b. b -> Either a b
P.Right UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO'Invalid
  Text
"unavailable" -> UsernameValidationStatusEnumDTO
-> Either FilePath UsernameValidationStatusEnumDTO
forall a b. b -> Either a b
P.Right UsernameValidationStatusEnumDTO
UsernameValidationStatusEnumDTO'Unavailable
  Text
s -> FilePath -> Either FilePath UsernameValidationStatusEnumDTO
forall a b. a -> Either a b
P.Left (FilePath -> Either FilePath UsernameValidationStatusEnumDTO)
-> FilePath -> Either FilePath UsernameValidationStatusEnumDTO
forall a b. (a -> b) -> a -> b
$ FilePath
"toUsernameValidationStatusEnumDTO: enum parse failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> FilePath
forall a. Show a => a -> FilePath
P.show Text
s


-- * Auth Methods

-- ** AuthOAuthOauth2
data AuthOAuthOauth2 = AuthOAuthOauth2 Text
    deriving (AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
(AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool)
-> (AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool)
-> Eq AuthOAuthOauth2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
$c/= :: AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
== :: AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
$c== :: AuthOAuthOauth2 -> AuthOAuthOauth2 -> Bool
P.Eq, Int -> AuthOAuthOauth2 -> ShowS
[AuthOAuthOauth2] -> ShowS
AuthOAuthOauth2 -> FilePath
(Int -> AuthOAuthOauth2 -> ShowS)
-> (AuthOAuthOauth2 -> FilePath)
-> ([AuthOAuthOauth2] -> ShowS)
-> Show AuthOAuthOauth2
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AuthOAuthOauth2] -> ShowS
$cshowList :: [AuthOAuthOauth2] -> ShowS
show :: AuthOAuthOauth2 -> FilePath
$cshow :: AuthOAuthOauth2 -> FilePath
showsPrec :: Int -> AuthOAuthOauth2 -> ShowS
$cshowsPrec :: Int -> AuthOAuthOauth2 -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthOAuthOauth2 where
  applyAuthMethod :: NeptuneBackendConfig
-> AuthOAuthOauth2
-> NeptuneBackendRequest req contentType res accept
-> IO (NeptuneBackendRequest req contentType res accept)
applyAuthMethod NeptuneBackendConfig
_ a :: AuthOAuthOauth2
a@(AuthOAuthOauth2 Text
secret) NeptuneBackendRequest req contentType res accept
req =
    NeptuneBackendRequest req contentType res accept
-> IO (NeptuneBackendRequest req contentType res accept)
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (NeptuneBackendRequest req contentType res accept
 -> IO (NeptuneBackendRequest req contentType res accept))
-> NeptuneBackendRequest req contentType res accept
-> IO (NeptuneBackendRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthOAuthOauth2 -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthOAuthOauth2
a TypeRep -> [TypeRep] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` NeptuneBackendRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
NeptuneBackendRequest req contentType res accept -> [TypeRep]
rAuthTypes NeptuneBackendRequest req contentType res accept
req)
      then NeptuneBackendRequest req contentType res accept
req NeptuneBackendRequest req contentType res accept
-> [Header] -> NeptuneBackendRequest req contentType res accept
forall req contentType res accept.
NeptuneBackendRequest req contentType res accept
-> [Header] -> NeptuneBackendRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", Text
"Bearer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
secret)
           NeptuneBackendRequest req contentType res accept
-> (NeptuneBackendRequest req contentType res accept
    -> NeptuneBackendRequest req contentType res accept)
-> NeptuneBackendRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (NeptuneBackendRequest req contentType res accept)
  (NeptuneBackendRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> NeptuneBackendRequest req contentType res accept
-> NeptuneBackendRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (NeptuneBackendRequest req contentType res accept)
  (NeptuneBackendRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept.
Lens_' (NeptuneBackendRequest req contentType res accept) [TypeRep]
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthOAuthOauth2 -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthOAuthOauth2
a))
      else NeptuneBackendRequest req contentType res accept
req