{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Copyright: (c) 2021 The closed eye of love
-- SPDX-License-Identifier: BSD-3-Clause
-- Maintainer: Poscat <poscat@mail.poscat.moe>, berberman <berberman@yandex.com>
-- Stability: alpha
-- Portability: portable
-- Data types used in API. This module enables [DuplicateRecordFields](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DuplicateRecordFields),
-- so please consider using "Web.Pixiv.Types.Lens" to access fields smoothly.
module Web.Pixiv.Types
  ( -- * ImageUrl
    ImageUrl,
    ImageUrls (..),
    OriginalImageUrl (..),

    -- * Tag
    Tag (..),
    TrendingTag (..),
    TrendingTags (..),

    -- * Illustration
    Series (..),
    IllustType (..),
    MetaPage (..),
    Illust (..),
    Illusts (..),
    IllustWrapper (..),

    -- * User
    User (..),
    UserProfile (..),
    Publicity (..),
    ProfilePublicity (..),
    Workspace (..),
    UserDetail (..),
    UserPreview (..),
    UserPreviews (..),

    -- * Comment
    Comment (..),
    Comments (..),

    -- * NextUrl
    NextUrlLess,
    HasNextUrl (..),

    -- * Ugoria
    UgoiraFrame (..),
    ZipUrls (..),
    UgoiraMetadata (..),
    UgoiraMetadataWrapper (..),

    -- * Article
    SpotlightArticle (..),
    SpotlightArticles (..),

    -- * Http
    RankMode (..),
    SearchTarget (..),
    SortingMethod (..),
    Duration (..),
  )
where

import qualified Data.Aeson as A
import Data.Text (Text)
import Data.Time (UTCTime)
import Web.Pixiv.TH

-- | Undecorate @next_url@ of a type.
--
-- @next_url@ is returned by some APIs for paging.
type family NextUrlLess a

-- | Class to get or unwrap @next_url@.
class HasNextUrl a where
  unNextUrl :: a -> NextUrlLess a
  getNextUrl :: a -> Maybe Text

-----------------------------------------------------------------------------

-- | Image urls are represented in 'Text'.
type ImageUrl = Text

-- | An object contains image urls.
--
-- * Example in 'Illust' or 'MetaPage':
--   @
--     "image_urls": {
--       "square_medium": "...",
--       "medium": "...",
--       "large": "..."
--     }
--   @
-- * Example in 'User':
--   @
--     "profile_image_urls": {
--       "medium": "..."
--     }
--   @
data ImageUrls = ImageUrls
  { ImageUrls -> Maybe ImageUrl
_squareMedium :: Maybe ImageUrl,
    ImageUrls -> Maybe ImageUrl
_medium :: Maybe ImageUrl,
    ImageUrls -> Maybe ImageUrl
_large :: Maybe ImageUrl,
    ImageUrls -> Maybe ImageUrl
_original :: Maybe ImageUrl
  }
  deriving stock (ImageUrls -> ImageUrls -> Bool
(ImageUrls -> ImageUrls -> Bool)
-> (ImageUrls -> ImageUrls -> Bool) -> Eq ImageUrls
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageUrls -> ImageUrls -> Bool
$c/= :: ImageUrls -> ImageUrls -> Bool
== :: ImageUrls -> ImageUrls -> Bool
$c== :: ImageUrls -> ImageUrls -> Bool
Eq, Int -> ImageUrls -> ShowS
[ImageUrls] -> ShowS
ImageUrls -> String
(Int -> ImageUrls -> ShowS)
-> (ImageUrls -> String)
-> ([ImageUrls] -> ShowS)
-> Show ImageUrls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageUrls] -> ShowS
$cshowList :: [ImageUrls] -> ShowS
show :: ImageUrls -> String
$cshow :: ImageUrls -> String
showsPrec :: Int -> ImageUrls -> ShowS
$cshowsPrec :: Int -> ImageUrls -> ShowS
Show, ReadPrec [ImageUrls]
ReadPrec ImageUrls
Int -> ReadS ImageUrls
ReadS [ImageUrls]
(Int -> ReadS ImageUrls)
-> ReadS [ImageUrls]
-> ReadPrec ImageUrls
-> ReadPrec [ImageUrls]
-> Read ImageUrls
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageUrls]
$creadListPrec :: ReadPrec [ImageUrls]
readPrec :: ReadPrec ImageUrls
$creadPrec :: ReadPrec ImageUrls
readList :: ReadS [ImageUrls]
$creadList :: ReadS [ImageUrls]
readsPrec :: Int -> ReadS ImageUrls
$creadsPrec :: Int -> ReadS ImageUrls
Read)

derivePixivJSON' ''ImageUrls

-----------------------------------------------------------------------------

-- | An object contains a single image url.
--
-- In 'Illust':
--   @
--     "meta_single_page": {
--       "original_image_url": "..."
--     }
--   @
newtype OriginalImageUrl = OriginalImageUrl
  { OriginalImageUrl -> Maybe ImageUrl
_originalImageUrl :: Maybe ImageUrl
  }
  deriving stock (OriginalImageUrl -> OriginalImageUrl -> Bool
(OriginalImageUrl -> OriginalImageUrl -> Bool)
-> (OriginalImageUrl -> OriginalImageUrl -> Bool)
-> Eq OriginalImageUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OriginalImageUrl -> OriginalImageUrl -> Bool
$c/= :: OriginalImageUrl -> OriginalImageUrl -> Bool
== :: OriginalImageUrl -> OriginalImageUrl -> Bool
$c== :: OriginalImageUrl -> OriginalImageUrl -> Bool
Eq, Int -> OriginalImageUrl -> ShowS
[OriginalImageUrl] -> ShowS
OriginalImageUrl -> String
(Int -> OriginalImageUrl -> ShowS)
-> (OriginalImageUrl -> String)
-> ([OriginalImageUrl] -> ShowS)
-> Show OriginalImageUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OriginalImageUrl] -> ShowS
$cshowList :: [OriginalImageUrl] -> ShowS
show :: OriginalImageUrl -> String
$cshow :: OriginalImageUrl -> String
showsPrec :: Int -> OriginalImageUrl -> ShowS
$cshowsPrec :: Int -> OriginalImageUrl -> ShowS
Show, ReadPrec [OriginalImageUrl]
ReadPrec OriginalImageUrl
Int -> ReadS OriginalImageUrl
ReadS [OriginalImageUrl]
(Int -> ReadS OriginalImageUrl)
-> ReadS [OriginalImageUrl]
-> ReadPrec OriginalImageUrl
-> ReadPrec [OriginalImageUrl]
-> Read OriginalImageUrl
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OriginalImageUrl]
$creadListPrec :: ReadPrec [OriginalImageUrl]
readPrec :: ReadPrec OriginalImageUrl
$creadPrec :: ReadPrec OriginalImageUrl
readList :: ReadS [OriginalImageUrl]
$creadList :: ReadS [OriginalImageUrl]
readsPrec :: Int -> ReadS OriginalImageUrl
$creadsPrec :: Int -> ReadS OriginalImageUrl
Read)

derivePixivJSON' ''OriginalImageUrl

-----------------------------------------------------------------------------

-- | A tag.
--
-- Example:
-- @
--   {
--     "name": "...",
--     "translated_name": null
--   }
-- @
data Tag = Tag
  { Tag -> ImageUrl
_name :: Text,
    Tag -> Maybe ImageUrl
_translatedName :: Maybe Text
  }
  deriving stock (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, ReadPrec [Tag]
ReadPrec Tag
Int -> ReadS Tag
ReadS [Tag]
(Int -> ReadS Tag)
-> ReadS [Tag] -> ReadPrec Tag -> ReadPrec [Tag] -> Read Tag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tag]
$creadListPrec :: ReadPrec [Tag]
readPrec :: ReadPrec Tag
$creadPrec :: ReadPrec Tag
readList :: ReadS [Tag]
$creadList :: ReadS [Tag]
readsPrec :: Int -> ReadS Tag
$creadsPrec :: Int -> ReadS Tag
Read)

derivePixivJSON' ''Tag

-----------------------------------------------------------------------------

-- | Type of illustration.
--
-- In pixiv API, all of illustrations, mangas, and ugoiras are represented in 'Illust' data type.
-- So they can be distinguished by 'IllustType'.
data IllustType = TypeIllust | TypeManga | TypeUgoira
  deriving stock (IllustType -> IllustType -> Bool
(IllustType -> IllustType -> Bool)
-> (IllustType -> IllustType -> Bool) -> Eq IllustType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IllustType -> IllustType -> Bool
$c/= :: IllustType -> IllustType -> Bool
== :: IllustType -> IllustType -> Bool
$c== :: IllustType -> IllustType -> Bool
Eq, Eq IllustType
Eq IllustType
-> (IllustType -> IllustType -> Ordering)
-> (IllustType -> IllustType -> Bool)
-> (IllustType -> IllustType -> Bool)
-> (IllustType -> IllustType -> Bool)
-> (IllustType -> IllustType -> Bool)
-> (IllustType -> IllustType -> IllustType)
-> (IllustType -> IllustType -> IllustType)
-> Ord IllustType
IllustType -> IllustType -> Bool
IllustType -> IllustType -> Ordering
IllustType -> IllustType -> IllustType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IllustType -> IllustType -> IllustType
$cmin :: IllustType -> IllustType -> IllustType
max :: IllustType -> IllustType -> IllustType
$cmax :: IllustType -> IllustType -> IllustType
>= :: IllustType -> IllustType -> Bool
$c>= :: IllustType -> IllustType -> Bool
> :: IllustType -> IllustType -> Bool
$c> :: IllustType -> IllustType -> Bool
<= :: IllustType -> IllustType -> Bool
$c<= :: IllustType -> IllustType -> Bool
< :: IllustType -> IllustType -> Bool
$c< :: IllustType -> IllustType -> Bool
compare :: IllustType -> IllustType -> Ordering
$ccompare :: IllustType -> IllustType -> Ordering
$cp1Ord :: Eq IllustType
Ord, Int -> IllustType
IllustType -> Int
IllustType -> [IllustType]
IllustType -> IllustType
IllustType -> IllustType -> [IllustType]
IllustType -> IllustType -> IllustType -> [IllustType]
(IllustType -> IllustType)
-> (IllustType -> IllustType)
-> (Int -> IllustType)
-> (IllustType -> Int)
-> (IllustType -> [IllustType])
-> (IllustType -> IllustType -> [IllustType])
-> (IllustType -> IllustType -> [IllustType])
-> (IllustType -> IllustType -> IllustType -> [IllustType])
-> Enum IllustType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IllustType -> IllustType -> IllustType -> [IllustType]
$cenumFromThenTo :: IllustType -> IllustType -> IllustType -> [IllustType]
enumFromTo :: IllustType -> IllustType -> [IllustType]
$cenumFromTo :: IllustType -> IllustType -> [IllustType]
enumFromThen :: IllustType -> IllustType -> [IllustType]
$cenumFromThen :: IllustType -> IllustType -> [IllustType]
enumFrom :: IllustType -> [IllustType]
$cenumFrom :: IllustType -> [IllustType]
fromEnum :: IllustType -> Int
$cfromEnum :: IllustType -> Int
toEnum :: Int -> IllustType
$ctoEnum :: Int -> IllustType
pred :: IllustType -> IllustType
$cpred :: IllustType -> IllustType
succ :: IllustType -> IllustType
$csucc :: IllustType -> IllustType
Enum, Int -> IllustType -> ShowS
[IllustType] -> ShowS
IllustType -> String
(Int -> IllustType -> ShowS)
-> (IllustType -> String)
-> ([IllustType] -> ShowS)
-> Show IllustType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IllustType] -> ShowS
$cshowList :: [IllustType] -> ShowS
show :: IllustType -> String
$cshow :: IllustType -> String
showsPrec :: Int -> IllustType -> ShowS
$cshowsPrec :: Int -> IllustType -> ShowS
Show, ReadPrec [IllustType]
ReadPrec IllustType
Int -> ReadS IllustType
ReadS [IllustType]
(Int -> ReadS IllustType)
-> ReadS [IllustType]
-> ReadPrec IllustType
-> ReadPrec [IllustType]
-> Read IllustType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IllustType]
$creadListPrec :: ReadPrec [IllustType]
readPrec :: ReadPrec IllustType
$creadPrec :: ReadPrec IllustType
readList :: ReadS [IllustType]
$creadList :: ReadS [IllustType]
readsPrec :: Int -> ReadS IllustType
$creadsPrec :: Int -> ReadS IllustType
Read)

