{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Web.Exhentai.Types where

import Control.Lens
import Data.Set (Set, fromList, toList)
import Data.Text (Text, pack)
import Data.Void
import Text.Megaparsec
  ( MonadParsec (notFollowedBy, takeWhile1P),
    Parsec,
    anySingle,
    chunk,
    many,
    optional,
    parseMaybe,
    single,
    takeRest,
  )
import Text.Megaparsec.Char.Lexer

type Parser = Parsec Void Text

data GalleryCat
  = Misc
  | Doujinshi
  | Manga
  | ArtistCG
  | GameCG
  | ImageSet
  | Cosplay
  | AsianPorn
  | NonH
  | Western
  | Private
  deriving (Int -> GalleryCat -> ShowS
[GalleryCat] -> ShowS
GalleryCat -> String
(Int -> GalleryCat -> ShowS)
-> (GalleryCat -> String)
-> ([GalleryCat] -> ShowS)
-> Show GalleryCat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GalleryCat] -> ShowS
$cshowList :: [GalleryCat] -> ShowS
show :: GalleryCat -> String
$cshow :: GalleryCat -> String
showsPrec :: Int -> GalleryCat -> ShowS
$cshowsPrec :: Int -> GalleryCat -> ShowS
Show, GalleryCat -> GalleryCat -> Bool
(GalleryCat -> GalleryCat -> Bool)
-> (GalleryCat -> GalleryCat -> Bool) -> Eq GalleryCat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GalleryCat -> GalleryCat -> Bool
$c/= :: GalleryCat -> GalleryCat -> Bool
== :: GalleryCat -> GalleryCat -> Bool
$c== :: GalleryCat -> GalleryCat -> Bool
Eq, Eq GalleryCat
Eq GalleryCat
-> (GalleryCat -> GalleryCat -> Ordering)
-> (GalleryCat -> GalleryCat -> Bool)
-> (GalleryCat -> GalleryCat -> Bool)
-> (GalleryCat -> GalleryCat -> Bool)
-> (GalleryCat -> GalleryCat -> Bool)
-> (GalleryCat -> GalleryCat -> GalleryCat)
-> (GalleryCat -> GalleryCat -> GalleryCat)
-> Ord GalleryCat
GalleryCat -> GalleryCat -> Bool
GalleryCat -> GalleryCat -> Ordering
GalleryCat -> GalleryCat -> GalleryCat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GalleryCat -> GalleryCat -> GalleryCat
$cmin :: GalleryCat -> GalleryCat -> GalleryCat
max :: GalleryCat -> GalleryCat -> GalleryCat
$cmax :: GalleryCat -> GalleryCat -> GalleryCat
>= :: GalleryCat -> GalleryCat -> Bool
$c>= :: GalleryCat -> GalleryCat -> Bool
> :: GalleryCat -> GalleryCat -> Bool
$c> :: GalleryCat -> GalleryCat -> Bool
<= :: GalleryCat -> GalleryCat -> Bool
$c<= :: GalleryCat -> GalleryCat -> Bool
< :: GalleryCat -> GalleryCat -> Bool
$c< :: GalleryCat -> GalleryCat -> Bool
compare :: GalleryCat -> GalleryCat -> Ordering
$ccompare :: GalleryCat -> GalleryCat -> Ordering
$cp1Ord :: Eq GalleryCat
Ord, Int -> GalleryCat
GalleryCat -> Int
GalleryCat -> [GalleryCat]
GalleryCat -> GalleryCat
GalleryCat -> GalleryCat -> [GalleryCat]
GalleryCat -> GalleryCat -> GalleryCat -> [GalleryCat]
(GalleryCat -> GalleryCat)
-> (GalleryCat -> GalleryCat)
-> (Int -> GalleryCat)
-> (GalleryCat -> Int)
-> (GalleryCat -> [GalleryCat])
-> (GalleryCat -> GalleryCat -> [GalleryCat])
-> (GalleryCat -> GalleryCat -> [GalleryCat])
-> (GalleryCat -> GalleryCat -> GalleryCat -> [GalleryCat])
-> Enum GalleryCat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GalleryCat -> GalleryCat -> GalleryCat -> [GalleryCat]
$cenumFromThenTo :: GalleryCat -> GalleryCat -> GalleryCat -> [GalleryCat]
enumFromTo :: GalleryCat -> GalleryCat -> [GalleryCat]
$cenumFromTo :: GalleryCat -> GalleryCat -> [GalleryCat]
enumFromThen :: GalleryCat -> GalleryCat -> [GalleryCat]
$cenumFromThen :: GalleryCat -> GalleryCat -> [GalleryCat]
enumFrom :: GalleryCat -> [GalleryCat]
$cenumFrom :: GalleryCat -> [GalleryCat]
fromEnum :: GalleryCat -> Int
$cfromEnum :: GalleryCat -> Int
toEnum :: Int -> GalleryCat
$ctoEnum :: Int -> GalleryCat
pred :: GalleryCat -> GalleryCat
$cpred :: GalleryCat -> GalleryCat
succ :: GalleryCat -> GalleryCat
$csucc :: GalleryCat -> GalleryCat
Enum, GalleryCat
GalleryCat -> GalleryCat -> Bounded GalleryCat
forall a. a -> a -> Bounded a
maxBound :: GalleryCat
$cmaxBound :: GalleryCat
minBound :: GalleryCat
$cminBound :: GalleryCat
Bounded)

