{-# 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 { name :: {-# UNPACK #-} Text, key :: {-# UNPACK #-} Text, thumbnail :: {-# UNPACK #-} Text } deriving (Show, Eq) instance FromJSON MpvImage where parseJSON = withObject "mpv image" $ \o -> MpvImage <$> o .: "n" <*> o .: "k" <*> o .: "t" -- | All the variables defined in the scripts that came with the MPV data Vars = Vars { gid :: {-# UNPACK #-} Int, mpvkey :: {-# UNPACK #-} Text, pageCount :: {-# UNPACK #-} Int, imageList :: [MpvImage] } deriving (Show, Eq) class As a b where as :: a -> Maybe b instance As JSExpression Int where as (JSDecimal _ s) = decode (pack s) as (JSExpressionBinary expr1 op expr2) = do i1 <- as expr1 i2 <- as expr2 case op of JSBinOpPlus {} -> pure $ i1 + i2 JSBinOpMinus {} -> pure $ i1 - i2 JSBinOpTimes {} -> pure $ i1 * i2 JSBinOpDivide {} -> pure $ i1 `div` i2 _ -> Nothing as (JSUnaryExpression op expr) = do i <- as expr case op of JSUnaryOpIncr {} -> pure $ i + 1 JSUnaryOpDecr {} -> pure $ i - 1 JSUnaryOpMinus {} -> pure $ - i JSUnaryOpPlus {} -> pure i _ -> Nothing as (JSVarInitExpression _ initializer) = as initializer as _ = Nothing instance As JSExpression a => As JSVarInitializer a where as (JSVarInit _ expr) = as expr as _ = Nothing instance As (JSCommaList JSExpression) a => As JSStatement a where as (JSVariable _ l _) = as l as _ = Nothing instance {-# OVERLAPPABLE #-} As a b => As (JSCommaList a) b where as (JSLOne x) = as x as (JSLCons _ _ x) = as x as _ = Nothing instance As JSExpression Text where as (JSStringLiteral _ s) = decode (pack s) as (JSVarInitExpression _ initializer) = as initializer as _ = Nothing instance As JSPropertyName Text where as (JSPropertyString _ s) = readMaybe s as _ = Nothing instance As JSArrayElement a => As JSExpression [a] where as (JSArrayLiteral _ l _) = Just $ mapMaybe as l as (JSVarInitExpression _ initializer) = as initializer as _ = Nothing instance As JSExpression a => As JSArrayElement a where as (JSArrayElement expr) = as expr as (JSArrayComma _) = Nothing class AsPair a where asPair :: a -> Maybe (Text, Text) instance AsPair JSObjectProperty where asPair (JSPropertyNameandValue n _ [expr]) = (,) <$> as n <*> as expr asPair _ = Nothing instance As (JSCommaList JSObjectProperty) [(Text, Text)] where as (JSLCons xs _ p) = (:) <$> asPair p <*> as xs as (JSLOne p) = pure <$> asPair p as JSLNil = pure [] instance {-# OVERLAPPABLE #-} As (JSCommaList a) b => As (JSCommaTrailingList a) b where as (JSCTLComma l _) = as l as (JSCTLNone l) = as l instance As JSObjectPropertyList MpvImage where as l = do mapping <- (as l :: Maybe [(Text, Text)]) thumbnail <- lookup "t" mapping key <- lookup "k" mapping name <- lookup "n" mapping pure MpvImage {..} instance As JSExpression MpvImage where as (JSObjectLiteral _ l _) = as l as _ = Nothing instance As JSAST Vars where as (JSAstProgram stmts _) = do gidStmt <- stmts !! 1 gid <- as gidStmt imgStmt <- stmts !! 3 imageList <- as imgStmt keyStmt <- stmts !! 2 mpvkey <- as keyStmt pgCountStmt <- stmts !! 9 pageCount <- as pgCountStmt pure Vars {..} as _ = 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 {..} -}