deriveEnumJSON "Type" ''IllustType
deriveEnumToHttpApiData "Type" ''IllustType

-----------------------------------------------------------------------------

-- | Manga series.
data Series = Series
  { Series -> Int
_seriesId :: Int,
    Series -> ImageUrl
_title :: Text
  }
  deriving stock (Series -> Series -> Bool
(Series -> Series -> Bool)
-> (Series -> Series -> Bool) -> Eq Series
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Series -> Series -> Bool
$c/= :: Series -> Series -> Bool
== :: Series -> Series -> Bool
$c== :: Series -> Series -> Bool
Eq, Int -> Series -> ShowS
[Series] -> ShowS
Series -> String
(Int -> Series -> ShowS)
-> (Series -> String) -> ([Series] -> ShowS) -> Show Series
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Series] -> ShowS
$cshowList :: [Series] -> ShowS
show :: Series -> String
$cshow :: Series -> String
showsPrec :: Int -> Series -> ShowS
$cshowsPrec :: Int -> Series -> ShowS
Show, ReadPrec [Series]
ReadPrec Series
Int -> ReadS Series
ReadS [Series]
(Int -> ReadS Series)
-> ReadS [Series]
-> ReadPrec Series
-> ReadPrec [Series]
-> Read Series
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Series]
$creadListPrec :: ReadPrec [Series]
readPrec :: ReadPrec Series
$creadPrec :: ReadPrec Series
readList :: ReadS [Series]
$creadList :: ReadS [Series]
readsPrec :: Int -> ReadS Series
$creadsPrec :: Int -> ReadS Series
Read)

derivePixivJSON "series" ''Series

-----------------------------------------------------------------------------

-- | A page of 'Illust' containing 'ImageUrls'.
newtype MetaPage = MetaPage
  { MetaPage -> ImageUrls
_imageUrls :: ImageUrls
  }
  deriving stock (MetaPage -> MetaPage -> Bool
(MetaPage -> MetaPage -> Bool)
-> (MetaPage -> MetaPage -> Bool) -> Eq MetaPage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaPage -> MetaPage -> Bool
$c/= :: MetaPage -> MetaPage -> Bool
== :: MetaPage -> MetaPage -> Bool
$c== :: MetaPage -> MetaPage -> Bool
Eq, Int -> MetaPage -> ShowS
[MetaPage] -> ShowS
MetaPage -> String
(Int -> MetaPage -> ShowS)
-> (MetaPage -> String) -> ([MetaPage] -> ShowS) -> Show MetaPage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaPage] -> ShowS
$cshowList :: [MetaPage] -> ShowS
show :: MetaPage -> String
$cshow :: MetaPage -> String
showsPrec :: Int -> MetaPage -> ShowS
$cshowsPrec :: Int -> MetaPage -> ShowS
Show, ReadPrec [MetaPage]
ReadPrec MetaPage
Int -> ReadS MetaPage
ReadS [MetaPage]
(Int -> ReadS MetaPage)
-> ReadS [MetaPage]
-> ReadPrec MetaPage
-> ReadPrec [MetaPage]
-> Read MetaPage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MetaPage]
$creadListPrec :: ReadPrec [MetaPage]
readPrec :: ReadPrec MetaPage
$creadPrec :: ReadPrec MetaPage
readList :: ReadS [MetaPage]
$creadList :: ReadS [MetaPage]
readsPrec :: Int -> ReadS MetaPage
$creadsPrec :: Int -> ReadS MetaPage
Read)

derivePixivJSON' ''MetaPage

-----------------------------------------------------------------------------

-- | User data type.
data User = User
  { User -> Int
_userId :: Int,
    User -> ImageUrl
_name :: Text,
    User -> ImageUrl
_account :: Text,
    User -> ImageUrls
_profileImageUrls :: ImageUrls,
    User -> Maybe ImageUrl
_comment :: Maybe Text,
    -- | For login account.
    User -> Maybe Bool
_isFollowed :: Maybe Bool
  }
  deriving stock (User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: 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
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show, ReadPrec [User]
ReadPrec User
Int -> ReadS User
ReadS [User]
(Int -> ReadS User)
-> ReadS [User] -> ReadPrec User -> ReadPrec [User] -> Read User
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [User]
$creadListPrec :: ReadPrec [User]
readPrec :: ReadPrec User
$creadPrec :: ReadPrec User
readList :: ReadS [User]
$creadList :: ReadS [User]
readsPrec :: Int -> ReadS User
$creadsPrec :: Int -> ReadS User
Read)

derivePixivJSON "user" ''User

-----------------------------------------------------------------------------

-- | Illustraion data type.
--
-- See 'IllustType'.
data Illust = Illust
  { Illust -> Int
_illustId :: Int,
    Illust -> ImageUrl
_title :: Text,
    Illust -> IllustType
_illustType :: IllustType,
    Illust -> ImageUrls
_imageUrls :: ImageUrls,
    Illust -> ImageUrl
_caption :: Text,
    Illust -> Int
_restrict :: Int,
    Illust -> User
_user :: User,
    Illust -> [Tag]
_tags :: [Tag],
    Illust -> [ImageUrl]
_tools :: [Text],
    Illust -> UTCTime
_createDate :: UTCTime,
    Illust -> Int
_pageCount :: Int,
    Illust -> Int
_width :: Int,
    Illust -> Int
_height :: Int,
    Illust -> Int
_sanityLevel :: Int,
    Illust -> Int
_xRestrict :: Int,
    -- | Only manga may have this field.
    Illust -> Maybe Series
_series :: Maybe Series,
    -- | Only single page illustration has this field.
    Illust -> Maybe OriginalImageUrl
_metaSinglePage :: Maybe OriginalImageUrl,
    -- | Only multi page illustration has this field.
    Illust -> [MetaPage]
_metaPages :: [MetaPage],
    Illust -> Int
_totalView :: Int,
    Illust -> Int
_totalBookmarks :: Int,
    -- | For login account.
    Illust -> Bool
_isBookmarked :: Bool,
    Illust -> Bool
_visible :: Bool,
    Illust -> Bool
_isMuted :: Bool,
    Illust -> Maybe Int
_totalComments :: Maybe Int
  }
  deriving stock (Illust -> Illust -> Bool
(Illust -> Illust -> Bool)
-> (Illust -> Illust -> Bool) -> Eq Illust
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Illust -> Illust -> Bool
$c/= :: Illust -> Illust -> Bool
== :: Illust -> Illust -> Bool
$c== :: Illust -> Illust -> Bool
Eq, Int -> Illust -> ShowS
[Illust] -> ShowS
Illust -> String
(Int -> Illust -> ShowS)
-> (Illust -> String) -> ([Illust] -> ShowS) -> Show Illust
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Illust] -> ShowS
$cshowList :: [Illust] -> ShowS
show :: Illust -> String
$cshow :: Illust -> String
showsPrec :: Int -> Illust -> ShowS
$cshowsPrec :: Int -> Illust -> ShowS
Show, ReadPrec [Illust]
ReadPrec Illust
Int -> ReadS Illust
ReadS [Illust]
(Int -> ReadS Illust)
-> ReadS [Illust]
-> ReadPrec Illust
-> ReadPrec [Illust]
-> Read Illust
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Illust]
$creadListPrec :: ReadPrec [Illust]
readPrec :: ReadPrec Illust
$creadPrec :: ReadPrec Illust
readList :: ReadS [Illust]
$creadList :: ReadS [Illust]
readsPrec :: Int -> ReadS Illust
$creadsPrec :: Int -> ReadS Illust
Read)

derivePixivJSON "illust" ''Illust

-----------------------------------------------------------------------------

-- | A trending tag.
--
-- Don't confuse with 'Tag'. 'TrendingTag' contains 'Illust',
-- and the textual name of the tag is called @tag@, instead of @name@ in 'Tag'.
data TrendingTag = TrendingTag
  { -- This is ugly, not consistent with normal 'Tag'
    TrendingTag -> ImageUrl
_trendTag :: Text,
    TrendingTag -> Maybe ImageUrl
_translatedName :: Maybe Text,
    TrendingTag -> Illust
_illust :: Illust
  }
  deriving stock (TrendingTag -> TrendingTag -> Bool
(TrendingTag -> TrendingTag -> Bool)
-> (TrendingTag -> TrendingTag -> Bool) -> Eq TrendingTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrendingTag -> TrendingTag -> Bool
$c/= :: TrendingTag -> TrendingTag -> Bool
== :: TrendingTag -> TrendingTag -> Bool
$c== :: TrendingTag -> TrendingTag -> Bool
Eq, Int -> TrendingTag -> ShowS
[TrendingTag] -> ShowS
TrendingTag -> String
(Int -> TrendingTag -> ShowS)
-> (TrendingTag -> String)
-> ([TrendingTag] -> ShowS)
-> Show TrendingTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrendingTag] -> ShowS
$cshowList :: [TrendingTag] -> ShowS
show :: TrendingTag -> String
$cshow :: TrendingTag -> String
showsPrec :: Int -> TrendingTag -> ShowS
$cshowsPrec :: Int -> TrendingTag -> ShowS
Show, ReadPrec [TrendingTag]
ReadPrec TrendingTag
Int -> ReadS TrendingTag
ReadS [TrendingTag]
(Int -> ReadS TrendingTag)
-> ReadS [TrendingTag]
-> ReadPrec TrendingTag
-> ReadPrec [TrendingTag]
-> Read TrendingTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TrendingTag]
$creadListPrec :: ReadPrec [TrendingTag]
readPrec :: ReadPrec TrendingTag
$creadPrec :: ReadPrec TrendingTag
readList :: ReadS [TrendingTag]
$creadList :: ReadS [TrendingTag]
readsPrec :: Int -> ReadS TrendingTag
$creadsPrec :: Int -> ReadS TrendingTag
Read)