allGalleryCats :: Set GalleryCat
allGalleryCats :: Set GalleryCat
allGalleryCats = [GalleryCat] -> Set GalleryCat
forall a. Ord a => [a] -> Set a
fromList [GalleryCat
Misc .. GalleryCat
Private]

toBitField :: Set GalleryCat -> Int
toBitField :: Set GalleryCat -> Int
toBitField = [Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> (Set GalleryCat -> [Int]) -> Set GalleryCat -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GalleryCat -> Int) -> [GalleryCat] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^) (Int -> Int) -> (GalleryCat -> Int) -> GalleryCat -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GalleryCat -> Int
forall a. Enum a => a -> Int
fromEnum) ([GalleryCat] -> [Int])
-> (Set GalleryCat -> [GalleryCat]) -> Set GalleryCat -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set GalleryCat -> [GalleryCat]
forall a. Set a -> [a]
toList

showCat :: GalleryCat -> Text
showCat :: GalleryCat -> Text
showCat GalleryCat
Doujinshi = Text
"Doujinshi"
showCat GalleryCat
Manga = Text
"Manga"
showCat GalleryCat
ArtistCG = Text
"Artist CG"
showCat GalleryCat
GameCG = Text
"Game CG"
showCat GalleryCat
NonH = Text
"Non-H"
showCat GalleryCat
ImageSet = Text
"Image Set"
showCat GalleryCat
Western = Text
"Western"
showCat GalleryCat
Cosplay = Text
"Cosplay"
showCat GalleryCat
Misc = Text
"Misc"
showCat GalleryCat
Private = Text
"Private"
showCat GalleryCat
AsianPorn = Text
"Asian Porn"

readCat :: Text -> Maybe GalleryCat
readCat :: Text -> Maybe GalleryCat
readCat Text
"Doujinshi" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
Doujinshi
readCat Text
"Manga" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
Manga
readCat Text
"Artist CG" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
ArtistCG
readCat Text
"Game CG" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
GameCG
readCat Text
"Non-H" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
NonH
readCat Text
"Image Set" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
ImageSet
readCat Text
"Western" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
Western
readCat Text
"Cosplay" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
Cosplay
readCat Text
"Misc" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
Misc
readCat Text
"Private" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
Private
readCat Text
"Asian Porn" = GalleryCat -> Maybe GalleryCat
forall a. a -> Maybe a
Just GalleryCat
AsianPorn
readCat Text
_ = Maybe GalleryCat
forall a. Maybe a
Nothing

