{-# LANGUAGE StrictData #-}

module Web.Exhentai.API.Gallery
  ( GalleryInfo (..),
    Visibility (..),
    fetchGalleryInfo,
    parseGallery,
  )
where

import Control.Lens ((^..), (^?))
import Control.Monad
import Control.Monad.Catch
import Data.Coerce
import Data.Text (Text, strip)
import Data.Time
import GHC.Generics
import Text.XML
import Text.XML.Lens
import Web.Exhentai.Errors
import qualified Web.Exhentai.Parsing.Gallery as G
import Web.Exhentai.Types
import Web.Exhentai.Types.CookieT
import Web.Exhentai.Utils
import Prelude hiding (length)
import qualified Prelude as P

-- | Information about a gallery
data GalleryInfo = GalleryInfo
  { GalleryInfo -> Text
title :: {-# UNPACK #-} Text,
    GalleryInfo -> Text
previewLink :: {-# UNPACK #-} Text,
    GalleryInfo -> GalleryCat
category :: GalleryCat,
    GalleryInfo -> Text
jaTitle :: {-# UNPACK #-} Text,
    GalleryInfo -> Text
uploader :: {-# UNPACK #-} Text,
    GalleryInfo -> Float
rating :: {-# UNPACK #-} Float,
    GalleryInfo -> Int
ratingCount :: {-# UNPACK #-} Int,
    GalleryInfo -> Int
favoriteCount :: {-# UNPACK #-} Int,
    GalleryInfo -> [(TagCategory, [Text])]
tags :: [(G.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
  }
  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, (forall x. GalleryInfo -> Rep GalleryInfo x)
-> (forall x. Rep GalleryInfo x -> GalleryInfo)
-> Generic GalleryInfo
forall x. Rep GalleryInfo x -> GalleryInfo
forall x. GalleryInfo -> Rep GalleryInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GalleryInfo x -> GalleryInfo
$cfrom :: forall x. GalleryInfo -> Rep GalleryInfo x
Generic)

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, (forall x. Visibility -> Rep Visibility x)
-> (forall x. Rep Visibility x -> Visibility) -> Generic Visibility
forall x. Rep Visibility x -> Visibility
forall x. Visibility -> Rep Visibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Visibility x -> Visibility
$cfrom :: forall x. Visibility -> Rep Visibility x
Generic)

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 -> Maybe GalleryInfo
parseGallery :: Document -> Maybe GalleryInfo
parseGallery Document
d = do
  Text
title <- Document
d Document -> Fold Element Text -> Maybe Text
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element Text
Fold Element Text
G.enTitle
  Text
previewLink <- Document
d Document -> Fold Element Text -> Maybe Text
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element Text
Fold Element 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
  Text
jaTitle <- Document
d Document -> Fold Element Text -> Maybe Text
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element Text
Fold Element Text
G.jaTitle
  GalleryCat
category <- Document
d Document -> Fold Element GalleryCat -> Maybe GalleryCat
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element GalleryCat
Fold Element GalleryCat
G.category
  Text
uploader <- Document
d Document -> Fold Element Text -> Maybe Text
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element Text
Fold Element Text
G.uploader
  (AverageRating -> Float
coerce -> Float
rating) <- Document
d Document -> Fold Element AverageRating -> Maybe AverageRating
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element AverageRating
Fold Element AverageRating
G.averageRating
  Int
ratingCount <- Document
d Document -> Fold Element Int -> Maybe Int
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element Int
Fold Element Int
G.ratingCount
  (PopUpLink -> Text
coerce -> Text
archiverLink) <- Document
d Document -> Fold Element PopUpLink -> Maybe PopUpLink
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element PopUpLink
Fold Element PopUpLink
G.archiverLink
  let newer :: Maybe Gallery
newer = Document
d Document -> Fold Element Gallery -> Maybe Gallery
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element Gallery
Fold Element Gallery
G.newer
  case Document
d Document -> Fold Element Element -> [Element]
forall a. Document -> Fold Element a -> [a]
^..: Traversal' Element Element
Fold Element Element
G.metaValues of
    (Element
time : Element
parn : Element
vis : Element
lang : Element
_ : Element
len : Element
fav : [Element]
_) -> do
      UTCTime
uploadTime <- Element
time Element -> Getting (First Text) Element Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Node -> Const (First Text) Node)
-> Element -> Const (First Text) Element
Traversal' Element Node
lower ((Node -> Const (First Text) Node)
 -> Element -> Const (First Text) Element)
-> ((Text -> Const (First Text) Text)
    -> Node -> Const (First Text) Node)
-> Getting (First Text) Element Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Node -> Const (First Text) Node
Prism' Node 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 -> Getting (First Gallery) Element Gallery -> Maybe Gallery
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Node -> Const (First Gallery) Node)
-> Element -> Const (First Gallery) Element
Traversal' Element Node
lower ((Node -> Const (First Gallery) Node)
 -> Element -> Const (First Gallery) Element)
-> ((Gallery -> Const (First Gallery) Gallery)
    -> Node -> Const (First Gallery) Node)
-> Getting (First Gallery) Element Gallery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Const (First Gallery) Element)
-> Node -> Const (First Gallery) Node
Prism' Node Element
_Element ((Element -> Const (First Gallery) Element)
 -> Node -> Const (First Gallery) Node)
-> Getting (First Gallery) Element Gallery
-> (Gallery -> Const (First Gallery) Gallery)
-> Node
-> Const (First Gallery) Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Traversal' Element Text
attr Name
"href" ((Text -> Const (First Gallery) Text)
 -> Element -> Const (First Gallery) Element)
-> ((Gallery -> Const (First Gallery) Gallery)
    -> Text -> Const (First Gallery) Text)
-> Getting (First Gallery) Element Gallery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gallery -> Const (First Gallery) Gallery)
-> Text -> Const (First Gallery) Text
Prism' Text Gallery
_GalleryLink
      (Text -> Visibility
readVisibility -> Visibility
visibility) <- Element
vis Element -> Getting (First Text) Element Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Node -> Const (First Text) Node)
-> Element -> Const (First Text) Element
Traversal' Element Node
lower ((Node -> Const (First Text) Node)
 -> Element -> Const (First Text) Element)
-> ((Text -> Const (First Text) Text)
    -> Node -> Const (First Text) Node)
-> Getting (First Text) Element Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Node -> Const (First Text) Node
Prism' Node Text
_Content
      (Text -> Text
strip -> Text
language) <- Element
lang Element -> Getting (First Text) Element Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Node -> Const (First Text) Node)
-> Element -> Const (First Text) Element
Traversal' Element Node
lower ((Node -> Const (First Text) Node)
 -> Element -> Const (First Text) Element)
-> ((Text -> Const (First Text) Text)
    -> Node -> Const (First Text) Node)
-> Getting (First Text) Element Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Node -> Const (First Text) Node
Prism' Node Text
_Content
      (GalleryLength -> Int
coerce -> Int
length) <- Element
len Element -> Getting (First Text) Element Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Node -> Const (First Text) Node)
-> Element -> Const (First Text) Element
Traversal' Element Node
lower ((Node -> Const (First Text) Node)
 -> Element -> Const (First Text) Element)
-> ((Text -> Const (First Text) Text)
    -> Node -> Const (First Text) Node)
-> Getting (First Text) Element Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Node -> Const (First Text) Node
Prism' Node Text
_Content Maybe Text -> (Text -> Maybe GalleryLength) -> Maybe GalleryLength
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe GalleryLength
parseGalleryLength
      let cats :: [TagCategory]
cats = Document
d Document -> Fold Element TagCategory -> [TagCategory]
forall a. Document -> Fold Element a -> [a]
^..: Traversal' Element TagCategory
Fold Element TagCategory
G.tagCategory
      let tags' :: [[Text]]
tags' = (Element -> [Text]) -> [Element] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Getting (Endo [Text]) Element Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Text]) Element Text
Traversal' Element Text
G.tags) ([Element] -> [[Text]]) -> [Element] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ Document
d Document -> Fold Element Element -> [Element]
forall a. Document -> Fold Element a -> [a]
^..: Traversal' Element Element
Fold Element Element
G.tagsByCategory
      Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [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'
      let tags :: [(TagCategory, [Text])]
tags = [TagCategory] -> [[Text]] -> [(TagCategory, [Text])]
forall a b. [a] -> [b] -> [(a, b)]
zip [TagCategory]
cats [[Text]]
tags'
      (FavoriteCount -> Int
coerce -> Int
favoriteCount) <- Element
fav Element -> Getting (First Text) Element Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Node -> Const (First Text) Node)
-> Element -> Const (First Text) Element
Traversal' Element Node
lower ((Node -> Const (First Text) Node)
 -> Element -> Const (First Text) Element)