derivePixivJSON "trend" ''TrendingTag

-----------------------------------------------------------------------------

-- | A wrapper of 'TrendingTag's for JSON deserialization.
newtype TrendingTags = TrendingTags
  { TrendingTags -> [TrendingTag]
_trend_tags :: [TrendingTag]
  }
  deriving stock (TrendingTags -> TrendingTags -> Bool
(TrendingTags -> TrendingTags -> Bool)
-> (TrendingTags -> TrendingTags -> Bool) -> Eq TrendingTags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrendingTags -> TrendingTags -> Bool
$c/= :: TrendingTags -> TrendingTags -> Bool
== :: TrendingTags -> TrendingTags -> Bool
$c== :: TrendingTags -> TrendingTags -> Bool
Eq, Int -> TrendingTags -> ShowS
[TrendingTags] -> ShowS
TrendingTags -> String
(Int -> TrendingTags -> ShowS)
-> (TrendingTags -> String)
-> ([TrendingTags] -> ShowS)
-> Show TrendingTags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrendingTags] -> ShowS
$cshowList :: [TrendingTags] -> ShowS
show :: TrendingTags -> String
$cshow :: TrendingTags -> String
showsPrec :: Int -> TrendingTags -> ShowS
$cshowsPrec :: Int -> TrendingTags -> ShowS
Show, ReadPrec [TrendingTags]
ReadPrec TrendingTags
Int -> ReadS TrendingTags
ReadS [TrendingTags]
(Int -> ReadS TrendingTags)
-> ReadS [TrendingTags]
-> ReadPrec TrendingTags
-> ReadPrec [TrendingTags]
-> Read TrendingTags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TrendingTags]
$creadListPrec :: ReadPrec [TrendingTags]
readPrec :: ReadPrec TrendingTags
$creadPrec :: ReadPrec TrendingTags
readList :: ReadS [TrendingTags]
$creadList :: ReadS [TrendingTags]
readsPrec :: Int -> ReadS TrendingTags
$creadsPrec :: Int -> ReadS TrendingTags
Read)

derivePixivJSON' ''TrendingTags

-----------------------------------------------------------------------------

-- | Response of API which returns illustrations.
data Illusts = Illusts
  { Illusts -> [Illust]
_illusts :: [Illust],
    Illusts -> Maybe ImageUrl
_nextUrl :: Maybe Text
  }
  deriving stock (Illusts -> Illusts -> Bool
(Illusts -> Illusts -> Bool)
-> (Illusts -> Illusts -> Bool) -> Eq Illusts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Illusts -> Illusts -> Bool
$c/= :: Illusts -> Illusts -> Bool
== :: Illusts -> Illusts -> Bool
$c== :: Illusts -> Illusts -> Bool
Eq, Int -> Illusts -> ShowS
[Illusts] -> ShowS
Illusts -> String
(Int -> Illusts -> ShowS)
-> (Illusts -> String) -> ([Illusts] -> ShowS) -> Show Illusts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Illusts] -> ShowS
$cshowList :: [Illusts] -> ShowS
show :: Illusts -> String
$cshow :: Illusts -> String
showsPrec :: Int -> Illusts -> ShowS
$cshowsPrec :: Int -> Illusts -> ShowS
Show, ReadPrec [Illusts]
ReadPrec Illusts
Int -> ReadS Illusts
ReadS [Illusts]
(Int -> ReadS Illusts)
-> ReadS [Illusts]
-> ReadPrec Illusts
-> ReadPrec [Illusts]
-> Read Illusts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Illusts]
$creadListPrec :: ReadPrec [Illusts]
readPrec :: ReadPrec Illusts
$creadPrec :: ReadPrec Illusts
readList :: ReadS [Illusts]
$creadList :: ReadS [Illusts]
readsPrec :: Int -> ReadS Illusts
$creadsPrec :: Int -> ReadS Illusts
Read)

derivePixivJSON' ''Illusts

type instance NextUrlLess Illusts = [Illust]

instance HasNextUrl Illusts where
  unNextUrl :: Illusts -> NextUrlLess Illusts
unNextUrl Illusts {[Illust]
Maybe ImageUrl
_nextUrl :: Maybe ImageUrl
_illusts :: [Illust]
$sel:_nextUrl:Illusts :: Illusts -> Maybe ImageUrl
$sel:_illusts:Illusts :: Illusts -> [Illust]
..} = [Illust]
NextUrlLess Illusts
_illusts
  getNextUrl :: Illusts -> Maybe ImageUrl
getNextUrl Illusts {[Illust]
Maybe ImageUrl
_nextUrl :: Maybe ImageUrl
_illusts :: [Illust]
$sel:_nextUrl:Illusts :: Illusts -> Maybe ImageUrl
$sel:_illusts:Illusts :: Illusts -> [Illust]
..} = Maybe ImageUrl
_nextUrl

-----------------------------------------------------------------------------

-- | A wrapper of 'Illust' for JSON deserialization.
newtype IllustWrapper = IllustWrapper
  { IllustWrapper -> Illust
_illust :: Illust
  }
  deriving stock (Int -> IllustWrapper -> ShowS
[IllustWrapper] -> ShowS
IllustWrapper -> String
(Int -> IllustWrapper -> ShowS)
-> (IllustWrapper -> String)
-> ([IllustWrapper] -> ShowS)
-> Show IllustWrapper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IllustWrapper] -> ShowS
$cshowList :: [IllustWrapper] -> ShowS
show :: IllustWrapper -> String
$cshow :: IllustWrapper -> String
showsPrec :: Int -> IllustWrapper -> ShowS
$cshowsPrec :: Int -> IllustWrapper -> ShowS
Show, IllustWrapper -> IllustWrapper -> Bool
(IllustWrapper -> IllustWrapper -> Bool)
-> (IllustWrapper -> IllustWrapper -> Bool) -> Eq IllustWrapper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IllustWrapper -> IllustWrapper -> Bool
$c/= :: IllustWrapper -> IllustWrapper -> Bool
== :: IllustWrapper -> IllustWrapper -> Bool
$c== :: IllustWrapper -> IllustWrapper -> Bool
Eq, ReadPrec [IllustWrapper]
ReadPrec IllustWrapper
Int -> ReadS IllustWrapper
ReadS [IllustWrapper]
(Int -> ReadS IllustWrapper)
-> ReadS [IllustWrapper]
-> ReadPrec IllustWrapper
-> ReadPrec [IllustWrapper]
-> Read IllustWrapper
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IllustWrapper]
$creadListPrec :: ReadPrec [IllustWrapper]
readPrec :: ReadPrec IllustWrapper
$creadPrec :: ReadPrec IllustWrapper
readList :: ReadS [IllustWrapper]
$creadList :: ReadS [IllustWrapper]
readsPrec :: Int -> ReadS IllustWrapper
$creadsPrec :: Int -> ReadS IllustWrapper
Read)

derivePixivJSON' ''IllustWrapper

-----------------------------------------------------------------------------

-- | UserProfile data type.
--
-- Not sure if all fields are covered, and maybe some fields should be optional.
data UserProfile = UserProfile
  { UserProfile -> Maybe ImageUrl
_webpage :: Maybe Text,
    UserProfile -> ImageUrl
_gender :: Text,
    UserProfile -> ImageUrl
_birth :: Text,
    UserProfile -> ImageUrl
_birthDay :: Text,
    UserProfile -> Int
_birthYear :: Int,
    UserProfile -> ImageUrl
_region :: Text,
    UserProfile -> Int
_addressId :: Int,
    UserProfile -> ImageUrl
_countryCode :: Text,
    UserProfile -> ImageUrl
_job :: Text,
    UserProfile -> Int
_jobId :: Int,
    UserProfile -> Int
_totalFollowUsers :: Int,
    UserProfile -> Int
_totalMypixivUsers :: Int,
    UserProfile -> Int
_totalIllusts :: Int,
    UserProfile -> Int
_totalManga :: Int,
    UserProfile -> Int
_totalIllustBookmarksPublic :: Int,
    UserProfile -> Int
_totalIllustSeries :: Int,
    UserProfile -> Int
_totalNovelSeries :: Int,
    UserProfile -> Maybe ImageUrl
_backgroundImageUrl :: Maybe ImageUrl,
    UserProfile -> ImageUrl
_twitterAccount :: Text,
    UserProfile -> Maybe ImageUrl
_twitterUrl :: Maybe Text,
    UserProfile -> Maybe ImageUrl
_pawooUrl :: Maybe Text,
    UserProfile -> Maybe Bool
_isPreminum :: Maybe Bool,
    UserProfile -> Bool
_isUsingCustomProfileImage :: Bool
  }
  deriving stock (UserProfile -> UserProfile -> Bool
(UserProfile -> UserProfile -> Bool)
-> (UserProfile -> UserProfile -> Bool) -> Eq UserProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserProfile -> UserProfile -> Bool
$c/= :: UserProfile -> UserProfile -> Bool
== :: UserProfile -> UserProfile -> Bool
$c== :: UserProfile -> UserProfile -> Bool
Eq, Int -> UserProfile -> ShowS
[UserProfile] -> ShowS
UserProfile -> String
(Int -> UserProfile -> ShowS)
-> (UserProfile -> String)
-> ([UserProfile] -> ShowS)
-> Show UserProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserProfile] -> ShowS
$cshowList :: [UserProfile] -> ShowS
show :: UserProfile -> String
$cshow :: UserProfile -> String
showsPrec :: Int -> UserProfile -> ShowS
$cshowsPrec :: Int -> UserProfile -> ShowS
Show, ReadPrec [UserProfile]
ReadPrec UserProfile
Int -> ReadS UserProfile
ReadS [UserProfile]
(Int -> ReadS UserProfile)
-> ReadS [UserProfile]
-> ReadPrec UserProfile
-> ReadPrec [UserProfile]
-> Read UserProfile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserProfile]
$creadListPrec :: ReadPrec [UserProfile]
readPrec :: ReadPrec UserProfile
$creadPrec :: ReadPrec UserProfile
readList :: ReadS [UserProfile]
$creadList :: ReadS [UserProfile]
readsPrec :: Int -> ReadS UserProfile
$creadsPrec :: Int -> ReadS UserProfile
Read)

