{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Gallery API.
module Web.Exhentai.API.Gallery
  ( Gallery (..),
    GalleryInfo (..),
    Visibility (..),
    GalleryCategory (..),
    TagCategory (..),
    allGalleryCats,
    fetchGalleryInfo,

    -- ** Internal API
    parseGalleryLink,
    parseGallery,
  )
where

import Control.Effect
import Control.Effect.Bracket
import Control.Effect.Error
import Control.Effect.Exh
import Control.Monad
import Data.Maybe
import Data.Set (Set, fromList)
import Data.Text (Text, pack, strip)
import Data.Time
import Data.Void
import Network.HTTP.Client hiding (Cookie)
import Optics.Core
import Optics.TH
import Text.Megaparsec hiding (token)
import Text.Megaparsec.Char.Lexer
import Text.XML
import Text.XML.Optics
import Web.Exhentai.Errors
import qualified Web.Exhentai.Parsing.Gallery as G
import Web.Exhentai.Utils
import Prelude hiding (length)
import qualified Prelude as P

data Gallery = Gallery
  { Gallery -> Int
galleryId :: {-# UNPACK #-} !Int,
    Gallery -> Text
token :: {-# UNPACK #-} !Text
  }
  deriving (Int -> Gallery -> ShowS
[Gallery] -> ShowS
Gallery -> String
(Int -> Gallery -> ShowS)
-> (Gallery -> String) -> ([Gallery] -> ShowS) -> Show Gallery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gallery] -> ShowS
$cshowList :: [Gallery] -> ShowS
show :: Gallery -> String
$cshow :: Gallery -> String
showsPrec :: Int -> Gallery -> ShowS
$cshowsPrec :: Int -> Gallery -> ShowS
Show, Gallery -> Gallery -> Bool
(Gallery -> Gallery -> Bool)
-> (Gallery -> Gallery -> Bool) -> Eq Gallery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gallery -> Gallery -> Bool
$c/= :: Gallery -> Gallery -> Bool
== :: Gallery -> Gallery -> Bool
$c== :: Gallery -> Gallery -> Bool
Eq)

toGalleryLink :: Gallery -> Text
toGalleryLink :: Gallery -> Text
toGalleryLink Gallery {Int
Text
token :: Text
galleryId :: Int
$sel:token:Gallery :: Gallery -> Text
$sel:galleryId:Gallery :: Gallery -> Int
..} = Text
"https://exhentai.org/g/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
galleryId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
token Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"

parseGalleryLink :: Text -> Maybe Gallery
parseGalleryLink :: Text -> Maybe Gallery
parseGalleryLink = Parsec Void Text Gallery -> Text -> Maybe Gallery
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text Gallery
galleryLink
  where
    galleryLink :: Parser Gallery
    galleryLink :: Parsec Void Text Gallery
galleryLink = do
      Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"https://exhentai.org/g/"
      Int
galleryId <- ParsecT Void Text Identity Int
forall e s (m :: Type -> Type) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'/'
      Text
token <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/')
      Maybe Char
_ <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity (Maybe Char))
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'/'
      Gallery -> Parsec Void Text Gallery
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Gallery :: Int -> Text -> Gallery
Gallery {Int
Text
token :: Text
galleryId :: Int
$sel:token:Gallery :: Text
$sel:galleryId:Gallery :: Int
..}

data TagCategory
  = Language
  | Parody
  | Character
  | Group
  | Artist
  | Male
  | Female
  | Misc'
  | Reclass
  deriving (Int -> TagCategory -> ShowS
[TagCategory] -> ShowS
TagCategory -> String
(Int -> TagCategory -> ShowS)
-> (TagCategory -> String)
-> ([TagCategory] -> ShowS)
-> Show TagCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagCategory] -> ShowS
$cshowList :: [TagCategory] -> ShowS
show :: TagCategory -> String
$cshow :: TagCategory -> String
showsPrec :: Int -> TagCategory -> ShowS
$cshowsPrec :: Int -> TagCategory -> ShowS
Show, TagCategory -> TagCategory -> Bool
(TagCategory -> TagCategory -> Bool)
-> (TagCategory -> TagCategory -> Bool) -> Eq TagCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagCategory -> TagCategory -> Bool
$c/= :: TagCategory -> TagCategory -> Bool
== :: TagCategory -> TagCategory -> Bool
$c== :: TagCategory -> TagCategory -> Bool
Eq, Int -> TagCategory
TagCategory -> Int
TagCategory -> [TagCategory]
TagCategory -> TagCategory
TagCategory -> TagCategory -> [TagCategory]
TagCategory -> TagCategory -> TagCategory -> [TagCategory]
(TagCategory -> TagCategory)
-> (TagCategory -> TagCategory)
-> (Int -> TagCategory)
-> (TagCategory -> Int)
-> (TagCategory -> [TagCategory])
-> (TagCategory -> TagCategory -> [TagCategory])
-> (TagCategory -> TagCategory -> [TagCategory])
-> (TagCategory -> TagCategory -> TagCategory -> [TagCategory])
-> Enum TagCategory
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 :: TagCategory -> TagCategory -> TagCategory -> [TagCategory]
$cenumFromThenTo :: TagCategory -> TagCategory -> TagCategory -> [TagCategory]
enumFromTo :: TagCategory -> TagCategory -> [TagCategory]
$cenumFromTo :: TagCategory -> TagCategory -> [TagCategory]
enumFromThen :: TagCategory -> TagCategory -> [TagCategory]
$cenumFromThen :: TagCategory -> TagCategory -> [TagCategory]
enumFrom :: TagCategory -> [TagCategory]
$cenumFrom :: TagCategory -> [TagCategory]
fromEnum :: TagCategory -> Int
$cfromEnum :: TagCategory -> Int
toEnum :: Int -> TagCategory
$ctoEnum :: Int -> TagCategory
pred :: TagCategory -> TagCategory
$cpred :: TagCategory -> TagCategory
succ :: TagCategory -> TagCategory
$csucc :: TagCategory -> TagCategory
Enum)

