{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | MPV (multi-page viewer) API.
module Web.Exhentai.API.MPV
  ( DispatchRequest (..),
    Server (..),
    Dim (..),
    buildRequest,
    fetchImage,
  )
where

import Conduit
import Control.Applicative
import Control.Effect
import Control.Effect.Bracket
import Control.Effect.Error
import Control.Effect.Exh
import Control.Monad
import Control.Monad.Trans.Cont
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Text (Text, pack, unpack)
import Language.JavaScript.Extraction
import Language.JavaScript.Parser
import Network.HTTP.Client hiding (Cookie)
import Optics.Core
import Optics.TH
import Text.XML
import Text.XML.Optics
import Web.Exhentai.API.Gallery
import Web.Exhentai.Errors
import Web.Exhentai.Utils
import Prelude hiding ((!!))

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

instance FromJSON Server where
  parseJSON :: Value -> Parser Server
parseJSON Value
v =
    Int -> Server
HAtH (Int -> Server) -> Parser Int -> Parser Server
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Server -> Parser Server -> Parser Server
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Text -> Server
Other (Text -> Server) -> Parser Text -> Parser Server
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON Server where
  toJSON :: Server -> Value
toJSON (HAtH Int
i) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
i
  toJSON (Other Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t

newtype Dim = Dim Int
  deriving newtype (Int -> Dim -> ShowS
[Dim] -> ShowS
Dim -> String
(Int -> Dim -> ShowS)
-> (Dim -> String) -> ([Dim] -> ShowS) -> Show Dim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dim] -> ShowS
$cshowList :: [Dim] -> ShowS
show :: Dim -> String
$cshow :: Dim -> String
showsPrec :: Int -> Dim -> ShowS
$cshowsPrec :: Int -> Dim -> ShowS
Show, Dim -> Dim -> Bool
(Dim -> Dim -> Bool) -> (Dim -> Dim -> Bool) -> Eq Dim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dim -> Dim -> Bool
$c/= :: Dim -> Dim -> Bool
== :: Dim -> Dim -> Bool
$c== :: Dim -> Dim -> Bool
Eq)

instance FromJSON Dim where
  parseJSON :: Value -> Parser Dim
parseJSON Value
v = Int -> Dim
Dim (Int -> Dim) -> Parser Int -> Parser Dim
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
str Parser Dim -> Parser Dim -> Parser Dim
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Int -> Dim
Dim (Int -> Dim) -> Parser Int -> Parser Dim
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
int
    where
      str :: Parser Int
str = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser String -> Parser Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      int :: Parser Int
int = Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

data DispatchResult = DispatchResult
  { -- | A piece of text describing the dimensions and the size of this image
    DispatchResult -> Text
dimension :: {-# UNPACK #-} Text,
    -- | The path part of the url pointing to the original image
    DispatchResult -> Text
origImgPath :: {-# UNPACK #-} Text,
    -- | The path part of the url that searches for the gallery containing this image
    DispatchResult -> Text
searchPath :: {-# UNPACK #-} Text,
    -- | The path part of the non-mpv page that displays this image
    DispatchResult -> Text
galleryPath :: {-# UNPACK #-} Text,
    DispatchResult -> Dim
width :: {-# UNPACK #-} Dim,
    DispatchResult -> Dim
height :: {-# UNPACK #-} Dim,
    -- | The full url to this image
    DispatchResult -> Text
imgLink :: {-# UNPACK #-} Text,
    -- | The server that serves this image
    DispatchResult -> Server
server :: Server
  }
  deriving (Int -> DispatchResult -> ShowS
[DispatchResult] -> ShowS
DispatchResult -> String
(Int -> DispatchResult -> ShowS)
-> (DispatchResult -> String)
-> ([DispatchResult] -> ShowS)
-> Show DispatchResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DispatchResult] -> ShowS
$cshowList :: [DispatchResult] -> ShowS
show :: DispatchResult -> String
$cshow :: DispatchResult -> String
showsPrec :: Int -> DispatchResult -> ShowS
$cshowsPrec :: Int -> DispatchResult -> ShowS
Show, DispatchResult -> DispatchResult -> Bool
(DispatchResult -> DispatchResult -> Bool)
-> (DispatchResult -> DispatchResult -> Bool) -> Eq DispatchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DispatchResult -> DispatchResult -> Bool
$c/= :: DispatchResult -> DispatchResult -> Bool
== :: DispatchResult -> DispatchResult -> Bool
$c== :: DispatchResult -> DispatchResult -> Bool
Eq)

instance FromJSON DispatchResult where
  parseJSON :: Value -> Parser DispatchResult
parseJSON = String
-> (Object -> Parser DispatchResult)
-> Value
-> Parser DispatchResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"imagedispatch result" ((Object -> Parser DispatchResult)
 -> Value -> Parser DispatchResult)
-> (Object -> Parser DispatchResult)
-> Value
-> Parser DispatchResult
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text
-> Text
-> Text
-> Dim
-> Dim
-> Text
-> Server
-> DispatchResult
DispatchResult
      (Text
 -> Text
 -> Text
 -> Text
 -> Dim
 -> Dim
 -> Text
 -> Server
 -> DispatchResult)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
      Parser
  (Text
   -> Text -> Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
-> Parser Text
-> Parser
     (Text -> Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"lf"
      Parser
  (Text -> Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
-> Parser Text
-> Parser (Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ls"
      Parser (Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
-> Parser Text
-> Parser (Dim -> Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"lo"
      Parser (Dim -> Dim -> Text -> Server -> DispatchResult)
-> Parser Dim -> Parser (Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Dim
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"xres"
      Parser (Dim -> Text -> Server -> DispatchResult)
-> Parser Dim -> Parser (Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Dim
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"yres"
      Parser (Text -> Server -> DispatchResult)
-> Parser Text -> Parser (Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"i"
      Parser (Server -> DispatchResult)
-> Parser Server -> Parser DispatchResult
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Server
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"s"

data DispatchRequest = DispatchRequest
  { DispatchRequest -> Int
galleryId :: {-# UNPACK #-} Int,
    DispatchRequest -> Int
page :: {-# UNPACK #-} Int,
    DispatchRequest -> Text
imgKey :: {-# UNPACK #-} Text,
    DispatchRequest -> Text
mpvKey :: {-# UNPACK #-} Text,
    DispatchRequest -> Maybe Server
exclude :: Maybe Server
  }
  deriving (Int -> DispatchRequest -> ShowS
[DispatchRequest] -> ShowS
DispatchRequest -> String
(Int -> DispatchRequest -> ShowS)
-> (DispatchRequest -> String)
-> ([DispatchRequest] -> ShowS)
-> Show DispatchRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DispatchRequest] -> ShowS
$cshowList :: [DispatchRequest] -> ShowS
show :: DispatchRequest -> String
$cshow :: DispatchRequest -> String
showsPrec :: Int -> DispatchRequest -> ShowS
$cshowsPrec :: Int -> DispatchRequest -> ShowS
Show, DispatchRequest -> DispatchRequest -> Bool
(DispatchRequest -> DispatchRequest -> Bool)
-> (DispatchRequest -> DispatchRequest -> Bool)
-> Eq DispatchRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DispatchRequest -> DispatchRequest -> Bool
$c/= :: DispatchRequest -> DispatchRequest -> Bool
== :: DispatchRequest -> DispatchRequest -> Bool
$c== :: DispatchRequest -> DispatchRequest -> Bool
Eq)

instance ToJSON DispatchRequest where
  toJSON :: DispatchRequest -> Value
toJSON DispatchRequest {Int
Maybe Server
Text
exclude :: Maybe Server
mpvKey :: Text
imgKey :: Text
page :: Int
galleryId :: Int
$sel:exclude:DispatchRequest :: DispatchRequest -> Maybe Server
$sel:mpvKey:DispatchRequest :: DispatchRequest -> Text
$sel:imgKey:DispatchRequest :: DispatchRequest -> Text
$sel:page:DispatchRequest :: DispatchRequest -> Int
$sel:galleryId:DispatchRequest :: DispatchRequest -> Int
..} = [Pair] -> Value
object [Pair]
l
    where
      exc :: [Pair]
exc = [Pair] -> (Server -> [Pair]) -> Maybe Server -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Server
s -> [Text
"nl" Text -> Server -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Server
s]) Maybe Server
exclude
      l :: [Pair]
l =
        [Pair]
exc
          [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [ Text
"method" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"imagedispatch" :: Text),
               Text
"gid" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
galleryId,
               Text
"page" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
page,
               Text
"imgkey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
imgKey,
               Text
"mpvkey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
mpvKey
             ]

-- | Generate a list of requests from a 'Vars'
toRequests :: Vars -> [DispatchRequest]
toRequests :: Vars -> [DispatchRequest]
toRequests Vars {Int
[MpvImage]
Text
$sel:imageList:Vars :: Vars -> [MpvImage]
$sel:pageCount:Vars :: Vars -> Int
$sel:mpvkey:Vars :: Vars -> Text
$sel:gid:Vars :: Vars -> Int
imageList :: [MpvImage]
pageCount :: Int
mpvkey :: Text
gid :: Int
..} = (Int -> MpvImage -> DispatchRequest)
-> [Int] -> [MpvImage] -> [DispatchRequest]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> MpvImage -> DispatchRequest
formReq [Int
1 ..] [MpvImage]
imageList
  where
    formReq :: Int -> MpvImage -> DispatchRequest
formReq Int
i MpvImage {Text
$sel:thumbnail:MpvImage :: MpvImage -> Text
$sel:key:MpvImage :: MpvImage -> Text
$sel:name:MpvImage :: MpvImage -> Text
thumbnail :: Text
key :: Text
name :: Text
..} =
      DispatchRequest :: Int -> Int -> Text -> Text -> Maybe Server -> DispatchRequest
DispatchRequest
        { $sel:galleryId:DispatchRequest :: Int
galleryId = Int
gid,
          $sel:page:DispatchRequest :: Int
page = Int
i,
          $sel:imgKey:DispatchRequest :: Text
imgKey = Text
key,
          $sel:exclude:DispatchRequest :: Maybe Server
exclude = Maybe Server
forall a. Maybe a
Nothing,
          $sel:mpvKey:DispatchRequest :: Text
mpvKey = Text
mpvkey
        }

toMpvLink :: Gallery -> Text
toMpvLink :: Gallery -> Text
toMpvLink Gallery {Int
Text
$sel:token:Gallery :: Gallery -> Text
$sel:galleryId:Gallery :: Gallery -> Int
token :: Text
galleryId :: Int
..} = Text
"https://exhentai.org/mpv/" 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
"/"

-- | Fetch the 'Vars' from a Gallery's mpv page
fetchMpv ::
  Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
  Gallery ->
  m Vars
fetchMpv :: Gallery -> m Vars
fetchMpv Gallery
g = Text -> m Document
forall (m :: Type -> Type).
Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m =>
Text -> m Document
htmlRequest' (Gallery -> Text
toMpvLink Gallery
g) m Document -> (Document -> m Vars) -> m Vars
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Document -> m Vars
forall (m :: Type -> Type).
Effs '[Throw ExhentaiError] m =>
Document -> m Vars
parseMpv
{-# INLINEABLE fetchMpv #-}

parseMpv :: Effs '[Throw ExhentaiError] m => Document -> m Vars
parseMpv :: Document -> m Vars
parseMpv Document
doc = do
  let script :: Text
script = Optic' A_Traversal NoIx Document Text -> Document -> Text
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Optic' A_Traversal NoIx Document Text
allScripts Document
doc
      mast :: Either String JSAST
mast = String -> String -> Either String JSAST
parse (Text -> String
unpack Text
script) String
""
  case Either String JSAST
mast of
    Left String
_ -> String -> m Vars
forall a. HasCallStack => String -> a
error String
"impossible, javascript parse failed"
    Right JSAST
ast ->
      case JSAST -> Maybe Vars
forall a b. As a b => a -> Maybe b
as JSAST
ast of
        Maybe Vars
Nothing -> ExhentaiError -> m Vars
forall e (m :: Type -> Type) a. Eff (Throw e) m => e -> m a
throw ExhentaiError
ExtractionFailure
        Just Vars
vars -> Vars -> m Vars
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Vars
vars
{-# INLINEABLE parseMpv #-}

-- | Build dispatch requests for a gallery
buildRequest ::
  Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
  Gallery ->
  m [DispatchRequest]
buildRequest :: Gallery -> m [DispatchRequest]
buildRequest Gallery
g = Vars -> [DispatchRequest]
toRequests (Vars -> [DispatchRequest]) -> m Vars -> m [DispatchRequest]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gallery -> m Vars
forall (m :: Type -> Type).
Effs
  '[Http, Error HttpException, Cookie, ConduitIO, Bracket,
    Throw ExhentaiError]
  m =>
Gallery -> m Vars
fetchMpv Gallery
g
{-# INLINEABLE buildRequest #-}

-- | Calls the API to dispatch a image request to a H@H server
imageDispatch ::
  Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
  DispatchRequest ->
  m DispatchResult
imageDispatch :: DispatchRequest -> m DispatchResult
imageDispatch DispatchRequest
dreq = do
  Request
initReq <- String -> m Request
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] m =>
String -> m Request
formRequest String
"https://exhentai.org/api.php"
  let req :: Request
req = Request
initReq {method :: Method
method = Method
"POST", requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ DispatchRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode DispatchRequest
dreq}
  Either String DispatchResult
r <- Request -> m (Either String DispatchResult)
forall a (m :: Type -> Type).
(FromJSON a,
 Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m) =>
Request -> m (Either String a)
jsonRequest Request
req
  case Either String DispatchResult
r of
    Left String
e -> ExhentaiError -> m DispatchResult
forall e (m :: Type -> Type) a. Eff (Throw e) m => e -> m a
throw (ExhentaiError -> m DispatchResult)
-> ExhentaiError -> m DispatchResult
forall a b. (a -> b) -> a -> b
$ String -> ExhentaiError
JSONParseFailure String
e
    Right DispatchResult
res -> DispatchResult -> m DispatchResult
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DispatchResult
res
{-# INLINEABLE imageDispatch #-}

-- | Fetch an image with a 'DispatchRequest'
fetchImage ::
  Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
  DispatchRequest ->
  ContT r m (Response (ConduitT i ByteString IO ()))
fetchImage :: DispatchRequest -> ContT r m (Response (ConduitT i Method IO ()))
fetchImage DispatchRequest
dreq = ((Response (ConduitT i Method IO ()) -> m r) -> m r)
-> ContT r m (Response (ConduitT i Method IO ()))
forall k (r :: k) (m :: k -> Type) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Response (ConduitT i Method IO ()) -> m r) -> m r)
 -> ContT r m (Response (ConduitT i Method IO ())))
-> ((Response (ConduitT i Method IO ()) -> m r) -> m r)
-> ContT r m (Response (ConduitT i Method IO ()))
forall a b. (a -> b) -> a -> b
$ \Response (ConduitT i Method IO ()) -> m r
k -> m (Response (ConduitT i Method IO ()))
-> (Response (ConduitT i Method IO ()) -> m ())
-> (Response (ConduitT i Method IO ()) -> m r)
-> m r
forall (m :: Type -> Type) a c b.
Eff Bracket m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (DispatchRequest -> m (Response (ConduitT i Method IO ()))
forall (m :: Type -> Type) i.
Effs
  '[Http, Error HttpException, Cookie, ConduitIO, Bracket,
    Throw ExhentaiError]
  m =>
DispatchRequest -> m (Response (ConduitT i Method IO ()))
fetchImage' DispatchRequest
dreq) Response (ConduitT i Method IO ()) -> m ()
forall (m :: Type -> Type) a. Eff Http m => Response a -> m ()
respClose Response (ConduitT i Method IO ()) -> m r
k
{-# INLINEABLE fetchImage #-}

-- | Like 'fetchImage', but the user is responsible of closing the response
fetchImage' ::
  Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
  DispatchRequest ->
  m (Response (ConduitT i ByteString IO ()))
fetchImage' :: DispatchRequest -> m (Response (ConduitT i Method IO ()))
fetchImage' DispatchRequest
dreq = do
  DispatchResult
res <- DispatchRequest -> m DispatchResult
forall (m :: Type -> Type).
Effs
  '[Http, Error HttpException, Cookie, ConduitIO, Bracket,
    Throw ExhentaiError]
  m =>
DispatchRequest -> m DispatchResult
imageDispatch DispatchRequest
dreq
  Request
req <- String -> m Request
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] m =>
String -> m Request
formRequest (String -> m Request) -> String -> m Request
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ DispatchResult -> Text
imgLink DispatchResult
res
  Request -> m (Response (ConduitT i Method IO ()))
forall (m :: Type -> Type) i.
Effs '[Http, Cookie, Error HttpException] m =>
Request -> m (Response (ConduitT i Method IO ()))
openWithJar Request
req m (Response (ConduitT i Method IO ()))
-> (HttpException -> m (Response (ConduitT i Method IO ())))
-> m (Response (ConduitT i Method IO ()))
forall e (m :: Type -> Type) a.
Eff (Catch e) m =>
m a -> (e -> m a) -> m a
`catch` \(HttpException
_ :: HttpException) -> do
    DispatchResult
res' <- DispatchRequest -> m DispatchResult
forall (m :: Type -> Type).
Effs
  '[Http, Error HttpException, Cookie, ConduitIO, Bracket,
    Throw ExhentaiError]
  m =>
DispatchRequest -> m DispatchResult
imageDispatch (DispatchRequest -> m DispatchResult)
-> DispatchRequest -> m DispatchResult
forall a b. (a -> b) -> a -> b
$ DispatchRequest
dreq {$sel:exclude:DispatchRequest :: Maybe Server
exclude = Server -> Maybe Server
forall a. a -> Maybe a
Just (Server -> Maybe Server) -> Server -> Maybe Server
forall a b. (a -> b) -> a -> b
$ DispatchResult -> Server
server DispatchResult
res}
    Request
req' <- String -> m Request
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] m =>
String -> m Request
formRequest (String -> m Request) -> String -> m Request
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ DispatchResult -> Text
imgLink DispatchResult
res'
    Request -> m (Response (ConduitT i Method IO ()))
forall (m :: Type -> Type) i.
Effs '[Http, Cookie, Error HttpException] m =>
Request -> m (Response (ConduitT i Method IO ()))
openWithJar Request
req' m (Response (ConduitT i Method IO ()))
-> (HttpException -> m (Response (ConduitT i Method IO ())))
-> m (Response (ConduitT i Method IO ()))
forall e (m :: Type -> Type) a.
Eff (Catch e) m =>
m a -> (e -> m a) -> m a
`catch` \(HttpException
_ :: HttpException) -> do
      Request
req'' <- String -> m Request
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] m =>
String -> m Request
formRequest (String -> m Request) -> String -> m Request
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"https://exhentai.org/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DispatchResult -> Text
origImgPath DispatchResult
res
      Request -> m (Response (ConduitT i Method IO ()))
forall (m :: Type -> Type) i.
Effs '[Http, Cookie, Error HttpException] m =>
Request -> m (Response (ConduitT i Method IO ()))
openWithJar Request
req''
{-# INLINEABLE fetchImage' #-}

allScripts :: Traversal' Document Text
allScripts :: Optic' A_Traversal NoIx Document Text
allScripts = Traversal' Document Element
body Traversal' Document Element
-> Optic A_Traversal NoIx Element Element Text Text
-> Optic
     (Join (Join A_Traversal A_Traversal) A_Traversal)
     (Append NoIx NoIx)
     Document
     Document
     Text
     Text
forall k l (is :: IxList) s t (js :: IxList) a b.
(Is (Join k A_Traversal) (Join (Join k A_Traversal) l),
 Is l (Join (Join k A_Traversal) l), Is k (Join k A_Traversal),
 Is A_Traversal (Join k A_Traversal)) =>
Optic k is s t Element Element
-> Optic l js Element Element a b
-> Optic (Join (Join k A_Traversal) l) (Append is js) s t a b
.// (AffineTraversal' Element Element
scripts AffineTraversal' Element Element
-> Optic A_Traversal (WithIx Int) Element Element Node Node
-> Optic A_Traversal (WithIx Int) Element Element Node Node
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_Traversal (WithIx Int) Element Element Node Node
lower Optic A_Traversal (WithIx Int) Element Element Node Node
-> Optic A_Prism NoIx Node Node Text Text
-> Optic A_Traversal NoIx Element Element Text Text
forall m k l s t u v (is :: IxList) (js :: IxList) a b.
(m ~ Join k l, Is k m, Is l m, IxOptic k s t u v,
 NonEmptyIndices is) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m js s t a b
%> Optic A_Prism NoIx Node Node Text Text
_Content)

makeFieldLabelsWith noPrefixFieldLabels ''DispatchResult
makeFieldLabelsWith noPrefixFieldLabels ''DispatchRequest
makePrismLabels ''Dim
makePrismLabels ''Server