{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
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"
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