{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Internal module. Extract values from mpv script
module Language.JavaScript.Extraction where

import Data.Aeson
import Data.ByteString.Lazy.Char8 (pack)
import Data.Maybe
import Data.Text (Text)
import Language.JavaScript.Parser.AST
import Optics.TH
import Text.Read
import Web.Exhentai.Utils hiding (div)
import Prelude hiding ((!!))

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)

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 -> 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)

class As a b where
  as :: a -> Maybe b

instance As JSExpression Int where
  as :: JSExpression -> Maybe Int
as (JSDecimal JSAnnot
_ String
s) = ByteString -> Maybe Int
forall a. FromJSON a => ByteString -> Maybe a
decode (String -> ByteString
pack String
s)
  as (JSExpressionBinary JSExpression
expr1 JSBinOp
op JSExpression
expr2) = do
    Int
i1 <- JSExpression -> Maybe Int
forall a b. As a b => a -> Maybe b
as JSExpression
expr1
    Int
i2 <- JSExpression -> Maybe Int
forall a b. As a b => a -> Maybe b
as JSExpression
expr2
    case JSBinOp
op of
      JSBinOpPlus {} -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i2
      JSBinOpMinus {} -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i2
      JSBinOpTimes {} -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i2
      JSBinOpDivide {} -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
i1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
i2
      JSBinOp
_ -> Maybe Int
forall a. Maybe a
Nothing
  as (JSUnaryExpression JSUnaryOp
op JSExpression
expr) = do
    Int
i <- JSExpression -> Maybe Int
forall a b. As a b => a -> Maybe b
as JSExpression
expr
    case JSUnaryOp
op of
      JSUnaryOpIncr {} -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      JSUnaryOpDecr {} -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      JSUnaryOpMinus {} -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ - Int
i
      JSUnaryOpPlus {} -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
i
      JSUnaryOp
_ -> Maybe Int
forall a. Maybe a
Nothing
  as (JSVarInitExpression JSExpression
_ JSVarInitializer
initializer) = JSVarInitializer -> Maybe Int
forall a b. As a b => a -> Maybe b
as JSVarInitializer
initializer
  as JSExpression
_ = Maybe Int
forall a. Maybe a
Nothing

instance As JSExpression a => As JSVarInitializer a where
  as :: JSVarInitializer -> Maybe a
as (JSVarInit JSAnnot
_ JSExpression
expr) = JSExpression -> Maybe a
forall a b. As a b => a -> Maybe b
as JSExpression
expr
  as JSVarInitializer
_ = Maybe a
forall a. Maybe a
Nothing

instance As (JSCommaList JSExpression) a => As JSStatement a where
  as :: JSStatement -> Maybe a
as (JSVariable JSAnnot
_ JSCommaList JSExpression
l JSSemi
_) = JSCommaList JSExpression -> Maybe a
forall a b. As a b => a -> Maybe b
as JSCommaList JSExpression
l
  as JSStatement
_ = Maybe a
forall a. Maybe a
Nothing