derivePixivJSON' ''UserProfile

-----------------------------------------------------------------------------

-- | Publicity data type.
--
-- The value @public@ or @private@ are present in 'ProfilePublicity'.
-- This type is also used in @restrict@ query param.
data Publicity
  = Public
  | Private
  | -- | May not be available in @restrict@ query param
    Mypixiv
  deriving stock (Publicity -> Publicity -> Bool
(Publicity -> Publicity -> Bool)
-> (Publicity -> Publicity -> Bool) -> Eq Publicity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Publicity -> Publicity -> Bool
$c/= :: Publicity -> Publicity -> Bool
== :: Publicity -> Publicity -> Bool
$c== :: Publicity -> Publicity -> Bool
Eq, Eq Publicity
Eq Publicity
-> (Publicity -> Publicity -> Ordering)
-> (Publicity -> Publicity -> Bool)
-> (Publicity -> Publicity -> Bool)
-> (Publicity -> Publicity -> Bool)
-> (Publicity -> Publicity -> Bool)
-> (Publicity -> Publicity -> Publicity)
-> (Publicity -> Publicity -> Publicity)
-> Ord Publicity
Publicity -> Publicity -> Bool
Publicity -> Publicity -> Ordering
Publicity -> Publicity -> Publicity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Publicity -> Publicity -> Publicity
$cmin :: Publicity -> Publicity -> Publicity
max :: Publicity -> Publicity -> Publicity
$cmax :: Publicity -> Publicity -> Publicity
>= :: Publicity -> Publicity -> Bool
$c>= :: Publicity -> Publicity -> Bool
> :: Publicity -> Publicity -> Bool
$c> :: Publicity -> Publicity -> Bool
<= :: Publicity -> Publicity -> Bool
$c<= :: Publicity -> Publicity -> Bool
< :: Publicity -> Publicity -> Bool
$c< :: Publicity -> Publicity -> Bool
compare :: Publicity -> Publicity -> Ordering
$ccompare :: Publicity -> Publicity -> Ordering
$cp1Ord :: Eq Publicity
Ord, Int -> Publicity
Publicity -> Int
Publicity -> [Publicity]
Publicity -> Publicity
Publicity -> Publicity -> [Publicity]
Publicity -> Publicity -> Publicity -> [Publicity]
(Publicity -> Publicity)
-> (Publicity -> Publicity)
-> (Int -> Publicity)
-> (Publicity -> Int)
-> (Publicity -> [Publicity])
-> (Publicity -> Publicity -> [Publicity])
-> (Publicity -> Publicity -> [Publicity])
-> (Publicity -> Publicity -> Publicity -> [Publicity])
-> Enum Publicity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Publicity -> Publicity -> Publicity -> [Publicity]
$cenumFromThenTo :: Publicity -> Publicity -> Publicity -> [Publicity]
enumFromTo :: Publicity -> Publicity -> [Publicity]
$cenumFromTo :: Publicity -> Publicity -> [Publicity]
enumFromThen :: Publicity -> Publicity -> [Publicity]
$cenumFromThen :: Publicity -> Publicity -> [Publicity]
enumFrom :: Publicity -> [Publicity]
$cenumFrom :: Publicity -> [Publicity]
fromEnum :: Publicity -> Int
$cfromEnum :: Publicity -> Int
toEnum :: Int -> Publicity
$ctoEnum :: Int -> Publicity
pred :: Publicity -> Publicity
$cpred :: Publicity -> Publicity
succ :: Publicity -> Publicity
$csucc :: Publicity -> Publicity
Enum, Int -> Publicity -> ShowS
[Publicity] -> ShowS
Publicity -> String
(Int -> Publicity -> ShowS)
-> (Publicity -> String)
-> ([Publicity] -> ShowS)
-> Show Publicity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Publicity] -> ShowS
$cshowList :: [Publicity] -> ShowS
show :: Publicity -> String
$cshow :: Publicity -> String
showsPrec :: Int -> Publicity -> ShowS
$cshowsPrec :: Int -> Publicity -> ShowS
Show, ReadPrec [Publicity]
ReadPrec Publicity
Int -> ReadS Publicity
ReadS [Publicity]
(Int -> ReadS Publicity)
-> ReadS [Publicity]
-> ReadPrec Publicity
-> ReadPrec [Publicity]
-> Read Publicity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Publicity]
$creadListPrec :: ReadPrec [Publicity]
readPrec :: ReadPrec Publicity
$creadPrec :: ReadPrec Publicity
readList :: ReadS [Publicity]
$creadList :: ReadS [Publicity]
readsPrec :: Int -> ReadS Publicity
$creadsPrec :: Int -> ReadS Publicity
Read)

deriveEnumJSON' ''Publicity
deriveEnumToHttpApiData' ''Publicity

-----------------------------------------------------------------------------

-- | Profile publicity of a user.
--
-- Not sure if all fields are covered, and maybe some fields should be optional.
data ProfilePublicity = ProfilePublicity
  { ProfilePublicity -> Publicity
_gender :: Publicity,
    ProfilePublicity -> Publicity
_region :: Publicity,
    ProfilePublicity -> Publicity
_birthDay :: Publicity,
    ProfilePublicity -> Publicity
_birthYear :: Publicity,
    ProfilePublicity -> Publicity
_job :: Publicity,
    ProfilePublicity -> Bool
_pawoo :: Bool
  }
  deriving stock (ProfilePublicity -> ProfilePublicity -> Bool
(ProfilePublicity -> ProfilePublicity -> Bool)
-> (ProfilePublicity -> ProfilePublicity -> Bool)
-> Eq ProfilePublicity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilePublicity -> ProfilePublicity -> Bool
$c/= :: ProfilePublicity -> ProfilePublicity -> Bool
== :: ProfilePublicity -> ProfilePublicity -> Bool
$c== :: ProfilePublicity -> ProfilePublicity -> Bool
Eq, Int -> ProfilePublicity -> ShowS
[ProfilePublicity] -> ShowS
ProfilePublicity -> String
(Int -> ProfilePublicity -> ShowS)
-> (ProfilePublicity -> String)
-> ([ProfilePublicity] -> ShowS)
-> Show ProfilePublicity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilePublicity] -> ShowS
$cshowList :: [ProfilePublicity] -> ShowS
show :: ProfilePublicity -> String
$cshow :: ProfilePublicity -> String
showsPrec :: Int -> ProfilePublicity -> ShowS
$cshowsPrec :: Int -> ProfilePublicity -> ShowS
Show, ReadPrec [ProfilePublicity]
ReadPrec ProfilePublicity
Int -> ReadS ProfilePublicity
ReadS [ProfilePublicity]
(Int -> ReadS ProfilePublicity)
-> ReadS [ProfilePublicity]
-> ReadPrec ProfilePublicity
-> ReadPrec [ProfilePublicity]
-> Read ProfilePublicity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProfilePublicity]
$creadListPrec :: ReadPrec [ProfilePublicity]
readPrec :: ReadPrec ProfilePublicity
$creadPrec :: ReadPrec ProfilePublicity
readList :: ReadS [ProfilePublicity]
$creadList :: ReadS [ProfilePublicity]
readsPrec :: Int -> ReadS ProfilePublicity
$creadsPrec :: Int -> ReadS ProfilePublicity
Read)

derivePixivJSON' ''ProfilePublicity

-----------------------------------------------------------------------------

-- | Workspace information of a user.
-- Not sure if all fields are covered, and maybe some fields should be optional.
data Workspace = Workspace
  { Workspace -> ImageUrl
_pc :: Text,
    Workspace -> ImageUrl
_monitor :: Text,
    Workspace -> ImageUrl
_tool :: Text,
    Workspace -> ImageUrl
_scanner :: Text,
    Workspace -> ImageUrl
_tablet :: Text,
    Workspace -> ImageUrl
_mouse :: Text,
    Workspace -> ImageUrl
_printer :: Text,
    Workspace -> ImageUrl
_desktop :: Text,
    Workspace -> ImageUrl
_music :: Text,
    Workspace -> ImageUrl
_desk :: Text,
    Workspace -> ImageUrl
_chair :: Text,
    Workspace -> ImageUrl
_comment :: Text,
    Workspace -> Maybe ImageUrl
_workspaceImageUrl :: Maybe Text
  }
  deriving stock (Workspace -> Workspace -> Bool
(Workspace -> Workspace -> Bool)
-> (Workspace -> Workspace -> Bool) -> Eq Workspace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Workspace -> Workspace -> Bool
$c/= :: Workspace -> Workspace -> Bool
== :: Workspace -> Workspace -> Bool
$c== :: Workspace -> Workspace -> Bool
Eq, Int -> Workspace -> ShowS
[Workspace] -> ShowS
Workspace -> String
(Int -> Workspace -> ShowS)
-> (Workspace -> String)
-> ([Workspace] -> ShowS)
-> Show Workspace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Workspace] -> ShowS
$cshowList :: [Workspace] -> ShowS
show :: Workspace -> String
$cshow :: Workspace -> String
showsPrec :: Int -> Workspace -> ShowS
$cshowsPrec :: Int -> Workspace -> ShowS
Show, ReadPrec [Workspace]
ReadPrec Workspace
Int -> ReadS Workspace
ReadS [Workspace]
(Int -> ReadS Workspace)
-> ReadS [Workspace]
-> ReadPrec Workspace
-> ReadPrec [Workspace]
-> Read Workspace
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Workspace]
$creadListPrec :: ReadPrec [Workspace]
readPrec :: ReadPrec Workspace
$creadPrec :: ReadPrec Workspace
readList :: ReadS [Workspace]
$creadList :: ReadS [Workspace]
readsPrec :: Int -> ReadS Workspace
$creadsPrec :: Int -> ReadS Workspace
Read)

derivePixivJSON' ''Workspace

-----------------------------------------------------------------------------

