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

module WikiMusic.Model.Artist
  ( Artist (..),
    ArtistArtwork (..),
    ArtistComment (..),
    ArtistOpinion (..),
    validateArtist,
    validateArtistArtwork,
    validateArtistComment,
    validateArtistOpinion,
    ArtistSortOrder (..),
    ArtistExternalSources (..),
    validateArtistExternalSources,
    ArtistArtworkOrderUpdate (..),
    validateArtistArtworkOrderUpdate,
    validateArtistDelta,
    ArtistDelta (..),
    Prelude.show,
    Prelude.read,
    ArtistIncludes (..),
    EnrichArtistParams (..),
    fullEnrichment,
    noEnrichment,
    parseInclude,
  )
where

import Data.Aeson hiding (Success)
import Data.Map qualified as Map
import Data.OpenApi
import Data.Text qualified as T
import Data.Time
import Data.UUID
import Keuringsdienst
import Keuringsdienst.Helpers
import Relude
import Text.Read
import WikiMusic.Model.Artwork
import WikiMusic.Model.Comment
import WikiMusic.Model.Opinion
import WikiMusic.Model.Thread
import Prelude qualified
import Optics

data ArtistIncludes = IncludeComments | IncludeOpinions | IncludeArtworks deriving (ArtistIncludes -> ArtistIncludes -> Bool
(ArtistIncludes -> ArtistIncludes -> Bool)
-> (ArtistIncludes -> ArtistIncludes -> Bool) -> Eq ArtistIncludes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArtistIncludes -> ArtistIncludes -> Bool
== :: ArtistIncludes -> ArtistIncludes -> Bool
$c/= :: ArtistIncludes -> ArtistIncludes -> Bool
/= :: ArtistIncludes -> ArtistIncludes -> Bool
Eq, (forall x. ArtistIncludes -> Rep ArtistIncludes x)
-> (forall x. Rep ArtistIncludes x -> ArtistIncludes)
-> Generic ArtistIncludes
forall x. Rep ArtistIncludes x -> ArtistIncludes
forall x. ArtistIncludes -> Rep ArtistIncludes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArtistIncludes -> Rep ArtistIncludes x
from :: forall x. ArtistIncludes -> Rep ArtistIncludes x
$cto :: forall x. Rep ArtistIncludes x -> ArtistIncludes
to :: forall x. Rep ArtistIncludes x -> ArtistIncludes
Generic, Maybe ArtistIncludes
Value -> Parser [ArtistIncludes]
Value -> Parser ArtistIncludes
(Value -> Parser ArtistIncludes)
-> (Value -> Parser [ArtistIncludes])
-> Maybe ArtistIncludes
-> FromJSON ArtistIncludes
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ArtistIncludes
parseJSON :: Value -> Parser ArtistIncludes
$cparseJSONList :: Value -> Parser [ArtistIncludes]
parseJSONList :: Value -> Parser [ArtistIncludes]
$comittedField :: Maybe ArtistIncludes
omittedField :: Maybe ArtistIncludes
FromJSON, [ArtistIncludes] -> Value
[ArtistIncludes] -> Encoding
ArtistIncludes -> Bool
ArtistIncludes -> Value
ArtistIncludes -> Encoding
(ArtistIncludes -> Value)
-> (ArtistIncludes -> Encoding)
-> ([ArtistIncludes] -> Value)
-> ([ArtistIncludes] -> Encoding)
-> (ArtistIncludes -> Bool)
-> ToJSON ArtistIncludes
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ArtistIncludes -> Value
toJSON :: ArtistIncludes -> Value
$ctoEncoding :: ArtistIncludes -> Encoding
toEncoding :: ArtistIncludes -> Encoding
$ctoJSONList :: [ArtistIncludes] -> Value
toJSONList :: [ArtistIncludes] -> Value
$ctoEncodingList :: [ArtistIncludes] -> Encoding
toEncodingList :: [ArtistIncludes] -> Encoding
$comitField :: ArtistIncludes -> Bool
omitField :: ArtistIncludes -> Bool
ToJSON, Typeable ArtistIncludes
Typeable ArtistIncludes =>
(Proxy ArtistIncludes -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ArtistIncludes
Proxy ArtistIncludes -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ArtistIncludes -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ArtistIncludes -> Declare (Definitions Schema) NamedSchema
ToSchema)

instance Show ArtistIncludes where
  show :: ArtistIncludes -> String
show ArtistIncludes
IncludeComments = String
"comments"
  show ArtistIncludes
IncludeOpinions = String
"opinions"
  show ArtistIncludes
IncludeArtworks = String
"artworks"

instance Read ArtistIncludes where
  readsPrec :: Int -> ReadS ArtistIncludes
readsPrec Int
_ String
"comments" = [(ArtistIncludes
IncludeComments, String
"")]
  readsPrec Int
_ String
"opinions" = [(ArtistIncludes
IncludeOpinions, String
"")]
  readsPrec Int
_ String
"artworks" = [(ArtistIncludes
IncludeArtworks, String
"")]
  readsPrec Int
_ String
_ = []

data ArtistSortOrder
  = DescCreatedAt
  | AscCreatedAt
  | DescLastEditedAt
  | AscLastEditedAt
  | DescDisplayName
  | AscDisplayName

instance Show ArtistSortOrder where
  show :: ArtistSortOrder -> String
show ArtistSortOrder
DescCreatedAt = String
"artists.created_at DESC"
  show ArtistSortOrder
AscCreatedAt = String
"artists.created_at ASC"
  show ArtistSortOrder
DescLastEditedAt = String
"artists.last_edited_at DESC"
  show ArtistSortOrder
AscLastEditedAt = String
"artists.last_edited_at ASC"
  show ArtistSortOrder
DescDisplayName = String
"artists.display_name DESC"
  show ArtistSortOrder
AscDisplayName = String
"artists.display_name ASC"

instance Read ArtistSortOrder where
  readsPrec :: Int -> ReadS ArtistSortOrder
readsPrec Int
_ String
"created-at-desc" = [(ArtistSortOrder
DescCreatedAt, String
"")]
  readsPrec Int
_ String
"created-at-asc" = [(ArtistSortOrder
AscCreatedAt, String
"")]
  readsPrec Int
_ String
"last-edited-at-desc" = [(ArtistSortOrder
DescLastEditedAt, String
"")]
  readsPrec Int
_ String
"last-edited-at-asc" = [(ArtistSortOrder
AscLastEditedAt, String
"")]
  readsPrec Int
_ String
"display-name-desc" = [(ArtistSortOrder
DescDisplayName, String
"")]
  readsPrec Int
_ String
"display-name-asc" = [(ArtistSortOrder
AscDisplayName, String
"")]
  readsPrec Int
_ String
_ = []

validateArtistOpinion :: ArtistOpinion -> ValidationResult
validateArtistOpinion :: ArtistOpinion -> ValidationResult
validateArtistOpinion ArtistOpinion
x =
  (ArtistOpinion
x ArtistOpinion -> Optic' A_Lens NoIx ArtistOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistOpinion ArtistOpinion Opinion Opinion
#opinion Optic A_Lens NoIx ArtistOpinion ArtistOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx ArtistOpinion Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Opinion Opinion Bool Bool
#isLike)
    Bool -> ValidationRule Bool -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| Bool -> ValidationRule Bool
forall a. (Show a, Eq a) => a -> ValidationRule a
isNotEqualTo (ArtistOpinion
x ArtistOpinion -> Optic' A_Lens NoIx ArtistOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistOpinion ArtistOpinion Opinion Opinion
#opinion Optic A_Lens NoIx ArtistOpinion ArtistOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx ArtistOpinion Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Opinion Opinion Bool Bool
#isDislike)
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistOpinion
x ArtistOpinion -> Optic' A_Lens NoIx ArtistOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistOpinion ArtistOpinion Opinion Opinion
#opinion Optic A_Lens NoIx ArtistOpinion ArtistOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx ArtistOpinion Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Opinion Opinion Bool Bool
#isDislike)
      Bool -> ValidationRule Bool -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| Bool -> ValidationRule Bool
forall a. (Show a, Eq a) => a -> ValidationRule a
isNotEqualTo (ArtistOpinion
x ArtistOpinion -> Optic' A_Lens NoIx ArtistOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistOpinion ArtistOpinion Opinion Opinion
#opinion Optic A_Lens NoIx ArtistOpinion ArtistOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx ArtistOpinion Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Opinion Opinion Bool Bool
#isLike)

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

validateArtistArtwork :: ArtistArtwork -> ValidationResult
validateArtistArtwork :: ArtistArtwork -> ValidationResult
validateArtistArtwork ArtistArtwork
x =
  (ArtistArtwork
x ArtistArtwork -> Optic' A_Lens NoIx ArtistArtwork Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistArtwork ArtistArtwork Artwork Artwork
#artwork Optic A_Lens NoIx ArtistArtwork ArtistArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork Text Text
-> Optic' A_Lens NoIx ArtistArtwork Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Artwork Artwork Text Text
#contentUrl)
    Text -> ValidationRule Text -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistArtwork
x ArtistArtwork
-> Optic' A_Lens NoIx ArtistArtwork (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistArtwork ArtistArtwork Artwork Artwork
#artwork Optic A_Lens NoIx ArtistArtwork ArtistArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork (Maybe Text) (Maybe Text)
-> Optic' A_Lens NoIx ArtistArtwork (Maybe Text)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Artwork Artwork (Maybe Text) (Maybe Text)
#contentCaption)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistArtwork
x ArtistArtwork -> Optic' A_Lens NoIx ArtistArtwork Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistArtwork ArtistArtwork Artwork Artwork
#artwork Optic A_Lens NoIx ArtistArtwork ArtistArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork Int Int
-> Optic' A_Lens NoIx ArtistArtwork Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Artwork Artwork Int Int
#visibilityStatus)
      Int -> ValidationRule Int -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| ValidationRule Int
isPositiveOrZero
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistArtwork
x ArtistArtwork -> Optic' A_Lens NoIx ArtistArtwork Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistArtwork ArtistArtwork Artwork Artwork
#artwork Optic A_Lens NoIx ArtistArtwork ArtistArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork Int Int
-> Optic' A_Lens NoIx ArtistArtwork Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Artwork Artwork Int Int
#orderValue)
      Int -> ValidationRule Int -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| ValidationRule Int
isPositiveOrZero

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

validateArtistComment :: ArtistComment -> ValidationResult
validateArtistComment :: ArtistComment -> ValidationResult
validateArtistComment ArtistComment
x =
  (ArtistComment
x ArtistComment -> Optic' A_Lens NoIx ArtistComment Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistComment ArtistComment Comment Comment
#comment Optic A_Lens NoIx ArtistComment ArtistComment Comment Comment
-> Optic A_Lens NoIx Comment Comment Int Int
-> Optic' A_Lens NoIx ArtistComment Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Comment Comment Int Int
#visibilityStatus)
    Int -> ValidationRule Int -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| ValidationRule Int
isPositiveOrZero
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistComment
x ArtistComment -> Optic' A_Lens NoIx ArtistComment Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ArtistComment ArtistComment Comment Comment
#comment Optic A_Lens NoIx ArtistComment ArtistComment Comment Comment
-> Optic A_Lens NoIx Comment Comment Text Text
-> Optic' A_Lens NoIx ArtistComment Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Comment Comment Text Text
#contents)
      Text -> ValidationRule Text -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| (ValidationRule Text
isNonEmptyText ValidationRule Text -> ValidationRule Text -> ValidationRule Text
forall a. Semigroup a => a -> a -> a
<> Int -> ValidationRule Text
isTextSmallerThanOrEqual Int
8200)

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

validateArtist :: Artist -> ValidationResult
validateArtist :: Artist -> ValidationResult
validateArtist Artist
x =
  (Artist
x Artist -> Optic' A_Lens NoIx Artist Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artist Text
#displayName)
    Text -> ValidationRule Text -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| (ValidationRule Text
isNonEmptyText ValidationRule Text -> ValidationRule Text -> ValidationRule Text
forall a. Semigroup a => a -> a -> a
<> Int -> ValidationRule Text
isTextSmallerThanOrEqual Int
340)
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (Artist
x Artist -> Optic' A_Lens NoIx Artist Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artist Int
#visibilityStatus)
      Int -> ValidationRule Int -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| ValidationRule Int
isPositiveOrZero
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (Artist
x Artist -> Optic' A_Lens NoIx Artist (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artist (Maybe Text)
#spotifyUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (Artist
x Artist -> Optic' A_Lens NoIx Artist (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artist (Maybe Text)
#youtubeUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (Artist
x Artist -> Optic' A_Lens NoIx Artist (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artist (Maybe Text)
#soundcloudUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (Artist
x Artist -> Optic' A_Lens NoIx Artist (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artist (Maybe Text)
#wikipediaUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText

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

makeFieldLabelsNoPrefix ''Artist
makeFieldLabelsNoPrefix ''ArtistComment
makeFieldLabelsNoPrefix ''ArtistArtwork
makeFieldLabelsNoPrefix ''ArtistOpinion

validateArtistExternalSources :: ArtistExternalSources -> ValidationResult
validateArtistExternalSources :: ArtistExternalSources -> ValidationResult
validateArtistExternalSources ArtistExternalSources
x =
  (ArtistExternalSources
x ArtistExternalSources
-> Optic' A_Lens NoIx ArtistExternalSources (Maybe Text)
-> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistExternalSources (Maybe Text)
#spotifyUrl)
    Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistExternalSources
x ArtistExternalSources
-> Optic' A_Lens NoIx ArtistExternalSources (Maybe Text)
-> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistExternalSources (Maybe Text)
#youtubeUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistExternalSources
x ArtistExternalSources
-> Optic' A_Lens NoIx ArtistExternalSources (Maybe Text)
-> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistExternalSources (Maybe Text)
#soundcloudUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistExternalSources
x ArtistExternalSources
-> Optic' A_Lens NoIx ArtistExternalSources (Maybe Text)
-> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistExternalSources (Maybe Text)
#wikipediaUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText

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

makeFieldLabelsNoPrefix ''ArtistExternalSources

validateArtistArtworkOrderUpdate :: ArtistArtworkOrderUpdate -> ValidationResult
validateArtistArtworkOrderUpdate :: ArtistArtworkOrderUpdate -> ValidationResult
validateArtistArtworkOrderUpdate ArtistArtworkOrderUpdate
x =
  (ArtistArtworkOrderUpdate
x ArtistArtworkOrderUpdate
-> Optic' A_Lens NoIx ArtistArtworkOrderUpdate Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistArtworkOrderUpdate Int
#orderValue) Int -> ValidationRule Int -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| ValidationRule Int
isPositiveOrZero

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

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

makeFieldLabelsNoPrefix ''ArtistDelta

validateArtistDelta :: ArtistDelta -> ValidationResult
validateArtistDelta :: ArtistDelta -> ValidationResult
validateArtistDelta ArtistDelta
x =
  (ArtistDelta
x ArtistDelta
-> Optic' A_Lens NoIx ArtistDelta (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistDelta (Maybe Text)
#displayName)
    Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| (ValidationRule Text
isNonEmptyText ValidationRule Text -> ValidationRule Text -> ValidationRule Text
forall a. Semigroup a => a -> a -> a
<> Int -> ValidationRule Text
isTextSmallerThanOrEqual Int
340)
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistDelta
x ArtistDelta
-> Optic' A_Lens NoIx ArtistDelta (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistDelta (Maybe Text)
#spotifyUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistDelta
x ArtistDelta
-> Optic' A_Lens NoIx ArtistDelta (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistDelta (Maybe Text)
#youtubeUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistDelta
x ArtistDelta
-> Optic' A_Lens NoIx ArtistDelta (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistDelta (Maybe Text)
#soundcloudUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (ArtistDelta
x ArtistDelta
-> Optic' A_Lens NoIx ArtistDelta (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistDelta (Maybe Text)
#wikipediaUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText

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

makeFieldLabelsNoPrefix ''EnrichArtistParams

fullEnrichment :: EnrichArtistParams
fullEnrichment :: EnrichArtistParams
fullEnrichment =
  EnrichArtistParams
    { $sel:includeComments:EnrichArtistParams :: Bool
includeComments = Bool
True,
      $sel:includeArtworks:EnrichArtistParams :: Bool
includeArtworks = Bool
True,
      $sel:includeOpinions:EnrichArtistParams :: Bool
includeOpinions = Bool
True
    }

noEnrichment :: EnrichArtistParams
noEnrichment :: EnrichArtistParams
noEnrichment =
  EnrichArtistParams
    { $sel:includeComments:EnrichArtistParams :: Bool
includeComments = Bool
False,
      $sel:includeArtworks:EnrichArtistParams :: Bool
includeArtworks = Bool
False,
      $sel:includeOpinions:EnrichArtistParams :: Bool
includeOpinions = Bool
False
    }

parseInclude :: Text -> EnrichArtistParams
parseInclude :: Text -> EnrichArtistParams
parseInclude Text
includeString = do
  EnrichArtistParams
    { $sel:includeComments:EnrichArtistParams :: Bool
includeComments = ArtistIncludes -> Bool
fromIncludeMap ArtistIncludes
IncludeComments,
      $sel:includeOpinions:EnrichArtistParams :: Bool
includeOpinions = ArtistIncludes -> Bool
fromIncludeMap ArtistIncludes
IncludeOpinions,
      $sel:includeArtworks:EnrichArtistParams :: Bool
includeArtworks = ArtistIncludes -> Bool
fromIncludeMap ArtistIncludes
IncludeArtworks
    }
  where
    includes :: Map Text Bool
includes = [(Text, Bool)] -> Map Text Bool
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Bool)] -> Map Text Bool)
-> [(Text, Bool)] -> Map Text Bool
forall a b. (a -> b) -> a -> b
$ (Text -> (Text, Bool)) -> [Text] -> [(Text, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (,Bool
True) ((Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
includeString)
    fromIncludeMap :: ArtistIncludes -> Bool
fromIncludeMap ArtistIncludes
k = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Map Text Bool
includes Map Text Bool -> Text -> Maybe Bool
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? (String -> Text
T.pack (String -> Text)
-> (ArtistIncludes -> String) -> ArtistIncludes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtistIncludes -> String
forall b a. (Show a, IsString b) => a -> b
show (ArtistIncludes -> Text) -> ArtistIncludes -> Text
forall a b. (a -> b) -> a -> b
$ ArtistIncludes
k))