{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoFieldSelectors #-} module WikiMusic.Model.Genre ( Genre (..), GenreArtwork (..), GenreComment (..), GenreOpinion (..), validateGenre, validateGenreArtwork, validateGenreComment, validateGenreOpinion, GenreSortOrder (..), GenreExternalSources (..), validateGenreExternalSources, GenreArtworkOrderUpdate (..), validateGenreArtworkOrderUpdate, validateGenreDelta, GenreDelta (..), Prelude.show, Prelude.read, GenreIncludes (..), EnrichGenreParams (..), 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 GenreIncludes = IncludeComments | IncludeOpinions | IncludeArtworks deriving (Eq, Generic, FromJSON, ToJSON, ToSchema) instance Show GenreIncludes where show IncludeComments = "comments" show IncludeOpinions = "opinions" show IncludeArtworks = "artworks" instance Read GenreIncludes where readsPrec _ "comments" = [(IncludeComments, "")] readsPrec _ "opinions" = [(IncludeOpinions, "")] readsPrec _ "artworks" = [(IncludeArtworks, "")] readsPrec _ _ = [] data GenreSortOrder = DescCreatedAt | AscCreatedAt | DescLastEditedAt | AscLastEditedAt | DescDisplayName | AscDisplayName instance Show GenreSortOrder where show DescCreatedAt = "genres.created_at DESC" show AscCreatedAt = "genres.created_at ASC" show DescLastEditedAt = "genres.last_edited_at DESC" show AscLastEditedAt = "genres.last_edited_at ASC" show DescDisplayName = "genres.display_name DESC" show AscDisplayName = "genres.display_name ASC" instance Read GenreSortOrder where readsPrec _ "created-at-desc" = [(DescCreatedAt, "")] readsPrec _ "created-at-asc" = [(AscCreatedAt, "")] readsPrec _ "last-edited-at-desc" = [(DescLastEditedAt, "")] readsPrec _ "last-edited-at-asc" = [(AscLastEditedAt, "")] readsPrec _ "display-name-desc" = [(DescDisplayName, "")] readsPrec _ "display-name-asc" = [(AscDisplayName, "")] readsPrec _ _ = [] validateGenreOpinion :: GenreOpinion -> ValidationResult validateGenreOpinion x = (x ^. #opinion % #isLike) |?| isNotEqualTo (x ^. #opinion % #isDislike) <> (x ^. #opinion % #isDislike) |?| isNotEqualTo (x ^. #opinion % #isLike) data GenreOpinion = GenreOpinion { genreIdentifier :: UUID, opinion :: Opinion } deriving (Eq, Show, Generic, FromJSON, ToJSON, ToSchema) validateGenreArtwork :: GenreArtwork -> ValidationResult validateGenreArtwork x = (x ^. #artwork % #contentUrl) |?| isNonEmptyText <> (x ^. #artwork % #contentCaption) |??| isNonEmptyText <> (x ^. #artwork % #visibilityStatus) |?| isPositiveOrZero <> (x ^. #artwork % #orderValue) |?| isPositiveOrZero data GenreArtwork = GenreArtwork { genreIdentifier :: UUID, artwork :: Artwork } deriving (Eq, Show, Generic, FromJSON, ToJSON, ToSchema) validateGenreComment :: GenreComment -> ValidationResult validateGenreComment x = (x ^. #comment % #visibilityStatus) |?| isPositiveOrZero <> (x ^. #comment % #contents) |?| (isNonEmptyText <> isTextSmallerThanOrEqual 8200) data GenreComment = GenreComment { genreIdentifier :: UUID, comment :: Comment } deriving (Eq, Show, Generic, FromJSON, ToJSON, ToSchema) validateGenre :: Genre -> ValidationResult validateGenre x = (x ^. #displayName) |?| (isNonEmptyText <> isTextSmallerThanOrEqual 340) <> (x ^. #visibilityStatus) |?| isPositiveOrZero <> (x ^. #spotifyUrl) |??| isNonEmptyText <> (x ^. #youtubeUrl) |??| isNonEmptyText <> (x ^. #soundcloudUrl) |??| isNonEmptyText <> (x ^. #wikipediaUrl) |??| isNonEmptyText data Genre = Genre { identifier :: UUID, parentIdentifier :: Maybe UUID, displayName :: Text, createdBy :: UUID, visibilityStatus :: Int, approvedBy :: Maybe UUID, createdAt :: UTCTime, lastEditedAt :: Maybe UTCTime, artworks :: Map UUID GenreArtwork, comments :: [ThreadRender GenreComment], opinions :: Map UUID GenreOpinion, spotifyUrl :: Maybe Text, youtubeUrl :: Maybe Text, soundcloudUrl :: Maybe Text, wikipediaUrl :: Maybe Text, viewCount :: Int, description :: Maybe Text } deriving (Eq, Show, Generic, FromJSON, ToJSON, ToSchema) makeFieldLabelsNoPrefix ''Genre makeFieldLabelsNoPrefix ''GenreComment makeFieldLabelsNoPrefix ''GenreArtwork makeFieldLabelsNoPrefix ''GenreOpinion validateGenreExternalSources :: GenreExternalSources -> ValidationResult validateGenreExternalSources x = (x ^. #spotifyUrl) |??| isNonEmptyText <> (x ^. #youtubeUrl) |??| isNonEmptyText <> (x ^. #soundcloudUrl) |??| isNonEmptyText <> (x ^. #wikipediaUrl) |??| isNonEmptyText data GenreExternalSources = GenreExternalSources { identifier :: UUID, genreIdentifier :: UUID, createdBy :: UUID, spotifyUrl :: Maybe Text, youtubeUrl :: Maybe Text, soundcloudUrl :: Maybe Text, wikipediaUrl :: Maybe Text, createdAt :: UTCTime, lastEditedAt :: Maybe UTCTime } deriving (Eq, Show, Generic, FromJSON, ToJSON, ToSchema) makeFieldLabelsNoPrefix ''GenreExternalSources validateGenreArtworkOrderUpdate :: GenreArtworkOrderUpdate -> ValidationResult validateGenreArtworkOrderUpdate x = (x ^. #orderValue) |?| isPositiveOrZero data GenreArtworkOrderUpdate = GenreArtworkOrderUpdate { identifier :: UUID, orderValue :: Int } deriving (Eq, Show, Generic, FromJSON, ToJSON, ToSchema) data GenreDelta = GenreDelta { identifier :: UUID, displayName :: Maybe Text, spotifyUrl :: Maybe Text, youtubeUrl :: Maybe Text, soundcloudUrl :: Maybe Text, wikipediaUrl :: Maybe Text, description :: Maybe Text } deriving (Eq, Show, Generic, FromJSON, ToJSON, ToSchema) makeFieldLabelsNoPrefix ''GenreDelta validateGenreDelta :: GenreDelta -> ValidationResult validateGenreDelta x = (x ^. #displayName) |??| (isNonEmptyText <> isTextSmallerThanOrEqual 340) <> (x ^. #spotifyUrl) |??| isNonEmptyText <> (x ^. #youtubeUrl) |??| isNonEmptyText <> (x ^. #soundcloudUrl) |??| isNonEmptyText <> (x ^. #wikipediaUrl) |??| isNonEmptyText data EnrichGenreParams = EnrichGenreParams { includeComments :: Bool, includeOpinions :: Bool, includeArtworks :: Bool } deriving (Eq, Show, Generic, FromJSON, ToJSON, ToSchema) makeFieldLabelsNoPrefix ''EnrichGenreParams fullEnrichment :: EnrichGenreParams fullEnrichment = EnrichGenreParams { includeComments = True, includeArtworks = True, includeOpinions = True } noEnrichment :: EnrichGenreParams noEnrichment = EnrichGenreParams { includeComments = False, includeArtworks = False, includeOpinions = False } parseInclude :: Text -> EnrichGenreParams parseInclude includeString = do EnrichGenreParams { includeComments = fromIncludeMap IncludeComments, includeOpinions = fromIncludeMap IncludeOpinions, includeArtworks = fromIncludeMap IncludeArtworks } where includes = Map.fromList $ map (,True) (T.split (== ',') includeString) fromIncludeMap k = fromMaybe False (includes Map.!? (T.pack . show $ k))