-- | Details of a user.
data UserDetail = UserDetail
  { UserDetail -> User
_user :: User,
    UserDetail -> UserProfile
_profile :: UserProfile,
    UserDetail -> ProfilePublicity
_profilePublicity :: ProfilePublicity,
    UserDetail -> Workspace
_workspace :: Workspace
  }
  deriving stock (UserDetail -> UserDetail -> Bool
(UserDetail -> UserDetail -> Bool)
-> (UserDetail -> UserDetail -> Bool) -> Eq UserDetail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserDetail -> UserDetail -> Bool
$c/= :: UserDetail -> UserDetail -> Bool
== :: UserDetail -> UserDetail -> Bool
$c== :: UserDetail -> UserDetail -> Bool
Eq, Int -> UserDetail -> ShowS
[UserDetail] -> ShowS
UserDetail -> String
(Int -> UserDetail -> ShowS)
-> (UserDetail -> String)
-> ([UserDetail] -> ShowS)
-> Show UserDetail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserDetail] -> ShowS
$cshowList :: [UserDetail] -> ShowS
show :: UserDetail -> String
$cshow :: UserDetail -> String
showsPrec :: Int -> UserDetail -> ShowS
$cshowsPrec :: Int -> UserDetail -> ShowS
Show, ReadPrec [UserDetail]
ReadPrec UserDetail
Int -> ReadS UserDetail
ReadS [UserDetail]
(Int -> ReadS UserDetail)
-> ReadS [UserDetail]
-> ReadPrec UserDetail
-> ReadPrec [UserDetail]
-> Read UserDetail
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserDetail]
$creadListPrec :: ReadPrec [UserDetail]
readPrec :: ReadPrec UserDetail
$creadPrec :: ReadPrec UserDetail
readList :: ReadS [UserDetail]
$creadList :: ReadS [UserDetail]
readsPrec :: Int -> ReadS UserDetail
$creadsPrec :: Int -> ReadS UserDetail
Read)

derivePixivJSON' ''UserDetail

-----------------------------------------------------------------------------

-- | A preview of user information.
--
-- Except 'Web.Pixiv.API.getUserDetail', other API involving users return this data type.
data UserPreview = UserPreview
  { UserPreview -> User
_user :: User,
    UserPreview -> [Illust]
_illusts :: [Illust],
    -- | Novels are not supported currently.
    UserPreview -> Value
_novels :: A.Value,
    UserPreview -> Bool
_isMuted :: Bool
  }
  deriving stock (UserPreview -> UserPreview -> Bool
(UserPreview -> UserPreview -> Bool)
-> (UserPreview -> UserPreview -> Bool) -> Eq UserPreview
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserPreview -> UserPreview -> Bool
$c/= :: UserPreview -> UserPreview -> Bool
== :: UserPreview -> UserPreview -> Bool
$c== :: UserPreview -> UserPreview -> Bool
Eq, Int -> UserPreview -> ShowS
[UserPreview] -> ShowS
UserPreview -> String
(Int -> UserPreview -> ShowS)
-> (UserPreview -> String)
-> ([UserPreview] -> ShowS)
-> Show UserPreview
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserPreview] -> ShowS
$cshowList :: [UserPreview] -> ShowS
show :: UserPreview -> String
$cshow :: UserPreview -> String
showsPrec :: Int -> UserPreview -> ShowS
$cshowsPrec :: Int -> UserPreview -> ShowS
Show, ReadPrec [UserPreview]
ReadPrec UserPreview
Int -> ReadS UserPreview
ReadS [UserPreview]
(Int -> ReadS UserPreview)
-> ReadS [UserPreview]
-> ReadPrec UserPreview
-> ReadPrec [UserPreview]
-> Read UserPreview
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserPreview]
$creadListPrec :: ReadPrec [UserPreview]
readPrec :: ReadPrec UserPreview
$creadPrec :: ReadPrec UserPreview
readList :: ReadS [UserPreview]
$creadList :: ReadS [UserPreview]
readsPrec :: Int -> ReadS UserPreview
$creadsPrec :: Int -> ReadS UserPreview
Read)

derivePixivJSON' ''UserPreview

-----------------------------------------------------------------------------

-- | Response of API which returns user previews.
data UserPreviews = UserPreviews
  { UserPreviews -> [UserPreview]
_userPreviews :: [UserPreview],
    UserPreviews -> Maybe ImageUrl
_nextUrl :: Maybe Text
  }
  deriving stock (UserPreviews -> UserPreviews -> Bool
(UserPreviews -> UserPreviews -> Bool)
-> (UserPreviews -> UserPreviews -> Bool) -> Eq UserPreviews
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserPreviews -> UserPreviews -> Bool
$c/= :: UserPreviews -> UserPreviews -> Bool
== :: UserPreviews -> UserPreviews -> Bool
$c== :: UserPreviews -> UserPreviews -> Bool
Eq, Int -> UserPreviews -> ShowS
[UserPreviews] -> ShowS
UserPreviews -> String
(Int -> UserPreviews -> ShowS)
-> (UserPreviews -> String)
-> ([UserPreviews] -> ShowS)
-> Show UserPreviews
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserPreviews] -> ShowS
$cshowList :: [UserPreviews] -> ShowS
show :: UserPreviews -> String
$cshow :: UserPreviews -> String
showsPrec :: Int -> UserPreviews -> ShowS
$cshowsPrec :: Int -> UserPreviews -> ShowS
Show, ReadPrec [UserPreviews]
ReadPrec UserPreviews
Int -> ReadS UserPreviews
ReadS [UserPreviews]
(Int -> ReadS UserPreviews)
-> ReadS [UserPreviews]
-> ReadPrec UserPreviews
-> ReadPrec [UserPreviews]
-> Read UserPreviews
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserPreviews]
$creadListPrec :: ReadPrec [UserPreviews]
readPrec :: ReadPrec UserPreviews
$creadPrec :: ReadPrec UserPreviews
readList :: ReadS [UserPreviews]
$creadList :: ReadS [UserPreviews]
readsPrec :: Int -> ReadS UserPreviews
$creadsPrec :: Int -> ReadS UserPreviews
Read)

derivePixivJSON' ''UserPreviews

type instance NextUrlLess UserPreviews = [UserPreview]

instance HasNextUrl UserPreviews where
  unNextUrl :: UserPreviews -> NextUrlLess UserPreviews
unNextUrl UserPreviews {[UserPreview]
Maybe ImageUrl
_nextUrl :: Maybe ImageUrl
_userPreviews :: [UserPreview]
$sel:_nextUrl:UserPreviews :: UserPreviews -> Maybe ImageUrl
$sel:_userPreviews:UserPreviews :: UserPreviews -> [UserPreview]
..} = [UserPreview]
NextUrlLess UserPreviews
_userPreviews
  getNextUrl :: UserPreviews -> Maybe ImageUrl
getNextUrl UserPreviews {[UserPreview]
Maybe ImageUrl
_nextUrl :: Maybe ImageUrl
_userPreviews :: [UserPreview]
$sel:_nextUrl:UserPreviews :: UserPreviews -> Maybe ImageUrl
$sel:_userPreviews:UserPreviews :: UserPreviews -> [UserPreview]
..} = Maybe ImageUrl
_nextUrl

-----------------------------------------------------------------------------

-- | A comment.
data Comment = Comment
  { Comment -> Int
_commentId :: Int,
    Comment -> ImageUrl
_comment :: Text,
    Comment -> UTCTime
_date :: UTCTime,
    Comment -> User
_user :: User,
    -- TODO
    Comment -> Maybe Value
_parentComment :: Maybe A.Value
  }
  deriving stock (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c== :: Comment -> Comment -> Bool
Eq, Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comment] -> ShowS
$cshowList :: [Comment] -> ShowS
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> ShowS
$cshowsPrec :: Int -> Comment -> ShowS
Show, ReadPrec [Comment]
ReadPrec Comment
Int -> ReadS Comment
ReadS [Comment]
(Int -> ReadS Comment)
-> ReadS [Comment]
-> ReadPrec Comment
-> ReadPrec [Comment]
-> Read Comment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Comment]
$creadListPrec :: ReadPrec [Comment]
readPrec :: ReadPrec Comment
$creadPrec :: ReadPrec Comment
readList :: ReadS [Comment]
$creadList :: ReadS [Comment]
readsPrec :: Int -> ReadS Comment
$creadsPrec :: Int -> ReadS Comment
Read)

derivePixivJSON "comment" ''Comment

-----------------------------------------------------------------------------

-- | Response of API which returns comments.
data Comments = Comments
  { Comments -> Int
_totalComments :: Int,
    Comments -> [Comment]
_comments :: [Comment],
    Comments -> Maybe ImageUrl
_nextUrl :: Maybe Text
  }
  deriving stock (Comments -> Comments -> Bool
(Comments -> Comments -> Bool)
-> (Comments -> Comments -> Bool) -> Eq Comments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comments -> Comments -> Bool
$c/= :: Comments -> Comments -> Bool
== :: Comments -> Comments -> Bool
$c== :: Comments -> Comments -> Bool
Eq, Int -> Comments -> ShowS
[Comments] -> ShowS
Comments -> String
(Int -> Comments -> ShowS)
-> (Comments -> String) -> ([Comments] -> ShowS) -> Show Comments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comments] -> ShowS
$cshowList :: [Comments] -> ShowS
show :: Comments -> String
$cshow :: Comments -> String
showsPrec :: Int -> Comments -> ShowS
$cshowsPrec :: Int -> Comments -> ShowS
Show, ReadPrec [Comments]
ReadPrec Comments
Int -> ReadS Comments
ReadS [Comments]
(Int -> ReadS Comments)
-> ReadS [Comments]
-> ReadPrec Comments
-> ReadPrec [Comments]
-> Read Comments
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Comments]
$creadListPrec :: ReadPrec [Comments]
readPrec :: ReadPrec Comments
$creadPrec :: ReadPrec Comments
readList :: ReadS [Comments]
$creadList :: ReadS [Comments]
readsPrec :: Int -> ReadS Comments
$creadsPrec :: Int -> ReadS Comments
Read)

derivePixivJSON' ''Comments

type instance NextUrlLess Comments = [Comment]

instance HasNextUrl Comments where
  unNextUrl :: Comments -> NextUrlLess Comments
unNextUrl Comments {Int
[Comment]
Maybe ImageUrl
_nextUrl :: Maybe ImageUrl
_comments :: [Comment]
_totalComments :: Int
$sel:_nextUrl:Comments :: Comments -> Maybe ImageUrl
$sel:_comments:Comments :: Comments -> [Comment]
$sel:_totalComments:Comments :: Comments -> Int
..} = [Comment]
NextUrlLess Comments
_comments
  getNextUrl :: Comments -> Maybe ImageUrl
getNextUrl Comments {Int
[Comment]
Maybe ImageUrl
_nextUrl :: Maybe ImageUrl
_comments :: [Comment]
_totalComments :: Int
$sel:_nextUrl:Comments :: Comments -> Maybe ImageUrl
$sel:_comments:Comments :: Comments -> [Comment]
$sel:_totalComments:Comments :: Comments -> Int
..} = Maybe ImageUrl
_nextUrl

-----------------------------------------------------------------------------