instance {-# OVERLAPPABLE #-} As a b => As (JSCommaList a) b where
  as :: JSCommaList a -> Maybe b
as (JSLOne a
x) = a -> Maybe b
forall a b. As a b => a -> Maybe b
as a
x
  as (JSLCons JSCommaList a
_ JSAnnot
_ a
x) = a -> Maybe b
forall a b. As a b => a -> Maybe b
as a
x
  as JSCommaList a
_ = Maybe b
forall a. Maybe a
Nothing

instance As JSExpression Text where
  as :: JSExpression -> Maybe Text
as (JSStringLiteral JSAnnot
_ String
s) = ByteString -> Maybe Text
forall a. FromJSON a => ByteString -> Maybe a
decode (String -> ByteString
pack String
s)
  as (JSVarInitExpression JSExpression
_ JSVarInitializer
initializer) = JSVarInitializer -> Maybe Text
forall a b. As a b => a -> Maybe b
as JSVarInitializer
initializer
  as JSExpression
_ = Maybe Text
forall a. Maybe a
Nothing

instance As JSPropertyName Text where
  as :: JSPropertyName -> Maybe Text
as (JSPropertyString JSAnnot
_ String
s) = String -> Maybe Text
forall a. Read a => String -> Maybe a
readMaybe String
s
  as JSPropertyName
_ = Maybe Text
forall a. Maybe a
Nothing

instance As JSArrayElement a => As JSExpression [a] where
  as :: JSExpression -> Maybe [a]
as (JSArrayLiteral JSAnnot
_ [JSArrayElement]
l JSAnnot
_) = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ (JSArrayElement -> Maybe a) -> [JSArrayElement] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe JSArrayElement -> Maybe a
forall a b. As a b => a -> Maybe b
as [JSArrayElement]
l
  as (JSVarInitExpression JSExpression
_ JSVarInitializer
initializer) = JSVarInitializer -> Maybe [a]
forall a b. As a b => a -> Maybe b
as JSVarInitializer
initializer
  as JSExpression
_ = Maybe [a]
forall a. Maybe a
Nothing

instance As JSExpression a => As JSArrayElement a where
  as :: JSArrayElement -> Maybe a
as (JSArrayElement JSExpression
expr) = JSExpression -> Maybe a
forall a b. As a b => a -> Maybe b
as JSExpression
expr
  as (JSArrayComma JSAnnot
_) = Maybe a
forall a. Maybe a
Nothing

class AsPair a where
  asPair :: a -> Maybe (Text, Text)

instance AsPair JSObjectProperty where
  asPair :: JSObjectProperty -> Maybe (Text, Text)
asPair (JSPropertyNameandValue JSPropertyName
n JSAnnot
_ [JSExpression
expr]) = (,) (Text -> Text -> (Text, Text))
-> Maybe Text -> Maybe (Text -> (Text, Text))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> JSPropertyName -> Maybe Text
forall a b. As a b => a -> Maybe b
as JSPropertyName
n Maybe (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> JSExpression -> Maybe Text
forall a b. As a b => a -> Maybe b
as JSExpression
expr
  asPair JSObjectProperty
_ = Maybe (Text, Text)
forall a. Maybe a
Nothing

instance As (JSCommaList JSObjectProperty) [(Text, Text)] where
  as :: JSCommaList JSObjectProperty -> Maybe [(Text, Text)]
as (JSLCons JSCommaList JSObjectProperty
xs JSAnnot
_ JSObjectProperty
p) = (:) ((Text, Text) -> [(Text, Text)] -> [(Text, Text)])
-> Maybe (Text, Text) -> Maybe ([(Text, Text)] -> [(Text, Text)])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> JSObjectProperty -> Maybe (Text, Text)
forall a. AsPair a => a -> Maybe (Text, Text)
asPair JSObjectProperty
p Maybe ([(Text, Text)] -> [(Text, Text)])
-> Maybe [(Text, Text)] -> Maybe [(Text, Text)]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> JSCommaList JSObjectProperty -> Maybe [(Text, Text)]
forall a b. As a b => a -> Maybe b
as JSCommaList JSObjectProperty
xs
  as (JSLOne JSObjectProperty
p) = (Text, Text) -> [(Text, Text)]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text, Text) -> [(Text, Text)])
-> Maybe (Text, Text) -> Maybe [(Text, Text)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> JSObjectProperty -> Maybe (Text, Text)
forall a. AsPair a => a -> Maybe (Text, Text)
asPair JSObjectProperty
p
  as JSCommaList JSObjectProperty
JSLNil = [(Text, Text)] -> Maybe [(Text, Text)]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []

instance {-# OVERLAPPABLE #-} As (JSCommaList a) b => As (JSCommaTrailingList a) b where
  as :: JSCommaTrailingList a -> Maybe b
as (JSCTLComma JSCommaList a
l JSAnnot
_) = JSCommaList a -> Maybe b
forall a b. As a b => a -> Maybe b
as JSCommaList a
l
  as (JSCTLNone JSCommaList a
l) = JSCommaList a -> Maybe b
forall a b. As a b => a -> Maybe b
as JSCommaList a
l

instance As JSObjectPropertyList MpvImage where
  as :: JSObjectPropertyList -> Maybe MpvImage
as JSObjectPropertyList
l = do
    [(Text, Text)]
mapping <- (JSObjectPropertyList -> Maybe [(Text, Text)]
forall a b. As a b => a -> Maybe b
as JSObjectPropertyList
l :: Maybe [(Text, Text)])
    Text
thumbnail <- Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"t" [(Text, Text)]
mapping
    Text
key <- Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"k" [(Text, Text)]
mapping
    Text
name <- Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"n" [(Text, Text)]
mapping
    MpvImage -> Maybe MpvImage
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure MpvImage :: Text -> Text -> Text -> MpvImage
MpvImage {Text
name :: Text
key :: Text
thumbnail :: Text
$sel:thumbnail:MpvImage :: Text
$sel:key:MpvImage :: Text
$sel:name:MpvImage :: Text
..}

instance As JSExpression MpvImage where
  as :: JSExpression -> Maybe MpvImage
as (JSObjectLiteral JSAnnot
_ JSObjectPropertyList
l JSAnnot
_) = JSObjectPropertyList -> Maybe MpvImage
forall a b. As a b => a -> Maybe b
as JSObjectPropertyList
l
  as JSExpression
_ = Maybe MpvImage
forall a. Maybe a
Nothing

instance As JSAST Vars where
  as :: JSAST -> Maybe Vars
as (JSAstProgram [JSStatement]
stmts JSAnnot
_) = do
    JSStatement
gidStmt <- [JSStatement]
stmts [JSStatement] -> Int -> Maybe JSStatement
forall a. [a] -> Int -> Maybe a
!! Int
1
    Int
gid <- JSStatement -> Maybe Int
forall a b. As a b => a -> Maybe b
as JSStatement
gidStmt
    JSStatement
imgStmt <- [JSStatement]
stmts [JSStatement] -> Int -> Maybe JSStatement
forall a. [a] -> Int -> Maybe a
!! Int
3
    [MpvImage]
imageList <- JSStatement -> Maybe [MpvImage]
forall a b. As a b => a -> Maybe b
as JSStatement
imgStmt
    JSStatement
keyStmt <- [JSStatement]
stmts [JSStatement] -> Int -> Maybe JSStatement
forall a. [a] -> Int -> Maybe a
!! Int
2
    Text
mpvkey <- JSStatement -> Maybe Text
forall a b. As a b => a -> Maybe b
as JSStatement
keyStmt
    JSStatement
pgCountStmt <- [JSStatement]
stmts [JSStatement] -> Int -> Maybe JSStatement
forall a. [a] -> Int -> Maybe a
!! Int
9
    Int
pageCount <- JSStatement -> Maybe Int
forall a b. As a b => a -> Maybe b
as JSStatement
pgCountStmt
    Vars -> Maybe Vars
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Vars :: Int -> Text -> Int -> [MpvImage] -> Vars
Vars {Int
[MpvImage]
Text
pageCount :: Int
mpvkey :: Text
imageList :: [MpvImage]
gid :: Int
$sel:imageList:Vars :: [MpvImage]
$sel:pageCount:Vars :: Int
$sel:mpvkey:Vars :: Text
$sel:gid:Vars :: Int
..}
  as JSAST
_ = Maybe Vars
forall a. Maybe a
Nothing

makeFieldLabelsWith noPrefixFieldLabels ''Vars
makeFieldLabelsWith noPrefixFieldLabels ''MpvImage

{-
extractEnv :: Text -> IO (Result Vars)
extractEnv script = quickjs $ do
  eval_ $ encodeUtf8 script
  gid' <- eval "gid"
  mpvkey' <- eval "mpvkey"
  imageList' <- eval "imagelist"
  pageCount' <- eval "pagecount"
  pure $ do
    gid <- fromJSON gid'
    mpvkey <- fromJSON mpvkey'
    imageList <- fromJSON imageList'
    pageCount <- fromJSON pageCount'
    pure Vars {..}
-}