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

module WikiMusic.Interaction.Model.Artist
  ( ArtistError (..),
    ifAllValid,
    Artist (..),
    ArtistArtwork (..),
    ArtistComment (..),
    ArtistOpinion (..),
    GetArtistsQueryResponse (..),
    InsertArtistsCommandResponse (..),
    InsertArtistsRequest (..),
    InsertArtistsRequestItem (..),
    InsertArtistCommentsCommandResponse (..),
    InsertArtistCommentsRequest (..),
    InsertArtistCommentsRequestItem (..),
    UpsertArtistOpinionsCommandResponse (..),
    UpsertArtistOpinionsRequest (..),
    UpsertArtistOpinionsRequestItem (..),
    InsertArtistArtworksCommandResponse (..),
    InsertArtistArtworksRequest (..),
    InsertArtistArtworksRequestItem (..),
    ArtistArtworkOrderUpdateRequest (..),
    ArtistDeltaRequest (..),
  )
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.Artist

instance ToSchema (Validation [Text])

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

makeFieldLabelsNoPrefix ''GetArtistsQueryResponse

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

makeFieldLabelsNoPrefix ''InsertArtistsCommandResponse

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

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

makeFieldLabelsNoPrefix ''InsertArtistsRequest
makeFieldLabelsNoPrefix ''InsertArtistsRequestItem

-- artist comments

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

makeFieldLabelsNoPrefix ''InsertArtistCommentsCommandResponse

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

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

makeFieldLabelsNoPrefix ''InsertArtistCommentsRequest
makeFieldLabelsNoPrefix ''InsertArtistCommentsRequestItem

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

makeFieldLabelsNoPrefix ''UpsertArtistOpinionsCommandResponse

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

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

makeFieldLabelsNoPrefix ''UpsertArtistOpinionsRequest
makeFieldLabelsNoPrefix ''UpsertArtistOpinionsRequestItem

-- artist artworks

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

makeFieldLabelsNoPrefix ''InsertArtistArtworksCommandResponse

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

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

makeFieldLabelsNoPrefix ''InsertArtistArtworksRequest
makeFieldLabelsNoPrefix ''InsertArtistArtworksRequestItem

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

makeFieldLabelsNoPrefix ''ArtistArtworkOrderUpdateRequest

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

makeFieldLabelsNoPrefix ''ArtistDeltaRequest

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

ifAllValid ::
  (Applicative f) =>
  Map Text (Validation [Text]) ->
  f (Either ArtistError b) ->
  f (Either ArtistError b)
ifAllValid :: forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either ArtistError b) -> f (Either ArtistError b)
ifAllValid Map Text (Validation [Text])
validationResults f (Either ArtistError 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 ArtistError b)
eff
    else Either ArtistError b -> f (Either ArtistError b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ArtistError b -> f (Either ArtistError b))
-> (ArtistError -> Either ArtistError b)
-> ArtistError
-> f (Either ArtistError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtistError -> Either ArtistError b
forall a b. a -> Either a b
Left (ArtistError -> f (Either ArtistError b))
-> ArtistError -> f (Either ArtistError b)
forall a b. (a -> b) -> a -> b
$ Map Text (Validation [Text]) -> ArtistError
ValidationFailedError Map Text (Validation [Text])
validationResults