{-# LANGUAGE StrictData #-}

module Web.Exhentai.API.Search
  ( SearchQuery (..),
    SearchResult (..),
    search,
    searchRecur,
    fetchSearchPage,
    fetchSearchPage',
  )
where

import Conduit
import Control.Lens ((...))
import Control.Lens.Fold
import Control.Monad
import Data.Set (Set, (\\))
import Data.String
import Data.Text (Text, unpack)
import Data.Text.Encoding (encodeUtf8)
import GHC.Generics
import Network.HTTP.Client.Conduit
import Text.XML
import Web.Exhentai.Parsing.Search
import Web.Exhentai.Types
import Web.Exhentai.Types.CookieT
import Web.Exhentai.Utils
import Prelude hiding (last)

data SearchQuery = SearchQuery
  { SearchQuery -> Maybe (Set GalleryCat)
categories :: Maybe (Set GalleryCat),
    SearchQuery -> Text
searchString :: {-# UNPACK #-} Text
  }
  deriving (Int -> SearchQuery -> ShowS
[SearchQuery] -> ShowS
SearchQuery -> String
(Int -> SearchQuery -> ShowS)
-> (SearchQuery -> String)
-> ([SearchQuery] -> ShowS)
-> Show SearchQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchQuery] -> ShowS
$cshowList :: [SearchQuery] -> ShowS
show :: SearchQuery -> String
$cshow :: SearchQuery -> String
showsPrec :: Int -> SearchQuery -> ShowS
$cshowsPrec :: Int -> SearchQuery -> ShowS
Show, SearchQuery -> SearchQuery -> Bool
(SearchQuery -> SearchQuery -> Bool)
-> (SearchQuery -> SearchQuery -> Bool) -> Eq SearchQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchQuery -> SearchQuery -> Bool
$c/= :: SearchQuery -> SearchQuery -> Bool
== :: SearchQuery -> SearchQuery -> Bool
$c== :: SearchQuery -> SearchQuery -> Bool
Eq, (forall x. SearchQuery -> Rep SearchQuery x)
-> (forall x. Rep SearchQuery x -> SearchQuery)
-> Generic SearchQuery
forall x. Rep SearchQuery x -> SearchQuery
forall x. SearchQuery -> Rep SearchQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchQuery x -> SearchQuery
$cfrom :: forall x. SearchQuery -> Rep SearchQuery x
Generic)

queryArgCat :: Set GalleryCat -> Int
queryArgCat :: Set GalleryCat -> Int
queryArgCat Set GalleryCat
s = Set GalleryCat -> Int
toBitField (Set GalleryCat -> Int) -> Set GalleryCat -> Int
forall a b. (a -> b) -> a -> b
$ Set GalleryCat
allGalleryCats Set GalleryCat -> Set GalleryCat -> Set GalleryCat
forall a. Ord a => Set a -> Set a -> Set a
\\ Set GalleryCat
s

data SearchResult = SearchResult
  { SearchResult -> [Gallery]
galleries :: [Gallery],
    SearchResult -> Maybe Text
prevPage :: Maybe Text,
    SearchResult -> Maybe Text
nextPage :: Maybe Text
  }
  deriving (Int -> SearchResult -> ShowS
[SearchResult] -> ShowS
SearchResult -> String
(Int -> SearchResult -> ShowS)
-> (SearchResult -> String)
-> ([SearchResult] -> ShowS)
-> Show SearchResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchResult] -> ShowS
$cshowList :: [SearchResult] -> ShowS
show :: SearchResult -> String
$cshow :: SearchResult -> String
showsPrec :: Int -> SearchResult -> ShowS
$cshowsPrec :: Int -> SearchResult -> ShowS
Show, SearchResult -> SearchResult -> Bool
(SearchResult -> SearchResult -> Bool)
-> (SearchResult -> SearchResult -> Bool) -> Eq SearchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchResult -> SearchResult -> Bool
$c/= :: SearchResult -> SearchResult -> Bool
== :: SearchResult -> SearchResult -> Bool
$c== :: SearchResult -> SearchResult -> Bool
Eq, (forall x. SearchResult -> Rep SearchResult x)
-> (forall x. Rep SearchResult x -> SearchResult)
-> Generic SearchResult
forall x. Rep SearchResult x -> SearchResult
forall x. SearchResult -> Rep SearchResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchResult x -> SearchResult
$cfrom :: forall x. SearchResult -> Rep SearchResult x
Generic)

