{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Interaction.Model.Genre
  ( GenreError (..),
    ifAllValid,
    Genre (..),
    GenreArtwork (..),
    GenreComment (..),
    GenreOpinion (..),
    GetGenresQueryResponse (..),
    InsertGenresCommandResponse (..),
    InsertGenresRequest (..),
    InsertGenresRequestItem (..),
    InsertGenreCommentsCommandResponse (..),
    InsertGenreCommentsRequest (..),
    InsertGenreCommentsRequestItem (..),
    UpsertGenreOpinionsCommandResponse (..),
    UpsertGenreOpinionsRequest (..),
    UpsertGenreOpinionsRequestItem (..),
    InsertGenreArtworksCommandResponse (..),
    InsertGenreArtworksRequest (..),
    InsertGenreArtworksRequestItem (..),
    GenreArtworkOrderUpdateRequest (..),
    GenreDeltaRequest (..),
  )
where

import Data.Aeson hiding (Success)
import Data.OpenApi
import Data.UUID hiding (null)
import Keuringsdienst
import Keuringsdienst.Helpers
import Optics
import Relude
import WikiMusic.Model.Genre

instance ToSchema (Validation [Text])

data GetGenresQueryResponse = GetGenresQueryResponse
  { GetGenresQueryResponse -> Map UUID Genre
genres :: Map UUID Genre,
    GetGenresQueryResponse -> [UUID]
sortOrder :: [UUID]
  }
  deriving (GetGenresQueryResponse -> GetGenresQueryResponse -> Bool
(GetGenresQueryResponse -> GetGenresQueryResponse -> Bool)
-> (GetGenresQueryResponse -> GetGenresQueryResponse -> Bool)
-> Eq GetGenresQueryResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetGenresQueryResponse -> GetGenresQueryResponse -> Bool
== :: GetGenresQueryResponse -> GetGenresQueryResponse -> Bool
$c/= :: GetGenresQueryResponse -> GetGenresQueryResponse -> Bool
/= :: GetGenresQueryResponse -> GetGenresQueryResponse -> Bool
Eq, Int -> GetGenresQueryResponse -> ShowS
[GetGenresQueryResponse] -> ShowS
GetGenresQueryResponse -> String
(Int -> GetGenresQueryResponse -> ShowS)
-> (GetGenresQueryResponse -> String)
-> ([GetGenresQueryResponse] -> ShowS)
-> Show GetGenresQueryResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetGenresQueryResponse -> ShowS
showsPrec :: Int -> GetGenresQueryResponse -> ShowS
$cshow :: GetGenresQueryResponse -> String
show :: GetGenresQueryResponse -> String
$cshowList :: [GetGenresQueryResponse] -> ShowS
showList :: [GetGenresQueryResponse] -> ShowS
Show, (forall x. GetGenresQueryResponse -> Rep GetGenresQueryResponse x)
-> (forall x.
    Rep GetGenresQueryResponse x -> GetGenresQueryResponse)
-> Generic GetGenresQueryResponse
forall x. Rep GetGenresQueryResponse x -> GetGenresQueryResponse
forall x. GetGenresQueryResponse -> Rep GetGenresQueryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetGenresQueryResponse -> Rep GetGenresQueryResponse x
from :: forall x. GetGenresQueryResponse -> Rep GetGenresQueryResponse x
$cto :: forall x. Rep GetGenresQueryResponse x -> GetGenresQueryResponse
to :: forall x. Rep GetGenresQueryResponse x -> GetGenresQueryResponse
Generic, Maybe GetGenresQueryResponse
Value -> Parser [GetGenresQueryResponse]
Value -> Parser GetGenresQueryResponse
(Value -> Parser GetGenresQueryResponse)
-> (Value -> Parser [GetGenresQueryResponse])
-> Maybe GetGenresQueryResponse
-> FromJSON GetGenresQueryResponse
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GetGenresQueryResponse
parseJSON :: Value -> Parser GetGenresQueryResponse
$cparseJSONList :: Value -> Parser [GetGenresQueryResponse]
parseJSONList :: Value -> Parser [GetGenresQueryResponse]
$comittedField :: Maybe GetGenresQueryResponse
omittedField :: Maybe GetGenresQueryResponse
FromJSON, [GetGenresQueryResponse] -> Value
[GetGenresQueryResponse] -> Encoding
GetGenresQueryResponse -> Bool
GetGenresQueryResponse -> Value
GetGenresQueryResponse -> Encoding
(GetGenresQueryResponse -> Value)
-> (GetGenresQueryResponse -> Encoding)
-> ([GetGenresQueryResponse] -> Value)
-> ([GetGenresQueryResponse] -> Encoding)
-> (GetGenresQueryResponse -> Bool)
-> ToJSON GetGenresQueryResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GetGenresQueryResponse -> Value
toJSON :: GetGenresQueryResponse -> Value
$ctoEncoding :: GetGenresQueryResponse -> Encoding
toEncoding :: GetGenresQueryResponse -> Encoding
$ctoJSONList :: [GetGenresQueryResponse] -> Value
toJSONList :: [GetGenresQueryResponse] -> Value
$ctoEncodingList :: [GetGenresQueryResponse] -> Encoding
toEncodingList :: [GetGenresQueryResponse] -> Encoding
$comitField :: GetGenresQueryResponse -> Bool
omitField :: GetGenresQueryResponse -> Bool
ToJSON, Typeable GetGenresQueryResponse
Typeable GetGenresQueryResponse =>
(Proxy GetGenresQueryResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema GetGenresQueryResponse
Proxy GetGenresQueryResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy GetGenresQueryResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy GetGenresQueryResponse
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''GetGenresQueryResponse

data InsertGenresCommandResponse = InsertGenresQueryResponse
  { InsertGenresCommandResponse -> Map UUID Genre
genres :: Map UUID Genre,
    InsertGenresCommandResponse -> [UUID]
sortOrder :: [UUID],
    InsertGenresCommandResponse -> Map Text (Validation [Text])
validationResults :: Map Text ValidationResult
  }
  deriving (InsertGenresCommandResponse -> InsertGenresCommandResponse -> Bool
(InsertGenresCommandResponse
 -> InsertGenresCommandResponse -> Bool)
-> (InsertGenresCommandResponse
    -> InsertGenresCommandResponse -> Bool)
-> Eq InsertGenresCommandResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertGenresCommandResponse -> InsertGenresCommandResponse -> Bool
== :: InsertGenresCommandResponse -> InsertGenresCommandResponse -> Bool
$c/= :: InsertGenresCommandResponse -> InsertGenresCommandResponse -> Bool
/= :: InsertGenresCommandResponse -> InsertGenresCommandResponse -> Bool
Eq, Int -> InsertGenresCommandResponse -> ShowS
[InsertGenresCommandResponse] -> ShowS
InsertGenresCommandResponse -> String
(Int -> InsertGenresCommandResponse -> ShowS)
-> (InsertGenresCommandResponse -> String)
-> ([InsertGenresCommandResponse] -> ShowS)
-> Show InsertGenresCommandResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertGenresCommandResponse -> ShowS
showsPrec :: Int -> InsertGenresCommandResponse -> ShowS
$cshow :: InsertGenresCommandResponse -> String
show :: InsertGenresCommandResponse -> String
$cshowList :: [InsertGenresCommandResponse] -> ShowS
showList :: [InsertGenresCommandResponse] -> ShowS
Show, (forall x.
 InsertGenresCommandResponse -> Rep InsertGenresCommandResponse x)
-> (forall x.
    Rep InsertGenresCommandResponse x -> InsertGenresCommandResponse)
-> Generic InsertGenresCommandResponse
forall x.
Rep InsertGenresCommandResponse x -> InsertGenresCommandResponse
forall x.
InsertGenresCommandResponse -> Rep InsertGenresCommandResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InsertGenresCommandResponse -> Rep InsertGenresCommandResponse x
from :: forall x.
InsertGenresCommandResponse -> Rep InsertGenresCommandResponse x
$cto :: forall x.
Rep InsertGenresCommandResponse x -> InsertGenresCommandResponse
to :: forall x.
Rep InsertGenresCommandResponse x -> InsertGenresCommandResponse
Generic, Maybe InsertGenresCommandResponse
Value -> Parser [InsertGenresCommandResponse]
Value -> Parser InsertGenresCommandResponse
(Value -> Parser InsertGenresCommandResponse)
-> (Value -> Parser [InsertGenresCommandResponse])
-> Maybe InsertGenresCommandResponse
-> FromJSON InsertGenresCommandResponse
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InsertGenresCommandResponse
parseJSON :: Value -> Parser InsertGenresCommandResponse
$cparseJSONList :: Value -> Parser [InsertGenresCommandResponse]
parseJSONList :: Value -> Parser [InsertGenresCommandResponse]
$comittedField :: Maybe InsertGenresCommandResponse
omittedField :: Maybe InsertGenresCommandResponse
FromJSON, [InsertGenresCommandResponse] -> Value
[InsertGenresCommandResponse] -> Encoding
InsertGenresCommandResponse -> Bool
InsertGenresCommandResponse -> Value
InsertGenresCommandResponse -> Encoding
(InsertGenresCommandResponse -> Value)
-> (InsertGenresCommandResponse -> Encoding)
-> ([InsertGenresCommandResponse] -> Value)
-> ([InsertGenresCommandResponse] -> Encoding)
-> (InsertGenresCommandResponse -> Bool)
-> ToJSON InsertGenresCommandResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InsertGenresCommandResponse -> Value
toJSON :: InsertGenresCommandResponse -> Value
$ctoEncoding :: InsertGenresCommandResponse -> Encoding
toEncoding :: InsertGenresCommandResponse -> Encoding
$ctoJSONList :: [InsertGenresCommandResponse] -> Value
toJSONList :: [InsertGenresCommandResponse] -> Value
$ctoEncodingList :: [InsertGenresCommandResponse] -> Encoding
toEncodingList :: [InsertGenresCommandResponse] -> Encoding
$comitField :: InsertGenresCommandResponse -> Bool
omitField :: InsertGenresCommandResponse -> Bool
ToJSON, Typeable InsertGenresCommandResponse
Typeable InsertGenresCommandResponse =>
(Proxy InsertGenresCommandResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InsertGenresCommandResponse
Proxy InsertGenresCommandResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InsertGenresCommandResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InsertGenresCommandResponse
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''InsertGenresCommandResponse

data InsertGenresRequestItem = InsertGenresRequestItem
  { InsertGenresRequestItem -> Text
displayName :: Text,
    InsertGenresRequestItem -> Maybe Text
spotifyUrl :: Maybe Text,
    InsertGenresRequestItem -> Maybe Text
youtubeUrl :: Maybe Text,
    InsertGenresRequestItem -> Maybe Text
soundcloudUrl :: Maybe Text,
    InsertGenresRequestItem -> Maybe Text
wikipediaUrl :: Maybe Text,
    InsertGenresRequestItem -> Maybe Text
description :: Maybe Text
  }
  deriving (InsertGenresRequestItem -> InsertGenresRequestItem -> Bool
(InsertGenresRequestItem -> InsertGenresRequestItem -> Bool)
-> (InsertGenresRequestItem -> InsertGenresRequestItem -> Bool)
-> Eq InsertGenresRequestItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertGenresRequestItem -> InsertGenresRequestItem -> Bool
== :: InsertGenresRequestItem -> InsertGenresRequestItem -> Bool
$c/= :: InsertGenresRequestItem -> InsertGenresRequestItem -> Bool
/= :: InsertGenresRequestItem -> InsertGenresRequestItem -> Bool
Eq, Int -> InsertGenresRequestItem -> ShowS
[InsertGenresRequestItem] -> ShowS
InsertGenresRequestItem -> String
(Int -> InsertGenresRequestItem -> ShowS)
-> (InsertGenresRequestItem -> String)
-> ([InsertGenresRequestItem] -> ShowS)
-> Show InsertGenresRequestItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertGenresRequestItem -> ShowS
showsPrec :: Int -> InsertGenresRequestItem -> ShowS
$cshow :: InsertGenresRequestItem -> String
show :: InsertGenresRequestItem -> String
$cshowList :: [InsertGenresRequestItem] -> ShowS
showList :: [InsertGenresRequestItem] -> ShowS
Show, (forall x.
 InsertGenresRequestItem -> Rep InsertGenresRequestItem x)
-> (forall x.
    Rep InsertGenresRequestItem x -> InsertGenresRequestItem)
-> Generic InsertGenresRequestItem
forall x. Rep InsertGenresRequestItem x -> InsertGenresRequestItem
forall x. InsertGenresRequestItem -> Rep InsertGenresRequestItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InsertGenresRequestItem -> Rep InsertGenresRequestItem x
from :: forall x. InsertGenresRequestItem -> Rep InsertGenresRequestItem x
$cto :: forall x. Rep InsertGenresRequestItem x -> InsertGenresRequestItem
to :: forall x. Rep InsertGenresRequestItem x -> InsertGenresRequestItem
Generic, Maybe InsertGenresRequestItem
Value -> Parser [InsertGenresRequestItem]
Value -> Parser InsertGenresRequestItem
(Value -> Parser InsertGenresRequestItem)
-> (Value -> Parser [InsertGenresRequestItem])
-> Maybe InsertGenresRequestItem
-> FromJSON InsertGenresRequestItem
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InsertGenresRequestItem
parseJSON :: Value -> Parser InsertGenresRequestItem
$cparseJSONList :: Value -> Parser [InsertGenresRequestItem]
parseJSONList :: Value -> Parser [InsertGenresRequestItem]
$comittedField :: Maybe InsertGenresRequestItem
omittedField :: Maybe InsertGenresRequestItem
FromJSON, [InsertGenresRequestItem] -> Value
[InsertGenresRequestItem] -> Encoding
InsertGenresRequestItem -> Bool
InsertGenresRequestItem -> Value
InsertGenresRequestItem -> Encoding
(InsertGenresRequestItem -> Value)
-> (InsertGenresRequestItem -> Encoding)
-> ([InsertGenresRequestItem] -> Value)
-> ([InsertGenresRequestItem] -> Encoding)
-> (InsertGenresRequestItem -> Bool)
-> ToJSON InsertGenresRequestItem
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InsertGenresRequestItem -> Value
toJSON :: InsertGenresRequestItem -> Value
$ctoEncoding :: InsertGenresRequestItem -> Encoding
toEncoding :: InsertGenresRequestItem -> Encoding
$ctoJSONList :: [InsertGenresRequestItem] -> Value
toJSONList :: [InsertGenresRequestItem] -> Value
$ctoEncodingList :: [InsertGenresRequestItem] -> Encoding
toEncodingList :: [InsertGenresRequestItem] -> Encoding
$comitField :: InsertGenresRequestItem -> Bool
omitField :: InsertGenresRequestItem -> Bool
ToJSON, Typeable InsertGenresRequestItem
Typeable InsertGenresRequestItem =>
(Proxy InsertGenresRequestItem
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InsertGenresRequestItem
Proxy InsertGenresRequestItem
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InsertGenresRequestItem
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InsertGenresRequestItem
-> Declare (Definitions Schema) NamedSchema
ToSchema)

newtype InsertGenresRequest = InsertGenresRequest
  { InsertGenresRequest -> [InsertGenresRequestItem]
genres :: [InsertGenresRequestItem]
  }
  deriving (InsertGenresRequest -> InsertGenresRequest -> Bool
(InsertGenresRequest -> InsertGenresRequest -> Bool)
-> (InsertGenresRequest -> InsertGenresRequest -> Bool)
-> Eq InsertGenresRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertGenresRequest -> InsertGenresRequest -> Bool
== :: InsertGenresRequest -> InsertGenresRequest -> Bool
$c/= :: InsertGenresRequest -> InsertGenresRequest -> Bool
/= :: InsertGenresRequest -> InsertGenresRequest -> Bool
Eq, Int -> InsertGenresRequest -> ShowS
[InsertGenresRequest] -> ShowS
InsertGenresRequest -> String
(Int -> InsertGenresRequest -> ShowS)
-> (InsertGenresRequest -> String)
-> ([InsertGenresRequest] -> ShowS)
-> Show InsertGenresRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertGenresRequest -> ShowS
showsPrec :: Int -> InsertGenresRequest -> ShowS
$cshow :: InsertGenresRequest -> String
show :: InsertGenresRequest -> String
$cshowList :: [InsertGenresRequest] -> ShowS
showList :: [InsertGenresRequest] -> ShowS
Show, (forall x. InsertGenresRequest -> Rep InsertGenresRequest x)
-> (forall x. Rep InsertGenresRequest x -> InsertGenresRequest)
-> Generic InsertGenresRequest
forall x. Rep InsertGenresRequest x -> InsertGenresRequest
forall x. InsertGenresRequest -> Rep InsertGenresRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InsertGenresRequest -> Rep InsertGenresRequest x
from :: forall x. InsertGenresRequest -> Rep InsertGenresRequest x
$cto :: forall x. Rep InsertGenresRequest x -> InsertGenresRequest
to :: forall x. Rep InsertGenresRequest x -> InsertGenresRequest
Generic, Maybe InsertGenresRequest
Value -> Parser [InsertGenresRequest]
Value -> Parser InsertGenresRequest
(Value -> Parser InsertGenresRequest)
-> (Value -> Parser [InsertGenresRequest])
-> Maybe InsertGenresRequest
-> FromJSON InsertGenresRequest
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InsertGenresRequest
parseJSON :: Value -> Parser InsertGenresRequest
$cparseJSONList :: Value -> Parser [InsertGenresRequest]
parseJSONList :: Value -> Parser [InsertGenresRequest]
$comittedField :: Maybe InsertGenresRequest
omittedField :: Maybe InsertGenresRequest
FromJSON, [InsertGenresRequest] -> Value
[InsertGenresRequest] -> Encoding
InsertGenresRequest -> Bool
InsertGenresRequest -> Value
InsertGenresRequest -> Encoding
(InsertGenresRequest -> Value)
-> (InsertGenresRequest -> Encoding)
-> ([InsertGenresRequest] -> Value)
-> ([InsertGenresRequest] -> Encoding)
-> (InsertGenresRequest -> Bool)
-> ToJSON InsertGenresRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InsertGenresRequest -> Value
toJSON :: InsertGenresRequest -> Value
$ctoEncoding :: InsertGenresRequest -> Encoding
toEncoding :: InsertGenresRequest -> Encoding
$ctoJSONList :: [InsertGenresRequest] -> Value
toJSONList :: [InsertGenresRequest] -> Value
$ctoEncodingList :: [InsertGenresRequest] -> Encoding
toEncodingList :: [InsertGenresRequest] -> Encoding
$comitField :: InsertGenresRequest -> Bool
omitField :: InsertGenresRequest -> Bool
ToJSON, Typeable InsertGenresRequest
Typeable InsertGenresRequest =>
(Proxy InsertGenresRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InsertGenresRequest
Proxy InsertGenresRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InsertGenresRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InsertGenresRequest
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''InsertGenresRequest
makeFieldLabelsNoPrefix ''InsertGenresRequestItem

-- genre comments

data InsertGenreCommentsCommandResponse = InsertGenreCommentsCommandResponse
  { InsertGenreCommentsCommandResponse -> Map UUID GenreComment
genreComments :: Map UUID GenreComment,
    InsertGenreCommentsCommandResponse -> Map Text (Validation [Text])
validationResults :: Map Text ValidationResult
  }
  deriving (InsertGenreCommentsCommandResponse
-> InsertGenreCommentsCommandResponse -> Bool
(InsertGenreCommentsCommandResponse
 -> InsertGenreCommentsCommandResponse -> Bool)
-> (InsertGenreCommentsCommandResponse
    -> InsertGenreCommentsCommandResponse -> Bool)
-> Eq InsertGenreCommentsCommandResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertGenreCommentsCommandResponse
-> InsertGenreCommentsCommandResponse -> Bool
== :: InsertGenreCommentsCommandResponse
-> InsertGenreCommentsCommandResponse -> Bool
$c/= :: InsertGenreCommentsCommandResponse
-> InsertGenreCommentsCommandResponse -> Bool
/= :: InsertGenreCommentsCommandResponse
-> InsertGenreCommentsCommandResponse -> Bool
Eq, Int -> InsertGenreCommentsCommandResponse -> ShowS
[InsertGenreCommentsCommandResponse] -> ShowS
InsertGenreCommentsCommandResponse -> String
(Int -> InsertGenreCommentsCommandResponse -> ShowS)
-> (InsertGenreCommentsCommandResponse -> String)
-> ([InsertGenreCommentsCommandResponse] -> ShowS)
-> Show InsertGenreCommentsCommandResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertGenreCommentsCommandResponse -> ShowS
showsPrec :: Int -> InsertGenreCommentsCommandResponse -> ShowS
$cshow :: InsertGenreCommentsCommandResponse -> String
show :: InsertGenreCommentsCommandResponse -> String
$cshowList :: [InsertGenreCommentsCommandResponse] -> ShowS
showList :: [InsertGenreCommentsCommandResponse] -> ShowS
Show, (forall x.
 InsertGenreCommentsCommandResponse
 -> Rep InsertGenreCommentsCommandResponse x)
-> (forall x.
    Rep InsertGenreCommentsCommandResponse x
    -> InsertGenreCommentsCommandResponse)
-> Generic InsertGenreCommentsCommandResponse
forall x.
Rep InsertGenreCommentsCommandResponse x
-> InsertGenreCommentsCommandResponse
forall x.
InsertGenreCommentsCommandResponse
-> Rep InsertGenreCommentsCommandResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InsertGenreCommentsCommandResponse
-> Rep InsertGenreCommentsCommandResponse x
from :: forall x.
InsertGenreCommentsCommandResponse
-> Rep InsertGenreCommentsCommandResponse x
$cto :: forall x.
Rep InsertGenreCommentsCommandResponse x
-> InsertGenreCommentsCommandResponse
to :: forall x.
Rep InsertGenreCommentsCommandResponse x
-> InsertGenreCommentsCommandResponse
Generic, Maybe InsertGenreCommentsCommandResponse
Value -> Parser [InsertGenreCommentsCommandResponse]
Value -> Parser InsertGenreCommentsCommandResponse
(Value -> Parser InsertGenreCommentsCommandResponse)
-> (Value -> Parser [InsertGenreCommentsCommandResponse])
-> Maybe InsertGenreCommentsCommandResponse
-> FromJSON InsertGenreCommentsCommandResponse
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InsertGenreCommentsCommandResponse
parseJSON :: Value -> Parser InsertGenreCommentsCommandResponse
$cparseJSONList :: Value -> Parser [InsertGenreCommentsCommandResponse]
parseJSONList :: Value -> Parser [InsertGenreCommentsCommandResponse]
$comittedField :: Maybe InsertGenreCommentsCommandResponse
omittedField :: Maybe InsertGenreCommentsCommandResponse
FromJSON, [InsertGenreCommentsCommandResponse] -> Value
[InsertGenreCommentsCommandResponse] -> Encoding
InsertGenreCommentsCommandResponse -> Bool
InsertGenreCommentsCommandResponse -> Value
InsertGenreCommentsCommandResponse -> Encoding
(InsertGenreCommentsCommandResponse -> Value)
-> (InsertGenreCommentsCommandResponse -> Encoding)
-> ([InsertGenreCommentsCommandResponse] -> Value)
-> ([InsertGenreCommentsCommandResponse] -> Encoding)
-> (InsertGenreCommentsCommandResponse -> Bool)
-> ToJSON InsertGenreCommentsCommandResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InsertGenreCommentsCommandResponse -> Value
toJSON :: InsertGenreCommentsCommandResponse -> Value
$ctoEncoding :: InsertGenreCommentsCommandResponse -> Encoding
toEncoding :: InsertGenreCommentsCommandResponse -> Encoding
$ctoJSONList :: [InsertGenreCommentsCommandResponse] -> Value
toJSONList :: [InsertGenreCommentsCommandResponse] -> Value
$ctoEncodingList :: [InsertGenreCommentsCommandResponse] -> Encoding
toEncodingList :: [InsertGenreCommentsCommandResponse] -> Encoding
$comitField :: InsertGenreCommentsCommandResponse -> Bool
omitField :: InsertGenreCommentsCommandResponse -> Bool
ToJSON, Typeable InsertGenreCommentsCommandResponse
Typeable InsertGenreCommentsCommandResponse =>
(Proxy InsertGenreCommentsCommandResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InsertGenreCommentsCommandResponse
Proxy InsertGenreCommentsCommandResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InsertGenreCommentsCommandResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InsertGenreCommentsCommandResponse
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''InsertGenreCommentsCommandResponse

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

newtype InsertGenreCommentsRequest = InsertGenreCommentsRequest
  { InsertGenreCommentsRequest -> [InsertGenreCommentsRequestItem]
genreComments :: [InsertGenreCommentsRequestItem]
  }
  deriving (InsertGenreCommentsRequest -> InsertGenreCommentsRequest -> Bool
(InsertGenreCommentsRequest -> InsertGenreCommentsRequest -> Bool)
-> (InsertGenreCommentsRequest
    -> InsertGenreCommentsRequest -> Bool)
-> Eq InsertGenreCommentsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertGenreCommentsRequest -> InsertGenreCommentsRequest -> Bool
== :: InsertGenreCommentsRequest -> InsertGenreCommentsRequest -> Bool
$c/= :: InsertGenreCommentsRequest -> InsertGenreCommentsRequest -> Bool
/= :: InsertGenreCommentsRequest -> InsertGenreCommentsRequest -> Bool
Eq, Int -> InsertGenreCommentsRequest -> ShowS
[InsertGenreCommentsRequest] -> ShowS
InsertGenreCommentsRequest -> String
(Int -> InsertGenreCommentsRequest -> ShowS)
-> (InsertGenreCommentsRequest -> String)
-> ([InsertGenreCommentsRequest] -> ShowS)
-> Show InsertGenreCommentsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertGenreCommentsRequest -> ShowS
showsPrec :: Int -> InsertGenreCommentsRequest -> ShowS
$cshow :: InsertGenreCommentsRequest -> String
show :: InsertGenreCommentsRequest -> String
$cshowList :: [InsertGenreCommentsRequest] -> ShowS
showList :: [InsertGenreCommentsRequest] -> ShowS
Show, (forall x.
 InsertGenreCommentsRequest -> Rep InsertGenreCommentsRequest x)
-> (forall x.
    Rep InsertGenreCommentsRequest x -> InsertGenreCommentsRequest)
-> Generic InsertGenreCommentsRequest
forall x.
Rep InsertGenreCommentsRequest x -> InsertGenreCommentsRequest
forall x.
InsertGenreCommentsRequest -> Rep InsertGenreCommentsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InsertGenreCommentsRequest -> Rep InsertGenreCommentsRequest x
from :: forall x.
InsertGenreCommentsRequest -> Rep InsertGenreCommentsRequest x
$cto :: forall x.
Rep InsertGenreCommentsRequest x -> InsertGenreCommentsRequest
to :: forall x.
Rep InsertGenreCommentsRequest x -> InsertGenreCommentsRequest
Generic, Maybe InsertGenreCommentsRequest
Value -> Parser [InsertGenreCommentsRequest]
Value -> Parser InsertGenreCommentsRequest
(Value -> Parser InsertGenreCommentsRequest)
-> (Value -> Parser [InsertGenreCommentsRequest])
-> Maybe InsertGenreCommentsRequest
-> FromJSON InsertGenreCommentsRequest
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InsertGenreCommentsRequest
parseJSON :: Value -> Parser InsertGenreCommentsRequest
$cparseJSONList :: Value -> Parser [InsertGenreCommentsRequest]
parseJSONList :: Value -> Parser [InsertGenreCommentsRequest]
$comittedField :: Maybe InsertGenreCommentsRequest
omittedField :: Maybe InsertGenreCommentsRequest
FromJSON, [InsertGenreCommentsRequest] -> Value
[InsertGenreCommentsRequest] -> Encoding
InsertGenreCommentsRequest -> Bool
InsertGenreCommentsRequest -> Value
InsertGenreCommentsRequest -> Encoding
(InsertGenreCommentsRequest -> Value)
-> (InsertGenreCommentsRequest -> Encoding)
-> ([InsertGenreCommentsRequest] -> Value)
-> ([InsertGenreCommentsRequest] -> Encoding)
-> (InsertGenreCommentsRequest -> Bool)
-> ToJSON InsertGenreCommentsRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InsertGenreCommentsRequest -> Value
toJSON :: InsertGenreCommentsRequest -> Value
$ctoEncoding :: InsertGenreCommentsRequest -> Encoding
toEncoding :: InsertGenreCommentsRequest -> Encoding
$ctoJSONList :: [InsertGenreCommentsRequest] -> Value
toJSONList :: [InsertGenreCommentsRequest] -> Value
$ctoEncodingList :: [InsertGenreCommentsRequest] -> Encoding
toEncodingList :: [InsertGenreCommentsRequest] -> Encoding
$comitField :: InsertGenreCommentsRequest -> Bool
omitField :: InsertGenreCommentsRequest -> Bool
ToJSON, Typeable InsertGenreCommentsRequest
Typeable InsertGenreCommentsRequest =>
(Proxy InsertGenreCommentsRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InsertGenreCommentsRequest
Proxy InsertGenreCommentsRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InsertGenreCommentsRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InsertGenreCommentsRequest
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''InsertGenreCommentsRequest
makeFieldLabelsNoPrefix ''InsertGenreCommentsRequestItem

-- genre opinions
data UpsertGenreOpinionsCommandResponse = UpsertGenreOpinionsCommandResponse
  { UpsertGenreOpinionsCommandResponse -> Map UUID GenreOpinion
genreOpinions :: Map UUID GenreOpinion,
    UpsertGenreOpinionsCommandResponse -> Map Text (Validation [Text])
validationResults :: Map Text ValidationResult
  }
  deriving (UpsertGenreOpinionsCommandResponse
-> UpsertGenreOpinionsCommandResponse -> Bool
(UpsertGenreOpinionsCommandResponse
 -> UpsertGenreOpinionsCommandResponse -> Bool)
-> (UpsertGenreOpinionsCommandResponse
    -> UpsertGenreOpinionsCommandResponse -> Bool)
-> Eq UpsertGenreOpinionsCommandResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpsertGenreOpinionsCommandResponse
-> UpsertGenreOpinionsCommandResponse -> Bool
== :: UpsertGenreOpinionsCommandResponse
-> UpsertGenreOpinionsCommandResponse -> Bool
$c/= :: UpsertGenreOpinionsCommandResponse
-> UpsertGenreOpinionsCommandResponse -> Bool
/= :: UpsertGenreOpinionsCommandResponse
-> UpsertGenreOpinionsCommandResponse -> Bool
Eq, Int -> UpsertGenreOpinionsCommandResponse -> ShowS
[UpsertGenreOpinionsCommandResponse] -> ShowS
UpsertGenreOpinionsCommandResponse -> String
(Int -> UpsertGenreOpinionsCommandResponse -> ShowS)
-> (UpsertGenreOpinionsCommandResponse -> String)
-> ([UpsertGenreOpinionsCommandResponse] -> ShowS)
-> Show UpsertGenreOpinionsCommandResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpsertGenreOpinionsCommandResponse -> ShowS
showsPrec :: Int -> UpsertGenreOpinionsCommandResponse -> ShowS
$cshow :: UpsertGenreOpinionsCommandResponse -> String
show :: UpsertGenreOpinionsCommandResponse -> String
$cshowList :: [UpsertGenreOpinionsCommandResponse] -> ShowS
showList :: [UpsertGenreOpinionsCommandResponse] -> ShowS
Show, (forall x.
 UpsertGenreOpinionsCommandResponse
 -> Rep UpsertGenreOpinionsCommandResponse x)
-> (forall x.
    Rep UpsertGenreOpinionsCommandResponse x
    -> UpsertGenreOpinionsCommandResponse)
-> Generic UpsertGenreOpinionsCommandResponse
forall x.
Rep UpsertGenreOpinionsCommandResponse x
-> UpsertGenreOpinionsCommandResponse
forall x.
UpsertGenreOpinionsCommandResponse
-> Rep UpsertGenreOpinionsCommandResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
UpsertGenreOpinionsCommandResponse
-> Rep UpsertGenreOpinionsCommandResponse x
from :: forall x.
UpsertGenreOpinionsCommandResponse
-> Rep UpsertGenreOpinionsCommandResponse x
$cto :: forall x.
Rep UpsertGenreOpinionsCommandResponse x
-> UpsertGenreOpinionsCommandResponse
to :: forall x.
Rep UpsertGenreOpinionsCommandResponse x
-> UpsertGenreOpinionsCommandResponse
Generic, Maybe UpsertGenreOpinionsCommandResponse
Value -> Parser [UpsertGenreOpinionsCommandResponse]
Value -> Parser UpsertGenreOpinionsCommandResponse
(Value -> Parser UpsertGenreOpinionsCommandResponse)
-> (Value -> Parser [UpsertGenreOpinionsCommandResponse])
-> Maybe UpsertGenreOpinionsCommandResponse
-> FromJSON UpsertGenreOpinionsCommandResponse
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UpsertGenreOpinionsCommandResponse
parseJSON :: Value -> Parser UpsertGenreOpinionsCommandResponse
$cparseJSONList :: Value -> Parser [UpsertGenreOpinionsCommandResponse]
parseJSONList :: Value -> Parser [UpsertGenreOpinionsCommandResponse]
$comittedField :: Maybe UpsertGenreOpinionsCommandResponse
omittedField :: Maybe UpsertGenreOpinionsCommandResponse
FromJSON, [UpsertGenreOpinionsCommandResponse] -> Value
[UpsertGenreOpinionsCommandResponse] -> Encoding
UpsertGenreOpinionsCommandResponse -> Bool
UpsertGenreOpinionsCommandResponse -> Value
UpsertGenreOpinionsCommandResponse -> Encoding
(UpsertGenreOpinionsCommandResponse -> Value)
-> (UpsertGenreOpinionsCommandResponse -> Encoding)
-> ([UpsertGenreOpinionsCommandResponse] -> Value)
-> ([UpsertGenreOpinionsCommandResponse] -> Encoding)
-> (UpsertGenreOpinionsCommandResponse -> Bool)
-> ToJSON UpsertGenreOpinionsCommandResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UpsertGenreOpinionsCommandResponse -> Value
toJSON :: UpsertGenreOpinionsCommandResponse -> Value
$ctoEncoding :: UpsertGenreOpinionsCommandResponse -> Encoding
toEncoding :: UpsertGenreOpinionsCommandResponse -> Encoding
$ctoJSONList :: [UpsertGenreOpinionsCommandResponse] -> Value
toJSONList :: [UpsertGenreOpinionsCommandResponse] -> Value
$ctoEncodingList :: [UpsertGenreOpinionsCommandResponse] -> Encoding
toEncodingList :: [UpsertGenreOpinionsCommandResponse] -> Encoding
$comitField :: UpsertGenreOpinionsCommandResponse -> Bool
omitField :: UpsertGenreOpinionsCommandResponse -> Bool
ToJSON, Typeable UpsertGenreOpinionsCommandResponse
Typeable UpsertGenreOpinionsCommandResponse =>
(Proxy UpsertGenreOpinionsCommandResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UpsertGenreOpinionsCommandResponse
Proxy UpsertGenreOpinionsCommandResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UpsertGenreOpinionsCommandResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UpsertGenreOpinionsCommandResponse
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''UpsertGenreOpinionsCommandResponse

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

newtype UpsertGenreOpinionsRequest = UpsertGenreOpinionsRequest
  { UpsertGenreOpinionsRequest -> [UpsertGenreOpinionsRequestItem]
genreOpinions :: [UpsertGenreOpinionsRequestItem]
  }
  deriving (UpsertGenreOpinionsRequest -> UpsertGenreOpinionsRequest -> Bool
(UpsertGenreOpinionsRequest -> UpsertGenreOpinionsRequest -> Bool)
-> (UpsertGenreOpinionsRequest
    -> UpsertGenreOpinionsRequest -> Bool)
-> Eq UpsertGenreOpinionsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpsertGenreOpinionsRequest -> UpsertGenreOpinionsRequest -> Bool
== :: UpsertGenreOpinionsRequest -> UpsertGenreOpinionsRequest -> Bool
$c/= :: UpsertGenreOpinionsRequest -> UpsertGenreOpinionsRequest -> Bool
/= :: UpsertGenreOpinionsRequest -> UpsertGenreOpinionsRequest -> Bool
Eq, Int -> UpsertGenreOpinionsRequest -> ShowS
[UpsertGenreOpinionsRequest] -> ShowS
UpsertGenreOpinionsRequest -> String
(Int -> UpsertGenreOpinionsRequest -> ShowS)
-> (UpsertGenreOpinionsRequest -> String)
-> ([UpsertGenreOpinionsRequest] -> ShowS)
-> Show UpsertGenreOpinionsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpsertGenreOpinionsRequest -> ShowS
showsPrec :: Int -> UpsertGenreOpinionsRequest -> ShowS
$cshow :: UpsertGenreOpinionsRequest -> String
show :: UpsertGenreOpinionsRequest -> String
$cshowList :: [UpsertGenreOpinionsRequest] -> ShowS
showList :: [UpsertGenreOpinionsRequest] -> ShowS
Show, (forall x.
 UpsertGenreOpinionsRequest -> Rep UpsertGenreOpinionsRequest x)
-> (forall x.
    Rep UpsertGenreOpinionsRequest x -> UpsertGenreOpinionsRequest)
-> Generic UpsertGenreOpinionsRequest
forall x.
Rep UpsertGenreOpinionsRequest x -> UpsertGenreOpinionsRequest
forall x.
UpsertGenreOpinionsRequest -> Rep UpsertGenreOpinionsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
UpsertGenreOpinionsRequest -> Rep UpsertGenreOpinionsRequest x
from :: forall x.
UpsertGenreOpinionsRequest -> Rep UpsertGenreOpinionsRequest x
$cto :: forall x.
Rep UpsertGenreOpinionsRequest x -> UpsertGenreOpinionsRequest
to :: forall x.
Rep UpsertGenreOpinionsRequest x -> UpsertGenreOpinionsRequest
Generic, Maybe UpsertGenreOpinionsRequest
Value -> Parser [UpsertGenreOpinionsRequest]
Value -> Parser UpsertGenreOpinionsRequest
(Value -> Parser UpsertGenreOpinionsRequest)
-> (Value -> Parser [UpsertGenreOpinionsRequest])
-> Maybe UpsertGenreOpinionsRequest
-> FromJSON UpsertGenreOpinionsRequest
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UpsertGenreOpinionsRequest
parseJSON :: Value -> Parser UpsertGenreOpinionsRequest
$cparseJSONList :: Value -> Parser [UpsertGenreOpinionsRequest]
parseJSONList :: Value -> Parser [UpsertGenreOpinionsRequest]
$comittedField :: Maybe UpsertGenreOpinionsRequest
omittedField :: Maybe UpsertGenreOpinionsRequest
FromJSON, [UpsertGenreOpinionsRequest] -> Value
[UpsertGenreOpinionsRequest] -> Encoding
UpsertGenreOpinionsRequest -> Bool
UpsertGenreOpinionsRequest -> Value
UpsertGenreOpinionsRequest -> Encoding
(UpsertGenreOpinionsRequest -> Value)
-> (UpsertGenreOpinionsRequest -> Encoding)
-> ([UpsertGenreOpinionsRequest] -> Value)
-> ([UpsertGenreOpinionsRequest] -> Encoding)
-> (UpsertGenreOpinionsRequest -> Bool)
-> ToJSON UpsertGenreOpinionsRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UpsertGenreOpinionsRequest -> Value
toJSON :: UpsertGenreOpinionsRequest -> Value
$ctoEncoding :: UpsertGenreOpinionsRequest -> Encoding
toEncoding :: UpsertGenreOpinionsRequest -> Encoding
$ctoJSONList :: [UpsertGenreOpinionsRequest] -> Value
toJSONList :: [UpsertGenreOpinionsRequest] -> Value
$ctoEncodingList :: [UpsertGenreOpinionsRequest] -> Encoding
toEncodingList :: [UpsertGenreOpinionsRequest] -> Encoding
$comitField :: UpsertGenreOpinionsRequest -> Bool
omitField :: UpsertGenreOpinionsRequest -> Bool
ToJSON, Typeable UpsertGenreOpinionsRequest
Typeable UpsertGenreOpinionsRequest =>
(Proxy UpsertGenreOpinionsRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UpsertGenreOpinionsRequest
Proxy UpsertGenreOpinionsRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UpsertGenreOpinionsRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UpsertGenreOpinionsRequest
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''UpsertGenreOpinionsRequest
makeFieldLabelsNoPrefix ''UpsertGenreOpinionsRequestItem

-- genre artworks

data InsertGenreArtworksCommandResponse = InsertGenreArtworksCommandResponse
  { InsertGenreArtworksCommandResponse -> Map UUID GenreArtwork
genreArtworks :: Map UUID GenreArtwork,
    InsertGenreArtworksCommandResponse -> Map Text (Validation [Text])
validationResults :: Map Text ValidationResult
  }
  deriving (InsertGenreArtworksCommandResponse
-> InsertGenreArtworksCommandResponse -> Bool
(InsertGenreArtworksCommandResponse
 -> InsertGenreArtworksCommandResponse -> Bool)
-> (InsertGenreArtworksCommandResponse
    -> InsertGenreArtworksCommandResponse -> Bool)
-> Eq InsertGenreArtworksCommandResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertGenreArtworksCommandResponse
-> InsertGenreArtworksCommandResponse -> Bool
== :: InsertGenreArtworksCommandResponse
-> InsertGenreArtworksCommandResponse -> Bool
$c/= :: InsertGenreArtworksCommandResponse
-> InsertGenreArtworksCommandResponse -> Bool
/= :: InsertGenreArtworksCommandResponse
-> InsertGenreArtworksCommandResponse -> Bool
Eq, Int -> InsertGenreArtworksCommandResponse -> ShowS
[InsertGenreArtworksCommandResponse] -> ShowS
InsertGenreArtworksCommandResponse -> String
(Int -> InsertGenreArtworksCommandResponse -> ShowS)
-> (InsertGenreArtworksCommandResponse -> String)
-> ([InsertGenreArtworksCommandResponse] -> ShowS)
-> Show InsertGenreArtworksCommandResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertGenreArtworksCommandResponse -> ShowS
showsPrec :: Int -> InsertGenreArtworksCommandResponse -> ShowS
$cshow :: InsertGenreArtworksCommandResponse -> String
show :: InsertGenreArtworksCommandResponse -> String
$cshowList :: [InsertGenreArtworksCommandResponse] -> ShowS
showList :: [InsertGenreArtworksCommandResponse] -> ShowS
Show, (forall x.
 InsertGenreArtworksCommandResponse
 -> Rep InsertGenreArtworksCommandResponse x)
-> (forall x.
    Rep InsertGenreArtworksCommandResponse x
    -> InsertGenreArtworksCommandResponse)
-> Generic InsertGenreArtworksCommandResponse
forall x.
Rep InsertGenreArtworksCommandResponse x
-> InsertGenreArtworksCommandResponse
forall x.
InsertGenreArtworksCommandResponse
-> Rep InsertGenreArtworksCommandResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InsertGenreArtworksCommandResponse
-> Rep InsertGenreArtworksCommandResponse x
from :: forall x.
InsertGenreArtworksCommandResponse
-> Rep InsertGenreArtworksCommandResponse x
$cto :: forall x.
Rep InsertGenreArtworksCommandResponse x
-> InsertGenreArtworksCommandResponse
to :: forall x.
Rep InsertGenreArtworksCommandResponse x
-> InsertGenreArtworksCommandResponse
Generic, Maybe InsertGenreArtworksCommandResponse
Value -> Parser [InsertGenreArtworksCommandResponse]
Value -> Parser InsertGenreArtworksCommandResponse
(Value -> Parser InsertGenreArtworksCommandResponse)
-> (Value -> Parser [InsertGenreArtworksCommandResponse])
-> Maybe InsertGenreArtworksCommandResponse
-> FromJSON InsertGenreArtworksCommandResponse
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InsertGenreArtworksCommandResponse
parseJSON :: Value -> Parser InsertGenreArtworksCommandResponse
$cparseJSONList :: Value -> Parser [InsertGenreArtworksCommandResponse]
parseJSONList :: Value -> Parser [InsertGenreArtworksCommandResponse]
$comittedField :: Maybe InsertGenreArtworksCommandResponse
omittedField :: Maybe InsertGenreArtworksCommandResponse
FromJSON, [InsertGenreArtworksCommandResponse] -> Value
[InsertGenreArtworksCommandResponse] -> Encoding
InsertGenreArtworksCommandResponse -> Bool
InsertGenreArtworksCommandResponse -> Value
InsertGenreArtworksCommandResponse -> Encoding
(InsertGenreArtworksCommandResponse -> Value)
-> (InsertGenreArtworksCommandResponse -> Encoding)
-> ([InsertGenreArtworksCommandResponse] -> Value)
-> ([InsertGenreArtworksCommandResponse] -> Encoding)
-> (InsertGenreArtworksCommandResponse -> Bool)
-> ToJSON InsertGenreArtworksCommandResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InsertGenreArtworksCommandResponse -> Value
toJSON :: InsertGenreArtworksCommandResponse -> Value
$ctoEncoding :: InsertGenreArtworksCommandResponse -> Encoding
toEncoding :: InsertGenreArtworksCommandResponse -> Encoding
$ctoJSONList :: [InsertGenreArtworksCommandResponse] -> Value
toJSONList :: [InsertGenreArtworksCommandResponse] -> Value
$ctoEncodingList :: [InsertGenreArtworksCommandResponse] -> Encoding
toEncodingList :: [InsertGenreArtworksCommandResponse] -> Encoding
$comitField :: InsertGenreArtworksCommandResponse -> Bool
omitField :: InsertGenreArtworksCommandResponse -> Bool
ToJSON, Typeable InsertGenreArtworksCommandResponse
Typeable InsertGenreArtworksCommandResponse =>
(Proxy InsertGenreArtworksCommandResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InsertGenreArtworksCommandResponse
Proxy InsertGenreArtworksCommandResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InsertGenreArtworksCommandResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InsertGenreArtworksCommandResponse
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''InsertGenreArtworksCommandResponse

data InsertGenreArtworksRequestItem = InsertGenreArtworksRequestItem
  { InsertGenreArtworksRequestItem -> UUID
genreIdentifier :: UUID,
    InsertGenreArtworksRequestItem -> Text
contentUrl :: Text,
    InsertGenreArtworksRequestItem -> Maybe Text
contentCaption :: Maybe Text,
    InsertGenreArtworksRequestItem -> Int
orderValue :: Int
  }
  deriving (InsertGenreArtworksRequestItem
-> InsertGenreArtworksRequestItem -> Bool
(InsertGenreArtworksRequestItem
 -> InsertGenreArtworksRequestItem -> Bool)
-> (InsertGenreArtworksRequestItem
    -> InsertGenreArtworksRequestItem -> Bool)
-> Eq InsertGenreArtworksRequestItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertGenreArtworksRequestItem
-> InsertGenreArtworksRequestItem -> Bool
== :: InsertGenreArtworksRequestItem
-> InsertGenreArtworksRequestItem -> Bool
$c/= :: InsertGenreArtworksRequestItem
-> InsertGenreArtworksRequestItem -> Bool
/= :: InsertGenreArtworksRequestItem
-> InsertGenreArtworksRequestItem -> Bool
Eq, Int -> InsertGenreArtworksRequestItem -> ShowS
[InsertGenreArtworksRequestItem] -> ShowS
InsertGenreArtworksRequestItem -> String
(Int -> InsertGenreArtworksRequestItem -> ShowS)
-> (InsertGenreArtworksRequestItem -> String)
-> ([InsertGenreArtworksRequestItem] -> ShowS)
-> Show InsertGenreArtworksRequestItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertGenreArtworksRequestItem -> ShowS
showsPrec :: Int -> InsertGenreArtworksRequestItem -> ShowS
$cshow :: InsertGenreArtworksRequestItem -> String
show :: InsertGenreArtworksRequestItem -> String
$cshowList :: [InsertGenreArtworksRequestItem] -> ShowS
showList :: [InsertGenreArtworksRequestItem] -> ShowS
Show, (forall x.
 InsertGenreArtworksRequestItem
 -> Rep InsertGenreArtworksRequestItem x)
-> (forall x.
    Rep InsertGenreArtworksRequestItem x
    -> InsertGenreArtworksRequestItem)
-> Generic InsertGenreArtworksRequestItem
forall x.
Rep InsertGenreArtworksRequestItem x
-> InsertGenreArtworksRequestItem
forall x.
InsertGenreArtworksRequestItem
-> Rep InsertGenreArtworksRequestItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InsertGenreArtworksRequestItem
-> Rep InsertGenreArtworksRequestItem x
from :: forall x.
InsertGenreArtworksRequestItem
-> Rep InsertGenreArtworksRequestItem x
$cto :: forall x.
Rep InsertGenreArtworksRequestItem x
-> InsertGenreArtworksRequestItem
to :: forall x.
Rep InsertGenreArtworksRequestItem x
-> InsertGenreArtworksRequestItem
Generic, Maybe InsertGenreArtworksRequestItem
Value -> Parser [InsertGenreArtworksRequestItem]
Value -> Parser InsertGenreArtworksRequestItem
(Value -> Parser InsertGenreArtworksRequestItem)
-> (Value -> Parser [InsertGenreArtworksRequestItem])
-> Maybe InsertGenreArtworksRequestItem
-> FromJSON InsertGenreArtworksRequestItem
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InsertGenreArtworksRequestItem
parseJSON :: Value -> Parser InsertGenreArtworksRequestItem
$cparseJSONList :: Value -> Parser [InsertGenreArtworksRequestItem]
parseJSONList :: Value -> Parser [InsertGenreArtworksRequestItem]
$comittedField :: Maybe InsertGenreArtworksRequestItem
omittedField :: Maybe InsertGenreArtworksRequestItem
FromJSON, [InsertGenreArtworksRequestItem] -> Value
[InsertGenreArtworksRequestItem] -> Encoding
InsertGenreArtworksRequestItem -> Bool
InsertGenreArtworksRequestItem -> Value
InsertGenreArtworksRequestItem -> Encoding
(InsertGenreArtworksRequestItem -> Value)
-> (InsertGenreArtworksRequestItem -> Encoding)
-> ([InsertGenreArtworksRequestItem] -> Value)
-> ([InsertGenreArtworksRequestItem] -> Encoding)
-> (InsertGenreArtworksRequestItem -> Bool)
-> ToJSON InsertGenreArtworksRequestItem
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InsertGenreArtworksRequestItem -> Value
toJSON :: InsertGenreArtworksRequestItem -> Value
$ctoEncoding :: InsertGenreArtworksRequestItem -> Encoding
toEncoding :: InsertGenreArtworksRequestItem -> Encoding
$ctoJSONList :: [InsertGenreArtworksRequestItem] -> Value
toJSONList :: [InsertGenreArtworksRequestItem] -> Value
$ctoEncodingList :: [InsertGenreArtworksRequestItem] -> Encoding
toEncodingList :: [InsertGenreArtworksRequestItem] -> Encoding
$comitField :: InsertGenreArtworksRequestItem -> Bool
omitField :: InsertGenreArtworksRequestItem -> Bool
ToJSON, Typeable InsertGenreArtworksRequestItem
Typeable InsertGenreArtworksRequestItem =>
(Proxy InsertGenreArtworksRequestItem
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InsertGenreArtworksRequestItem
Proxy InsertGenreArtworksRequestItem
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InsertGenreArtworksRequestItem
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InsertGenreArtworksRequestItem
-> Declare (Definitions Schema) NamedSchema
ToSchema)

newtype InsertGenreArtworksRequest = InsertGenreArtworksRequest
  { InsertGenreArtworksRequest -> [InsertGenreArtworksRequestItem]
genreArtworks :: [InsertGenreArtworksRequestItem]
  }
  deriving (InsertGenreArtworksRequest -> InsertGenreArtworksRequest -> Bool
(InsertGenreArtworksRequest -> InsertGenreArtworksRequest -> Bool)
-> (InsertGenreArtworksRequest
    -> InsertGenreArtworksRequest -> Bool)
-> Eq InsertGenreArtworksRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertGenreArtworksRequest -> InsertGenreArtworksRequest -> Bool
== :: InsertGenreArtworksRequest -> InsertGenreArtworksRequest -> Bool
$c/= :: InsertGenreArtworksRequest -> InsertGenreArtworksRequest -> Bool
/= :: InsertGenreArtworksRequest -> InsertGenreArtworksRequest -> Bool
Eq, Int -> InsertGenreArtworksRequest -> ShowS
[InsertGenreArtworksRequest] -> ShowS
InsertGenreArtworksRequest -> String
(Int -> InsertGenreArtworksRequest -> ShowS)
-> (InsertGenreArtworksRequest -> String)
-> ([InsertGenreArtworksRequest] -> ShowS)
-> Show InsertGenreArtworksRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertGenreArtworksRequest -> ShowS
showsPrec :: Int -> InsertGenreArtworksRequest -> ShowS
$cshow :: InsertGenreArtworksRequest -> String
show :: InsertGenreArtworksRequest -> String
$cshowList :: [InsertGenreArtworksRequest] -> ShowS
showList :: [InsertGenreArtworksRequest] -> ShowS
Show, (forall x.
 InsertGenreArtworksRequest -> Rep InsertGenreArtworksRequest x)
-> (forall x.
    Rep InsertGenreArtworksRequest x -> InsertGenreArtworksRequest)
-> Generic InsertGenreArtworksRequest
forall x.
Rep InsertGenreArtworksRequest x -> InsertGenreArtworksRequest
forall x.
InsertGenreArtworksRequest -> Rep InsertGenreArtworksRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InsertGenreArtworksRequest -> Rep InsertGenreArtworksRequest x
from :: forall x.
InsertGenreArtworksRequest -> Rep InsertGenreArtworksRequest x
$cto :: forall x.
Rep InsertGenreArtworksRequest x -> InsertGenreArtworksRequest
to :: forall x.
Rep InsertGenreArtworksRequest x -> InsertGenreArtworksRequest
Generic, Maybe InsertGenreArtworksRequest
Value -> Parser [InsertGenreArtworksRequest]
Value -> Parser InsertGenreArtworksRequest
(Value -> Parser InsertGenreArtworksRequest)
-> (Value -> Parser [InsertGenreArtworksRequest])
-> Maybe InsertGenreArtworksRequest
-> FromJSON InsertGenreArtworksRequest
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InsertGenreArtworksRequest
parseJSON :: Value -> Parser InsertGenreArtworksRequest
$cparseJSONList :: Value -> Parser [InsertGenreArtworksRequest]
parseJSONList :: Value -> Parser [InsertGenreArtworksRequest]
$comittedField :: Maybe InsertGenreArtworksRequest
omittedField :: Maybe InsertGenreArtworksRequest
FromJSON, [InsertGenreArtworksRequest] -> Value
[InsertGenreArtworksRequest] -> Encoding
InsertGenreArtworksRequest -> Bool
InsertGenreArtworksRequest -> Value
InsertGenreArtworksRequest -> Encoding
(InsertGenreArtworksRequest -> Value)
-> (InsertGenreArtworksRequest -> Encoding)
-> ([InsertGenreArtworksRequest] -> Value)
-> ([InsertGenreArtworksRequest] -> Encoding)
-> (InsertGenreArtworksRequest -> Bool)
-> ToJSON InsertGenreArtworksRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InsertGenreArtworksRequest -> Value
toJSON :: InsertGenreArtworksRequest -> Value
$ctoEncoding :: InsertGenreArtworksRequest -> Encoding
toEncoding :: InsertGenreArtworksRequest -> Encoding
$ctoJSONList :: [InsertGenreArtworksRequest] -> Value
toJSONList :: [InsertGenreArtworksRequest] -> Value
$ctoEncodingList :: [InsertGenreArtworksRequest] -> Encoding
toEncodingList :: [InsertGenreArtworksRequest] -> Encoding
$comitField :: InsertGenreArtworksRequest -> Bool
omitField :: InsertGenreArtworksRequest -> Bool
ToJSON, Typeable InsertGenreArtworksRequest
Typeable InsertGenreArtworksRequest =>
(Proxy InsertGenreArtworksRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InsertGenreArtworksRequest
Proxy InsertGenreArtworksRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InsertGenreArtworksRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InsertGenreArtworksRequest
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''InsertGenreArtworksRequest
makeFieldLabelsNoPrefix ''InsertGenreArtworksRequestItem

newtype GenreArtworkOrderUpdateRequest = GenreArtworkOrderUpdateRequest
  { GenreArtworkOrderUpdateRequest -> [GenreArtworkOrderUpdate]
genreArtworkOrders :: [GenreArtworkOrderUpdate]
  }
  deriving (GenreArtworkOrderUpdateRequest
-> GenreArtworkOrderUpdateRequest -> Bool
(GenreArtworkOrderUpdateRequest
 -> GenreArtworkOrderUpdateRequest -> Bool)
-> (GenreArtworkOrderUpdateRequest
    -> GenreArtworkOrderUpdateRequest -> Bool)
-> Eq GenreArtworkOrderUpdateRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenreArtworkOrderUpdateRequest
-> GenreArtworkOrderUpdateRequest -> Bool
== :: GenreArtworkOrderUpdateRequest
-> GenreArtworkOrderUpdateRequest -> Bool
$c/= :: GenreArtworkOrderUpdateRequest
-> GenreArtworkOrderUpdateRequest -> Bool
/= :: GenreArtworkOrderUpdateRequest
-> GenreArtworkOrderUpdateRequest -> Bool
Eq, Int -> GenreArtworkOrderUpdateRequest -> ShowS
[GenreArtworkOrderUpdateRequest] -> ShowS
GenreArtworkOrderUpdateRequest -> String
(Int -> GenreArtworkOrderUpdateRequest -> ShowS)
-> (GenreArtworkOrderUpdateRequest -> String)
-> ([GenreArtworkOrderUpdateRequest] -> ShowS)
-> Show GenreArtworkOrderUpdateRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenreArtworkOrderUpdateRequest -> ShowS
showsPrec :: Int -> GenreArtworkOrderUpdateRequest -> ShowS
$cshow :: GenreArtworkOrderUpdateRequest -> String
show :: GenreArtworkOrderUpdateRequest -> String
$cshowList :: [GenreArtworkOrderUpdateRequest] -> ShowS
showList :: [GenreArtworkOrderUpdateRequest] -> ShowS
Show, (forall x.
 GenreArtworkOrderUpdateRequest
 -> Rep GenreArtworkOrderUpdateRequest x)
-> (forall x.
    Rep GenreArtworkOrderUpdateRequest x
    -> GenreArtworkOrderUpdateRequest)
-> Generic GenreArtworkOrderUpdateRequest
forall x.
Rep GenreArtworkOrderUpdateRequest x
-> GenreArtworkOrderUpdateRequest
forall x.
GenreArtworkOrderUpdateRequest
-> Rep GenreArtworkOrderUpdateRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GenreArtworkOrderUpdateRequest
-> Rep GenreArtworkOrderUpdateRequest x
from :: forall x.
GenreArtworkOrderUpdateRequest
-> Rep GenreArtworkOrderUpdateRequest x
$cto :: forall x.
Rep GenreArtworkOrderUpdateRequest x
-> GenreArtworkOrderUpdateRequest
to :: forall x.
Rep GenreArtworkOrderUpdateRequest x
-> GenreArtworkOrderUpdateRequest
Generic, Maybe GenreArtworkOrderUpdateRequest
Value -> Parser [GenreArtworkOrderUpdateRequest]
Value -> Parser GenreArtworkOrderUpdateRequest
(Value -> Parser GenreArtworkOrderUpdateRequest)
-> (Value -> Parser [GenreArtworkOrderUpdateRequest])
-> Maybe GenreArtworkOrderUpdateRequest
-> FromJSON GenreArtworkOrderUpdateRequest
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GenreArtworkOrderUpdateRequest
parseJSON :: Value -> Parser GenreArtworkOrderUpdateRequest
$cparseJSONList :: Value -> Parser [GenreArtworkOrderUpdateRequest]
parseJSONList :: Value -> Parser [GenreArtworkOrderUpdateRequest]
$comittedField :: Maybe GenreArtworkOrderUpdateRequest
omittedField :: Maybe GenreArtworkOrderUpdateRequest
FromJSON, [GenreArtworkOrderUpdateRequest] -> Value
[GenreArtworkOrderUpdateRequest] -> Encoding
GenreArtworkOrderUpdateRequest -> Bool
GenreArtworkOrderUpdateRequest -> Value
GenreArtworkOrderUpdateRequest -> Encoding
(GenreArtworkOrderUpdateRequest -> Value)
-> (GenreArtworkOrderUpdateRequest -> Encoding)
-> ([GenreArtworkOrderUpdateRequest] -> Value)
-> ([GenreArtworkOrderUpdateRequest] -> Encoding)
-> (GenreArtworkOrderUpdateRequest -> Bool)
-> ToJSON GenreArtworkOrderUpdateRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GenreArtworkOrderUpdateRequest -> Value
toJSON :: GenreArtworkOrderUpdateRequest -> Value
$ctoEncoding :: GenreArtworkOrderUpdateRequest -> Encoding
toEncoding :: GenreArtworkOrderUpdateRequest -> Encoding
$ctoJSONList :: [GenreArtworkOrderUpdateRequest] -> Value
toJSONList :: [GenreArtworkOrderUpdateRequest] -> Value
$ctoEncodingList :: [GenreArtworkOrderUpdateRequest] -> Encoding
toEncodingList :: [GenreArtworkOrderUpdateRequest] -> Encoding
$comitField :: GenreArtworkOrderUpdateRequest -> Bool
omitField :: GenreArtworkOrderUpdateRequest -> Bool
ToJSON, Typeable GenreArtworkOrderUpdateRequest
Typeable GenreArtworkOrderUpdateRequest =>
(Proxy GenreArtworkOrderUpdateRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema GenreArtworkOrderUpdateRequest
Proxy GenreArtworkOrderUpdateRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy GenreArtworkOrderUpdateRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy GenreArtworkOrderUpdateRequest
-> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''GenreArtworkOrderUpdateRequest

newtype GenreDeltaRequest = GenreDeltaRequest
  { GenreDeltaRequest -> [GenreDelta]
genreDeltas :: [GenreDelta]
  }
  deriving (GenreDeltaRequest -> GenreDeltaRequest -> Bool
(GenreDeltaRequest -> GenreDeltaRequest -> Bool)
-> (GenreDeltaRequest -> GenreDeltaRequest -> Bool)
-> Eq GenreDeltaRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenreDeltaRequest -> GenreDeltaRequest -> Bool
== :: GenreDeltaRequest -> GenreDeltaRequest -> Bool
$c/= :: GenreDeltaRequest -> GenreDeltaRequest -> Bool
/= :: GenreDeltaRequest -> GenreDeltaRequest -> Bool
Eq, Int -> GenreDeltaRequest -> ShowS
[GenreDeltaRequest] -> ShowS
GenreDeltaRequest -> String
(Int -> GenreDeltaRequest -> ShowS)
-> (GenreDeltaRequest -> String)
-> ([GenreDeltaRequest] -> ShowS)
-> Show GenreDeltaRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenreDeltaRequest -> ShowS
showsPrec :: Int -> GenreDeltaRequest -> ShowS
$cshow :: GenreDeltaRequest -> String
show :: GenreDeltaRequest -> String
$cshowList :: [GenreDeltaRequest] -> ShowS
showList :: [GenreDeltaRequest] -> ShowS
Show, (forall x. GenreDeltaRequest -> Rep GenreDeltaRequest x)
-> (forall x. Rep GenreDeltaRequest x -> GenreDeltaRequest)
-> Generic GenreDeltaRequest
forall x. Rep GenreDeltaRequest x -> GenreDeltaRequest
forall x. GenreDeltaRequest -> Rep GenreDeltaRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenreDeltaRequest -> Rep GenreDeltaRequest x
from :: forall x. GenreDeltaRequest -> Rep GenreDeltaRequest x
$cto :: forall x. Rep GenreDeltaRequest x -> GenreDeltaRequest
to :: forall x. Rep GenreDeltaRequest x -> GenreDeltaRequest
Generic, Maybe GenreDeltaRequest
Value -> Parser [GenreDeltaRequest]
Value -> Parser GenreDeltaRequest
(Value -> Parser GenreDeltaRequest)
-> (Value -> Parser [GenreDeltaRequest])
-> Maybe GenreDeltaRequest
-> FromJSON GenreDeltaRequest
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GenreDeltaRequest
parseJSON :: Value -> Parser GenreDeltaRequest
$cparseJSONList :: Value -> Parser [GenreDeltaRequest]
parseJSONList :: Value -> Parser [GenreDeltaRequest]
$comittedField :: Maybe GenreDeltaRequest
omittedField :: Maybe GenreDeltaRequest
FromJSON, [GenreDeltaRequest] -> Value
[GenreDeltaRequest] -> Encoding
GenreDeltaRequest -> Bool
GenreDeltaRequest -> Value
GenreDeltaRequest -> Encoding
(GenreDeltaRequest -> Value)
-> (GenreDeltaRequest -> Encoding)
-> ([GenreDeltaRequest] -> Value)
-> ([GenreDeltaRequest] -> Encoding)
-> (GenreDeltaRequest -> Bool)
-> ToJSON GenreDeltaRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GenreDeltaRequest -> Value
toJSON :: GenreDeltaRequest -> Value
$ctoEncoding :: GenreDeltaRequest -> Encoding
toEncoding :: GenreDeltaRequest -> Encoding
$ctoJSONList :: [GenreDeltaRequest] -> Value
toJSONList :: [GenreDeltaRequest] -> Value
$ctoEncodingList :: [GenreDeltaRequest] -> Encoding
toEncodingList :: [GenreDeltaRequest] -> Encoding
$comitField :: GenreDeltaRequest -> Bool
omitField :: GenreDeltaRequest -> Bool
ToJSON, Typeable GenreDeltaRequest
Typeable GenreDeltaRequest =>
(Proxy GenreDeltaRequest
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema GenreDeltaRequest
Proxy GenreDeltaRequest -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy GenreDeltaRequest -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy GenreDeltaRequest -> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''GenreDeltaRequest

data GenreError
  = ValidationFailedError (Map Text ValidationResult)
  | AccessUnauthorizedError
  | SomeError Text
  deriving (Int -> GenreError -> ShowS
[GenreError] -> ShowS
GenreError -> String
(Int -> GenreError -> ShowS)
-> (GenreError -> String)
-> ([GenreError] -> ShowS)
-> Show GenreError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenreError -> ShowS
showsPrec :: Int -> GenreError -> ShowS
$cshow :: GenreError -> String
show :: GenreError -> String
$cshowList :: [GenreError] -> ShowS
showList :: [GenreError] -> ShowS
Show, GenreError -> GenreError -> Bool
(GenreError -> GenreError -> Bool)
-> (GenreError -> GenreError -> Bool) -> Eq GenreError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenreError -> GenreError -> Bool
== :: GenreError -> GenreError -> Bool
$c/= :: GenreError -> GenreError -> Bool
/= :: GenreError -> GenreError -> Bool
Eq, (forall x. GenreError -> Rep GenreError x)
-> (forall x. Rep GenreError x -> GenreError) -> Generic GenreError
forall x. Rep GenreError x -> GenreError
forall x. GenreError -> Rep GenreError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenreError -> Rep GenreError x
from :: forall x. GenreError -> Rep GenreError x
$cto :: forall x. Rep GenreError x -> GenreError
to :: forall x. Rep GenreError x -> GenreError
Generic)

ifAllValid ::
  (Applicative f) =>
  Map Text (Validation [Text]) ->
  f (Either GenreError b) ->
  f (Either GenreError b)
ifAllValid :: forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either GenreError b) -> f (Either GenreError b)
ifAllValid Map Text (Validation [Text])
validationResults f (Either GenreError b)
eff = do
  if Map Text (Validation [Text]) -> Bool
forall a. Map Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map Text (Validation [Text]) -> Bool)
-> Map Text (Validation [Text]) -> Bool
forall a b. (a -> b) -> a -> b
$ Map Text (Validation [Text]) -> Map Text (Validation [Text])
forall err. Map Text (Validation err) -> Map Text (Validation err)
filterFailedValidations Map Text (Validation [Text])
validationResults
    then do f (Either GenreError b)
eff
    else Either GenreError b -> f (Either GenreError b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either GenreError b -> f (Either GenreError b))
-> (GenreError -> Either GenreError b)
-> GenreError
-> f (Either GenreError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenreError -> Either GenreError b
forall a b. a -> Either a b
Left (GenreError -> f (Either GenreError b))
-> GenreError -> f (Either GenreError b)
forall a b. (a -> b) -> a -> b
$ Map Text (Validation [Text]) -> GenreError
ValidationFailedError Map Text (Validation [Text])
validationResults