-- | A ugoira frame.
data UgoiraFrame = UgoiraFrame
  { -- | File name.
    UgoiraFrame -> ImageUrl
_ugoiraFile :: Text,
    -- | Duration of this frame (in millisecond).
    UgoiraFrame -> Int
_ugoiraDelay :: Int
  }
  deriving stock (UgoiraFrame -> UgoiraFrame -> Bool
(UgoiraFrame -> UgoiraFrame -> Bool)
-> (UgoiraFrame -> UgoiraFrame -> Bool) -> Eq UgoiraFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UgoiraFrame -> UgoiraFrame -> Bool
$c/= :: UgoiraFrame -> UgoiraFrame -> Bool
== :: UgoiraFrame -> UgoiraFrame -> Bool
$c== :: UgoiraFrame -> UgoiraFrame -> Bool
Eq, Int -> UgoiraFrame -> ShowS
[UgoiraFrame] -> ShowS
UgoiraFrame -> String
(Int -> UgoiraFrame -> ShowS)
-> (UgoiraFrame -> String)
-> ([UgoiraFrame] -> ShowS)
-> Show UgoiraFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UgoiraFrame] -> ShowS
$cshowList :: [UgoiraFrame] -> ShowS
show :: UgoiraFrame -> String
$cshow :: UgoiraFrame -> String
showsPrec :: Int -> UgoiraFrame -> ShowS
$cshowsPrec :: Int -> UgoiraFrame -> ShowS
Show, ReadPrec [UgoiraFrame]
ReadPrec UgoiraFrame
Int -> ReadS UgoiraFrame
ReadS [UgoiraFrame]
(Int -> ReadS UgoiraFrame)
-> ReadS [UgoiraFrame]
-> ReadPrec UgoiraFrame
-> ReadPrec [UgoiraFrame]
-> Read UgoiraFrame
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UgoiraFrame]
$creadListPrec :: ReadPrec [UgoiraFrame]
readPrec :: ReadPrec UgoiraFrame
$creadPrec :: ReadPrec UgoiraFrame
readList :: ReadS [UgoiraFrame]
$creadList :: ReadS [UgoiraFrame]
readsPrec :: Int -> ReadS UgoiraFrame
$creadsPrec :: Int -> ReadS UgoiraFrame
Read)

derivePixivJSON "ugoira" ''UgoiraFrame

-----------------------------------------------------------------------------

-- | A wrapper of ugoira zip file url.
newtype ZipUrls = ZipUrls
  { ZipUrls -> ImageUrl
_zipMedium :: Text
  }
  deriving stock (ZipUrls -> ZipUrls -> Bool
(ZipUrls -> ZipUrls -> Bool)
-> (ZipUrls -> ZipUrls -> Bool) -> Eq ZipUrls
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZipUrls -> ZipUrls -> Bool
$c/= :: ZipUrls -> ZipUrls -> Bool
== :: ZipUrls -> ZipUrls -> Bool
$c== :: ZipUrls -> ZipUrls -> Bool
Eq, Int -> ZipUrls -> ShowS
[ZipUrls] -> ShowS
ZipUrls -> String
(Int -> ZipUrls -> ShowS)
-> (ZipUrls -> String) -> ([ZipUrls] -> ShowS) -> Show ZipUrls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZipUrls] -> ShowS
$cshowList :: [ZipUrls] -> ShowS
show :: ZipUrls -> String
$cshow :: ZipUrls -> String
showsPrec :: Int -> ZipUrls -> ShowS
$cshowsPrec :: Int -> ZipUrls -> ShowS
Show, ReadPrec [ZipUrls]
ReadPrec ZipUrls
Int -> ReadS ZipUrls
ReadS [ZipUrls]
(Int -> ReadS ZipUrls)
-> ReadS [ZipUrls]
-> ReadPrec ZipUrls
-> ReadPrec [ZipUrls]
-> Read ZipUrls
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ZipUrls]
$creadListPrec :: ReadPrec [ZipUrls]
readPrec :: ReadPrec ZipUrls
$creadPrec :: ReadPrec ZipUrls
readList :: ReadS [ZipUrls]
$creadList :: ReadS [ZipUrls]
readsPrec :: Int -> ReadS ZipUrls
$creadsPrec :: Int -> ReadS ZipUrls
Read)

derivePixivJSON "zip" ''ZipUrls

-----------------------------------------------------------------------------

-- | Ugoira is a frame animation, whose common information is represented in 'Illust'.
-- This metadata contains a link to download the zip archive, which compresses frames of the ugoira;
-- and 'UgoiraFrame's to represents metadata of each frame.
-- Using 'Web.Pixiv.API.getUgoiraMetadata' can obtain value of this type.
-- See 'Web.Pixiv.Utils.ugoiraMetadataToFFConcat' and 'Web.Pixiv.Download.downloadUgoiraToMP4'.
data UgoiraMetadata = UgoiraMetadata
  { UgoiraMetadata -> ZipUrls
_zipUrls :: ZipUrls,
    UgoiraMetadata -> [UgoiraFrame]
_frames :: [UgoiraFrame]
  }
  deriving stock (UgoiraMetadata -> UgoiraMetadata -> Bool
(UgoiraMetadata -> UgoiraMetadata -> Bool)
-> (UgoiraMetadata -> UgoiraMetadata -> Bool) -> Eq UgoiraMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UgoiraMetadata -> UgoiraMetadata -> Bool
$c/= :: UgoiraMetadata -> UgoiraMetadata -> Bool
== :: UgoiraMetadata -> UgoiraMetadata -> Bool
$c== :: UgoiraMetadata -> UgoiraMetadata -> Bool
Eq, Int -> UgoiraMetadata -> ShowS
[UgoiraMetadata] -> ShowS
UgoiraMetadata -> String
(Int -> UgoiraMetadata -> ShowS)
-> (UgoiraMetadata -> String)
-> ([UgoiraMetadata] -> ShowS)
-> Show UgoiraMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UgoiraMetadata] -> ShowS
$cshowList :: [UgoiraMetadata] -> ShowS
show :: UgoiraMetadata -> String
$cshow :: UgoiraMetadata -> String
showsPrec :: Int -> UgoiraMetadata -> ShowS
$cshowsPrec :: Int -> UgoiraMetadata -> ShowS
Show, ReadPrec [UgoiraMetadata]
ReadPrec UgoiraMetadata
Int -> ReadS UgoiraMetadata
ReadS [UgoiraMetadata]
(Int -> ReadS UgoiraMetadata)
-> ReadS [UgoiraMetadata]
-> ReadPrec UgoiraMetadata
-> ReadPrec [UgoiraMetadata]
-> Read UgoiraMetadata
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UgoiraMetadata]
$creadListPrec :: ReadPrec [UgoiraMetadata]
readPrec :: ReadPrec UgoiraMetadata
$creadPrec :: ReadPrec UgoiraMetadata
readList :: ReadS [UgoiraMetadata]
$creadList :: ReadS [UgoiraMetadata]
readsPrec :: Int -> ReadS UgoiraMetadata
$creadsPrec :: Int -> ReadS UgoiraMetadata
Read)

derivePixivJSON' ''UgoiraMetadata

-----------------------------------------------------------------------------

-- | A wrapper of 'UgoiraMetadata' for JSON deserialization.
newtype UgoiraMetadataWrapper = UgoiraMetadataWrapper
  { UgoiraMetadataWrapper -> UgoiraMetadata
_ugoiraMetadata :: UgoiraMetadata
  }
  deriving stock (UgoiraMetadataWrapper -> UgoiraMetadataWrapper -> Bool
(UgoiraMetadataWrapper -> UgoiraMetadataWrapper -> Bool)
-> (UgoiraMetadataWrapper -> UgoiraMetadataWrapper -> Bool)
-> Eq UgoiraMetadataWrapper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UgoiraMetadataWrapper -> UgoiraMetadataWrapper -> Bool
$c/= :: UgoiraMetadataWrapper -> UgoiraMetadataWrapper -> Bool
== :: UgoiraMetadataWrapper -> UgoiraMetadataWrapper -> Bool
$c== :: UgoiraMetadataWrapper -> UgoiraMetadataWrapper -> Bool
Eq, Int -> UgoiraMetadataWrapper -> ShowS
[UgoiraMetadataWrapper] -> ShowS
UgoiraMetadataWrapper -> String
(Int -> UgoiraMetadataWrapper -> ShowS)
-> (UgoiraMetadataWrapper -> String)
-> ([UgoiraMetadataWrapper] -> ShowS)
-> Show UgoiraMetadataWrapper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UgoiraMetadataWrapper] -> ShowS
$cshowList :: [UgoiraMetadataWrapper] -> ShowS
show :: UgoiraMetadataWrapper -> String
$cshow :: UgoiraMetadataWrapper -> String
showsPrec :: Int -> UgoiraMetadataWrapper -> ShowS
$cshowsPrec :: Int -> UgoiraMetadataWrapper -> ShowS
Show, ReadPrec [UgoiraMetadataWrapper]
ReadPrec UgoiraMetadataWrapper
Int -> ReadS UgoiraMetadataWrapper
ReadS [UgoiraMetadataWrapper]
(Int -> ReadS UgoiraMetadataWrapper)
-> ReadS [UgoiraMetadataWrapper]
-> ReadPrec UgoiraMetadataWrapper
-> ReadPrec [UgoiraMetadataWrapper]
-> Read UgoiraMetadataWrapper
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UgoiraMetadataWrapper]
$creadListPrec :: ReadPrec [UgoiraMetadataWrapper]
readPrec :: ReadPrec UgoiraMetadataWrapper
$creadPrec :: ReadPrec UgoiraMetadataWrapper
readList :: ReadS [UgoiraMetadataWrapper]
$creadList :: ReadS [UgoiraMetadataWrapper]
readsPrec :: Int -> ReadS UgoiraMetadataWrapper
$creadsPrec :: Int -> ReadS UgoiraMetadataWrapper
Read)

derivePixivJSON' ''UgoiraMetadataWrapper

-----------------------------------------------------------------------------

