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

module WikiMusic.Model.Song
  ( Song (..),
    SongArtwork (..),
    SongComment (..),
    SongOpinion (..),
    SongContent (..),
    validateSong,
    validateSongArtwork,
    validateSongComment,
    validateSongOpinion,
    validateSongContent,
    SongSortOrder (..),
    validateArtistOfSong,
    ArtistOfSong (..),
    SongExternalSources (..),
    validateSongExternalSources,
    SongArtworkOrderUpdate (..),
    validateSongArtworkOrderUpdate,
    validateSongDelta,
    SongDelta (..),
    validateSongContentDelta,
    SongContentDelta (..),
    Prelude.show,
    Prelude.read,
    SongIncludes (..),
    EnrichSongParams (..),
    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 Optics
import Relude
import Text.Read
import WikiMusic.Model.Artwork
import WikiMusic.Model.Comment
import WikiMusic.Model.Opinion
import WikiMusic.Model.Thread
import Prelude qualified

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

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

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

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

makeFieldLabelsNoPrefix ''SongContent

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

validateSongArtwork :: SongArtwork -> ValidationResult
validateSongArtwork :: SongArtwork -> ValidationResult
validateSongArtwork SongArtwork
x =
  (SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork Text Text
-> Optic' A_Lens NoIx SongArtwork 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
<> (SongArtwork
x SongArtwork
-> Optic' A_Lens NoIx SongArtwork (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 SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork (Maybe Text) (Maybe Text)
-> Optic' A_Lens NoIx SongArtwork (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
<> (SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork Int Int
-> Optic' A_Lens NoIx SongArtwork 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
<> (SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork Int Int
-> Optic' A_Lens NoIx SongArtwork 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 SongArtwork = SongArtwork
  { SongArtwork -> UUID
songIdentifier :: UUID,
    SongArtwork -> Artwork
artwork :: Artwork
  }
  deriving (SongArtwork -> SongArtwork -> Bool
(SongArtwork -> SongArtwork -> Bool)
-> (SongArtwork -> SongArtwork -> Bool) -> Eq SongArtwork
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SongArtwork -> SongArtwork -> Bool
== :: SongArtwork -> SongArtwork -> Bool
$c/= :: SongArtwork -> SongArtwork -> Bool
/= :: SongArtwork -> SongArtwork -> Bool
Eq, Int -> SongArtwork -> ShowS
[SongArtwork] -> ShowS
SongArtwork -> String
(Int -> SongArtwork -> ShowS)
-> (SongArtwork -> String)
-> ([SongArtwork] -> ShowS)
-> Show SongArtwork
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SongArtwork -> ShowS
showsPrec :: Int -> SongArtwork -> ShowS
$cshow :: SongArtwork -> String
show :: SongArtwork -> String
$cshowList :: [SongArtwork] -> ShowS
showList :: [SongArtwork] -> ShowS
Show, (forall x. SongArtwork -> Rep SongArtwork x)
-> (forall x. Rep SongArtwork x -> SongArtwork)
-> Generic SongArtwork
forall x. Rep SongArtwork x -> SongArtwork
forall x. SongArtwork -> Rep SongArtwork x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SongArtwork -> Rep SongArtwork x
from :: forall x. SongArtwork -> Rep SongArtwork x
$cto :: forall x. Rep SongArtwork x -> SongArtwork
to :: forall x. Rep SongArtwork x -> SongArtwork
Generic, Maybe SongArtwork
Value -> Parser [SongArtwork]
Value -> Parser SongArtwork
(Value -> Parser SongArtwork)
-> (Value -> Parser [SongArtwork])
-> Maybe SongArtwork
-> FromJSON SongArtwork
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SongArtwork
parseJSON :: Value -> Parser SongArtwork
$cparseJSONList :: Value -> Parser [SongArtwork]
parseJSONList :: Value -> Parser [SongArtwork]
$comittedField :: Maybe SongArtwork
omittedField :: Maybe SongArtwork
FromJSON, [SongArtwork] -> Value
[SongArtwork] -> Encoding
SongArtwork -> Bool
SongArtwork -> Value
SongArtwork -> Encoding
(SongArtwork -> Value)
-> (SongArtwork -> Encoding)
-> ([SongArtwork] -> Value)
-> ([SongArtwork] -> Encoding)
-> (SongArtwork -> Bool)
-> ToJSON SongArtwork
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SongArtwork -> Value
toJSON :: SongArtwork -> Value
$ctoEncoding :: SongArtwork -> Encoding
toEncoding :: SongArtwork -> Encoding
$ctoJSONList :: [SongArtwork] -> Value
toJSONList :: [SongArtwork] -> Value
$ctoEncodingList :: [SongArtwork] -> Encoding
toEncodingList :: [SongArtwork] -> Encoding
$comitField :: SongArtwork -> Bool
omitField :: SongArtwork -> Bool
ToJSON, Typeable SongArtwork
Typeable SongArtwork =>
(Proxy SongArtwork -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SongArtwork
Proxy SongArtwork -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SongArtwork -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SongArtwork -> Declare (Definitions Schema) NamedSchema
ToSchema)

validateSongComment :: SongComment -> ValidationResult
validateSongComment :: SongComment -> ValidationResult
validateSongComment SongComment
x =
  (SongComment
x SongComment -> Optic' A_Lens NoIx SongComment Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment Int Int
-> Optic' A_Lens NoIx SongComment 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
<> (SongComment
x SongComment -> Optic' A_Lens NoIx SongComment Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment Text Text
-> Optic' A_Lens NoIx SongComment 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 SongComment = SongComment
  { SongComment -> UUID
songIdentifier :: UUID,
    SongComment -> Comment
comment :: Comment
  }
  deriving (SongComment -> SongComment -> Bool
(SongComment -> SongComment -> Bool)
-> (SongComment -> SongComment -> Bool) -> Eq SongComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SongComment -> SongComment -> Bool
== :: SongComment -> SongComment -> Bool
$c/= :: SongComment -> SongComment -> Bool
/= :: SongComment -> SongComment -> Bool
Eq, Int -> SongComment -> ShowS
[SongComment] -> ShowS
SongComment -> String
(Int -> SongComment -> ShowS)
-> (SongComment -> String)
-> ([SongComment] -> ShowS)
-> Show SongComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SongComment -> ShowS
showsPrec :: Int -> SongComment -> ShowS
$cshow :: SongComment -> String
show :: SongComment -> String
$cshowList :: [SongComment] -> ShowS
showList :: [SongComment] -> ShowS
Show, (forall x. SongComment -> Rep SongComment x)
-> (forall x. Rep SongComment x -> SongComment)
-> Generic SongComment
forall x. Rep SongComment x -> SongComment
forall x. SongComment -> Rep SongComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SongComment -> Rep SongComment x
from :: forall x. SongComment -> Rep SongComment x
$cto :: forall x. Rep SongComment x -> SongComment
to :: forall x. Rep SongComment x -> SongComment
Generic, Maybe SongComment
Value -> Parser [SongComment]
Value -> Parser SongComment
(Value -> Parser SongComment)
-> (Value -> Parser [SongComment])
-> Maybe SongComment
-> FromJSON SongComment
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SongComment
parseJSON :: Value -> Parser SongComment
$cparseJSONList :: Value -> Parser [SongComment]
parseJSONList :: Value -> Parser [SongComment]
$comittedField :: Maybe SongComment
omittedField :: Maybe SongComment
FromJSON, [SongComment] -> Value
[SongComment] -> Encoding
SongComment -> Bool
SongComment -> Value
SongComment -> Encoding
(SongComment -> Value)
-> (SongComment -> Encoding)
-> ([SongComment] -> Value)
-> ([SongComment] -> Encoding)
-> (SongComment -> Bool)
-> ToJSON SongComment
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SongComment -> Value
toJSON :: SongComment -> Value
$ctoEncoding :: SongComment -> Encoding
toEncoding :: SongComment -> Encoding
$ctoJSONList :: [SongComment] -> Value
toJSONList :: [SongComment] -> Value
$ctoEncodingList :: [SongComment] -> Encoding
toEncodingList :: [SongComment] -> Encoding
$comitField :: SongComment -> Bool
omitField :: SongComment -> Bool
ToJSON, Typeable SongComment
Typeable SongComment =>
(Proxy SongComment -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SongComment
Proxy SongComment -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SongComment -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SongComment -> Declare (Definitions Schema) NamedSchema
ToSchema)

validateSongExternalSources :: SongExternalSources -> ValidationResult
validateSongExternalSources :: SongExternalSources -> ValidationResult
validateSongExternalSources SongExternalSources
x =
  (SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources (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 SongExternalSources (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
<> (SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources (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 SongExternalSources (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
<> (SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources (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 SongExternalSources (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
<> (SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources (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 SongExternalSources (Maybe Text)
#wikipediaUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText

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

makeFieldLabelsNoPrefix ''SongExternalSources

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

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

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

makeFieldLabelsNoPrefix ''EnrichSongParams

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

instance Show SongIncludes where
  show :: SongIncludes -> String
show SongIncludes
IncludeComments = String
"comments"
  show SongIncludes
IncludeOpinions = String
"opinions"
  show SongIncludes
IncludeArtworks = String
"artworks"
  show SongIncludes
IncludeArtists = String
"artists"
  show SongIncludes
IncludeContents = String
"contents"

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

fullEnrichment :: EnrichSongParams
fullEnrichment :: EnrichSongParams
fullEnrichment =
  EnrichSongParams
    { $sel:includeComments:EnrichSongParams :: Bool
includeComments = Bool
True,
      $sel:includeArtworks:EnrichSongParams :: Bool
includeArtworks = Bool
True,
      $sel:includeOpinions:EnrichSongParams :: Bool
includeOpinions = Bool
True,
      $sel:includeArtists:EnrichSongParams :: Bool
includeArtists = Bool
True,
      $sel:includeContents:EnrichSongParams :: Bool
includeContents = Bool
True
    }

noEnrichment :: EnrichSongParams
noEnrichment :: EnrichSongParams
noEnrichment =
  EnrichSongParams
    { $sel:includeComments:EnrichSongParams :: Bool
includeComments = Bool
False,
      $sel:includeArtworks:EnrichSongParams :: Bool
includeArtworks = Bool
False,
      $sel:includeOpinions:EnrichSongParams :: Bool
includeOpinions = Bool
False,
      $sel:includeArtists:EnrichSongParams :: Bool
includeArtists = Bool
False,
      $sel:includeContents:EnrichSongParams :: Bool
includeContents = Bool
False
    }

parseInclude :: Text -> EnrichSongParams
parseInclude :: Text -> EnrichSongParams
parseInclude Text
includeString = do
  EnrichSongParams
    { $sel:includeComments:EnrichSongParams :: Bool
includeComments = SongIncludes -> Bool
fromIncludeMap SongIncludes
IncludeComments,
      $sel:includeOpinions:EnrichSongParams :: Bool
includeOpinions = SongIncludes -> Bool
fromIncludeMap SongIncludes
IncludeOpinions,
      $sel:includeArtworks:EnrichSongParams :: Bool
includeArtworks = SongIncludes -> Bool
fromIncludeMap SongIncludes
IncludeArtworks,
      $sel:includeArtists:EnrichSongParams :: Bool
includeArtists = SongIncludes -> Bool
fromIncludeMap SongIncludes
IncludeArtists,
      $sel:includeContents:EnrichSongParams :: Bool
includeContents = SongIncludes -> Bool
fromIncludeMap SongIncludes
IncludeContents
    }
  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 :: SongIncludes -> Bool
fromIncludeMap SongIncludes
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)
-> (SongIncludes -> String) -> SongIncludes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongIncludes -> String
forall b a. (Show a, IsString b) => a -> b
show (SongIncludes -> Text) -> SongIncludes -> Text
forall a b. (a -> b) -> a -> b
$ SongIncludes
k))

validateArtistOfSong :: ArtistOfSong -> ValidationResult
validateArtistOfSong :: ArtistOfSong -> ValidationResult
validateArtistOfSong ArtistOfSong
_ = ValidationResult
forall err. Validation err
Success

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

validateSongContent :: SongContent -> ValidationResult
validateSongContent :: SongContent -> ValidationResult
validateSongContent SongContent
x =
  (SongContent
x SongContent -> Optic' A_Lens NoIx SongContent Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent Text
#versionName)
    Text -> ValidationRule Text -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| Int -> ValidationRule Text
isTextSmallerThanOrEqual Int
400
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (SongContent
x SongContent -> Optic' A_Lens NoIx SongContent Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent Text
#instrumentType)
      Text -> ValidationRule Text -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| ValidationRule Text
isNonEmptyText
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (SongContent
x SongContent
-> Optic' A_Lens NoIx SongContent (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 SongContent (Maybe Text)
#asciiLegend)
      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
<> (SongContent
x SongContent
-> Optic' A_Lens NoIx SongContent (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 SongContent (Maybe Text)
#asciiContents)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText

validateSongContentDelta :: SongContentDelta -> ValidationResult
validateSongContentDelta :: SongContentDelta -> ValidationResult
validateSongContentDelta SongContentDelta
x =
  (SongContentDelta
x SongContentDelta
-> Optic' A_Lens NoIx SongContentDelta Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContentDelta Text
#versionName)
    Text -> ValidationRule Text -> ValidationResult
forall a. a -> ValidationRule a -> ValidationResult
|?| Int -> ValidationRule Text
isTextSmallerThanOrEqual Int
400
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (SongContentDelta
x SongContentDelta
-> Optic' A_Lens NoIx SongContentDelta (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 SongContentDelta (Maybe Text)
#instrumentType)
      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
<> (SongContentDelta
x SongContentDelta
-> Optic' A_Lens NoIx SongContentDelta (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 SongContentDelta (Maybe Text)
#asciiLegend)
      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
<> (SongContentDelta
x SongContentDelta
-> Optic' A_Lens NoIx SongContentDelta (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 SongContentDelta (Maybe Text)
#asciiContents)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText

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

makeFieldLabelsNoPrefix ''Song
makeFieldLabelsNoPrefix ''SongComment
makeFieldLabelsNoPrefix ''SongArtwork
makeFieldLabelsNoPrefix ''SongOpinion

makeFieldLabelsNoPrefix ''ArtistOfSong

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

makeFieldLabelsNoPrefix ''SongDelta

validateSongDelta :: SongDelta -> ValidationResult
validateSongDelta :: SongDelta -> ValidationResult
validateSongDelta SongDelta
x =
  (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (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
<> (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (Maybe Text)
#musicKey)
      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
100)
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (Maybe Text)
#musicTuning)
      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
100)
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (Maybe Text)
#musicCreationDate)
      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
<> (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (Maybe Text)
#albumName)
      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
<> (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (Maybe Text)
#albumInfoLink)
      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
<> (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (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
<> (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (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
<> (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (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
<> (SongDelta
x SongDelta
-> Optic' A_Lens NoIx SongDelta (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 SongDelta (Maybe Text)
#wikipediaUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText

validateSong :: Song -> ValidationResult
validateSong :: Song -> ValidationResult
validateSong Song
x =
  (Song
x Song -> Optic' A_Lens NoIx Song Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song 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
<> (Song
x Song -> Optic' A_Lens NoIx Song (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 Song (Maybe Text)
#musicKey)
      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
50)
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (Song
x Song -> Optic' A_Lens NoIx Song (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 Song (Maybe Text)
#musicTuning)
      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
50)
    ValidationResult -> ValidationResult -> ValidationResult
forall a. Semigroup a => a -> a -> a
<> (Song
x Song -> Optic' A_Lens NoIx Song (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 Song (Maybe Text)
#musicCreationDate)
      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
<> (Song
x Song -> Optic' A_Lens NoIx Song (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 Song (Maybe Text)
#albumName)
      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
<> (Song
x Song -> Optic' A_Lens NoIx Song (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 Song (Maybe Text)
#albumInfoLink)
      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
<> (Song
x Song -> Optic' A_Lens NoIx Song Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song 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
<> (Song
x Song -> Optic' A_Lens NoIx Song (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 Song (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
<> (Song
x Song -> Optic' A_Lens NoIx Song (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 Song (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
<> (Song
x Song -> Optic' A_Lens NoIx Song (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 Song (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
<> (Song
x Song -> Optic' A_Lens NoIx Song (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 Song (Maybe Text)
#wikipediaUrl)
      Maybe Text -> ValidationRule Text -> ValidationResult
forall a. Maybe a -> ValidationRule a -> ValidationResult
|??| ValidationRule Text
isNonEmptyText

validateSongOpinion :: SongOpinion -> ValidationResult
validateSongOpinion :: SongOpinion -> ValidationResult
validateSongOpinion SongOpinion
x =
  (SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx SongOpinion 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 (SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx SongOpinion 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
<> (SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx SongOpinion 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 (SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx SongOpinion 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)

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