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

module WikiMusic.Model.Other
  ( User (..),
    SystemInformationResponse (..),
    Offset (..),
    Limit (..),
    FetchLimit (..),
    SearchInput (..),
  )
where

import Data.Aeson
import Data.OpenApi
import Relude
import Data.Time
import Optics

newtype Limit = Limit Int

newtype Offset = Offset Int

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

makeFieldLabelsNoPrefix ''SystemInformationResponse

data User = User
  { User -> Text
identifier :: Text,
    User -> Text
displayName :: Text,
    User -> Text
emailAddress :: Text,
    User -> Text
passwordHash :: Text,
    User -> Maybe Text
passwordResetToken :: Maybe Text,
    User -> Maybe UTCTime
latestLoginAt :: Maybe UTCTime,
    User -> Maybe Text
latestLoginDevice :: Maybe Text,
    User -> Maybe Text
avatarUrl :: Maybe Text,
    User -> UTCTime
createdAt :: UTCTime,
    User -> Maybe UTCTime
lastEditedAt :: Maybe UTCTime,
    User -> Maybe Text
description :: Maybe Text
  }
  deriving (User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: User -> User -> Bool
== :: User -> User -> Bool
$c/= :: User -> User -> Bool
/= :: User -> User -> Bool
Eq, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> User -> ShowS
showsPrec :: Int -> User -> ShowS
$cshow :: User -> String
show :: User -> String
$cshowList :: [User] -> ShowS
showList :: [User] -> ShowS
Show, (forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. User -> Rep User x
from :: forall x. User -> Rep User x
$cto :: forall x. Rep User x -> User
to :: forall x. Rep User x -> User
Generic, Maybe User
Value -> Parser [User]
Value -> Parser User
(Value -> Parser User)
-> (Value -> Parser [User]) -> Maybe User -> FromJSON User
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser User
parseJSON :: Value -> Parser User
$cparseJSONList :: Value -> Parser [User]
parseJSONList :: Value -> Parser [User]
$comittedField :: Maybe User
omittedField :: Maybe User
FromJSON, [User] -> Value
[User] -> Encoding
User -> Bool
User -> Value
User -> Encoding
(User -> Value)
-> (User -> Encoding)
-> ([User] -> Value)
-> ([User] -> Encoding)
-> (User -> Bool)
-> ToJSON User
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: User -> Value
toJSON :: User -> Value
$ctoEncoding :: User -> Encoding
toEncoding :: User -> Encoding
$ctoJSONList :: [User] -> Value
toJSONList :: [User] -> Value
$ctoEncodingList :: [User] -> Encoding
toEncodingList :: [User] -> Encoding
$comitField :: User -> Bool
omitField :: User -> Bool
ToJSON)

makeFieldLabelsNoPrefix ''User

newtype FetchLimit = FetchLimit
  { FetchLimit -> Int
value :: Int
  }
  deriving ((forall x. FetchLimit -> Rep FetchLimit x)
-> (forall x. Rep FetchLimit x -> FetchLimit) -> Generic FetchLimit
forall x. Rep FetchLimit x -> FetchLimit
forall x. FetchLimit -> Rep FetchLimit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FetchLimit -> Rep FetchLimit x
from :: forall x. FetchLimit -> Rep FetchLimit x
$cto :: forall x. Rep FetchLimit x -> FetchLimit
to :: forall x. Rep FetchLimit x -> FetchLimit
Generic, FetchLimit -> FetchLimit -> Bool
(FetchLimit -> FetchLimit -> Bool)
-> (FetchLimit -> FetchLimit -> Bool) -> Eq FetchLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FetchLimit -> FetchLimit -> Bool
== :: FetchLimit -> FetchLimit -> Bool
$c/= :: FetchLimit -> FetchLimit -> Bool
/= :: FetchLimit -> FetchLimit -> Bool
Eq, Int -> FetchLimit -> ShowS
[FetchLimit] -> ShowS
FetchLimit -> String
(Int -> FetchLimit -> ShowS)
-> (FetchLimit -> String)
-> ([FetchLimit] -> ShowS)
-> Show FetchLimit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FetchLimit -> ShowS
showsPrec :: Int -> FetchLimit -> ShowS
$cshow :: FetchLimit -> String
show :: FetchLimit -> String
$cshowList :: [FetchLimit] -> ShowS
showList :: [FetchLimit] -> ShowS
Show)

makeFieldLabelsNoPrefix ''FetchLimit

newtype SearchInput = SearchInput
  { SearchInput -> Text
value :: Text
  }
  deriving ((forall x. SearchInput -> Rep SearchInput x)
-> (forall x. Rep SearchInput x -> SearchInput)
-> Generic SearchInput
forall x. Rep SearchInput x -> SearchInput
forall x. SearchInput -> Rep SearchInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SearchInput -> Rep SearchInput x
from :: forall x. SearchInput -> Rep SearchInput x
$cto :: forall x. Rep SearchInput x -> SearchInput
to :: forall x. Rep SearchInput x -> SearchInput
Generic, SearchInput -> SearchInput -> Bool
(SearchInput -> SearchInput -> Bool)
-> (SearchInput -> SearchInput -> Bool) -> Eq SearchInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchInput -> SearchInput -> Bool
== :: SearchInput -> SearchInput -> Bool
$c/= :: SearchInput -> SearchInput -> Bool
/= :: SearchInput -> SearchInput -> Bool
Eq, Int -> SearchInput -> ShowS
[SearchInput] -> ShowS
SearchInput -> String
(Int -> SearchInput -> ShowS)
-> (SearchInput -> String)
-> ([SearchInput] -> ShowS)
-> Show SearchInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchInput -> ShowS
showsPrec :: Int -> SearchInput -> ShowS
$cshow :: SearchInput -> String
show :: SearchInput -> String
$cshowList :: [SearchInput] -> ShowS
showList :: [SearchInput] -> ShowS
Show)

makeFieldLabelsNoPrefix ''SearchInput

-- data ForumPage = ForumPage
--   { identifier :: Text,
--     displayName :: Text,
--     createdBy :: Text,
--     visibilityStatus :: Int,
--     approvedBy :: Maybe Text,
--     createdAt :: Text,
--     lastEditedAt :: Text,
-- viewCount :: Int
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumCategory = ForumCategory
--   { identifier :: Text,
--     parentIdentifier :: Maybe Text,
--     displayName :: Text,
--     createdBy :: Text,
--     visibilityStatus :: Int,
--     approvedBy :: Maybe Text,
--     createdAt :: Text,
--     lastEditedAt :: Text,
-- viewCount :: Int
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data Genre = Genre
--   { identifier :: Text,
--     parentIdentifier :: Maybe Text,
--     displayName :: Text,
--     createdBy :: Text,
--     visibilityStatus :: Int,
--     approvedBy :: Maybe Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data UserFavouriteSongFolder = UserFavouriteSongFolder
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data UserFavouriteArtist = UserFavouriteArtist
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumPageComment = ForumPageComment
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumPageContent = ForumPageContent
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumPageExternalSource = ForumPageExternalSource
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumPageOpinion = ForumPageOpinion
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data UserFavouriteForumPage = UserFavouriteForumPage
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumCategoryArtwork = ForumCategoryArtwork
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumCategoryComment = ForumCategoryComment
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumCategoryExtenalSource = ForumCategoryExtenalSource
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumCategoryOpinion = ForumCategoryOpinion
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data UserFavouriteForumCategory = UserFavouriteForumCategory
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data UserFavouriteGenre = UserFavouriteGenre
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data UserFavouriteSong = UserFavouriteSong
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data UserDonation = UserDonation
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data UserRole = UserRole
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data UserTrustScore = UserTrustScore
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data SongToGenres = SongToGenres
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data SongToArtists = SongToArtists
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ArtistToGenres = ArtistToGenres
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)

-- data ForumPageToForumCategories = ForumPageToForumCategories
--   { identifier :: Text,
--     displayName :: Text
--   }
--   deriving (Eq, Show, Generic, FromJSON, ToJSON)