readTagCat :: Text -> Maybe TagCategory
readTagCat :: Text -> Maybe TagCategory
readTagCat Text
"language:" = TagCategory -> Maybe TagCategory
forall a. a -> Maybe a
Just TagCategory
Language
readTagCat Text
"parody:" = TagCategory -> Maybe TagCategory
forall a. a -> Maybe a
Just TagCategory
Parody
readTagCat Text
"character:" = TagCategory -> Maybe TagCategory
forall a. a -> Maybe a
Just TagCategory
Character
readTagCat Text
"group:" = TagCategory -> Maybe TagCategory
forall a. a -> Maybe a
Just TagCategory
Group
readTagCat Text
"artist:" = TagCategory -> Maybe TagCategory
forall a. a -> Maybe a
Just TagCategory
Artist
readTagCat Text
"male:" = TagCategory -> Maybe TagCategory
forall a. a -> Maybe a
Just TagCategory
Male
readTagCat Text
"female:" = TagCategory -> Maybe TagCategory
forall a. a -> Maybe a
Just TagCategory
Female
readTagCat Text
"misc:" = TagCategory -> Maybe TagCategory
forall a. a -> Maybe a
Just TagCategory
Misc'
readTagCat Text
"reclass:" = TagCategory -> Maybe TagCategory
forall a. a -> Maybe a
Just TagCategory
Reclass
readTagCat Text
_ = Maybe TagCategory
forall a. Maybe a
Nothing