parseSearchPage :: Document -> SearchResult
parseSearchPage :: Document -> SearchResult
parseSearchPage Document
d =
  let galleries :: [Gallery]
galleries = 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
      fld :: Fold Document Element
      fld :: (Element -> f Element) -> Document -> f Document
fld = (Element -> f Element) -> Document -> f Document
Traversal' Document Element
body ((Element -> f Element) -> Document -> f Document)
-> Over (->) f Element Element Element Element
-> (Element -> f Element)
-> Document
-> f Document
forall k (f :: Type -> Type) c s t (p :: k -> Type -> Type)
       (a :: k) b.
(Applicative f, Plated c) =>
LensLike f s t c c -> Over p f c c a b -> Over p f s t a b
... Over (->) f Element Element Element Element
Traversal' Element Element
pagesElem
      prevPage :: Maybe Text
prevPage = do
        Element
first <- Getting (Leftmost Element) Document Element
-> Document -> Maybe Element
forall a s. Getting (Leftmost a) s a -> s -> Maybe a
firstOf Getting (Leftmost Element) Document Element
Fold Document Element
fld Document
d
        Element
first Element -> Getting (First Text) Element Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Text) Element Text
Traversal' Element Text
linkOf
      nextPage :: Maybe Text
nextPage = do
        Element
last <- Getting (Rightmost Element) Document Element
-> Document -> Maybe Element
forall a s. Getting (Rightmost a) s a -> s -> Maybe a
lastOf Getting (Rightmost Element) Document Element
Fold Document Element
fld Document
d
        Element
last Element -> Getting (First Text) Element Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Text) Element Text
Traversal' Element Text
linkOf
   in SearchResult :: [Gallery] -> Maybe Text -> Maybe Text -> SearchResult
SearchResult {[Gallery]
Maybe Text
nextPage :: Maybe Text
prevPage :: Maybe Text
galleries :: [Gallery]
$sel:nextPage:SearchResult :: Maybe Text
$sel:prevPage:SearchResult :: Maybe Text
$sel:galleries:SearchResult :: [Gallery]
..}

-- | Fetch a search page using a 'Request'
fetchSearchPage' :: MonadHttpState m => Request -> m SearchResult
fetchSearchPage' :: Request -> m SearchResult
fetchSearchPage' Request
req = do
  Document
d <- Request -> m Document
forall (m :: Type -> Type).
MonadHttpState m =>
Request -> m Document
htmlRequest Request
req
  SearchResult -> m SearchResult
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (SearchResult -> m SearchResult) -> SearchResult -> m SearchResult
forall a b. (a -> b) -> a -> b
$ Document -> SearchResult
parseSearchPage Document
d

-- | Fetch a search page using its url
fetchSearchPage :: MonadHttpState m => Text -> m SearchResult
fetchSearchPage :: Text -> m SearchResult
fetchSearchPage = Request -> m SearchResult
forall (m :: Type -> Type).
MonadHttpState m =>
Request -> m SearchResult
fetchSearchPage' (Request -> m SearchResult)
-> (Text -> m Request) -> Text -> m SearchResult
forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> m Request
forall (m :: Type -> Type). MonadHttp m => String -> m Request
formRequest (String -> m Request) -> (Text -> String) -> Text -> m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