-> ((Text -> Const (First Text) Text)
    -> Node -> Const (First Text) Node)
-> Getting (First Text) Element Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Node -> Const (First Text) Node
Prism' Node Text
_Content Maybe Text -> (Text -> Maybe FavoriteCount) -> Maybe FavoriteCount
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe FavoriteCount
parseFavoriteCount
      GalleryInfo -> Maybe GalleryInfo
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure GalleryInfo :: Text
-> Text
-> GalleryCat
-> Text
-> Text
-> Float
-> Int
-> Int
-> [(TagCategory, [Text])]
-> UTCTime
-> Maybe Gallery
-> Maybe Gallery
-> Visibility
-> Text
-> Int
-> Text
-> GalleryInfo
GalleryInfo {Float
Int
[(TagCategory, [Text])]
Maybe Gallery
Text
UTCTime
GalleryCat
Visibility
favoriteCount :: Int
tags :: [(TagCategory, [Text])]
length :: Int
language :: Text
visibility :: Visibility
parent :: Maybe Gallery
uploadTime :: UTCTime
newer :: Maybe Gallery
archiverLink :: Text
ratingCount :: Int
rating :: Float
uploader :: Text
category :: GalleryCat
jaTitle :: Text
previewLink :: Text
title :: 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 :: Float
$sel:uploader:GalleryInfo :: Text
$sel:jaTitle:GalleryInfo :: Text
$sel:category:GalleryInfo :: GalleryCat
$sel:previewLink:GalleryInfo :: Text
$sel:title:GalleryInfo :: Text
..}
    [Element]
_ -> Maybe GalleryInfo
forall a. Maybe a
Nothing

-- | Fetch a gallery's 'GalleryInfo'
fetchGalleryInfo :: MonadHttpState 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). MonadHttpState m => Text -> m Document
htmlRequest' Text
url
  case Document -> Maybe GalleryInfo
parseGallery Document
d of
    Maybe GalleryInfo
Nothing -> ExhentaiError -> m GalleryInfo
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (ExhentaiError -> m GalleryInfo) -> ExhentaiError -> m GalleryInfo
forall a b. (a -> b) -> a -> b
$ Text -> ExhentaiError
XMLParseFailure Text
url
    Just GalleryInfo
info -> GalleryInfo -> m GalleryInfo
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure GalleryInfo
info