data GalleryCategory
  = Misc
  | Doujinshi
  | Manga
  | ArtistCG
  | GameCG
  | ImageSet
  | Cosplay
  | AsianPorn
  | NonH
  | Western
  | Private
  deriving (Int -> GalleryCategory -> ShowS
[GalleryCategory] -> ShowS
GalleryCategory -> String
(Int -> GalleryCategory -> ShowS)
-> (GalleryCategory -> String)
-> ([GalleryCategory] -> ShowS)
-> Show GalleryCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GalleryCategory] -> ShowS
$cshowList :: [GalleryCategory] -> ShowS
show :: GalleryCategory -> String
$cshow :: GalleryCategory -> String
showsPrec :: Int -> GalleryCategory -> ShowS
$cshowsPrec :: Int -> GalleryCategory -> ShowS
Show, GalleryCategory -> GalleryCategory -> Bool
(GalleryCategory -> GalleryCategory -> Bool)
-> (GalleryCategory -> GalleryCategory -> Bool)
-> Eq GalleryCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GalleryCategory -> GalleryCategory -> Bool
$c/= :: GalleryCategory -> GalleryCategory -> Bool
== :: GalleryCategory -> GalleryCategory -> Bool
$c== :: GalleryCategory -> GalleryCategory -> Bool
Eq, Eq GalleryCategory
Eq GalleryCategory
-> (GalleryCategory -> GalleryCategory -> Ordering)
-> (GalleryCategory -> GalleryCategory -> Bool)
-> (GalleryCategory -> GalleryCategory -> Bool)
-> (GalleryCategory -> GalleryCategory -> Bool)
-> (GalleryCategory -> GalleryCategory -> Bool)
-> (GalleryCategory -> GalleryCategory -> GalleryCategory)
-> (GalleryCategory -> GalleryCategory -> GalleryCategory)
-> Ord GalleryCategory
GalleryCategory -> GalleryCategory -> Bool
GalleryCategory -> GalleryCategory -> Ordering
GalleryCategory -> GalleryCategory -> GalleryCategory
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 :: GalleryCategory -> GalleryCategory -> GalleryCategory
$cmin :: GalleryCategory -> GalleryCategory -> GalleryCategory
max :: GalleryCategory -> GalleryCategory -> GalleryCategory
$cmax :: GalleryCategory -> GalleryCategory -> GalleryCategory
>= :: GalleryCategory -> GalleryCategory -> Bool
$c>= :: GalleryCategory -> GalleryCategory -> Bool
> :: GalleryCategory -> GalleryCategory -> Bool
$c> :: GalleryCategory -> GalleryCategory -> Bool
<= :: GalleryCategory -> GalleryCategory -> Bool
$c<= :: GalleryCategory -> GalleryCategory -> Bool
< :: GalleryCategory -> GalleryCategory -> Bool
$c< :: GalleryCategory -> GalleryCategory -> Bool
compare :: GalleryCategory -> GalleryCategory -> Ordering
$ccompare :: GalleryCategory -> GalleryCategory -> Ordering
$cp1Ord :: Eq GalleryCategory
Ord, Int -> GalleryCategory
GalleryCategory -> Int
GalleryCategory -> [GalleryCategory]
GalleryCategory -> GalleryCategory
GalleryCategory -> GalleryCategory -> [GalleryCategory]
GalleryCategory
-> GalleryCategory -> GalleryCategory -> [GalleryCategory]
(GalleryCategory -> GalleryCategory)
-> (GalleryCategory -> GalleryCategory)
-> (Int -> GalleryCategory)
-> (GalleryCategory -> Int)
-> (GalleryCategory -> [GalleryCategory])
-> (GalleryCategory -> GalleryCategory -> [GalleryCategory])
-> (GalleryCategory -> GalleryCategory -> [GalleryCategory])
-> (GalleryCategory
    -> GalleryCategory -> GalleryCategory -> [GalleryCategory])
-> Enum GalleryCategory
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 :: GalleryCategory
-> GalleryCategory -> GalleryCategory -> [GalleryCategory]
$cenumFromThenTo :: GalleryCategory
-> GalleryCategory -> GalleryCategory -> [GalleryCategory]
enumFromTo :: GalleryCategory -> GalleryCategory -> [GalleryCategory]
$cenumFromTo :: GalleryCategory -> GalleryCategory -> [GalleryCategory]
enumFromThen :: GalleryCategory -> GalleryCategory -> [GalleryCategory]
$cenumFromThen :: GalleryCategory -> GalleryCategory -> [GalleryCategory]
enumFrom :: GalleryCategory -> [GalleryCategory]
$cenumFrom :: GalleryCategory -> [GalleryCategory]
fromEnum :: GalleryCategory -> Int
$cfromEnum :: GalleryCategory -> Int
toEnum :: Int -> GalleryCategory
$ctoEnum :: Int -> GalleryCategory
pred :: GalleryCategory -> GalleryCategory
$cpred :: GalleryCategory -> GalleryCategory
succ :: GalleryCategory -> GalleryCategory
$csucc :: GalleryCategory -> GalleryCategory
Enum, GalleryCategory
GalleryCategory -> GalleryCategory -> Bounded GalleryCategory
forall a. a -> a -> Bounded a
maxBound :: GalleryCategory
$cmaxBound :: GalleryCategory
minBound :: GalleryCategory
$cminBound :: GalleryCategory
Bounded)

allGalleryCats :: Set GalleryCategory
allGalleryCats :: Set GalleryCategory
allGalleryCats = [GalleryCategory] -> Set GalleryCategory
forall a. Ord a => [a] -> Set a
fromList [GalleryCategory
Misc .. GalleryCategory
Private]