_GalleryCat :: Prism' Text GalleryCat
_GalleryCat :: p GalleryCat (f GalleryCat) -> p Text (f Text)
_GalleryCat = (GalleryCat -> Text)
-> (Text -> Maybe GalleryCat)
-> Prism Text Text GalleryCat GalleryCat
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' GalleryCat -> Text
showCat Text -> Maybe GalleryCat
readCat

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

_PopUpLink :: Prism' Text PopUpLink
_PopUpLink :: p PopUpLink (f PopUpLink) -> p Text (f Text)
_PopUpLink = (PopUpLink -> Text)
-> (Text -> Maybe PopUpLink) -> Prism Text Text PopUpLink PopUpLink
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' PopUpLink -> Text
unLink Text -> Maybe PopUpLink
parsePopUpLink

parsePopUpLink :: Text -> Maybe PopUpLink
parsePopUpLink :: Text -> Maybe PopUpLink
parsePopUpLink = Parsec Void Text PopUpLink -> Text -> Maybe PopUpLink
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text PopUpLink
archiverLink
  where
    archiverLink :: Parser PopUpLink
    archiverLink :: Parsec Void Text PopUpLink
archiverLink = do
      Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"return popUp('"
      Text
url <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'')
      Text
_ <- ParsecT Void Text Identity Text
forall e s (m :: Type -> Type). MonadParsec e s m => m (Tokens s)
takeRest
      PopUpLink -> Parsec Void Text PopUpLink
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PopUpLink -> Parsec Void Text PopUpLink)
-> PopUpLink -> Parsec Void Text PopUpLink
forall a b. (a -> b) -> a -> b
$ Text -> PopUpLink
PopUpLink Text
url

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

_AverageRating :: Prism' Text AverageRating
_AverageRating :: p AverageRating (f AverageRating) -> p Text (f Text)
_AverageRating = (AverageRating -> Text)
-> (Text -> Maybe AverageRating)
-> Prism Text Text AverageRating AverageRating
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (String -> Text
pack (String -> Text)
-> (AverageRating -> String) -> AverageRating -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. Show a => a -> String
show (Float -> String)
-> (AverageRating -> Float) -> AverageRating -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AverageRating -> Float
unRating) Text -> Maybe AverageRating
parseAverageRating

parseAverageRating :: Text -> Maybe AverageRating
parseAverageRating :: Text -> Maybe AverageRating
parseAverageRating = Parsec Void Text AverageRating -> Text -> Maybe AverageRating
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text AverageRating
averageRating
  where
    averageRating :: Parser AverageRating
    averageRating :: Parsec Void Text AverageRating
averageRating = do
      Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"Average: "
      Float -> AverageRating
AverageRating (Float -> AverageRating)
-> ParsecT Void Text Identity Float
-> Parsec Void Text AverageRating
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Float
forall e s (m :: Type -> Type) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
float

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

_GalleryLength :: Prism' Text GalleryLength
_GalleryLength :: p GalleryLength (f GalleryLength) -> p Text (f Text)
_GalleryLength = (GalleryLength -> Text)
-> (Text -> Maybe GalleryLength)
-> Prism Text Text GalleryLength GalleryLength
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (String -> Text
pack (String -> Text)
-> (GalleryLength -> String) -> GalleryLength -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String)
-> (GalleryLength -> Int) -> GalleryLength -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GalleryLength -> Int
unGalleryLength) Text -> Maybe GalleryLength
parseGalleryLength

parseGalleryLength :: Text -> Maybe GalleryLength
parseGalleryLength :: Text -> Maybe GalleryLength
parseGalleryLength = Parsec Void Text GalleryLength -> Text -> Maybe GalleryLength
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text GalleryLength
galleryLength
  where
    galleryLength :: Parser GalleryLength
    galleryLength :: Parsec Void Text GalleryLength
