module Web.Exhentai.Parsing.Search where

import Control.Lens
import Data.Text (Text)
import Text.XML.Lens
import Web.Exhentai.Types
import Web.Exhentai.Utils
import Prelude hiding (div)

pages :: Traversal' Element Int
pages :: (Int -> f Int) -> Element -> f Element
pages = (Element -> f Element) -> Element -> f Element
Traversal' Element Element
pagesElem ((Element -> f Element) -> Element -> f Element)
-> ((Int -> f Int) -> Element -> f Element)
-> (Int -> f Int)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
a ((Element -> f Element) -> Element -> f Element)
-> ((Int -> f Int) -> Element -> f Element)
-> (Int -> f Int)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> f Node) -> Element -> f Element
Traversal' Element Node
lower ((Node -> f Node) -> Element -> f Element)
-> ((Int -> f Int) -> Node -> f Node)
-> (Int -> f Int)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Node -> f Node
Prism' Node Text
_Content ((Text -> f Text) -> Node -> f Node)
-> ((Int -> f Int) -> Text -> f Text)
-> (Int -> f Int)
-> Node
-> f Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> Text -> f Text
forall a. (Show a, Read a) => Prism' Text a
viaShowRead

pagesElem :: Traversal' Element Element
pagesElem :: (Element -> f Element) -> Element -> f Element
pagesElem = Text -> Traversal' Element Element
cl Text
"ido" ((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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
div ((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
... Text -> Traversal' Element Element
cl Text
"ptt" ((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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
tr ((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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
td

linkOf :: Traversal' Element Text
linkOf :: (Text -> f Text) -> Element -> f Element
linkOf = (Node -> f Node) -> Element -> f Element
Traversal' Element Node
lower ((Node -> f Node) -> Element -> f Element)
-> ((Text -> f Text) -> Node -> f Node)
-> (Text -> f Text)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> f Element) -> Node -> f Node
Prism' Node Element
_Element ((Element -> f Element) -> Node -> f Node)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> Node
-> f Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Traversal' Element Text
attr Name
"href"

galleryPreviewElement :: Traversal' Element Element
galleryPreviewElement :: (Element -> f Element) -> Element -> f Element
galleryPreviewElement = Text -> Traversal' Element Element
cl Text
"ido" ((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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
div ((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
... Text -> Traversal' Element Element
cl Text
"itg glte" ((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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
tr

previewImage :: Traversal' Element Text
previewImage :: (Text -> f Text) -> Element -> f Element
previewImage = (Element -> f Element) -> Element -> f Element
Traversal' Element Element
tr ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> 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
... Text -> Traversal' Element Element
cl Text
"gl1e" ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
div ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
a ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
img ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Traversal' Element Text
attr Name
"src"

title :: Traversal' Element Text
title :: (Text -> f Text) -> Element -> f Element
title = (Element -> f Element) -> Element -> f Element
Traversal' Element Element
tr ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> 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
... Text -> Traversal' Element Element
cl Text
"gl1e" ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
div ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
a ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
img ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Traversal' Element Text
attr Name
"title"

galleryLink :: Traversal' Element Gallery
galleryLink :: (Gallery -> f Gallery) -> Element -> f Element
galleryLink = (Element -> f Element) -> Element -> f Element
Traversal' Element Element
tr ((Element -> f Element) -> Element -> f Element)
-> ((Gallery -> f Gallery) -> Element -> f Element)
-> (Gallery -> f Gallery)
-> 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
... Text -> Traversal' Element Element
cl Text
"gl1e" ((Element -> f Element) -> Element -> f Element)
-> ((Gallery -> f Gallery) -> Element -> f Element)
-> (Gallery -> f Gallery)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
div ((Element -> f Element) -> Element -> f Element)
-> ((Gallery -> f Gallery) -> Element -> f Element)
-> (Gallery -> f Gallery)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
a ((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
. Name -> Traversal' Element Text
attr Name
"href" ((Text -> f Text) -> Element -> f Element)
-> ((Gallery -> f Gallery) -> Text -> f Text)
-> (Gallery -> f Gallery)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gallery -> f Gallery) -> Text -> f Text
Prism' Text Gallery
_GalleryLink

galleryLength :: Traversal' Element GalleryLength
galleryLength :: (GalleryLength -> f GalleryLength) -> Element -> f Element
galleryLength = (Element -> f Element) -> Element -> f Element
Traversal' Element Element
tr ((Element -> f Element) -> Element -> f Element)
-> ((GalleryLength -> f GalleryLength) -> Element -> f Element)
-> (GalleryLength -> f GalleryLength)
-> 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
... Text -> Traversal' Element Element
cl Text
"gl2e" ((Element -> f Element) -> Element -> f Element)
-> ((GalleryLength -> f GalleryLength) -> Element -> f Element)
-> (GalleryLength -> f GalleryLength)
-> 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
... (Element -> f Element) -> Element -> f Element
Traversal' Element Element
div ((Element -> f Element) -> Element -> f Element)
-> ((GalleryLength -> f GalleryLength) -> Element -> f Element)
-> (GalleryLength -> f GalleryLength)
-> 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
... Text -> Traversal' Element Element
cl Text
"gl3e" ((Element -> f Element) -> Element -> f Element)
-> ((GalleryLength -> f GalleryLength) -> Element -> f Element)
-> (GalleryLength -> f GalleryLength)
-> 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
... (Node -> f Node) -> Element -> f Element
Traversal' Element Node
lower ((Node -> f Node) -> Element -> f Element)
-> ((GalleryLength -> f GalleryLength) -> Node -> f Node)
-> (GalleryLength -> f GalleryLength)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Node -> f Node
Prism' Node Text
_Content ((Text -> f Text) -> Node -> f Node)
-> ((GalleryLength -> f GalleryLength) -> Text -> f Text)
-> (GalleryLength -> f GalleryLength)
-> Node
-> f Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GalleryLength -> f GalleryLength) -> Text -> f Text
Prism' Text GalleryLength
_GalleryLength