-- | Spotlight article.
data SpotlightArticle = SpotlightArticle
  { SpotlightArticle -> Int
_saId :: Int,
    SpotlightArticle -> ImageUrl
_title :: Text,
    SpotlightArticle -> ImageUrl
_pureTitle :: Text,
    SpotlightArticle -> ImageUrl
_thumbnail :: Text,
    SpotlightArticle -> ImageUrl
_articleUrl :: Text,
    SpotlightArticle -> UTCTime
_publishDate :: UTCTime,
    SpotlightArticle -> ImageUrl
_category :: Text,
    SpotlightArticle -> ImageUrl
_subcategoryLabel :: Text
  }
  deriving stock (SpotlightArticle -> SpotlightArticle -> Bool
(SpotlightArticle -> SpotlightArticle -> Bool)
-> (SpotlightArticle -> SpotlightArticle -> Bool)
-> Eq SpotlightArticle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpotlightArticle -> SpotlightArticle -> Bool
$c/= :: SpotlightArticle -> SpotlightArticle -> Bool
== :: SpotlightArticle -> SpotlightArticle -> Bool
$c== :: SpotlightArticle -> SpotlightArticle -> Bool
Eq, Int -> SpotlightArticle -> ShowS
[SpotlightArticle] -> ShowS
SpotlightArticle -> String
(Int -> SpotlightArticle -> ShowS)
-> (SpotlightArticle -> String)
-> ([SpotlightArticle] -> ShowS)
-> Show SpotlightArticle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpotlightArticle] -> ShowS
$cshowList :: [SpotlightArticle] -> ShowS
show :: SpotlightArticle -> String
$cshow :: SpotlightArticle -> String
showsPrec :: Int -> SpotlightArticle -> ShowS
$cshowsPrec :: Int -> SpotlightArticle -> ShowS
Show, ReadPrec [SpotlightArticle]
ReadPrec SpotlightArticle
Int -> ReadS SpotlightArticle
ReadS [SpotlightArticle]
(Int -> ReadS SpotlightArticle)
-> ReadS [SpotlightArticle]
-> ReadPrec SpotlightArticle
-> ReadPrec [SpotlightArticle]
-> Read SpotlightArticle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpotlightArticle]
$creadListPrec :: ReadPrec [SpotlightArticle]
readPrec :: ReadPrec SpotlightArticle
$creadPrec :: ReadPrec SpotlightArticle
readList :: ReadS [SpotlightArticle]
$creadList :: ReadS [SpotlightArticle]
readsPrec :: Int -> ReadS SpotlightArticle
$creadsPrec :: Int -> ReadS SpotlightArticle
Read)

derivePixivJSON' ''SpotlightArticle

-----------------------------------------------------------------------------

-- | Response of API which returns spotlight articles.
data SpotlightArticles = SpotlightArticles
  { SpotlightArticles -> [SpotlightArticle]
_spotlightArticles :: [SpotlightArticle],
    SpotlightArticles -> Maybe ImageUrl
_nextUrl :: Maybe Text
  }
  deriving stock (SpotlightArticles -> SpotlightArticles -> Bool
(SpotlightArticles -> SpotlightArticles -> Bool)
-> (SpotlightArticles -> SpotlightArticles -> Bool)
-> Eq SpotlightArticles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpotlightArticles -> SpotlightArticles -> Bool
$c/= :: SpotlightArticles -> SpotlightArticles -> Bool
== :: SpotlightArticles -> SpotlightArticles -> Bool
$c== :: SpotlightArticles -> SpotlightArticles -> Bool
Eq, Int -> SpotlightArticles -> ShowS
[SpotlightArticles] -> ShowS
SpotlightArticles -> String
(Int -> SpotlightArticles -> ShowS)
-> (SpotlightArticles -> String)
-> ([SpotlightArticles] -> ShowS)
-> Show SpotlightArticles
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpotlightArticles] -> ShowS
$cshowList :: [SpotlightArticles] -> ShowS
show :: SpotlightArticles -> String
$cshow :: SpotlightArticles -> String
showsPrec :: Int -> SpotlightArticles -> ShowS
$cshowsPrec :: Int -> SpotlightArticles -> ShowS
Show, ReadPrec [SpotlightArticles]
ReadPrec SpotlightArticles
Int -> ReadS SpotlightArticles
ReadS [SpotlightArticles]
(Int -> ReadS SpotlightArticles)
-> ReadS [SpotlightArticles]
-> ReadPrec SpotlightArticles
-> ReadPrec [SpotlightArticles]
-> Read SpotlightArticles
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpotlightArticles]
$creadListPrec :: ReadPrec [SpotlightArticles]
readPrec :: ReadPrec SpotlightArticles
$creadPrec :: ReadPrec SpotlightArticles
readList :: ReadS [SpotlightArticles]
$creadList :: ReadS [SpotlightArticles]
readsPrec :: Int -> ReadS SpotlightArticles
$creadsPrec :: Int -> ReadS SpotlightArticles
Read)

derivePixivJSON' ''SpotlightArticles

type instance NextUrlLess SpotlightArticles = [SpotlightArticle]

instance HasNextUrl SpotlightArticles where
  unNextUrl :: SpotlightArticles -> NextUrlLess SpotlightArticles
unNextUrl SpotlightArticles {[SpotlightArticle]
Maybe ImageUrl
_nextUrl :: Maybe ImageUrl
_spotlightArticles :: [SpotlightArticle]
$sel:_nextUrl:SpotlightArticles :: SpotlightArticles -> Maybe ImageUrl
$sel:_spotlightArticles:SpotlightArticles :: SpotlightArticles -> [SpotlightArticle]
..} = [SpotlightArticle]
NextUrlLess SpotlightArticles
_spotlightArticles
  getNextUrl :: SpotlightArticles -> Maybe ImageUrl
getNextUrl SpotlightArticles {[SpotlightArticle]
Maybe ImageUrl
_nextUrl :: Maybe ImageUrl
_spotlightArticles :: [SpotlightArticle]
$sel:_nextUrl:SpotlightArticles :: SpotlightArticles -> Maybe ImageUrl
$sel:_spotlightArticles:SpotlightArticles :: SpotlightArticles -> [SpotlightArticle]
..} = Maybe ImageUrl
_nextUrl

-----------------------------------------------------------------------------

-- | Rank mode query parm.
--
-- See 'Web.Pixiv.API.getIllustRanking'
data RankMode
  = Day
  | DayR18
  | DayMale
  | DayMaleR18
  | DayFemale
  | DayFemaleR18
  | Week
  | WeekR18
  | WeekR18G
  | Month
  | WeekOriginal
  | WeekRookie
  | DayManga
  deriving stock (Int -> RankMode -> ShowS
[RankMode] -> ShowS
RankMode -> String
(Int -> RankMode -> ShowS)
-> (RankMode -> String) -> ([RankMode] -> ShowS) -> Show RankMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RankMode] -> ShowS
$cshowList :: [RankMode] -> ShowS
show :: RankMode -> String
$cshow :: RankMode -> String
showsPrec :: Int -> RankMode -> ShowS
$cshowsPrec :: Int -> RankMode -> ShowS
Show, RankMode -> RankMode -> Bool
(RankMode -> RankMode -> Bool)
-> (RankMode -> RankMode -> Bool) -> Eq RankMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RankMode -> RankMode -> Bool
$c/= :: RankMode -> RankMode -> Bool
== :: RankMode -> RankMode -> Bool
$c== :: RankMode -> RankMode -> Bool
Eq, Eq RankMode
Eq RankMode
-> (RankMode -> RankMode -> Ordering)
-> (RankMode -> RankMode -> Bool)
-> (RankMode -> RankMode -> Bool)
-> (RankMode -> RankMode -> Bool)
-> (RankMode -> RankMode -> Bool)
-> (RankMode -> RankMode -> RankMode)
-> (RankMode -> RankMode -> RankMode)
-> Ord RankMode
RankMode -> RankMode -> Bool
RankMode -> RankMode -> Ordering
RankMode -> RankMode -> RankMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RankMode -> RankMode -> RankMode
$cmin :: RankMode -> RankMode -> RankMode
max :: RankMode -> RankMode -> RankMode
$cmax :: RankMode -> RankMode -> RankMode
>= :: RankMode -> RankMode -> Bool
$c>= :: RankMode -> RankMode -> Bool
> :: RankMode -> RankMode -> Bool
$c> :: RankMode -> RankMode -> Bool
<= :: RankMode -> RankMode -> Bool
$c<= :: RankMode -> RankMode -> Bool
< :: RankMode -> RankMode -> Bool
$c< :: RankMode -> RankMode -> Bool
compare :: RankMode -> RankMode -> Ordering
$ccompare :: RankMode -> RankMode -> Ordering
$cp1Ord :: Eq RankMode
Ord, Int -> RankMode
RankMode -> Int
RankMode -> [RankMode]
RankMode -> RankMode
RankMode -> RankMode -> [RankMode]
RankMode -> RankMode -> RankMode -> [RankMode]
(RankMode -> RankMode)
-> (RankMode -> RankMode)
-> (Int -> RankMode)
-> (RankMode -> Int)
-> (RankMode -> [RankMode])
-> (RankMode -> RankMode -> [RankMode])
-> (RankMode -> RankMode -> [RankMode])
-> (RankMode -> RankMode -> RankMode -> [RankMode])
-> Enum RankMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RankMode -> RankMode -> RankMode -> [RankMode]
$cenumFromThenTo :: RankMode -> RankMode -> RankMode -> [RankMode]
enumFromTo :: RankMode -> RankMode -> [RankMode]
$cenumFromTo :: RankMode -> RankMode -> [RankMode]
enumFromThen :: RankMode -> RankMode -> [RankMode]
$cenumFromThen :: RankMode -> RankMode -> [RankMode]
enumFrom :: RankMode -> [RankMode]
$cenumFrom :: RankMode -> [RankMode]
fromEnum :: RankMode -> Int
$cfromEnum :: RankMode -> Int
toEnum :: Int -> RankMode
$ctoEnum :: Int -> RankMode
pred :: RankMode -> RankMode
$cpred :: RankMode -> RankMode
succ :: RankMode -> RankMode
$csucc :: RankMode -> RankMode
Enum, ReadPrec [RankMode]
ReadPrec RankMode
Int -> ReadS RankMode
ReadS [RankMode]
(Int -> ReadS RankMode)
-> ReadS [RankMode]
-> ReadPrec RankMode
-> ReadPrec [RankMode]
-> Read RankMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RankMode]
$creadListPrec :: ReadPrec [RankMode]
readPrec :: ReadPrec RankMode
$creadPrec :: ReadPrec RankMode
readList :: ReadS [RankMode]
$creadList :: ReadS [RankMode]
readsPrec :: Int -> ReadS RankMode
$creadsPrec :: Int -> ReadS RankMode
Read)

deriveEnumToHttpApiData' ''RankMode

-----------------------------------------------------------------------------