galleryLength = do
      Int
d <- ParsecT Void Text Identity Int
forall e s (m :: Type -> Type) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
" pages"
      GalleryLength -> Parsec Void Text GalleryLength
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (GalleryLength -> Parsec Void Text GalleryLength)
-> GalleryLength -> Parsec Void Text GalleryLength
forall a b. (a -> b) -> a -> b
$ Int -> GalleryLength
GalleryLength Int
d

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

parseFavoriteCount :: Text -> Maybe FavoriteCount
parseFavoriteCount :: Text -> Maybe FavoriteCount
parseFavoriteCount = Parsec Void Text FavoriteCount -> Text -> Maybe FavoriteCount
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text FavoriteCount
favoriteCount
  where
    favoriteCount :: Parser FavoriteCount
    favoriteCount :: Parsec Void Text FavoriteCount
favoriteCount = do
      Int
d <- ParsecT Void Text Identity Int
forall e s (m :: Type -> Type) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
" times"
      FavoriteCount -> Parsec Void Text FavoriteCount
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (FavoriteCount -> Parsec Void Text FavoriteCount)
-> FavoriteCount -> Parsec Void Text FavoriteCount
forall a b. (a -> b) -> a -> b
$ Int -> FavoriteCount
FavoriteCount Int
d

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

_GalleryLink :: Prism' Text Gallery
_GalleryLink :: p Gallery (f Gallery) -> p Text (f Text)
_GalleryLink = (Gallery -> Text)
-> (Text -> Maybe Gallery) -> Prism Text Text Gallery Gallery
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Gallery -> Text
toGalleryLink Text -> Maybe Gallery
parseGalleryLink

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

toMpvLink :: Gallery -> Text
toMpvLink :: Gallery -> Text
toMpvLink Gallery {Int
Text
token :: Text
galleryId :: Int
$sel:token:Gallery :: Gallery -> Text
$sel:galleryId:Gallery :: Gallery -> 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
"/"

parseGalleryLink :: Text -> Maybe Gallery
parseGalleryLink :: Text -> Maybe Gallery
parseGalleryLink = Parsec Void Text Gallery -> Text -> Maybe Gallery
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text Gallery
galleryLink
  where
    galleryLink :: Parser Gallery
    galleryLink :: Parsec Void Text Gallery
galleryLink = do
      Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"https://exhentai.org/g/"
      Int
galleryId <- ParsecT Void Text Identity Int
forall e s (m :: Type -> Type) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'/'
      Text
token <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/')
      Maybe Char
_ <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity (Maybe Char))
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'/'
      Gallery -> Parsec Void Text Gallery
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Gallery :: Int -> Text -> Gallery
Gallery {Int
Text
token :: Text
galleryId :: Int
$sel:token:Gallery :: Text
$sel:galleryId:Gallery :: Int
..}

parsePreviewLink :: Text -> Maybe Text
parsePreviewLink :: Text -> Maybe Text
parsePreviewLink = ParsecT Void Text Identity Text -> Text -> Maybe Text
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe ParsecT Void Text Identity Text
previewLink
  where
    previewLink :: Parser Text
    previewLink :: ParsecT Void Text Identity Text
previewLink = do
      String
_ <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ do
        ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void Text Identity Text
urlOpening
        ParsecT Void Text Identity Char
forall e s (m :: Type -> Type). MonadParsec e s m => m (Token s)
anySingle
      Text
_ <- ParsecT Void Text Identity Text
urlOpening
      Text
url <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')')
      Text
_ <- ParsecT Void Text Identity Text
forall e s (m :: Type -> Type). MonadParsec e s m => m (Tokens s)
takeRest
      Text -> ParsecT Void Text Identity Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
url
    urlOpening :: Parser Text
    urlOpening :: ParsecT Void Text Identity Text
urlOpening = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"url("