readCat :: Text -> Maybe GalleryCategory
readCat :: Text -> Maybe GalleryCategory
readCat Text
"Doujinshi" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
Doujinshi
readCat Text
"Manga" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
Manga
readCat Text
"Artist CG" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
ArtistCG
readCat Text
"Game CG" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
GameCG
readCat Text
"Non-H" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
NonH
readCat Text
"Image Set" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
ImageSet
readCat Text
"Western" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
Western
readCat Text
"Cosplay" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
Cosplay
readCat Text
"Misc" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
Misc
readCat Text
"Private" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
Private
readCat Text
"Asian Porn" = GalleryCategory -> Maybe GalleryCategory
forall a. a -> Maybe a
Just GalleryCategory
AsianPorn
readCat Text
_ = Maybe GalleryCategory
forall a. Maybe a
Nothing

-- | Information about a gallery
data GalleryInfo = GalleryInfo
  { GalleryInfo -> Text
title :: {-# UNPACK #-} Text,
    GalleryInfo -> Text
previewLink :: {-# UNPACK #-} Text,
    GalleryInfo -> GalleryCategory
category :: GalleryCategory,
    GalleryInfo -> Maybe Text
jaTitle :: Maybe Text,
    GalleryInfo -> Text
uploader :: {-# UNPACK #-} Text,
    GalleryInfo -> Double
rating :: {-# UNPACK #-} Double,
    GalleryInfo -> Int
ratingCount :: {-# UNPACK #-} Int,
    GalleryInfo -> Int
favoriteCount :: {-# UNPACK #-} Int,
    GalleryInfo -> [(TagCategory, [Text])]
tags :: [(TagCategory, [Text])],
    GalleryInfo -> UTCTime
uploadTime :: {-# UNPACK #-} UTCTime,
    GalleryInfo -> Maybe Gallery
newer :: Maybe Gallery,
    GalleryInfo -> Maybe Gallery
parent :: Maybe Gallery,
    GalleryInfo -> Visibility
visibility :: Visibility,
    GalleryInfo -> Text
language :: {-# UNPACK #-} Text,
    GalleryInfo -> Int
length :: {-# UNPACK #-} Int,
    GalleryInfo -> Text
archiverLink :: {-# UNPACK #-} Text,
    GalleryInfo -> Text
torrentLink :: {-# UNPACK #-} Text
  }
  deriving (Int -> GalleryInfo -> ShowS
[GalleryInfo] -> ShowS
GalleryInfo -> String
(Int -> GalleryInfo -> ShowS)
-> (GalleryInfo -> String)
-> ([GalleryInfo] -> ShowS)
-> Show GalleryInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GalleryInfo] -> ShowS
$cshowList :: [GalleryInfo] -> ShowS
show :: GalleryInfo -> String
$cshow :: GalleryInfo -> String
showsPrec :: Int -> GalleryInfo -> ShowS
$cshowsPrec :: Int -> GalleryInfo -> ShowS
Show, GalleryInfo -> GalleryInfo -> Bool
(GalleryInfo -> GalleryInfo -> Bool)
-> (GalleryInfo -> GalleryInfo -> Bool) -> Eq GalleryInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GalleryInfo -> GalleryInfo -> Bool
$c/= :: GalleryInfo -> GalleryInfo -> Bool
== :: GalleryInfo -> GalleryInfo -> Bool
$c== :: GalleryInfo -> GalleryInfo -> Bool
Eq)

data Visibility
  = Visible
  | Replaced
  | Expunged
  | Unknown {-# UNPACK #-} Text
  deriving (Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> String
$cshow :: Visibility -> String
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
Show, Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
Eq)

readVisibility :: Text -> Visibility
readVisibility :: Text -> Visibility
readVisibility Text
"Yes" = Visibility
Visible
readVisibility Text
"No (Replaced)" = Visibility
Replaced
readVisibility Text
"No (Expunged)" = Visibility
Expunged
readVisibility Text
v = Text -> Visibility
Unknown Text
v

-- | Extract all gallery informations from a document
parseGallery :: Document -> Either Text GalleryInfo
parseGallery :: Document -> Either Text GalleryInfo
parseGallery Document
d = do
  Text
title <- Text -> Maybe Text -> Either Text Text
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"title" (Maybe Text -> Either Text Text) -> Maybe Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> Maybe Text
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Optic A_Traversal NoIx Element Element Text Text
G.enTitle
  Text
previewLink <- Text -> Maybe Text -> Either Text Text
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"preview link" (Maybe Text -> Either Text Text) -> Maybe Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> Maybe Text
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Optic A_Traversal NoIx Element Element Text Text
G.previewStr Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
parsePreviewLink
  let jaTitle :: Maybe Text
jaTitle = Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> Maybe Text
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Optic A_Traversal NoIx Element Element Text Text
G.jaTitle
  GalleryCategory
category <- Text -> Maybe GalleryCategory -> Either Text GalleryCategory
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"category" (Maybe GalleryCategory -> Either Text GalleryCategory)
-> Maybe GalleryCategory -> Either Text GalleryCategory
forall a b. (a -> b) -> a -> b
$ Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> Maybe Text
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Optic A_Traversal NoIx Element Element Text Text
G.category Maybe Text
-> (Text -> Maybe GalleryCategory) -> Maybe GalleryCategory
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe GalleryCategory
readCat
  Text
uploader <- Text -> Maybe Text -> Either Text Text
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"uploader" (Maybe Text -> Either Text Text) -> Maybe Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> Maybe Text
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Optic A_Traversal NoIx Element Element Text Text
G.uploader
  Double
rating <- Text -> Maybe Double -> Either Text Double
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"average rating" (Maybe Double -> Either Text Double)
-> Maybe Double -> Either Text Double
forall a b. (a -> b) -> a -> b
$ Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> Maybe Text
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Optic A_Traversal NoIx Element Element Text Text
G.averageRating Maybe Text -> (Text -> Maybe Double) -> Maybe Double
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Double
parseAverageRating
  Int
ratingCount <- Text -> Maybe Int -> Either Text Int
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"rating count" (Maybe Int -> Either Text Int) -> Maybe Int -> Either Text Int
forall a b. (a -> b) -> a -> b
$ Document
d Document
-> Optic A_Traversal NoIx Element Element Int Int -> Maybe Int
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Optic A_Traversal NoIx Element Element Int Int
G.ratingCount
  Text
archiverLink <- Text -> Maybe Text -> Either Text Text
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"archiver link" (Maybe Text -> Either Text Text) -> Maybe Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> Maybe Text
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Optic A_Traversal NoIx Element Element Text Text
G.popupLink Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
parsePopUpLink
  Text
torrentLink <- Text -> Maybe Text -> Either Text Text
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"torrent link" (Maybe Text -> Either Text Text) -> Maybe Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ case Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> [Text]
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> [a]
^..: Optic A_Traversal NoIx Element Element Text Text
G.popupLink of (Text
_ : Text
tl : [Text]
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
tl; [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing
  let newer :: Maybe Gallery
newer = Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> Maybe Text
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Optic A_Traversal NoIx Element Element Text Text
G.newer Maybe Text -> (Text -> Maybe Gallery) -> Maybe Gallery
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Gallery
parseGalleryLink
  case Document
d Document
-> Optic A_Traversal NoIx Element Element Element Element
-> [Element]
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> [a]
^..: Optic A_Traversal NoIx Element Element Element Element
G.metaValues of
    (Element
time : Element
parn : Element
vis : Element
lang : Element
_ : Element
len : Element
fav : [Element]
_) -> do
      UTCTime
uploadTime <- Text -> Maybe UTCTime -> Either Text UTCTime
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"upload time" (Maybe UTCTime -> Either Text UTCTime)
-> Maybe UTCTime -> Either Text UTCTime
forall a b. (a -> b) -> a -> b
$ Element
time Element -> Optic' An_AffineFold NoIx Element Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic' A_Traversal (WithIx Int) Element Node
-> AffineFold Element Node
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> AffineFold s a
pre Optic' A_Traversal (WithIx Int) Element Node
lower AffineFold Element Node
-> Optic A_Prism NoIx Node Node Text Text
-> Optic' An_AffineFold NoIx Element Text
forall k m l (ks :: IxList) (is :: IxList) (js :: IxList) s t u v a
       b.
(Is k m, Is l m, m ~ Join k l, ks ~ Append is js) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Node Node Text Text
_Content Maybe Text -> (Text -> Maybe UTCTime) -> Maybe UTCTime
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe UTCTime
parseUploadTime
      let parent :: Maybe Gallery
parent = Element
parn Element -> Optic' An_AffineFold NoIx Element Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic' A_Traversal (WithIx Int) Element Node
-> AffineFold Element Node
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> AffineFold s a
pre Optic' A_Traversal (WithIx Int) Element Node
lower AffineFold Element Node
-> Optic A_Prism NoIx Node Node Element Element
-> Optic An_AffineFold NoIx Element Element Element Element
forall k m l (ks :: IxList) (is :: IxList) (js :: IxList) s t u v a
       b.
(Is k m, Is l m, m ~ Join k l, ks ~ Append is js) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Node Node Element Element
_Element Optic An_AffineFold NoIx Element Element Element Element
-> Optic An_AffineTraversal NoIx Element Element Text Text
-> Optic' An_AffineFold NoIx Element Text
forall k m l (ks :: IxList) (is :: IxList) (js :: IxList) s t u v a
       b.
(Is k m, Is l m, m ~ Join k l, ks ~ Append is js) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Name -> Optic An_AffineTraversal NoIx Element Element Text Text
attr Name
"href" Maybe Text -> (Text -> Maybe Gallery) -> Maybe Gallery
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Gallery
parseGalleryLink
      (Text -> Visibility
readVisibility -> Visibility
visibility) <- Text -> Maybe Text -> Either Text Text
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"visibility" (Maybe Text -> Either Text Text) -> Maybe Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Element
vis Element -> Optic' An_AffineFold NoIx Element Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic' A_Traversal (WithIx Int) Element Node
-> AffineFold Element Node
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> AffineFold s a
pre Optic' A_Traversal (WithIx Int) Element Node
lower AffineFold Element Node
-> Optic A_Prism NoIx Node Node Text Text
-> Optic' An_AffineFold NoIx Element Text
forall k m l (ks :: IxList) (is :: IxList) (js :: IxList) s t u v a
       b.
(Is k m, Is l m, m ~ Join k l, ks ~ Append is js) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Node Node Text Text
_Content
      (Text -> Text
strip -> Text
language) <- Text -> Maybe Text -> Either Text Text
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"language" (Maybe Text -> Either Text Text) -> Maybe Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Element
lang Element -> Optic' An_AffineFold NoIx Element Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic' A_Traversal (WithIx Int) Element Node
-> AffineFold Element Node
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> AffineFold s a
pre Optic' A_Traversal (WithIx Int) Element Node
lower AffineFold Element Node
-> Optic A_Prism NoIx Node Node Text Text
-> Optic' An_AffineFold NoIx Element Text
forall k m l (ks :: IxList) (is :: IxList) (js :: IxList) s t u v a
       b.
(Is k m, Is l m, m ~ Join k l, ks ~ Append is js) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Node Node Text Text
_Content
      Int
length <- Text -> Maybe Int -> Either Text Int
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"length" (Maybe Int -> Either Text Int) -> Maybe Int -> Either Text Int
forall a b. (a -> b) -> a -> b
$ Element
len Element -> Optic' An_AffineFold NoIx Element Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic' A_Traversal (WithIx Int) Element Node
-> AffineFold Element Node
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> AffineFold s a
pre Optic' A_Traversal (WithIx Int) Element Node
lower AffineFold Element Node
-> Optic A_Prism NoIx Node Node Text Text
-> Optic' An_AffineFold NoIx Element Text
forall k m l (ks :: IxList) (is :: IxList) (js :: IxList) s t u v a
       b.
(Is k m, Is l m, m ~ Join k l, ks ~ Append is js) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Node Node Text Text
_Content Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
parseGalleryLength
      let cats :: [TagCategory]
cats = (Text -> Maybe TagCategory) -> [Text] -> [TagCategory]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe TagCategory
readTagCat (Document
d Document
-> Optic A_Traversal NoIx Element Element Text Text -> [Text]
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> [a]
^..: Optic A_Traversal NoIx Element Element Text Text
G.tagCategory)
      let tags' :: [[Text]]
tags' = (Element -> [Text]) -> [Element] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (Element
-> Optic A_Traversal NoIx Element Element Text Text -> [Text]
forall k s (is :: IxList) a.
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Optic A_Traversal NoIx Element Element Text Text
G.tags) ([Element] -> [[Text]]) -> [Element] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ Document
d Document
-> Optic A_Traversal NoIx Element Element Element Element
-> [Element]
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
 Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> [a]
^..: Optic A_Traversal NoIx Element Element Element Element
G.tagsByCategory
      Bool -> Either Text () -> Either Text ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless ([TagCategory] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
P.length [TagCategory]
cats Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [[Text]] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
P.length [[Text]]
tags') (Either Text () -> Either Text ())
-> Either Text () -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"length of categories and tags does not match"
      let tags :: [(TagCategory, [Text])]
tags = [TagCategory] -> [[Text]] -> [(TagCategory, [Text])]
forall a b. [a] -> [b] -> [(a, b)]
zip [TagCategory]
cats [[Text]]
tags'
      Int
favoriteCount <- Text -> Maybe Int -> Either Text Int
forall ann a. ann -> Maybe a -> Either ann a
annotate Text
"favorite count" (Maybe Int -> Either Text Int) -> Maybe Int -> Either Text Int
forall a b. (a -> b) -> a -> b
$ Element
fav Element -> Optic' An_AffineFold NoIx Element Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic' A_Traversal (WithIx Int) Element Node
-> AffineFold Element Node
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> AffineFold s a
pre Optic' A_Traversal (WithIx Int) Element Node
lower AffineFold Element Node
-> Optic A_Prism NoIx Node Node Text Text
-> Optic' An_AffineFold NoIx Element Text
forall k m l (ks :: IxList) (is :: IxList) (js :: IxList) s t u v a
       b.
(Is k m, Is l m, m ~ Join k l, ks ~ Append is js) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Node Node Text Text
_Content Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
parseFavoriteCount
      GalleryInfo -> Either Text GalleryInfo
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure GalleryInfo :: Text
-> Text
-> GalleryCategory
-> Maybe Text
-> Text
-> Double
-> Int
-> Int
-> [(TagCategory, [Text])]
-> UTCTime
-> Maybe Gallery
-> Maybe Gallery
-> Visibility
-> Text
-> Int
-> Text
-> Text
-> GalleryInfo
GalleryInfo {Double
Int
[(TagCategory, [Text])]
Maybe Text
Maybe Gallery
Text
UTCTime
Visibility
GalleryCategory
favoriteCount :: Int
tags :: [(TagCategory, [Text])]
length :: Int
language :: Text
visibility :: Visibility
parent :: Maybe Gallery
uploadTime :: UTCTime
newer :: Maybe Gallery
torrentLink :: Text
archiverLink :: Text
ratingCount :: Int
rating :: Double
uploader :: Text
category :: GalleryCategory
jaTitle :: Maybe Text
previewLink :: Text
title :: Text
$sel:torrentLink:GalleryInfo :: Text
$sel:archiverLink:GalleryInfo :: Text
$sel:length:GalleryInfo :: Int
$sel:language:GalleryInfo :: Text
$sel:visibility:GalleryInfo :: Visibility
$sel:parent:GalleryInfo :: Maybe Gallery
$sel:newer:GalleryInfo :: Maybe Gallery
$sel:uploadTime:GalleryInfo :: UTCTime
$sel:tags:GalleryInfo :: [(TagCategory, [Text])]
$sel:favoriteCount:GalleryInfo :: Int
$sel:ratingCount:GalleryInfo :: Int
$sel:rating:GalleryInfo :: Double
$sel:uploader:GalleryInfo :: Text
$sel:jaTitle:GalleryInfo :: Maybe Text
$sel:category:GalleryInfo :: GalleryCategory
$sel:previewLink:GalleryInfo :: Text
$sel:title:GalleryInfo :: Text
..}
    [Element]
_ -> Text -> Either Text GalleryInfo
forall a b. a -> Either a b
Left Text
"extracting metadata"

-- | Fetch a gallery's 'GalleryInfo'
fetchGalleryInfo ::
  Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
  Gallery ->
  m GalleryInfo
fetchGalleryInfo :: Gallery -> m GalleryInfo
fetchGalleryInfo Gallery
g = do
  let url :: Text
url = Gallery -> Text
toGalleryLink Gallery
g
  Document
d <- Text -> m Document
forall (m :: Type -> Type).
Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m =>
Text -> m Document
htmlRequest' Text
url
  case Document -> Either Text GalleryInfo
parseGallery Document
d of
    Left Text
err -> ExhentaiError -> m GalleryInfo
forall e (m :: Type -> Type) a. Eff (Throw e) m => e -> m a
throw (ExhentaiError -> m GalleryInfo) -> ExhentaiError -> m GalleryInfo
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ExhentaiError
XMLParseFailure Text
err Text
url
    Right GalleryInfo
info -> GalleryInfo -> m GalleryInfo
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure GalleryInfo
info
{-# INLINEABLE fetchGalleryInfo #-}

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

type Parser = Parsec Void Text

parsePopUpLink :: Text -> Maybe Text
parsePopUpLink :: Text -> Maybe Text
parsePopUpLink = ParsecT Void Text Identity Text -> Text -> Maybe Text
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe ParsecT Void Text Identity Text
archiverLink
  where
    archiverLink :: Parser Text
    archiverLink :: ParsecT Void Text Identity Text
archiverLink = do
      Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"return popUp('"
      Text
url <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'')
      Text
_ <- ParsecT Void Text Identity Text
forall e s (m :: Type -> Type). MonadParsec e s m => m (Tokens s)
takeRest
      Text -> ParsecT Void Text Identity Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
url

parseAverageRating :: Text -> Maybe Double
parseAverageRating :: Text -> Maybe Double
parseAverageRating = Parsec Void Text Double -> Text -> Maybe Double
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text Double
averageRating
  where
    averageRating :: Parser Double
    averageRating :: Parsec Void Text Double
averageRating =
      ( do
          Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"Average: "
          Parsec Void Text Double
forall e s (m :: Type -> Type) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
float
      )
        Parsec Void Text Double
-> Parsec Void Text Double -> Parsec Void Text Double
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"Not Yet Rated" ParsecT Void Text Identity Text
-> Parsec Void Text Double -> Parsec Void Text Double
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Double -> Parsec Void Text Double
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Double
0)

parseGalleryLength :: Text -> Maybe Int
parseGalleryLength :: Text -> Maybe Int
parseGalleryLength = ParsecT Void Text Identity Int -> Text -> Maybe Int
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe ParsecT Void Text Identity Int
galleryLength
  where
    galleryLength :: Parser Int
    galleryLength :: ParsecT Void Text Identity Int
galleryLength = do
      Int
d <- ParsecT Void Text Identity Int
forall e s (m :: Type -> Type) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
" pages"
      Int -> ParsecT Void Text Identity Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
d

parseFavoriteCount :: Text -> Maybe Int
parseFavoriteCount :: Text -> Maybe Int
parseFavoriteCount = ParsecT Void Text Identity Int -> Text -> Maybe Int
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe ParsecT Void Text Identity Int
favoriteCount
  where
    once :: ParsecT Void Text Identity Int
once = do
      Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"Once"
      Int -> ParsecT Void Text Identity Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
1
    never :: ParsecT Void Text Identity Int
never = do
      Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"Never"
      Int -> ParsecT Void Text Identity Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0
    favoriteCount :: Parser Int
    favoriteCount :: ParsecT Void Text Identity Int
favoriteCount =
      ( do
          Int
d <- ParsecT Void Text Identity Int
forall e s (m :: Type -> Type) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
          Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
" times"
          Int -> ParsecT Void Text Identity Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
d
      )
        ParsecT Void Text Identity Int
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Int
once
        ParsecT Void Text Identity Int
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Int
never

parsePreviewLink :: Text -> Maybe Text
parsePreviewLink :: Text -> Maybe Text
parsePreviewLink = ParsecT Void Text Identity Text -> Text -> Maybe Text
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe ParsecT Void Text Identity Text
previewLink
  where
    previewLink :: Parser Text
    previewLink :: ParsecT Void Text Identity Text
previewLink = do
      String
_ <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ do
        ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void Text Identity Text
urlOpening
        ParsecT Void Text Identity Char
forall e s (m :: Type -> Type). MonadParsec e s m => m (Token s)
anySingle
      Text
_ <- ParsecT Void Text Identity Text
urlOpening
      Text
url <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')')
      Text
_ <- ParsecT Void Text Identity Text
forall e s (m :: Type -> Type). MonadParsec e s m => m (Tokens s)
takeRest
      Text -> ParsecT Void Text Identity Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
url
    urlOpening :: Parser Text
    urlOpening :: ParsecT Void Text Identity Text
urlOpening = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"url("

makeFieldLabelsWith noPrefixFieldLabels ''GalleryInfo
makePrismLabels ''TagCategory
makePrismLabels ''GalleryCategory
makePrismLabels ''Visibility