-- | Sorting method query parm.
--
-- See 'Web.Pixiv.API.searchIllust'.
data SortingMethod
  = DateDesc
  | DateAsc
  | PopularDesc
  deriving stock (Int -> SortingMethod -> ShowS
[SortingMethod] -> ShowS
SortingMethod -> String
(Int -> SortingMethod -> ShowS)
-> (SortingMethod -> String)
-> ([SortingMethod] -> ShowS)
-> Show SortingMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortingMethod] -> ShowS
$cshowList :: [SortingMethod] -> ShowS
show :: SortingMethod -> String
$cshow :: SortingMethod -> String
showsPrec :: Int -> SortingMethod -> ShowS
$cshowsPrec :: Int -> SortingMethod -> ShowS
Show, SortingMethod -> SortingMethod -> Bool
(SortingMethod -> SortingMethod -> Bool)
-> (SortingMethod -> SortingMethod -> Bool) -> Eq SortingMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortingMethod -> SortingMethod -> Bool
$c/= :: SortingMethod -> SortingMethod -> Bool
== :: SortingMethod -> SortingMethod -> Bool
$c== :: SortingMethod -> SortingMethod -> Bool
Eq, Eq SortingMethod
Eq SortingMethod
-> (SortingMethod -> SortingMethod -> Ordering)
-> (SortingMethod -> SortingMethod -> Bool)
-> (SortingMethod -> SortingMethod -> Bool)
-> (SortingMethod -> SortingMethod -> Bool)
-> (SortingMethod -> SortingMethod -> Bool)
-> (SortingMethod -> SortingMethod -> SortingMethod)
-> (SortingMethod -> SortingMethod -> SortingMethod)
-> Ord SortingMethod
SortingMethod -> SortingMethod -> Bool
SortingMethod -> SortingMethod -> Ordering
SortingMethod -> SortingMethod -> SortingMethod
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SortingMethod -> SortingMethod -> SortingMethod
$cmin :: SortingMethod -> SortingMethod -> SortingMethod
max :: SortingMethod -> SortingMethod -> SortingMethod
$cmax :: SortingMethod -> SortingMethod -> SortingMethod
>= :: SortingMethod -> SortingMethod -> Bool
$c>= :: SortingMethod -> SortingMethod -> Bool
> :: SortingMethod -> SortingMethod -> Bool
$c> :: SortingMethod -> SortingMethod -> Bool
<= :: SortingMethod -> SortingMethod -> Bool
$c<= :: SortingMethod -> SortingMethod -> Bool
< :: SortingMethod -> SortingMethod -> Bool
$c< :: SortingMethod -> SortingMethod -> Bool
compare :: SortingMethod -> SortingMethod -> Ordering
$ccompare :: SortingMethod -> SortingMethod -> Ordering
$cp1Ord :: Eq SortingMethod
Ord, Int -> SortingMethod
SortingMethod -> Int
SortingMethod -> [SortingMethod]
SortingMethod -> SortingMethod
SortingMethod -> SortingMethod -> [SortingMethod]
SortingMethod -> SortingMethod -> SortingMethod -> [SortingMethod]
(SortingMethod -> SortingMethod)
-> (SortingMethod -> SortingMethod)
-> (Int -> SortingMethod)
-> (SortingMethod -> Int)
-> (SortingMethod -> [SortingMethod])
-> (SortingMethod -> SortingMethod -> [SortingMethod])
-> (SortingMethod -> SortingMethod -> [SortingMethod])
-> (SortingMethod
    -> SortingMethod -> SortingMethod -> [SortingMethod])
-> Enum SortingMethod
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SortingMethod -> SortingMethod -> SortingMethod -> [SortingMethod]
$cenumFromThenTo :: SortingMethod -> SortingMethod -> SortingMethod -> [SortingMethod]
enumFromTo :: SortingMethod -> SortingMethod -> [SortingMethod]
$cenumFromTo :: SortingMethod -> SortingMethod -> [SortingMethod]
enumFromThen :: SortingMethod -> SortingMethod -> [SortingMethod]
$cenumFromThen :: SortingMethod -> SortingMethod -> [SortingMethod]
enumFrom :: SortingMethod -> [SortingMethod]
$cenumFrom :: SortingMethod -> [SortingMethod]
fromEnum :: SortingMethod -> Int
$cfromEnum :: SortingMethod -> Int
toEnum :: Int -> SortingMethod
$ctoEnum :: Int -> SortingMethod
pred :: SortingMethod -> SortingMethod
$cpred :: SortingMethod -> SortingMethod
succ :: SortingMethod -> SortingMethod
$csucc :: SortingMethod -> SortingMethod
Enum, ReadPrec [SortingMethod]
ReadPrec SortingMethod
Int -> ReadS SortingMethod
ReadS [SortingMethod]
(Int -> ReadS SortingMethod)
-> ReadS [SortingMethod]
-> ReadPrec SortingMethod
-> ReadPrec [SortingMethod]
-> Read SortingMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SortingMethod]
$creadListPrec :: ReadPrec [SortingMethod]
readPrec :: ReadPrec SortingMethod
$creadPrec :: ReadPrec SortingMethod
readList :: ReadS [SortingMethod]
$creadList :: ReadS [SortingMethod]
readsPrec :: Int -> ReadS SortingMethod
$creadsPrec :: Int -> ReadS SortingMethod
Read)

deriveEnumToHttpApiData' ''SortingMethod

-----------------------------------------------------------------------------

-- | Duration query parm.
--
-- See 'Web.Pixiv.API.searchIllust'.
data Duration
  = WithinLastDay
  | WithinLastMonth
  | WithinLastYear
  deriving stock (Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show, Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq, Eq Duration
Eq Duration
-> (Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmax :: Duration -> Duration -> Duration
>= :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c< :: Duration -> Duration -> Bool
compare :: Duration -> Duration -> Ordering
$ccompare :: Duration -> Duration -> Ordering
$cp1Ord :: Eq Duration
Ord, ReadPrec [Duration]
ReadPrec Duration
Int -> ReadS Duration
ReadS [Duration]
(Int -> ReadS Duration)
-> ReadS [Duration]
-> ReadPrec Duration
-> ReadPrec [Duration]
-> Read Duration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Duration]
$creadListPrec :: ReadPrec [Duration]
readPrec :: ReadPrec Duration
$creadPrec :: ReadPrec Duration
readList :: ReadS [Duration]
$creadList :: ReadS [Duration]
readsPrec :: Int -> ReadS Duration
$creadsPrec :: Int -> ReadS Duration
Read)

deriveEnumToHttpApiData' ''Duration

-----------------------------------------------------------------------------

-- | Search target query parm.
--
-- See 'Web.Pixiv.API.searchIllust'.
data SearchTarget = ExactMatchForTags | PartialMatchForTags | TitleAndCaption
  deriving stock (Int -> SearchTarget -> ShowS
[SearchTarget] -> ShowS
SearchTarget -> String
(Int -> SearchTarget -> ShowS)
-> (SearchTarget -> String)
-> ([SearchTarget] -> ShowS)
-> Show SearchTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchTarget] -> ShowS
$cshowList :: [SearchTarget] -> ShowS
show :: SearchTarget -> String
$cshow :: SearchTarget -> String
showsPrec :: Int -> SearchTarget -> ShowS
$cshowsPrec :: Int -> SearchTarget -> ShowS
Show, SearchTarget -> SearchTarget -> Bool
(SearchTarget -> SearchTarget -> Bool)
-> (SearchTarget -> SearchTarget -> Bool) -> Eq SearchTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchTarget -> SearchTarget -> Bool
$c/= :: SearchTarget -> SearchTarget -> Bool
== :: SearchTarget -> SearchTarget -> Bool
$c== :: SearchTarget -> SearchTarget -> Bool
Eq, Eq SearchTarget
Eq SearchTarget
-> (SearchTarget -> SearchTarget -> Ordering)
-> (SearchTarget -> SearchTarget -> Bool)
-> (SearchTarget -> SearchTarget -> Bool)
-> (SearchTarget -> SearchTarget -> Bool)
-> (SearchTarget -> SearchTarget -> Bool)
-> (SearchTarget -> SearchTarget -> SearchTarget)
-> (SearchTarget -> SearchTarget -> SearchTarget)
-> Ord SearchTarget
SearchTarget -> SearchTarget -> Bool
SearchTarget -> SearchTarget -> Ordering
SearchTarget -> SearchTarget -> SearchTarget
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SearchTarget -> SearchTarget -> SearchTarget
$cmin :: SearchTarget -> SearchTarget -> SearchTarget
max :: SearchTarget -> SearchTarget -> SearchTarget
$cmax :: SearchTarget -> SearchTarget -> SearchTarget
>= :: SearchTarget -> SearchTarget -> Bool
$c>= :: SearchTarget -> SearchTarget -> Bool
> :: SearchTarget -> SearchTarget -> Bool
$c> :: SearchTarget -> SearchTarget -> Bool
<= :: SearchTarget -> SearchTarget -> Bool
$c<= :: SearchTarget -> SearchTarget -> Bool
< :: SearchTarget -> SearchTarget -> Bool
$c< :: SearchTarget -> SearchTarget -> Bool
compare :: SearchTarget -> SearchTarget -> Ordering
$ccompare :: SearchTarget -> SearchTarget -> Ordering
$cp1Ord :: Eq SearchTarget
Ord, Int -> SearchTarget
SearchTarget -> Int
SearchTarget -> [SearchTarget]
SearchTarget -> SearchTarget
SearchTarget -> SearchTarget -> [SearchTarget]
SearchTarget -> SearchTarget -> SearchTarget -> [SearchTarget]
(SearchTarget -> SearchTarget)
-> (SearchTarget -> SearchTarget)
-> (Int -> SearchTarget)
-> (SearchTarget -> Int)
-> (SearchTarget -> [SearchTarget])
-> (SearchTarget -> SearchTarget -> [SearchTarget])
-> (SearchTarget -> SearchTarget -> [SearchTarget])
-> (SearchTarget -> SearchTarget -> SearchTarget -> [SearchTarget])
-> Enum SearchTarget
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SearchTarget -> SearchTarget -> SearchTarget -> [SearchTarget]
$cenumFromThenTo :: SearchTarget -> SearchTarget -> SearchTarget -> [SearchTarget]
enumFromTo :: SearchTarget -> SearchTarget -> [SearchTarget]
$cenumFromTo :: SearchTarget -> SearchTarget -> [SearchTarget]
enumFromThen :: SearchTarget -> SearchTarget -> [SearchTarget]
$cenumFromThen :: SearchTarget -> SearchTarget -> [SearchTarget]
enumFrom :: SearchTarget -> [SearchTarget]
$cenumFrom :: SearchTarget -> [SearchTarget]
fromEnum :: SearchTarget -> Int
$cfromEnum :: SearchTarget -> Int
toEnum :: Int -> SearchTarget
$ctoEnum :: Int -> SearchTarget
pred :: SearchTarget -> SearchTarget
$cpred :: SearchTarget -> SearchTarget
succ :: SearchTarget -> SearchTarget
$csucc :: SearchTarget -> SearchTarget
Enum, ReadPrec [SearchTarget]
ReadPrec SearchTarget
Int -> ReadS SearchTarget
ReadS [SearchTarget]
(Int -> ReadS SearchTarget)
-> ReadS [SearchTarget]
-> ReadPrec SearchTarget
-> ReadPrec [SearchTarget]
-> Read SearchTarget
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SearchTarget]
$creadListPrec :: ReadPrec [SearchTarget]
readPrec :: ReadPrec SearchTarget
$creadPrec :: ReadPrec SearchTarget
readList :: ReadS [SearchTarget]
$creadList :: ReadS [SearchTarget]
readsPrec :: Int -> ReadS SearchTarget
$creadsPrec :: Int -> ReadS SearchTarget
Read)

deriveEnumToHttpApiData' ''SearchTarget

-----------------------------------------------------------------------------