module Web.Exhentai.API.Watched
  ( fetchWatched,
    fetchPopular,
  )
where

import Web.Exhentai.Parsing.Search
import Web.Exhentai.Types
import Web.Exhentai.Types.CookieT
import Web.Exhentai.Utils

-- | Fetch the list of watched galleries
fetchWatched :: MonadHttpState m => m [Gallery]
fetchWatched :: m [Gallery]
fetchWatched = do
  Document
d <- Text -> m Document
forall (m :: Type -> Type). MonadHttpState m => Text -> m Document
htmlRequest' Text
"https://exhentai.org/watched"
  [Gallery] -> m [Gallery]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Gallery] -> m [Gallery]) -> [Gallery] -> m [Gallery]
forall a b. (a -> b) -> a -> b
$ Document
d Document -> Fold Element Gallery -> [Gallery]
forall a. Document -> Fold Element a -> [a]
^..: (Element -> f Element) -> Element -> f Element
Traversal' Element Element
galleryPreviewElement ((Element -> f Element) -> Element -> f Element)
-> ((Gallery -> f Gallery) -> Element -> f Element)
-> (Gallery -> f Gallery)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gallery -> f Gallery) -> Element -> f Element
Traversal' Element Gallery
galleryLink

-- | Fetch the list of popular galleries
fetchPopular :: MonadHttpState m => m [Gallery]
fetchPopular :: m [Gallery]
fetchPopular = do
  Document
d <- Text -> m Document
forall (m :: Type -> Type). MonadHttpState m => Text -> m Document
htmlRequest' Text
"https://exhentai.org/popular"
  [Gallery] -> m [Gallery]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Gallery] -> m [Gallery]) -> [Gallery] -> m [Gallery]
forall a b. (a -> b) -> a -> b
$ Document
d Document -> Fold Element Gallery -> [Gallery]
forall a. Document -> Fold Element a -> [a]
^..: (Element -> f Element) -> Element -> f Element
Traversal' Element Element
galleryPreviewElement ((Element -> f Element) -> Element -> f Element)
-> ((Gallery -> f Gallery) -> Element -> f Element)
-> (Gallery -> f Gallery)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gallery -> f Gallery) -> Element -> f Element
Traversal' Element Gallery
galleryLink