{-# LANGUAGE RankNTypes #-}

-- | Internal module
module Web.Exhentai.Utils where

import Conduit
import Control.Effect
import Control.Effect.Bracket
import Control.Effect.Error
import Control.Effect.Exh
import Control.Monad.Trans.Cont
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Text (Text, pack, unpack)
import Data.Time
import Network.HTTP.Client hiding (Cookie)
import Optics.Core
import Text.HTML.DOM
import Text.Read (readMaybe)
import Text.XML hiding (sinkDoc)
import Text.XML.Optics
import Prelude hiding ((!!))

body :: Traversal' Document Element
body :: Traversal' Document Element
body = (Lens' Document Element
root Lens' Document Element
-> Optic An_AffineTraversal NoIx Element Element Element Element
-> Optic An_AffineTraversal NoIx Document Document Element Element
forall (k :: OpticKind) (m :: OpticKind) (l :: OpticKind)
       (ks :: [OpticKind]) (is :: [OpticKind]) (js :: [OpticKind])
       (s :: OpticKind) (t :: OpticKind) (u :: OpticKind) (v :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(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
% Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"html") Optic An_AffineTraversal NoIx Document Document Element Element
-> Optic An_AffineTraversal NoIx Element Element Element Element
-> Optic
     (Join (Join An_AffineTraversal A_Traversal) An_AffineTraversal)
     (Append NoIx NoIx)
     Document
     Document
     Element
     Element
forall (k :: OpticKind) (l :: OpticKind) (is :: [OpticKind])
       (s :: OpticKind) (t :: OpticKind) (js :: [OpticKind])
       (a :: OpticKind) (b :: OpticKind).
(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
.// Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"body"
{-# INLINE body #-}

div :: AffineTraversal' Element Element
div :: Optic An_AffineTraversal NoIx Element Element Element Element
div = Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"div"
{-# INLINE div #-}

h1 :: AffineTraversal' Element Element
h1 :: Optic An_AffineTraversal NoIx Element Element Element Element
h1 = Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"h1"
{-# INLINE h1 #-}

a :: AffineTraversal' Element Element
a :: Optic An_AffineTraversal NoIx Element Element Element Element
a = Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"a"
{-# INLINE a #-}

table :: AffineTraversal' Element Element
table :: Optic An_AffineTraversal NoIx Element Element Element Element
table = Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"table"
{-# INLINE table #-}

tr :: AffineTraversal' Element Element
tr :: Optic An_AffineTraversal NoIx Element Element Element Element
tr = Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"tr"
{-# INLINE tr #-}

td :: AffineTraversal' Element Element
td :: Optic An_AffineTraversal NoIx Element Element Element Element
td = Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"td"
{-# INLINE td #-}

img :: AffineTraversal' Element Element
img :: Optic An_AffineTraversal NoIx Element Element Element Element
img = Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"img"
{-# INLINE img #-}

cl :: Text -> AffineTraversal' Element Element
cl :: Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
cl = Name
-> Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
attributeIs Name
"class"
{-# INLINE cl #-}

id :: Text -> AffineTraversal' Element Element
id :: Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
id = Name
-> Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
attributeIs Name
"id"
{-# INLINE id #-}

viaShowRead :: (Show a, Read a) => Prism' Text a
viaShowRead :: Prism' Text a
viaShowRead = (a -> Text) -> (Text -> Maybe a) -> Prism' Text a
forall (b :: OpticKind) (s :: OpticKind) (a :: OpticKind).
(b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. a -> String
forall (a :: OpticKind). Show a => a -> String
show) (String -> Maybe a
forall (a :: OpticKind). Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Text -> String) -> Text -> Maybe a
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack)
{-# INLINE viaShowRead #-}

scripts :: AffineTraversal' Element Element
scripts :: Optic An_AffineTraversal NoIx Element Element Element Element
scripts = Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
named Text
"script" Optic An_AffineTraversal NoIx Element Element Element Element
-> Optic An_AffineTraversal NoIx Element Element Element Element
-> Optic An_AffineTraversal NoIx Element Element Element Element
forall (k :: OpticKind) (m :: OpticKind) (l :: OpticKind)
       (ks :: [OpticKind]) (is :: [OpticKind]) (js :: [OpticKind])
       (s :: OpticKind) (t :: OpticKind) (u :: OpticKind) (v :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(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
-> Text
-> Optic An_AffineTraversal NoIx Element Element Element Element
attributeIs Name
"type" Text
"text/javascript"
{-# INLINE scripts #-}

infixl 8 ^?:

(^?:) :: (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
Document
doc ^?: :: Document -> Optic l is Element Element a a -> Maybe a
^?: Optic l is Element Element a a
fld = Document
doc Document -> Optic' An_AffineFold NoIx Document a -> Maybe a
forall (k :: OpticKind) (s :: OpticKind) (is :: [OpticKind])
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic' (Join A_Traversal l) is Document a
-> Optic' An_AffineFold NoIx Document a
forall (k :: OpticKind) (is :: [OpticKind]) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Fold =>
Optic' k is s a -> AffineFold s a
pre (Traversal' Document Element
body Traversal' Document Element
-> Optic l is Element Element a a
-> Optic
     (Join (Join A_Traversal A_Traversal) l)
     (Append NoIx is)
     Document
     Document
     a
     a
forall (k :: OpticKind) (l :: OpticKind) (is :: [OpticKind])
       (s :: OpticKind) (t :: OpticKind) (js :: [OpticKind])
       (a :: OpticKind) (b :: OpticKind).
(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
.// Optic l is Element Element a a
fld)
{-# INLINE (^?:) #-}

infixl 8 ^..:

(^..:) :: (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]
Document
doc ^..: :: Document -> Optic l is Element Element a a -> [a]
^..: Optic l is Element Element a a
fld = Document
doc Document -> Optic' (Join A_Traversal l) is Document a -> [a]
forall (k :: OpticKind) (s :: OpticKind) (is :: [OpticKind])
       (a :: OpticKind).
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Traversal' Document Element
body Traversal' Document Element
-> Optic l is Element Element a a
-> Optic
     (Join (Join A_Traversal A_Traversal) l)
     (Append NoIx is)
     Document
     Document
     a
     a
forall (k :: OpticKind) (l :: OpticKind) (is :: [OpticKind])
       (s :: OpticKind) (t :: OpticKind) (js :: [OpticKind])
       (a :: OpticKind) (b :: OpticKind).
(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
.// Optic l is Element Element a a
fld
{-# INLINE (^..:) #-}

sinkAeson :: (FromJSON a, Monad m) => ConduitT ByteString o m (Either String a)
sinkAeson :: ConduitT ByteString o m (Either String a)
sinkAeson = ByteString -> Either String a
forall (a :: OpticKind).
FromJSON a =>
ByteString -> Either String a
eitherDecode (ByteString -> Either String a)
-> ConduitT ByteString o m ByteString
-> ConduitT ByteString o m (Either String a)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> ConduitT ByteString o m ByteString
forall (m :: OpticKind -> OpticKind) (lazy :: OpticKind)
       (strict :: OpticKind) (o :: OpticKind).
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
sinkLazy
{-# INLINE sinkAeson #-}

jsonRequest :: (FromJSON a, Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m) => Request -> m (Either String a)
jsonRequest :: Request -> m (Either String a)
jsonRequest Request
req = ContT (Either String a) m (Either String a) -> m (Either String a)
forall (m :: OpticKind -> OpticKind) (r :: OpticKind).
Monad m =>
ContT r m r -> m r
evalContT (ContT (Either String a) m (Either String a)
 -> m (Either String a))
-> ContT (Either String a) m (Either String a)
-> m (Either String a)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  Response (ConduitT () ByteString IO ())
resp <- Request
-> ContT
     (Either String a) m (Response (ConduitT () ByteString IO ()))
forall (m :: OpticKind -> OpticKind) (r :: OpticKind)
       (i :: OpticKind).
Effs '[Http, Cookie, Error HttpException, Bracket] m =>
Request -> ContT r m (Response (ConduitT i ByteString IO ()))
withSource Request
req
  m (Either String a) -> ContT (Either String a) m (Either String a)
forall (t :: (OpticKind -> OpticKind) -> OpticKind -> OpticKind)
       (m :: OpticKind -> OpticKind) (a :: OpticKind).
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either String a)
 -> ContT (Either String a) m (Either String a))
-> m (Either String a)
-> ContT (Either String a) m (Either String a)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ConduitT () Void IO (Either String a) -> m (Either String a)
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Eff ConduitIO m =>
ConduitT () Void IO a -> m a
runConduitIO (ConduitT () Void IO (Either String a) -> m (Either String a))
-> ConduitT () Void IO (Either String a) -> m (Either String a)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Response (ConduitT () ByteString IO ())
-> ConduitT () ByteString IO ()
forall (body :: OpticKind). Response body -> body
responseBody Response (ConduitT () ByteString IO ())
resp ConduitT () ByteString IO ()
-> ConduitM ByteString Void IO (Either String a)
-> ConduitT () Void IO (Either String a)
forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind) (c :: OpticKind) (r :: OpticKind).
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void IO (Either String a)
forall (a :: OpticKind) (m :: OpticKind -> OpticKind)
       (o :: OpticKind).
(FromJSON a, Monad m) =>
ConduitT ByteString o m (Either String a)
sinkAeson
{-# INLINEABLE jsonRequest #-}

htmlRequest :: Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m => Request -> m Document
htmlRequest :: Request -> m Document
htmlRequest Request
req = ContT Document m Document -> m Document
forall (m :: OpticKind -> OpticKind) (r :: OpticKind).
Monad m =>
ContT r m r -> m r
evalContT (ContT Document m Document -> m Document)
-> ContT Document m Document -> m Document
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  Response (ConduitT () ByteString IO ())
resp <- Request
-> ContT Document m (Response (ConduitT () ByteString IO ()))
forall (m :: OpticKind -> OpticKind) (r :: OpticKind)
       (i :: OpticKind).
Effs '[Http, Cookie, Error HttpException, Bracket] m =>
Request -> ContT r m (Response (ConduitT i ByteString IO ()))
withSource Request
req
  m Document -> ContT Document m Document
forall (t :: (OpticKind -> OpticKind) -> OpticKind -> OpticKind)
       (m :: OpticKind -> OpticKind) (a :: OpticKind).
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Document -> ContT Document m Document)
-> m Document -> ContT Document m Document
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ConduitT () Void IO Document -> m Document
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Eff ConduitIO m =>
ConduitT () Void IO a -> m a
runConduitIO (ConduitT () Void IO Document -> m Document)
-> ConduitT () Void IO Document -> m Document
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Response (ConduitT () ByteString IO ())
-> ConduitT () ByteString IO ()
forall (body :: OpticKind). Response body -> body
responseBody Response (ConduitT () ByteString IO ())
resp ConduitT () ByteString IO ()
-> ConduitM ByteString Void IO Document
-> ConduitT () Void IO Document
forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind) (c :: OpticKind) (r :: OpticKind).
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void IO Document
forall (m :: OpticKind -> OpticKind) (o :: OpticKind).
MonadThrow m =>
ConduitT ByteString o m Document
sinkDoc
{-# INLINEABLE htmlRequest #-}

htmlRequest' :: Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m => Text -> m Document
htmlRequest' :: Text -> m Document
htmlRequest' Text
url = do
  Request
req <- String -> m Request
forall (m :: OpticKind -> OpticKind).
Effs '[Http, Error HttpException] m =>
String -> m Request
formRequest (String -> m Request) -> String -> m Request
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Text -> String
unpack Text
url
  Request -> m Document
forall (m :: OpticKind -> OpticKind).
Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m =>
Request -> m Document
htmlRequest Request
req
{-# INLINEABLE htmlRequest' #-}

parseUploadTime :: Text -> Maybe UTCTime
parseUploadTime :: Text -> Maybe UTCTime
parseUploadTime Text
s = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: OpticKind -> OpticKind) (t :: OpticKind).
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%F %R" (String -> Maybe UTCTime) -> String -> Maybe UTCTime
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Text -> String
unpack Text
s
{-# INLINE parseUploadTime #-}

annotate :: ann -> Maybe a -> Either ann a
annotate :: ann -> Maybe a -> Either ann a
annotate ann
_ (Just a
a') = a -> Either ann a
forall (a :: OpticKind) (b :: OpticKind). b -> Either a b
Right a
a'
annotate ann
ann Maybe a
Nothing = ann -> Either ann a
forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left ann
ann
{-# INLINE annotate #-}

(!!) :: [a] -> Int -> Maybe a
[a]
l !! :: [a] -> Int -> Maybe a
!! Int
i
  | Int
i Int -> Int -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== Int
0,
    (a
x : [a]
_) <- [a]
l =
    a -> Maybe a
forall (a :: OpticKind). a -> Maybe a
Just a
x
  | Int
i Int -> Int -> Bool
forall (a :: OpticKind). Ord a => a -> a -> Bool
> Int
0,
    (a
_ : [a]
xs) <- [a]
l =
    [a]
xs [a] -> Int -> Maybe a
forall (a :: OpticKind). [a] -> Int -> Maybe a
!! (Int
i Int -> Int -> Int
forall (a :: OpticKind). Num a => a -> a -> a
- Int
1)
  | Bool
otherwise = Maybe a
forall (a :: OpticKind). Maybe a
Nothing
{-# INLINE (!!) #-}