{-# LANGUAGE RankNTypes #-}

module Web.Exhentai.Utils where

import Conduit
import Control.Lens
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Maybe (isNothing)
import Data.Text (Text, pack, unpack)
import Data.Time
import Network.HTTP.Client.Conduit
import Text.HTML.DOM
import Text.Read
import Text.XML hiding (sinkDoc)
import Text.XML.Lens
import Web.Exhentai.Types.CookieT

attributeSatisfies' :: Name -> (Maybe Text -> Bool) -> Traversal' Element Element
attributeSatisfies' :: Name -> (Maybe Text -> Bool) -> Traversal' Element Element
attributeSatisfies' Name
n Maybe Text -> Bool
p = (Element -> Bool) -> Optic' (->) f Element Element
forall (p :: Type -> Type -> Type) (f :: Type -> Type) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (Maybe Text -> Bool
p (Maybe Text -> Bool) -> (Element -> Maybe Text) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Element Text -> Element -> Maybe Text
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map Name Text -> Const (First Text) (Map Name Text))
-> Element -> Const (First Text) Element
Lens' Element (Map Name Text)
attrs ((Map Name Text -> Const (First Text) (Map Name Text))
 -> Element -> Const (First Text) Element)
-> ((Text -> Const (First Text) Text)
    -> Map Name Text -> Const (First Text) (Map Name Text))
-> Getting (First Text) Element Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Name Text)
-> Traversal' (Map Name Text) (IxValue (Map Name Text))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Name Text)
Name
n))

withoutAttribute :: Name -> Traversal' Element Element
withoutAttribute :: Name -> Traversal' Element Element
withoutAttribute = (Name
 -> (Maybe Text -> Bool)
 -> (Element -> f Element)
 -> Element
 -> f Element)
-> (Maybe Text -> Bool)
-> Name
-> (Element -> f Element)
-> Element
-> f Element
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name
-> (Maybe Text -> Bool)
-> (Element -> f Element)
-> Element
-> f Element
Name -> (Maybe Text -> Bool) -> Traversal' Element Element
attributeSatisfies' Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing

lower :: Traversal' Element Node
lower :: (Node -> f Node) -> Element -> f Element
lower = ([Node] -> f [Node]) -> Element -> f Element
Lens' Element [Node]
nodes (([Node] -> f [Node]) -> Element -> f Element)
-> ((Node -> f Node) -> [Node] -> f [Node])
-> (Node -> f Node)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> f Node) -> [Node] -> f [Node]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse

body :: Traversal' Document Element
body :: (Element -> f Element) -> Document -> f Document
body = (Element -> f Element) -> Document -> f Document
Lens' Document Element
root ((Element -> f Element) -> Document -> f Document)
-> ((Element -> f Element) -> Element -> f Element)
-> (Element -> f Element)
-> Document
-> f Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Traversal' Element Element
named CI Text
"html" ((Element -> f Element) -> Element -> f Element)
-> ((Element -> f Element) -> Element -> f Element)
-> (Element -> f Element)
-> Element
-> f Element
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
... CI Text -> Traversal' Element Element
named CI Text
"body"

div :: Traversal' Element Element
div :: (Element -> f Element) -> Element -> f Element
div = CI Text -> Traversal' Element Element
named CI Text
"div"

h1 :: Traversal' Element Element
h1 :: (Element -> f Element) -> Element -> f Element
h1 = CI Text -> Traversal' Element Element
named CI Text
"h1"

a :: Traversal' Element Element
a :: (Element -> f Element) -> Element -> f Element
a = CI Text -> Traversal' Element Element
named CI Text
"a"

table :: Traversal' Element Element
table :: (Element -> f Element) -> Element -> f Element
table = CI Text -> Traversal' Element Element
named CI Text
"table"

tr :: Traversal' Element Element
tr :: (Element -> f Element) -> Element -> f Element
tr = CI Text -> Traversal' Element Element
named CI Text
"tr"

td :: Traversal' Element Element
td :: (Element -> f Element) -> Element -> f Element
td = CI Text -> Traversal' Element Element
named CI Text
"td"

img :: Traversal' Element Element
img :: (Element -> f Element) -> Element -> f Element
img = CI Text -> Traversal' Element Element
named CI Text
"img"

cl :: Text -> Traversal' Element Element
cl :: Text -> Traversal' Element Element
cl = Name -> Text -> Traversal' Element Element
attributeIs Name
"class"

id :: Text -> Traversal' Element Element
id :: Text -> Traversal' Element Element
id = Name -> Text -> Traversal' Element Element
attributeIs Name
"id"

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

scripts :: Traversal' Element Element
scripts :: (Element -> f Element) -> Element -> f Element
scripts = CI Text -> Traversal' Element Element
named CI Text
"script" ((Element -> f Element) -> Element -> f Element)
-> ((Element -> f Element) -> Element -> f Element)
-> (Element -> f Element)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text -> Traversal' Element Element
attributeIs Name
"type" Text
"text/javascript"

