{-# LANGUAGE StrictData #-}

module Web.Exhentai.Parsing.MPV where

import Control.Lens
import Data.Aeson
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import GHC.Generics
import Quickjs
import Text.XML.Lens
import Web.Exhentai.Utils

allScripts :: Traversal' Document Text
allScripts :: (Text -> f Text) -> Document -> f Document
allScripts = (Element -> f Element) -> Document -> f Document
Traversal' Document Element
body ((Element -> f Element) -> Document -> f Document)
-> Over (->) f Element Element Text Text
-> (Text -> f Text)
-> Document
-> f Document
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
scripts ((Element -> f Element) -> Element -> f Element)
-> Over (->) f Element Element Text Text
-> Over (->) f Element Element Text Text
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)
-> ((Text -> f Text) -> Node -> f Node)
-> Over (->) f Element Element Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Node -> f Node
Prism' Node Text
_Content

data MpvImage = MpvImage
  { MpvImage -> Text
name :: {-# UNPACK #-} Text,
    MpvImage -> Text
key :: {-# UNPACK #-} Text,
    MpvImage -> Text
thumbnail :: {-# UNPACK #-} Text
  }
  deriving (Int -> MpvImage -> ShowS
[MpvImage] -> ShowS
MpvImage -> String
(Int -> MpvImage -> ShowS)
-> (MpvImage -> String) -> ([MpvImage] -> ShowS) -> Show MpvImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MpvImage] -> ShowS
$cshowList :: [MpvImage] -> ShowS
show :: MpvImage -> String
$cshow :: MpvImage -> String
showsPrec :: Int -> MpvImage -> ShowS
$cshowsPrec :: Int -> MpvImage -> ShowS
Show, MpvImage -> MpvImage -> Bool
(MpvImage -> MpvImage -> Bool)
-> (MpvImage -> MpvImage -> Bool) -> Eq MpvImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MpvImage -> MpvImage -> Bool
$c/= :: MpvImage -> MpvImage -> Bool
== :: MpvImage -> MpvImage -> Bool
$c== :: MpvImage -> MpvImage -> Bool
Eq, (forall x. MpvImage -> Rep MpvImage x)
-> (forall x. Rep MpvImage x -> MpvImage) -> Generic MpvImage
forall x. Rep MpvImage x -> MpvImage
forall x. MpvImage -> Rep MpvImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MpvImage x -> MpvImage
$cfrom :: forall x. MpvImage -> Rep MpvImage x
Generic)

instance FromJSON MpvImage where
  parseJSON :: Value -> Parser MpvImage
parseJSON = String -> (Object -> Parser MpvImage) -> Value -> Parser MpvImage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"mpv image" ((Object -> Parser MpvImage) -> Value -> Parser MpvImage)
-> (Object -> Parser MpvImage) -> Value -> Parser MpvImage
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Text -> MpvImage
MpvImage
      (Text -> Text -> Text -> MpvImage)
-> Parser Text -> Parser (Text -> Text -> MpvImage)
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
"n"
      Parser (Text -> Text -> MpvImage)
-> Parser Text -> Parser (Text -> MpvImage)
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
"k"
      Parser (Text -> MpvImage) -> Parser Text -> Parser MpvImage
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
"t"

-- | All the variables defined in the scripts that came with the MPV
data Vars = Vars
  { Vars -> Int
gid :: {-# UNPACK #-} Int,
    Vars -> Text
mpvkey :: {-# UNPACK #-} Text,
    Vars -> Text
apiUrl :: {-# UNPACK #-} Text,
    Vars -> Int
pageCount :: {-# UNPACK #-} Int,
    Vars -> [MpvImage]
imageList :: [MpvImage]
  }
  deriving (Int -> Vars -> ShowS
[Vars] -> ShowS
Vars -> String
(Int -> Vars -> ShowS)
-> (Vars -> String) -> ([Vars] -> ShowS) -> Show Vars
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vars] -> ShowS
$cshowList :: [Vars] -> ShowS
show :: Vars -> String
$cshow :: Vars -> String
showsPrec :: Int -> Vars -> ShowS
$cshowsPrec :: Int -> Vars -> ShowS
Show, Vars -> Vars -> Bool
(Vars -> Vars -> Bool) -> (Vars -> Vars -> Bool) -> Eq Vars
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vars -> Vars -> Bool
$c/= :: Vars -> Vars -> Bool
== :: Vars -> Vars -> Bool
$c== :: Vars -> Vars -> Bool
Eq, (forall x. Vars -> Rep Vars x)
-> (forall x. Rep Vars x -> Vars) -> Generic Vars
forall x. Rep Vars x -> Vars
forall x. Vars -> Rep Vars x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Vars x -> Vars
$cfrom :: forall x. Vars -> Rep Vars x
Generic)

extractEnv :: Text -> IO (Result Vars)
extractEnv :: Text -> IO (Result Vars)
extractEnv Text
script = ReaderT (Ptr JSContext) IO (Result Vars) -> IO (Result Vars)
forall (m :: Type -> Type) b.
MonadIO m =>
ReaderT (Ptr JSContext) m b -> m b
quickjs (ReaderT (Ptr JSContext) IO (Result Vars) -> IO (Result Vars))
-> ReaderT (Ptr JSContext) IO (Result Vars) -> IO (Result Vars)
forall a b. (a -> b) -> a -> b
$ do
  ByteString -> ReaderT (Ptr JSContext) IO ()
forall (m :: Type -> Type).
(MonadThrow m, MonadReader (Ptr JSContext) m, MonadIO m) =>
ByteString -> m ()
eval_ (ByteString -> ReaderT (Ptr JSContext) IO ())
-> ByteString -> ReaderT (Ptr JSContext) IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
script
  Value
gid' <- ByteString -> ReaderT (Ptr JSContext) IO Value
forall (m :: Type -> Type).
(MonadMask m, MonadReader (Ptr JSContext) m, MonadIO m) =>
ByteString -> m Value
eval ByteString
"gid"
  Value
mpvkey' <- ByteString -> ReaderT (Ptr JSContext) IO Value
forall (m :: Type -> Type).
(MonadMask m, MonadReader (Ptr JSContext) m, MonadIO m) =>
ByteString -> m Value
eval ByteString
"mpvkey"
  Value
imageList' <- ByteString -> ReaderT (Ptr JSContext) IO Value
forall (m :: Type -> Type).
(MonadMask m, MonadReader (Ptr JSContext) m, MonadIO m) =>
ByteString -> m Value
eval ByteString
"imagelist"
  Value
apiUrl' <- ByteString -> ReaderT (Ptr JSContext) IO Value
forall (m :: Type -> Type).
(MonadMask m, MonadReader (Ptr JSContext) m, MonadIO m) =>
ByteString -> m Value
eval ByteString
"api_url"
  Value
pageCount' <- ByteString -> ReaderT (Ptr JSContext) IO Value
forall (m :: Type -> Type).
(MonadMask m, MonadReader (Ptr JSContext) m, MonadIO m) =>
ByteString -> m Value
eval ByteString
"pagecount"
  Result Vars -> ReaderT (Ptr JSContext) IO (Result Vars)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result Vars -> ReaderT (Ptr JSContext) IO (Result Vars))
-> Result Vars -> ReaderT (Ptr JSContext) IO (Result Vars)
forall a b. (a -> b) -> a -> b
$ do
    Int
gid <- Value -> Result Int
forall a. FromJSON a => Value -> Result a
fromJSON Value
gid'
    Text
mpvkey <- Value -> Result Text
forall a. FromJSON a => Value -> Result a
fromJSON Value
mpvkey'
    [MpvImage]
imageList <- Value -> Result [MpvImage]
forall a. FromJSON a => Value -> Result a
fromJSON Value
imageList'
    Text
apiUrl <- Value -> Result Text
forall a. FromJSON a => Value -> Result a
fromJSON Value
apiUrl'
    Int
pageCount <- Value -> Result Int
forall a. FromJSON a => Value -> Result a
fromJSON Value
pageCount'
    Vars -> Result Vars
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Vars :: Int -> Text -> Text -> Int -> [MpvImage] -> Vars
Vars {Int
[MpvImage]
Text
pageCount :: Int
apiUrl :: Text
imageList :: [MpvImage]
mpvkey :: Text
gid :: Int
$sel:imageList:Vars :: [MpvImage]
$sel:pageCount:Vars :: Int
$sel:apiUrl:Vars :: Text
$sel:mpvkey:Vars :: Text
$sel:gid:Vars :: Int
..}