-- | Search a search query
search :: MonadHttpState m => SearchQuery -> m SearchResult
search :: SearchQuery -> m SearchResult
search SearchQuery {Maybe (Set GalleryCat)
Text
searchString :: Text
categories :: Maybe (Set GalleryCat)
$sel:searchString:SearchQuery :: SearchQuery -> Text
$sel:categories:SearchQuery :: SearchQuery -> Maybe (Set GalleryCat)
..} = do
  let catQ :: [(ByteString, Maybe ByteString)]
catQ = [(ByteString, Maybe ByteString)]
-> (Set GalleryCat -> [(ByteString, Maybe ByteString)])
-> Maybe (Set GalleryCat)
-> [(ByteString, Maybe ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Set GalleryCat
c -> [(ByteString
"f_cats", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Set GalleryCat -> Int
queryArgCat Set GalleryCat
c)]) Maybe (Set GalleryCat)
categories
  Request
initReq <- String -> m Request
forall (m :: Type -> Type). MonadHttp m => String -> m Request
formRequest String
"https://exhentai.org"
  let req :: Request
req =
        [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString
          ( [(ByteString, Maybe ByteString)]
catQ
              [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. [a] -> [a] -> [a]
++ [ (ByteString
"f_search", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
searchString)
                 ]
          )
          Request
initReq
  Request -> m SearchResult
forall (m :: Type -> Type).
MonadHttpState m =>
Request -> m SearchResult
fetchSearchPage' Request
req

-- | Iterate through all the Galleries asosciated with a search query, putting them in a stream
searchRecur :: forall m i. MonadHttpState m => SearchQuery -> ConduitT i Gallery m ()
searchRecur :: SearchQuery -> ConduitT i Gallery m ()
searchRecur SearchQuery
q = do
  SearchResult {[Gallery]
Maybe Text
nextPage :: Maybe Text
prevPage :: Maybe Text
galleries :: [Gallery]
$sel:nextPage:SearchResult :: SearchResult -> Maybe Text
$sel:prevPage:SearchResult :: SearchResult -> Maybe Text
$sel:galleries:SearchResult :: SearchResult -> [Gallery]
..} <- m SearchResult -> ConduitT i Gallery m SearchResult
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m SearchResult -> ConduitT i Gallery m SearchResult)
-> m SearchResult -> ConduitT i Gallery m SearchResult
forall a b. (a -> b) -> a -> b
$ SearchQuery -> m SearchResult
forall (m :: Type -> Type).
MonadHttpState m =>
SearchQuery -> m SearchResult
search SearchQuery
q
  [Gallery] -> ConduitT i (Element [Gallery]) m ()
forall (m :: Type -> Type) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany [Gallery]
galleries
  case Maybe Text
nextPage of
    Maybe Text
Nothing -> () -> ConduitT i Gallery m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
    Just Text
url -> Text -> ConduitT i Gallery m ()
searchRecur' Text
url
  where
    searchRecur' :: Text -> ConduitT i Gallery m ()
    searchRecur' :: Text -> ConduitT i Gallery m ()
searchRecur' Text
url = do
      SearchResult {[Gallery]
Maybe Text
nextPage :: Maybe Text
prevPage :: Maybe Text
galleries :: [Gallery]
$sel:nextPage:SearchResult :: SearchResult -> Maybe Text
$sel:prevPage:SearchResult :: SearchResult -> Maybe Text
$sel:galleries:SearchResult :: SearchResult -> [Gallery]
..} <- m SearchResult -> ConduitT i Gallery m SearchResult
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m SearchResult -> ConduitT i Gallery m SearchResult)
-> m SearchResult -> ConduitT i Gallery m SearchResult
forall a b. (a -> b) -> a -> b
$ Text -> m SearchResult
forall (m :: Type -> Type).
MonadHttpState m =>
Text -> m SearchResult
fetchSearchPage Text
url
      [Gallery] -> ConduitT i (Element [Gallery]) m ()
forall (m :: Type -> Type) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany [Gallery]
galleries
      case Maybe Text
nextPage of
        Maybe Text
Nothing -> () -> ConduitT i Gallery m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
        Just Text
url' -> Text -> ConduitT i Gallery m ()
searchRecur' Text
url'