infixl 8 ^?:

(^?:) :: Document -> Fold Element a -> Maybe a
Document
doc ^?: :: Document -> Fold Element a -> Maybe a
^?: Fold Element a
fld = Document
doc Document -> Getting (First a) Document a -> Maybe a
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Element -> Const (First a) Element)
-> Document -> Const (First a) Document
Traversal' Document Element
body ((Element -> Const (First a) Element)
 -> Document -> Const (First a) Document)
-> Over (->) (Const (First a)) Element Element a a
-> Getting (First a) Document a
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 (->) (Const (First a)) Element Element a a
Fold Element a
fld

infixl 8 ^..:

(^..:) :: Document -> Fold Element a -> [a]
Document
doc ^..: :: Document -> Fold Element a -> [a]
^..: Fold Element a
fld = Document
doc Document -> Getting (Endo [a]) Document a -> [a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Element -> Const (Endo [a]) Element)
-> Document -> Const (Endo [a]) Document
Traversal' Document Element
body ((Element -> Const (Endo [a]) Element)
 -> Document -> Const (Endo [a]) Document)
-> Over (->) (Const (Endo [a])) Element Element a a
-> Getting (Endo [a]) Document a
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 (->) (Const (Endo [a])) Element Element a a
Fold Element a
fld

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. 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 :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT ByteString o m ByteString
forall (m :: Type -> Type) lazy strict o.
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
sinkLazy

jsonRequest :: (FromJSON a, MonadHttpState m) => Request -> m (Either String a)
jsonRequest :: Request -> m (Either String a)
jsonRequest Request
req = Request
-> (ConduitT () ByteString m () -> m (Either String a))
-> m (Either String a)
forall (m :: Type -> Type) (n :: Type -> Type) i a.
(MonadHttpState m, MonadIO n) =>
Request -> (ConduitT i ByteString n () -> m a) -> m a
withJar Request
req ((ConduitT () ByteString m () -> m (Either String a))
 -> m (Either String a))
-> (ConduitT () ByteString m () -> m (Either String a))
-> m (Either String a)
forall a b. (a -> b) -> a -> b
$ \ConduitT () ByteString m ()
source -> ConduitT () Void m (Either String a) -> m (Either String a)
forall (m :: Type -> Type) r.
Monad m =>
ConduitT () Void m r -> m r
runConduit (ConduitT () Void m (Either String a) -> m (Either String a))
-> ConduitT () Void m (Either String a) -> m (Either String a)
forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString m ()
source ConduitT () ByteString m ()
-> ConduitM ByteString Void m (Either String a)
-> ConduitT () Void m (Either String a)
forall (m :: Type -> Type) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m (Either String a)
forall a (m :: Type -> Type) o.
(FromJSON a, Monad m) =>
ConduitT ByteString o m (Either String a)
sinkAeson

htmlRequest :: MonadHttpState m => Request -> m Document
htmlRequest :: Request -> m Document
htmlRequest Request
req = Request
-> (ConduitT () ByteString m () -> m Document) -> m Document
forall (m :: Type -> Type) (n :: Type -> Type) i a.
(MonadHttpState m, MonadIO n) =>
Request -> (ConduitT i ByteString n () -> m a) -> m a
withJar Request
req ((ConduitT () ByteString m () -> m Document) -> m Document)
-> (ConduitT () ByteString m () -> m Document) -> m Document
forall a b. (a -> b) -> a -> b
$ \ConduitT () ByteString m ()
source -> ConduitT () Void m Document -> m Document
forall (m :: Type -> Type) r.
Monad m =>
ConduitT () Void m r -> m r
runConduit (ConduitT () Void m Document -> m Document)
-> ConduitT () Void m Document -> m Document
forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString m ()
source ConduitT () ByteString m ()
-> ConduitM ByteString Void m Document
-> ConduitT () Void m Document
forall (m :: Type -> Type) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m Document
forall (m :: Type -> Type) o.
MonadThrow m =>
ConduitT ByteString o m Document
sinkDoc

htmlRequest' :: MonadHttpState m => Text -> m Document
htmlRequest' :: Text -> m Document
htmlRequest' Text
url = do
  Request
req <- String -> m Request
forall (m :: Type -> Type). MonadHttp m => String -> m Request
formRequest (String -> m Request) -> String -> m Request
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
url
  Request -> m Document
forall (m :: Type -> Type).
MonadHttpState m =>
Request -> m Document
htmlRequest Request
req

parseUploadTime :: Text -> Maybe UTCTime
parseUploadTime :: Text -> Maybe UTCTime
parseUploadTime Text
s = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: Type -> Type) t.
(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 b. (a -> b) -> a -> b
$ Text -> String
unpack Text
s

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 b. b -> Either a b
Right a
a'
annotate ann
ann Maybe a
Nothing = ann -> Either ann a
forall a b. a -> Either a b
Left ann
ann