-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti
  ( TeamFeatureNoConfigMultiRequest (..),
    TeamFeatureNoConfigMultiResponse (..),
    TeamStatus (..),
  )
where

import Data.Aeson qualified as A
import Data.Id
import Data.OpenApi qualified as S
import Data.Schema
import Imports
import Wire.API.Team.Feature qualified as Public

newtype TeamFeatureNoConfigMultiRequest = TeamFeatureNoConfigMultiRequest
  { TeamFeatureNoConfigMultiRequest -> [TeamId]
teams :: [TeamId]
  }
  deriving (Int -> TeamFeatureNoConfigMultiRequest -> ShowS
[TeamFeatureNoConfigMultiRequest] -> ShowS
TeamFeatureNoConfigMultiRequest -> String
(Int -> TeamFeatureNoConfigMultiRequest -> ShowS)
-> (TeamFeatureNoConfigMultiRequest -> String)
-> ([TeamFeatureNoConfigMultiRequest] -> ShowS)
-> Show TeamFeatureNoConfigMultiRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TeamFeatureNoConfigMultiRequest -> ShowS
showsPrec :: Int -> TeamFeatureNoConfigMultiRequest -> ShowS
$cshow :: TeamFeatureNoConfigMultiRequest -> String
show :: TeamFeatureNoConfigMultiRequest -> String
$cshowList :: [TeamFeatureNoConfigMultiRequest] -> ShowS
showList :: [TeamFeatureNoConfigMultiRequest] -> ShowS
Show, TeamFeatureNoConfigMultiRequest
-> TeamFeatureNoConfigMultiRequest -> Bool
(TeamFeatureNoConfigMultiRequest
 -> TeamFeatureNoConfigMultiRequest -> Bool)
-> (TeamFeatureNoConfigMultiRequest
    -> TeamFeatureNoConfigMultiRequest -> Bool)
-> Eq TeamFeatureNoConfigMultiRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TeamFeatureNoConfigMultiRequest
-> TeamFeatureNoConfigMultiRequest -> Bool
== :: TeamFeatureNoConfigMultiRequest
-> TeamFeatureNoConfigMultiRequest -> Bool
$c/= :: TeamFeatureNoConfigMultiRequest
-> TeamFeatureNoConfigMultiRequest -> Bool
/= :: TeamFeatureNoConfigMultiRequest
-> TeamFeatureNoConfigMultiRequest -> Bool
Eq)
  deriving ([TeamFeatureNoConfigMultiRequest] -> Value
[TeamFeatureNoConfigMultiRequest] -> Encoding
TeamFeatureNoConfigMultiRequest -> Value
TeamFeatureNoConfigMultiRequest -> Encoding
(TeamFeatureNoConfigMultiRequest -> Value)
-> (TeamFeatureNoConfigMultiRequest -> Encoding)
-> ([TeamFeatureNoConfigMultiRequest] -> Value)
-> ([TeamFeatureNoConfigMultiRequest] -> Encoding)
-> ToJSON TeamFeatureNoConfigMultiRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TeamFeatureNoConfigMultiRequest -> Value
toJSON :: TeamFeatureNoConfigMultiRequest -> Value
$ctoEncoding :: TeamFeatureNoConfigMultiRequest -> Encoding
toEncoding :: TeamFeatureNoConfigMultiRequest -> Encoding
$ctoJSONList :: [TeamFeatureNoConfigMultiRequest] -> Value
toJSONList :: [TeamFeatureNoConfigMultiRequest] -> Value
$ctoEncodingList :: [TeamFeatureNoConfigMultiRequest] -> Encoding
toEncodingList :: [TeamFeatureNoConfigMultiRequest] -> Encoding
A.ToJSON, Value -> Parser [TeamFeatureNoConfigMultiRequest]
Value -> Parser TeamFeatureNoConfigMultiRequest
(Value -> Parser TeamFeatureNoConfigMultiRequest)
-> (Value -> Parser [TeamFeatureNoConfigMultiRequest])
-> FromJSON TeamFeatureNoConfigMultiRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TeamFeatureNoConfigMultiRequest
parseJSON :: Value -> Parser TeamFeatureNoConfigMultiRequest
$cparseJSONList :: Value -> Parser [TeamFeatureNoConfigMultiRequest]
parseJSONList :: Value -> Parser [TeamFeatureNoConfigMultiRequest]
A.FromJSON, Typeable TeamFeatureNoConfigMultiRequest
Typeable TeamFeatureNoConfigMultiRequest =>
(Proxy TeamFeatureNoConfigMultiRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema TeamFeatureNoConfigMultiRequest
Proxy TeamFeatureNoConfigMultiRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy TeamFeatureNoConfigMultiRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy TeamFeatureNoConfigMultiRequest
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema TeamFeatureNoConfigMultiRequest

instance ToSchema TeamFeatureNoConfigMultiRequest where
  schema :: ValueSchema NamedSwaggerDoc TeamFeatureNoConfigMultiRequest
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     TeamFeatureNoConfigMultiRequest
     TeamFeatureNoConfigMultiRequest
-> ValueSchema NamedSwaggerDoc TeamFeatureNoConfigMultiRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"TeamFeatureNoConfigMultiRequest" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   TeamFeatureNoConfigMultiRequest
   TeamFeatureNoConfigMultiRequest
 -> ValueSchema NamedSwaggerDoc TeamFeatureNoConfigMultiRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     TeamFeatureNoConfigMultiRequest
     TeamFeatureNoConfigMultiRequest
-> ValueSchema NamedSwaggerDoc TeamFeatureNoConfigMultiRequest
forall a b. (a -> b) -> a -> b
$
      [TeamId] -> TeamFeatureNoConfigMultiRequest
TeamFeatureNoConfigMultiRequest
        ([TeamId] -> TeamFeatureNoConfigMultiRequest)
-> SchemaP
     SwaggerDoc Object [Pair] TeamFeatureNoConfigMultiRequest [TeamId]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     TeamFeatureNoConfigMultiRequest
     TeamFeatureNoConfigMultiRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamFeatureNoConfigMultiRequest -> [TeamId]
teams (TeamFeatureNoConfigMultiRequest -> [TeamId])
-> SchemaP SwaggerDoc Object [Pair] [TeamId] [TeamId]
-> SchemaP
     SwaggerDoc Object [Pair] TeamFeatureNoConfigMultiRequest [TeamId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [TeamId] [TeamId]
-> SchemaP SwaggerDoc Object [Pair] [TeamId] [TeamId]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"teams" (ValueSchema NamedSwaggerDoc TeamId
-> SchemaP SwaggerDoc Value Value [TeamId] [TeamId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

newtype TeamFeatureNoConfigMultiResponse cfg = TeamFeatureNoConfigMultiResponse
  { forall {k} (cfg :: k).
TeamFeatureNoConfigMultiResponse cfg -> [TeamStatus cfg]
teamsStatuses :: [TeamStatus cfg]
  }
  deriving (Int -> TeamFeatureNoConfigMultiResponse cfg -> ShowS
[TeamFeatureNoConfigMultiResponse cfg] -> ShowS
TeamFeatureNoConfigMultiResponse cfg -> String
(Int -> TeamFeatureNoConfigMultiResponse cfg -> ShowS)
-> (TeamFeatureNoConfigMultiResponse cfg -> String)
-> ([TeamFeatureNoConfigMultiResponse cfg] -> ShowS)
-> Show (TeamFeatureNoConfigMultiResponse cfg)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (cfg :: k).
Int -> TeamFeatureNoConfigMultiResponse cfg -> ShowS
forall k (cfg :: k).
[TeamFeatureNoConfigMultiResponse cfg] -> ShowS
forall k (cfg :: k). TeamFeatureNoConfigMultiResponse cfg -> String
$cshowsPrec :: forall k (cfg :: k).
Int -> TeamFeatureNoConfigMultiResponse cfg -> ShowS
showsPrec :: Int -> TeamFeatureNoConfigMultiResponse cfg -> ShowS
$cshow :: forall k (cfg :: k). TeamFeatureNoConfigMultiResponse cfg -> String
show :: TeamFeatureNoConfigMultiResponse cfg -> String
$cshowList :: forall k (cfg :: k).
[TeamFeatureNoConfigMultiResponse cfg] -> ShowS
showList :: [TeamFeatureNoConfigMultiResponse cfg] -> ShowS
Show, TeamFeatureNoConfigMultiResponse cfg
-> TeamFeatureNoConfigMultiResponse cfg -> Bool
(TeamFeatureNoConfigMultiResponse cfg
 -> TeamFeatureNoConfigMultiResponse cfg -> Bool)
-> (TeamFeatureNoConfigMultiResponse cfg
    -> TeamFeatureNoConfigMultiResponse cfg -> Bool)
-> Eq (TeamFeatureNoConfigMultiResponse cfg)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (cfg :: k).
TeamFeatureNoConfigMultiResponse cfg
-> TeamFeatureNoConfigMultiResponse cfg -> Bool
$c== :: forall k (cfg :: k).
TeamFeatureNoConfigMultiResponse cfg
-> TeamFeatureNoConfigMultiResponse cfg -> Bool
== :: TeamFeatureNoConfigMultiResponse cfg
-> TeamFeatureNoConfigMultiResponse cfg -> Bool
$c/= :: forall k (cfg :: k).
TeamFeatureNoConfigMultiResponse cfg
-> TeamFeatureNoConfigMultiResponse cfg -> Bool
/= :: TeamFeatureNoConfigMultiResponse cfg
-> TeamFeatureNoConfigMultiResponse cfg -> Bool
Eq)
  deriving ([TeamFeatureNoConfigMultiResponse cfg] -> Value
[TeamFeatureNoConfigMultiResponse cfg] -> Encoding
TeamFeatureNoConfigMultiResponse cfg -> Value
TeamFeatureNoConfigMultiResponse cfg -> Encoding
(TeamFeatureNoConfigMultiResponse cfg -> Value)
-> (TeamFeatureNoConfigMultiResponse cfg -> Encoding)
-> ([TeamFeatureNoConfigMultiResponse cfg] -> Value)
-> ([TeamFeatureNoConfigMultiResponse cfg] -> Encoding)
-> ToJSON (TeamFeatureNoConfigMultiResponse cfg)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall k (cfg :: k).
[TeamFeatureNoConfigMultiResponse cfg] -> Value
forall k (cfg :: k).
[TeamFeatureNoConfigMultiResponse cfg] -> Encoding
forall k (cfg :: k). TeamFeatureNoConfigMultiResponse cfg -> Value
forall k (cfg :: k).
TeamFeatureNoConfigMultiResponse cfg -> Encoding
$ctoJSON :: forall k (cfg :: k). TeamFeatureNoConfigMultiResponse cfg -> Value
toJSON :: TeamFeatureNoConfigMultiResponse cfg -> Value
$ctoEncoding :: forall k (cfg :: k).
TeamFeatureNoConfigMultiResponse cfg -> Encoding
toEncoding :: TeamFeatureNoConfigMultiResponse cfg -> Encoding
$ctoJSONList :: forall k (cfg :: k).
[TeamFeatureNoConfigMultiResponse cfg] -> Value
toJSONList :: [TeamFeatureNoConfigMultiResponse cfg] -> Value
$ctoEncodingList :: forall k (cfg :: k).
[TeamFeatureNoConfigMultiResponse cfg] -> Encoding
toEncodingList :: [TeamFeatureNoConfigMultiResponse cfg] -> Encoding
A.ToJSON, Value -> Parser [TeamFeatureNoConfigMultiResponse cfg]
Value -> Parser (TeamFeatureNoConfigMultiResponse cfg)
(Value -> Parser (TeamFeatureNoConfigMultiResponse cfg))
-> (Value -> Parser [TeamFeatureNoConfigMultiResponse cfg])
-> FromJSON (TeamFeatureNoConfigMultiResponse cfg)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall k (cfg :: k).
Value -> Parser [TeamFeatureNoConfigMultiResponse cfg]
forall k (cfg :: k).
Value -> Parser (TeamFeatureNoConfigMultiResponse cfg)
$cparseJSON :: forall k (cfg :: k).
Value -> Parser (TeamFeatureNoConfigMultiResponse cfg)
parseJSON :: Value -> Parser (TeamFeatureNoConfigMultiResponse cfg)
$cparseJSONList :: forall k (cfg :: k).
Value -> Parser [TeamFeatureNoConfigMultiResponse cfg]
parseJSONList :: Value -> Parser [TeamFeatureNoConfigMultiResponse cfg]
A.FromJSON, Typeable (TeamFeatureNoConfigMultiResponse cfg)
Typeable (TeamFeatureNoConfigMultiResponse cfg) =>
(Proxy (TeamFeatureNoConfigMultiResponse cfg)
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (TeamFeatureNoConfigMultiResponse cfg)
Proxy (TeamFeatureNoConfigMultiResponse cfg)
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
forall k (cfg :: k).
(Typeable cfg, Typeable k) =>
Typeable (TeamFeatureNoConfigMultiResponse cfg)
forall k (cfg :: k).
(Typeable cfg, Typeable k) =>
Proxy (TeamFeatureNoConfigMultiResponse cfg)
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: forall k (cfg :: k).
(Typeable cfg, Typeable k) =>
Proxy (TeamFeatureNoConfigMultiResponse cfg)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (TeamFeatureNoConfigMultiResponse cfg)
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema (TeamFeatureNoConfigMultiResponse cfg)

instance ToSchema (TeamFeatureNoConfigMultiResponse cfg) where
  schema :: ValueSchema NamedSwaggerDoc (TeamFeatureNoConfigMultiResponse cfg)
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (TeamFeatureNoConfigMultiResponse cfg)
     (TeamFeatureNoConfigMultiResponse cfg)
-> ValueSchema
     NamedSwaggerDoc (TeamFeatureNoConfigMultiResponse cfg)
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"TeamFeatureNoConfigMultiResponse" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   (TeamFeatureNoConfigMultiResponse cfg)
   (TeamFeatureNoConfigMultiResponse cfg)
 -> ValueSchema
      NamedSwaggerDoc (TeamFeatureNoConfigMultiResponse cfg))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (TeamFeatureNoConfigMultiResponse cfg)
     (TeamFeatureNoConfigMultiResponse cfg)
-> ValueSchema
     NamedSwaggerDoc (TeamFeatureNoConfigMultiResponse cfg)
forall a b. (a -> b) -> a -> b
$
      [TeamStatus cfg] -> TeamFeatureNoConfigMultiResponse cfg
forall {k} (cfg :: k).
[TeamStatus cfg] -> TeamFeatureNoConfigMultiResponse cfg
TeamFeatureNoConfigMultiResponse
        ([TeamStatus cfg] -> TeamFeatureNoConfigMultiResponse cfg)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (TeamFeatureNoConfigMultiResponse cfg)
     [TeamStatus cfg]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (TeamFeatureNoConfigMultiResponse cfg)
     (TeamFeatureNoConfigMultiResponse cfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamFeatureNoConfigMultiResponse cfg -> [TeamStatus cfg]
forall {k} (cfg :: k).
TeamFeatureNoConfigMultiResponse cfg -> [TeamStatus cfg]
teamsStatuses (TeamFeatureNoConfigMultiResponse cfg -> [TeamStatus cfg])
-> SchemaP
     SwaggerDoc Object [Pair] [TeamStatus cfg] [TeamStatus cfg]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (TeamFeatureNoConfigMultiResponse cfg)
     [TeamStatus cfg]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [TeamStatus cfg] [TeamStatus cfg]
-> SchemaP
     SwaggerDoc Object [Pair] [TeamStatus cfg] [TeamStatus cfg]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"default_status" (ValueSchema NamedSwaggerDoc (TeamStatus cfg)
-> SchemaP SwaggerDoc Value Value [TeamStatus cfg] [TeamStatus cfg]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc (TeamStatus cfg)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

data TeamStatus cfg = TeamStatus
  { forall {k} (cfg :: k). TeamStatus cfg -> TeamId
team :: TeamId,
    forall {k} (cfg :: k). TeamStatus cfg -> FeatureStatus
status :: Public.FeatureStatus
  }
  deriving (Int -> TeamStatus cfg -> ShowS
[TeamStatus cfg] -> ShowS
TeamStatus cfg -> String
(Int -> TeamStatus cfg -> ShowS)
-> (TeamStatus cfg -> String)
-> ([TeamStatus cfg] -> ShowS)
-> Show (TeamStatus cfg)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (cfg :: k). Int -> TeamStatus cfg -> ShowS
forall k (cfg :: k). [TeamStatus cfg] -> ShowS
forall k (cfg :: k). TeamStatus cfg -> String
$cshowsPrec :: forall k (cfg :: k). Int -> TeamStatus cfg -> ShowS
showsPrec :: Int -> TeamStatus cfg -> ShowS
$cshow :: forall k (cfg :: k). TeamStatus cfg -> String
show :: TeamStatus cfg -> String
$cshowList :: forall k (cfg :: k). [TeamStatus cfg] -> ShowS
showList :: [TeamStatus cfg] -> ShowS
Show, TeamStatus cfg -> TeamStatus cfg -> Bool
(TeamStatus cfg -> TeamStatus cfg -> Bool)
-> (TeamStatus cfg -> TeamStatus cfg -> Bool)
-> Eq (TeamStatus cfg)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (cfg :: k). TeamStatus cfg -> TeamStatus cfg -> Bool
$c== :: forall k (cfg :: k). TeamStatus cfg -> TeamStatus cfg -> Bool
== :: TeamStatus cfg -> TeamStatus cfg -> Bool
$c/= :: forall k (cfg :: k). TeamStatus cfg -> TeamStatus cfg -> Bool
/= :: TeamStatus cfg -> TeamStatus cfg -> Bool
Eq)
  deriving ([TeamStatus cfg] -> Value
[TeamStatus cfg] -> Encoding
TeamStatus cfg -> Value
TeamStatus cfg -> Encoding
(TeamStatus cfg -> Value)
-> (TeamStatus cfg -> Encoding)
-> ([TeamStatus cfg] -> Value)
-> ([TeamStatus cfg] -> Encoding)
-> ToJSON (TeamStatus cfg)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall k (cfg :: k). [TeamStatus cfg] -> Value
forall k (cfg :: k). [TeamStatus cfg] -> Encoding
forall k (cfg :: k). TeamStatus cfg -> Value
forall k (cfg :: k). TeamStatus cfg -> Encoding
$ctoJSON :: forall k (cfg :: k). TeamStatus cfg -> Value
toJSON :: TeamStatus cfg -> Value
$ctoEncoding :: forall k (cfg :: k). TeamStatus cfg -> Encoding
toEncoding :: TeamStatus cfg -> Encoding
$ctoJSONList :: forall k (cfg :: k). [TeamStatus cfg] -> Value
toJSONList :: [TeamStatus cfg] -> Value
$ctoEncodingList :: forall k (cfg :: k). [TeamStatus cfg] -> Encoding
toEncodingList :: [TeamStatus cfg] -> Encoding
A.ToJSON, Value -> Parser [TeamStatus cfg]
Value -> Parser (TeamStatus cfg)
(Value -> Parser (TeamStatus cfg))
-> (Value -> Parser [TeamStatus cfg]) -> FromJSON (TeamStatus cfg)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall k (cfg :: k). Value -> Parser [TeamStatus cfg]
forall k (cfg :: k). Value -> Parser (TeamStatus cfg)
$cparseJSON :: forall k (cfg :: k). Value -> Parser (TeamStatus cfg)
parseJSON :: Value -> Parser (TeamStatus cfg)
$cparseJSONList :: forall k (cfg :: k). Value -> Parser [TeamStatus cfg]
parseJSONList :: Value -> Parser [TeamStatus cfg]
A.FromJSON, Typeable (TeamStatus cfg)
Typeable (TeamStatus cfg) =>
(Proxy (TeamStatus cfg)
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (TeamStatus cfg)
Proxy (TeamStatus cfg) -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
forall k (cfg :: k).
(Typeable cfg, Typeable k) =>
Typeable (TeamStatus cfg)
forall k (cfg :: k).
(Typeable cfg, Typeable k) =>
Proxy (TeamStatus cfg) -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: forall k (cfg :: k).
(Typeable cfg, Typeable k) =>
Proxy (TeamStatus cfg) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (TeamStatus cfg) -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema (TeamStatus cfg)

instance ToSchema (TeamStatus cfg) where
  schema :: ValueSchema NamedSwaggerDoc (TeamStatus cfg)
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] (TeamStatus cfg) (TeamStatus cfg)
-> ValueSchema NamedSwaggerDoc (TeamStatus cfg)
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"TeamStatus" (SchemaP SwaggerDoc Object [Pair] (TeamStatus cfg) (TeamStatus cfg)
 -> ValueSchema NamedSwaggerDoc (TeamStatus cfg))
-> SchemaP
     SwaggerDoc Object [Pair] (TeamStatus cfg) (TeamStatus cfg)
-> ValueSchema NamedSwaggerDoc (TeamStatus cfg)
forall a b. (a -> b) -> a -> b
$
      TeamId -> FeatureStatus -> TeamStatus cfg
forall {k} (cfg :: k). TeamId -> FeatureStatus -> TeamStatus cfg
TeamStatus
        (TeamId -> FeatureStatus -> TeamStatus cfg)
-> SchemaP SwaggerDoc Object [Pair] (TeamStatus cfg) TeamId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (TeamStatus cfg)
     (FeatureStatus -> TeamStatus cfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamStatus cfg -> TeamId
forall {k} (cfg :: k). TeamStatus cfg -> TeamId
team (TeamStatus cfg -> TeamId)
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] (TeamStatus cfg) TeamId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc TeamId
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"team" ValueSchema NamedSwaggerDoc TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (TeamStatus cfg)
  (FeatureStatus -> TeamStatus cfg)
-> SchemaP SwaggerDoc Object [Pair] (TeamStatus cfg) FeatureStatus
-> SchemaP
     SwaggerDoc Object [Pair] (TeamStatus cfg) (TeamStatus cfg)
forall a b.
SchemaP SwaggerDoc Object [Pair] (TeamStatus cfg) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (TeamStatus cfg) a
-> SchemaP SwaggerDoc Object [Pair] (TeamStatus cfg) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TeamStatus cfg -> FeatureStatus
forall {k} (cfg :: k). TeamStatus cfg -> FeatureStatus
status (TeamStatus cfg -> FeatureStatus)
-> SchemaP SwaggerDoc Object [Pair] FeatureStatus FeatureStatus
-> SchemaP SwaggerDoc Object [Pair] (TeamStatus cfg) FeatureStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus
-> SchemaP SwaggerDoc Object [Pair] FeatureStatus FeatureStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"status" SchemaP NamedSwaggerDoc Value Value FeatureStatus FeatureStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema