{-# LANGUAGE CPP, FlexibleInstances #-}
module Language.JavaScript.Process.Minify
(
minifyJS
) where
#if ! MIN_VERSION_base(4,13,0)
import Control.Applicative ((<$>))
#endif
import Language.JavaScript.Parser.AST
import Language.JavaScript.Parser.SrcLocation
import Language.JavaScript.Parser.Token
minifyJS :: JSAST -> JSAST
minifyJS :: JSAST -> JSAST
minifyJS (JSAstProgram xs :: [JSStatement]
xs _) = [JSStatement] -> JSAnnot -> JSAST
JSAstProgram (JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList JSSemi
noSemi [JSStatement]
xs) JSAnnot
emptyAnnot
minifyJS (JSAstModule xs :: [JSModuleItem]
xs _) = [JSModuleItem] -> JSAnnot -> JSAST
JSAstModule ((JSModuleItem -> JSModuleItem) -> [JSModuleItem] -> [JSModuleItem]
forall a b. (a -> b) -> [a] -> [b]
map (JSAnnot -> JSModuleItem -> JSModuleItem
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
emptyAnnot) [JSModuleItem]
xs) JSAnnot
emptyAnnot
minifyJS (JSAstStatement (JSStatementBlock _ [s :: JSStatement
s] _ _) _) = JSStatement -> JSAnnot -> JSAST
JSAstStatement (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
noSemi JSStatement
s) JSAnnot
emptyAnnot
minifyJS (JSAstStatement s :: JSStatement
s _) = JSStatement -> JSAnnot -> JSAST
JSAstStatement (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
noSemi JSStatement
s) JSAnnot
emptyAnnot
minifyJS (JSAstExpression e :: JSExpression
e _) = JSExpression -> JSAnnot -> JSAST
JSAstExpression (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot
minifyJS (JSAstLiteral s :: JSExpression
s _) = JSExpression -> JSAnnot -> JSAST
JSAstLiteral (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
s) JSAnnot
emptyAnnot
class MinifyJS a where
fix :: JSAnnot -> a -> a
fixEmpty :: MinifyJS a => a -> a
fixEmpty :: a -> a
fixEmpty = JSAnnot -> a -> a
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
emptyAnnot
fixSpace :: MinifyJS a => a -> a
fixSpace :: a -> a
fixSpace = JSAnnot -> a -> a
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
spaceAnnot
fixStmt :: JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt :: JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSStatementBlock _lb :: JSAnnot
_lb ss :: [JSStatement]
ss _rb :: JSAnnot
_rb _) = JSAnnot -> JSSemi -> [JSStatement] -> JSStatement
fixStatementBlock JSAnnot
a JSSemi
s [JSStatement]
ss
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSBreak _ i :: JSIdent
i _) = JSAnnot -> JSIdent -> JSSemi -> JSStatement
JSBreak JSAnnot
a (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
i) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSClass _ n :: JSIdent
n h :: JSClassHeritage
h _ ms :: [JSClassElement]
ms _ _) = JSAnnot
-> JSIdent
-> JSClassHeritage
-> JSAnnot
-> [JSClassElement]
-> JSAnnot
-> JSSemi
-> JSStatement
JSClass JSAnnot
a (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
n) (JSClassHeritage -> JSClassHeritage
forall a. MinifyJS a => a -> a
fixSpace JSClassHeritage
h) JSAnnot
emptyAnnot ([JSClassElement] -> [JSClassElement]
forall a. MinifyJS a => a -> a
fixEmpty [JSClassElement]
ms) JSAnnot
emptyAnnot JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSConstant _ ss :: JSCommaList JSExpression
ss _) = JSAnnot -> JSCommaList JSExpression -> JSSemi -> JSStatement
JSConstant JSAnnot
a (JSCommaList JSExpression -> JSCommaList JSExpression
fixVarList JSCommaList JSExpression
ss) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSContinue _ i :: JSIdent
i _) = JSAnnot -> JSIdent -> JSSemi -> JSStatement
JSContinue JSAnnot
a (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
i) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSDoWhile _ st :: JSStatement
st _ _ e :: JSExpression
e _ _) = JSAnnot
-> JSStatement
-> JSAnnot
-> JSAnnot
-> JSExpression
-> JSAnnot
-> JSSemi
-> JSStatement
JSDoWhile JSAnnot
a (JSSemi -> JSStatement -> JSStatement
mkStatementBlock JSSemi
noSemi JSStatement
st) JSAnnot
emptyAnnot JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSFor _ _ el1 :: JSCommaList JSExpression
el1 _ el2 :: JSCommaList JSExpression
el2 _ el3 :: JSCommaList JSExpression
el3 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSFor JSAnnot
a JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el1) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el2) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el3) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForIn _ _ e1 :: JSExpression
e1 op :: JSBinOp
op e2 :: JSExpression
e2 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSExpression
-> JSBinOp
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForIn JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e1) (JSBinOp -> JSBinOp
forall a. MinifyJS a => a -> a
fixSpace JSBinOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e2) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForVar _ _ _ el1 :: JSCommaList JSExpression
el1 _ el2 :: JSCommaList JSExpression
el2 _ el3 :: JSCommaList JSExpression
el3 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForVar JSAnnot
a JSAnnot
emptyAnnot JSAnnot
spaceAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el1) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el2) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el3) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForVarIn _ _ _ e1 :: JSExpression
e1 op :: JSBinOp
op e2 :: JSExpression
e2 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSAnnot
-> JSExpression
-> JSBinOp
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForVarIn JSAnnot
a JSAnnot
emptyAnnot JSAnnot
spaceAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e1) (JSBinOp -> JSBinOp
forall a. MinifyJS a => a -> a
fixSpace JSBinOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e2) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForLet _ _ _ el1 :: JSCommaList JSExpression
el1 _ el2 :: JSCommaList JSExpression
el2 _ el3 :: JSCommaList JSExpression
el3 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForLet JSAnnot
a JSAnnot
emptyAnnot JSAnnot
spaceAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el1) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el2) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el3) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForLetIn _ _ _ e1 :: JSExpression
e1 op :: JSBinOp
op e2 :: JSExpression
e2 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSAnnot
-> JSExpression
-> JSBinOp
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForLetIn JSAnnot
a JSAnnot
emptyAnnot JSAnnot
spaceAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e1) (JSBinOp -> JSBinOp
forall a. MinifyJS a => a -> a
fixSpace JSBinOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e2) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForLetOf _ _ _ e1 :: JSExpression
e1 op :: JSBinOp
op e2 :: JSExpression
e2 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSAnnot
-> JSExpression
-> JSBinOp
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForLetOf JSAnnot
a JSAnnot
emptyAnnot JSAnnot
spaceAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e1) (JSBinOp -> JSBinOp
forall a. MinifyJS a => a -> a
fixSpace JSBinOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e2) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForConst _ _ _ el1 :: JSCommaList JSExpression
el1 _ el2 :: JSCommaList JSExpression
el2 _ el3 :: JSCommaList JSExpression
el3 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForConst JSAnnot
a JSAnnot
emptyAnnot JSAnnot
spaceAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el1) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el2) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
el3) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForConstIn _ _ _ e1 :: JSExpression
e1 op :: JSBinOp
op e2 :: JSExpression
e2 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSAnnot
-> JSExpression
-> JSBinOp
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForConstIn JSAnnot
a JSAnnot
emptyAnnot JSAnnot
spaceAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e1) (JSBinOp -> JSBinOp
forall a. MinifyJS a => a -> a
fixSpace JSBinOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e2) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForConstOf _ _ _ e1 :: JSExpression
e1 op :: JSBinOp
op e2 :: JSExpression
e2 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSAnnot
-> JSExpression
-> JSBinOp
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForConstOf JSAnnot
a JSAnnot
emptyAnnot JSAnnot
spaceAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e1) (JSBinOp -> JSBinOp
forall a. MinifyJS a => a -> a
fixSpace JSBinOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e2) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForOf _ _ e1 :: JSExpression
e1 op :: JSBinOp
op e2 :: JSExpression
e2 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSExpression
-> JSBinOp
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForOf JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e1) (JSBinOp -> JSBinOp
forall a. MinifyJS a => a -> a
fixSpace JSBinOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e2) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSForVarOf _ _ _ e1 :: JSExpression
e1 op :: JSBinOp
op e2 :: JSExpression
e2 _ st :: JSStatement
st) = JSAnnot
-> JSAnnot
-> JSAnnot
-> JSExpression
-> JSBinOp
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSStatement
JSForVarOf JSAnnot
a JSAnnot
emptyAnnot JSAnnot
spaceAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e1) (JSBinOp -> JSBinOp
forall a. MinifyJS a => a -> a
fixSpace JSBinOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e2) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSAsyncFunction _ _ n :: JSIdent
n _ ps :: JSCommaList JSExpression
ps _ blk :: JSBlock
blk _) = JSAnnot
-> JSAnnot
-> JSIdent
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSSemi
-> JSStatement
JSAsyncFunction JSAnnot
a JSAnnot
spaceAnnot (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
n) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
ps) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
blk) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSFunction _ n :: JSIdent
n _ ps :: JSCommaList JSExpression
ps _ blk :: JSBlock
blk _) = JSAnnot
-> JSIdent
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSSemi
-> JSStatement
JSFunction JSAnnot
a (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
n) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
ps) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
blk) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSGenerator _ _ n :: JSIdent
n _ ps :: JSCommaList JSExpression
ps _ blk :: JSBlock
blk _) = JSAnnot
-> JSAnnot
-> JSIdent
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSSemi
-> JSStatement
JSGenerator JSAnnot
a JSAnnot
emptyAnnot (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
n) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
ps) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
blk) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSIf _ _ e :: JSExpression
e _ st :: JSStatement
st) = JSAnnot
-> JSAnnot -> JSExpression -> JSAnnot -> JSStatement -> JSStatement
JSIf JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot (JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixIfElseBlock JSAnnot
emptyAnnot JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSIfElse _ _ e :: JSExpression
e _ (JSEmptyStatement _) _ sf :: JSStatement
sf) = JSAnnot
-> JSAnnot
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSAnnot
-> JSStatement
-> JSStatement
JSIfElse JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot (JSAnnot -> JSStatement
JSEmptyStatement JSAnnot
emptyAnnot) JSAnnot
emptyAnnot (JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
spaceAnnot JSSemi
s JSStatement
sf)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSIfElse _ _ e :: JSExpression
e _ st :: JSStatement
st _ sf :: JSStatement
sf) = JSAnnot
-> JSAnnot
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSAnnot
-> JSStatement
-> JSStatement
JSIfElse JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
mkStatementBlock JSSemi
noSemi JSStatement
st) JSAnnot
emptyAnnot (JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixIfElseBlock JSAnnot
spaceAnnot JSSemi
s JSStatement
sf)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSLabelled e :: JSIdent
e _ st :: JSStatement
st) = JSIdent -> JSAnnot -> JSStatement -> JSStatement
JSLabelled (JSAnnot -> JSIdent -> JSIdent
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSIdent
e) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSLet _ xs :: JSCommaList JSExpression
xs _) = JSAnnot -> JSCommaList JSExpression -> JSSemi -> JSStatement
JSLet JSAnnot
a (JSCommaList JSExpression -> JSCommaList JSExpression
fixVarList JSCommaList JSExpression
xs) JSSemi
s
fixStmt _ _ (JSEmptyStatement _) = JSAnnot -> JSStatement
JSEmptyStatement JSAnnot
emptyAnnot
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSExpressionStatement e :: JSExpression
e _) = JSExpression -> JSSemi -> JSStatement
JSExpressionStatement (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
e) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSAssignStatement lhs :: JSExpression
lhs op :: JSAssignOp
op rhs :: JSExpression
rhs _) = JSExpression -> JSAssignOp -> JSExpression -> JSSemi -> JSStatement
JSAssignStatement (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
lhs) (JSAssignOp -> JSAssignOp
forall a. MinifyJS a => a -> a
fixEmpty JSAssignOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
rhs) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSMethodCall e :: JSExpression
e _ args :: JSCommaList JSExpression
args _ _) = JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSSemi
-> JSStatement
JSMethodCall (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
e) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
args) JSAnnot
emptyAnnot JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSReturn _ me :: Maybe JSExpression
me _) = JSAnnot -> Maybe JSExpression -> JSSemi -> JSStatement
JSReturn JSAnnot
a (Maybe JSExpression -> Maybe JSExpression
forall a. MinifyJS a => a -> a
fixSpace Maybe JSExpression
me) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSSwitch _ _ e :: JSExpression
e _ _ sps :: [JSSwitchParts]
sps _ _) = JSAnnot
-> JSAnnot
-> JSExpression
-> JSAnnot
-> JSAnnot
-> [JSSwitchParts]
-> JSAnnot
-> JSSemi
-> JSStatement
JSSwitch JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot JSAnnot
emptyAnnot ([JSSwitchParts] -> [JSSwitchParts]
fixSwitchParts [JSSwitchParts]
sps) JSAnnot
emptyAnnot JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSThrow _ e :: JSExpression
e _) = JSAnnot -> JSExpression -> JSSemi -> JSStatement
JSThrow JSAnnot
a (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e) JSSemi
s
fixStmt a :: JSAnnot
a _ (JSTry _ b :: JSBlock
b tc :: [JSTryCatch]
tc tf :: JSTryFinally
tf) = JSAnnot -> JSBlock -> [JSTryCatch] -> JSTryFinally -> JSStatement
JSTry JSAnnot
a (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
b) ((JSTryCatch -> JSTryCatch) -> [JSTryCatch] -> [JSTryCatch]
forall a b. (a -> b) -> [a] -> [b]
map JSTryCatch -> JSTryCatch
forall a. MinifyJS a => a -> a
fixEmpty [JSTryCatch]
tc) (JSTryFinally -> JSTryFinally
forall a. MinifyJS a => a -> a
fixEmpty JSTryFinally
tf)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSVariable _ ss :: JSCommaList JSExpression
ss _) = JSAnnot -> JSCommaList JSExpression -> JSSemi -> JSStatement
JSVariable JSAnnot
a (JSCommaList JSExpression -> JSCommaList JSExpression
fixVarList JSCommaList JSExpression
ss) JSSemi
s
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSWhile _ _ e :: JSExpression
e _ st :: JSStatement
st) = JSAnnot
-> JSAnnot -> JSExpression -> JSAnnot -> JSStatement -> JSStatement
JSWhile JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot (JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
s JSStatement
st)
fixStmt a :: JSAnnot
a s :: JSSemi
s (JSWith _ _ e :: JSExpression
e _ st :: JSStatement
st _) = JSAnnot
-> JSAnnot
-> JSExpression
-> JSAnnot
-> JSStatement
-> JSSemi
-> JSStatement
JSWith JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
noSemi JSStatement
st) JSSemi
s
fixIfElseBlock :: JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixIfElseBlock :: JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixIfElseBlock _ _ (JSStatementBlock _ [] _ _) = JSAnnot -> JSStatement
JSEmptyStatement JSAnnot
emptyAnnot
fixIfElseBlock a :: JSAnnot
a s :: JSSemi
s st :: JSStatement
st = JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
s JSStatement
st
fixStmtE :: JSSemi -> JSStatement -> JSStatement
fixStmtE :: JSSemi -> JSStatement -> JSStatement
fixStmtE = JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
emptyAnnot
mkStatementBlock :: JSSemi -> JSStatement -> JSStatement
mkStatementBlock :: JSSemi -> JSStatement -> JSStatement
mkStatementBlock s :: JSSemi
s (JSStatementBlock _ blk :: [JSStatement]
blk _ _) = JSAnnot -> [JSStatement] -> JSAnnot -> JSSemi -> JSStatement
JSStatementBlock JSAnnot
emptyAnnot (JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList JSSemi
noSemi [JSStatement]
blk) JSAnnot
emptyAnnot JSSemi
s
mkStatementBlock s :: JSSemi
s x :: JSStatement
x = JSAnnot -> [JSStatement] -> JSAnnot -> JSSemi -> JSStatement
JSStatementBlock JSAnnot
emptyAnnot [JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
noSemi JSStatement
x] JSAnnot
emptyAnnot JSSemi
s
fixStatementBlock :: JSAnnot -> JSSemi -> [JSStatement] -> JSStatement
fixStatementBlock :: JSAnnot -> JSSemi -> [JSStatement] -> JSStatement
fixStatementBlock a :: JSAnnot
a s :: JSSemi
s ss :: [JSStatement]
ss =
case (JSStatement -> Bool) -> [JSStatement] -> [JSStatement]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (JSStatement -> Bool) -> JSStatement -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSStatement -> Bool
isEmpty) [JSStatement]
ss of
[] -> JSAnnot -> [JSStatement] -> JSAnnot -> JSSemi -> JSStatement
JSStatementBlock JSAnnot
emptyAnnot [] JSAnnot
emptyAnnot JSSemi
s
[sx :: JSStatement
sx] -> JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
s JSStatement
sx
sss :: [JSStatement]
sss -> JSAnnot -> [JSStatement] -> JSAnnot -> JSSemi -> JSStatement
JSStatementBlock JSAnnot
emptyAnnot (JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList JSSemi
noSemi [JSStatement]
sss) JSAnnot
emptyAnnot JSSemi
s
where
isEmpty :: JSStatement -> Bool
isEmpty (JSEmptyStatement _) = Bool
True
isEmpty (JSStatementBlock _ [] _ _) = Bool
True
isEmpty _ = Bool
False
fixStatementList :: JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList :: JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList trailingSemi :: JSSemi
trailingSemi =
JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
emptyAnnot JSSemi
trailingSemi ([JSStatement] -> [JSStatement])
-> ([JSStatement] -> [JSStatement])
-> [JSStatement]
-> [JSStatement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSStatement -> Bool) -> [JSStatement] -> [JSStatement]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (JSStatement -> Bool) -> JSStatement -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSStatement -> Bool
isRedundant)
where
isRedundant :: JSStatement -> Bool
isRedundant (JSStatementBlock _ [] _ _) = Bool
True
isRedundant (JSEmptyStatement _) = Bool
True
isRedundant _ = Bool
False
fixList :: JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList _ _ [] = []
fixList a :: JSAnnot
a s :: JSSemi
s [JSStatementBlock _ blk :: [JSStatement]
blk _ _] = JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
a JSSemi
s [JSStatement]
blk
fixList a :: JSAnnot
a s :: JSSemi
s [x :: JSStatement
x] = [JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
s JSStatement
x]
fixList _ s :: JSSemi
s (JSStatementBlock _ blk :: [JSStatement]
blk _ _:xs :: [JSStatement]
xs) = JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
emptyAnnot JSSemi
semi ((JSStatement -> Bool) -> [JSStatement] -> [JSStatement]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (JSStatement -> Bool) -> JSStatement -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSStatement -> Bool
isRedundant) [JSStatement]
blk) [JSStatement] -> [JSStatement] -> [JSStatement]
forall a. [a] -> [a] -> [a]
++ JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
emptyAnnot JSSemi
s [JSStatement]
xs
fixList a :: JSAnnot
a s :: JSSemi
s (JSConstant _ vs1 :: JSCommaList JSExpression
vs1 _:JSConstant _ vs2 :: JSCommaList JSExpression
vs2 _: xs :: [JSStatement]
xs) = JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
a JSSemi
s (JSAnnot -> JSCommaList JSExpression -> JSSemi -> JSStatement
JSConstant JSAnnot
spaceAnnot (JSCommaList JSExpression
-> JSCommaList JSExpression -> JSCommaList JSExpression
forall a. JSCommaList a -> JSCommaList a -> JSCommaList a
concatCommaList JSCommaList JSExpression
vs1 JSCommaList JSExpression
vs2) JSSemi
s JSStatement -> [JSStatement] -> [JSStatement]
forall a. a -> [a] -> [a]
: [JSStatement]
xs)
fixList a :: JSAnnot
a s :: JSSemi
s (JSVariable _ vs1 :: JSCommaList JSExpression
vs1 _:JSVariable _ vs2 :: JSCommaList JSExpression
vs2 _: xs :: [JSStatement]
xs) = JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
a JSSemi
s (JSAnnot -> JSCommaList JSExpression -> JSSemi -> JSStatement
JSVariable JSAnnot
spaceAnnot (JSCommaList JSExpression
-> JSCommaList JSExpression -> JSCommaList JSExpression
forall a. JSCommaList a -> JSCommaList a -> JSCommaList a
concatCommaList JSCommaList JSExpression
vs1 JSCommaList JSExpression
vs2) JSSemi
s JSStatement -> [JSStatement] -> [JSStatement]
forall a. a -> [a] -> [a]
: [JSStatement]
xs)
fixList a :: JSAnnot
a s :: JSSemi
s (x1 :: JSStatement
x1@JSFunction{}:x2 :: JSStatement
x2@JSFunction{}:xs :: [JSStatement]
xs) = JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
noSemi JSStatement
x1 JSStatement -> [JSStatement] -> [JSStatement]
forall a. a -> [a] -> [a]
: JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
newlineAnnot JSSemi
s (JSStatement
x2JSStatement -> [JSStatement] -> [JSStatement]
forall a. a -> [a] -> [a]
:[JSStatement]
xs)
fixList a :: JSAnnot
a s :: JSSemi
s (x :: JSStatement
x:xs :: [JSStatement]
xs) = JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
semi JSStatement
x JSStatement -> [JSStatement] -> [JSStatement]
forall a. a -> [a] -> [a]
: JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
emptyAnnot JSSemi
s [JSStatement]
xs
concatCommaList :: JSCommaList a -> JSCommaList a -> JSCommaList a
concatCommaList :: JSCommaList a -> JSCommaList a -> JSCommaList a
concatCommaList xs :: JSCommaList a
xs JSLNil = JSCommaList a
xs
concatCommaList JSLNil ys :: JSCommaList a
ys = JSCommaList a
ys
concatCommaList xs :: JSCommaList a
xs (JSLOne y :: a
y) = JSCommaList a -> JSAnnot -> a -> JSCommaList a
forall a. JSCommaList a -> JSAnnot -> a -> JSCommaList a
JSLCons JSCommaList a
xs JSAnnot
emptyAnnot a
y
concatCommaList xs :: JSCommaList a
xs ys :: JSCommaList a
ys =
let recurse :: (a, JSCommaList a) -> JSCommaList a
recurse (z :: a
z, zs :: JSCommaList a
zs) = JSCommaList a -> JSCommaList a -> JSCommaList a
forall a. JSCommaList a -> JSCommaList a -> JSCommaList a
concatCommaList (JSCommaList a -> JSAnnot -> a -> JSCommaList a
forall a. JSCommaList a -> JSAnnot -> a -> JSCommaList a
JSLCons JSCommaList a
xs JSAnnot
emptyAnnot a
z) JSCommaList a
zs
in JSCommaList a
-> ((a, JSCommaList a) -> JSCommaList a)
-> Maybe (a, JSCommaList a)
-> JSCommaList a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe JSCommaList a
xs (a, JSCommaList a) -> JSCommaList a
recurse (Maybe (a, JSCommaList a) -> JSCommaList a)
-> Maybe (a, JSCommaList a) -> JSCommaList a
forall a b. (a -> b) -> a -> b
$ JSCommaList a -> Maybe (a, JSCommaList a)
forall a. JSCommaList a -> Maybe (a, JSCommaList a)
headCommaList JSCommaList a
ys
headCommaList :: JSCommaList a -> Maybe (a, JSCommaList a)
headCommaList :: JSCommaList a -> Maybe (a, JSCommaList a)
headCommaList JSLNil = Maybe (a, JSCommaList a)
forall a. Maybe a
Nothing
headCommaList (JSLOne x :: a
x) = (a, JSCommaList a) -> Maybe (a, JSCommaList a)
forall a. a -> Maybe a
Just (a
x, JSCommaList a
forall a. JSCommaList a
JSLNil)
headCommaList (JSLCons (JSLOne x :: a
x) _ y :: a
y) = (a, JSCommaList a) -> Maybe (a, JSCommaList a)
forall a. a -> Maybe a
Just (a
x, a -> JSCommaList a
forall a. a -> JSCommaList a
JSLOne a
y)
headCommaList (JSLCons xs :: JSCommaList a
xs _ y :: a
y) =
let rebuild :: (a, JSCommaList a) -> (a, JSCommaList a)
rebuild (x :: a
x, ys :: JSCommaList a
ys) = (a
x, JSCommaList a -> JSAnnot -> a -> JSCommaList a
forall a. JSCommaList a -> JSAnnot -> a -> JSCommaList a
JSLCons JSCommaList a
ys JSAnnot
emptyAnnot a
y)
in (a, JSCommaList a) -> (a, JSCommaList a)
forall a. (a, JSCommaList a) -> (a, JSCommaList a)
rebuild ((a, JSCommaList a) -> (a, JSCommaList a))
-> Maybe (a, JSCommaList a) -> Maybe (a, JSCommaList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSCommaList a -> Maybe (a, JSCommaList a)
forall a. JSCommaList a -> Maybe (a, JSCommaList a)
headCommaList JSCommaList a
xs
instance MinifyJS JSExpression where
fix :: JSAnnot -> JSExpression -> JSExpression
fix a :: JSAnnot
a (JSIdentifier _ s :: String
s) = JSAnnot -> String -> JSExpression
JSIdentifier JSAnnot
a String
s
fix a :: JSAnnot
a (JSDecimal _ s :: String
s) = JSAnnot -> String -> JSExpression
JSDecimal JSAnnot
a String
s
fix a :: JSAnnot
a (JSLiteral _ s :: String
s) = JSAnnot -> String -> JSExpression
JSLiteral JSAnnot
a String
s
fix a :: JSAnnot
a (JSHexInteger _ s :: String
s) = JSAnnot -> String -> JSExpression
JSHexInteger JSAnnot
a String
s
fix a :: JSAnnot
a (JSOctal _ s :: String
s) = JSAnnot -> String -> JSExpression
JSOctal JSAnnot
a String
s
fix _ (JSStringLiteral _ s :: String
s) = JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot String
s
fix _ (JSRegEx _ s :: String
s) = JSAnnot -> String -> JSExpression
JSRegEx JSAnnot
emptyAnnot String
s
fix _ (JSArrayLiteral _ xs :: [JSArrayElement]
xs _) = JSAnnot -> [JSArrayElement] -> JSAnnot -> JSExpression
JSArrayLiteral JSAnnot
emptyAnnot ((JSArrayElement -> JSArrayElement)
-> [JSArrayElement] -> [JSArrayElement]
forall a b. (a -> b) -> [a] -> [b]
map JSArrayElement -> JSArrayElement
forall a. MinifyJS a => a -> a
fixEmpty [JSArrayElement]
xs) JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSArrowExpression ps :: JSArrowParameterList
ps _ ss :: JSStatement
ss) = JSArrowParameterList -> JSAnnot -> JSStatement -> JSExpression
JSArrowExpression (JSAnnot -> JSArrowParameterList -> JSArrowParameterList
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSArrowParameterList
ps) JSAnnot
emptyAnnot (JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
emptyAnnot JSSemi
noSemi JSStatement
ss)
fix a :: JSAnnot
a (JSAssignExpression lhs :: JSExpression
lhs op :: JSAssignOp
op rhs :: JSExpression
rhs) = JSExpression -> JSAssignOp -> JSExpression -> JSExpression
JSAssignExpression (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
lhs) (JSAssignOp -> JSAssignOp
forall a. MinifyJS a => a -> a
fixEmpty JSAssignOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
rhs)
fix a :: JSAnnot
a (JSAwaitExpression _ ex :: JSExpression
ex) = JSAnnot -> JSExpression -> JSExpression
JSAwaitExpression JSAnnot
a (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
ex)
fix a :: JSAnnot
a (JSCallExpression ex :: JSExpression
ex _ xs :: JSCommaList JSExpression
xs _) = JSExpression
-> JSAnnot -> JSCommaList JSExpression -> JSAnnot -> JSExpression
JSCallExpression (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
ex) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
xs) JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSCallExpressionDot ex :: JSExpression
ex _ xs :: JSExpression
xs) = JSExpression -> JSAnnot -> JSExpression -> JSExpression
JSCallExpressionDot (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
ex) JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
xs)
fix a :: JSAnnot
a (JSCallExpressionSquare ex :: JSExpression
ex _ xs :: JSExpression
xs _) = JSExpression -> JSAnnot -> JSExpression -> JSAnnot -> JSExpression
JSCallExpressionSquare (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
ex) JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
xs) JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSClassExpression _ n :: JSIdent
n h :: JSClassHeritage
h _ ms :: [JSClassElement]
ms _) = JSAnnot
-> JSIdent
-> JSClassHeritage
-> JSAnnot
-> [JSClassElement]
-> JSAnnot
-> JSExpression
JSClassExpression JSAnnot
a (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
n) (JSClassHeritage -> JSClassHeritage
forall a. MinifyJS a => a -> a
fixSpace JSClassHeritage
h) JSAnnot
emptyAnnot ([JSClassElement] -> [JSClassElement]
forall a. MinifyJS a => a -> a
fixEmpty [JSClassElement]
ms) JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSCommaExpression le :: JSExpression
le _ re :: JSExpression
re) = JSExpression -> JSAnnot -> JSExpression -> JSExpression
JSCommaExpression (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
le) JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
re)
fix a :: JSAnnot
a (JSExpressionBinary lhs :: JSExpression
lhs op :: JSBinOp
op rhs :: JSExpression
rhs) = JSAnnot -> JSBinOp -> JSExpression -> JSExpression -> JSExpression
fixBinOpExpression JSAnnot
a JSBinOp
op JSExpression
lhs JSExpression
rhs
fix _ (JSExpressionParen _ e :: JSExpression
e _) = JSAnnot -> JSExpression -> JSAnnot -> JSExpression
JSExpressionParen JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSExpressionPostfix e :: JSExpression
e op :: JSUnaryOp
op) = JSExpression -> JSUnaryOp -> JSExpression
JSExpressionPostfix (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
e) (JSUnaryOp -> JSUnaryOp
forall a. MinifyJS a => a -> a
fixEmpty JSUnaryOp
op)
fix a :: JSAnnot
a (JSExpressionTernary cond :: JSExpression
cond _ v1 :: JSExpression
v1 _ v2 :: JSExpression
v2) = JSExpression
-> JSAnnot
-> JSExpression
-> JSAnnot
-> JSExpression
-> JSExpression
JSExpressionTernary (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
cond) JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
v1) JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
v2)
fix a :: JSAnnot
a (JSFunctionExpression _ n :: JSIdent
n _ x2s :: JSCommaList JSExpression
x2s _ x3 :: JSBlock
x3) = JSAnnot
-> JSIdent
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSExpression
JSFunctionExpression JSAnnot
a (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
n) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
x2s) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
x3)
fix a :: JSAnnot
a (JSGeneratorExpression _ _ n :: JSIdent
n _ x2s :: JSCommaList JSExpression
x2s _ x3 :: JSBlock
x3) = JSAnnot
-> JSAnnot
-> JSIdent
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSExpression
JSGeneratorExpression JSAnnot
a JSAnnot
emptyAnnot (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
n) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
x2s) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
x3)
fix a :: JSAnnot
a (JSMemberDot xs :: JSExpression
xs _ n :: JSExpression
n) = JSExpression -> JSAnnot -> JSExpression -> JSExpression
JSMemberDot (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
xs) JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
n)
fix a :: JSAnnot
a (JSMemberExpression e :: JSExpression
e _ args :: JSCommaList JSExpression
args _) = JSExpression
-> JSAnnot -> JSCommaList JSExpression -> JSAnnot -> JSExpression
JSMemberExpression (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
e) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
args) JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSMemberNew _ n :: JSExpression
n _ s :: JSCommaList JSExpression
s _) = JSAnnot
-> JSExpression
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSExpression
JSMemberNew JSAnnot
a (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
spaceAnnot JSExpression
n) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
s) JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSMemberSquare xs :: JSExpression
xs _ e :: JSExpression
e _) = JSExpression -> JSAnnot -> JSExpression -> JSAnnot -> JSExpression
JSMemberSquare (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
xs) JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSNewExpression _ e :: JSExpression
e) = JSAnnot -> JSExpression -> JSExpression
JSNewExpression JSAnnot
a (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e)
fix _ (JSObjectLiteral _ xs :: JSObjectPropertyList
xs _) = JSAnnot -> JSObjectPropertyList -> JSAnnot -> JSExpression
JSObjectLiteral JSAnnot
emptyAnnot (JSObjectPropertyList -> JSObjectPropertyList
forall a. MinifyJS a => a -> a
fixEmpty JSObjectPropertyList
xs) JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSTemplateLiteral t :: Maybe JSExpression
t _ s :: String
s ps :: [JSTemplatePart]
ps) = Maybe JSExpression
-> JSAnnot -> String -> [JSTemplatePart] -> JSExpression
JSTemplateLiteral ((JSExpression -> JSExpression)
-> Maybe JSExpression -> Maybe JSExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a) Maybe JSExpression
t) JSAnnot
emptyAnnot String
s ((JSTemplatePart -> JSTemplatePart)
-> [JSTemplatePart] -> [JSTemplatePart]
forall a b. (a -> b) -> [a] -> [b]
map JSTemplatePart -> JSTemplatePart
forall a. MinifyJS a => a -> a
fixEmpty [JSTemplatePart]
ps)
fix a :: JSAnnot
a (JSUnaryExpression op :: JSUnaryOp
op x :: JSExpression
x) = let (ta :: JSAnnot
ta, fop :: JSUnaryOp
fop) = JSAnnot -> JSUnaryOp -> (JSAnnot, JSUnaryOp)
fixUnaryOp JSAnnot
a JSUnaryOp
op in JSUnaryOp -> JSExpression -> JSExpression
JSUnaryExpression JSUnaryOp
fop (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
ta JSExpression
x)
fix a :: JSAnnot
a (JSVarInitExpression x1 :: JSExpression
x1 x2 :: JSVarInitializer
x2) = JSExpression -> JSVarInitializer -> JSExpression
JSVarInitExpression (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
x1) (JSVarInitializer -> JSVarInitializer
forall a. MinifyJS a => a -> a
fixEmpty JSVarInitializer
x2)
fix a :: JSAnnot
a (JSYieldExpression _ x :: Maybe JSExpression
x) = JSAnnot -> Maybe JSExpression -> JSExpression
JSYieldExpression JSAnnot
a (Maybe JSExpression -> Maybe JSExpression
forall a. MinifyJS a => a -> a
fixSpace Maybe JSExpression
x)
fix a :: JSAnnot
a (JSYieldFromExpression _ _ x :: JSExpression
x) = JSAnnot -> JSAnnot -> JSExpression -> JSExpression
JSYieldFromExpression JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
x)
fix a :: JSAnnot
a (JSSpreadExpression _ e :: JSExpression
e) = JSAnnot -> JSExpression -> JSExpression
JSSpreadExpression JSAnnot
a (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e)
instance MinifyJS JSArrowParameterList where
fix :: JSAnnot -> JSArrowParameterList -> JSArrowParameterList
fix _ (JSUnparenthesizedArrowParameter p :: JSIdent
p) = JSIdent -> JSArrowParameterList
JSUnparenthesizedArrowParameter (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
p)
fix _ (JSParenthesizedArrowParameterList _ ps :: JSCommaList JSExpression
ps _) = JSAnnot
-> JSCommaList JSExpression -> JSAnnot -> JSArrowParameterList
JSParenthesizedArrowParameterList JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
ps) JSAnnot
emptyAnnot
fixVarList :: JSCommaList JSExpression -> JSCommaList JSExpression
fixVarList :: JSCommaList JSExpression -> JSCommaList JSExpression
fixVarList (JSLCons h :: JSCommaList JSExpression
h _ v :: JSExpression
v) = JSCommaList JSExpression
-> JSAnnot -> JSExpression -> JSCommaList JSExpression
forall a. JSCommaList a -> JSAnnot -> a -> JSCommaList a
JSLCons (JSCommaList JSExpression -> JSCommaList JSExpression
fixVarList JSCommaList JSExpression
h) JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
v)
fixVarList (JSLOne a :: JSExpression
a) = JSExpression -> JSCommaList JSExpression
forall a. a -> JSCommaList a
JSLOne (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
a)
fixVarList JSLNil = JSCommaList JSExpression
forall a. JSCommaList a
JSLNil
fixBinOpExpression :: JSAnnot -> JSBinOp -> JSExpression -> JSExpression -> JSExpression
fixBinOpExpression :: JSAnnot -> JSBinOp -> JSExpression -> JSExpression -> JSExpression
fixBinOpExpression a :: JSAnnot
a (JSBinOpPlus _) lhs :: JSExpression
lhs rhs :: JSExpression
rhs = JSAnnot -> JSExpression -> JSExpression -> JSExpression
fixBinOpPlus JSAnnot
a JSExpression
lhs JSExpression
rhs
fixBinOpExpression a :: JSAnnot
a (JSBinOpIn _) lhs :: JSExpression
lhs rhs :: JSExpression
rhs = JSExpression -> JSBinOp -> JSExpression -> JSExpression
JSExpressionBinary (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
lhs) (JSAnnot -> JSBinOp
JSBinOpIn JSAnnot
spaceAnnot) (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
spaceAnnot JSExpression
rhs)
fixBinOpExpression a :: JSAnnot
a (JSBinOpInstanceOf _) lhs :: JSExpression
lhs rhs :: JSExpression
rhs = JSExpression -> JSBinOp -> JSExpression -> JSExpression
JSExpressionBinary (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
lhs) (JSAnnot -> JSBinOp
JSBinOpInstanceOf JSAnnot
spaceAnnot) (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
spaceAnnot JSExpression
rhs)
fixBinOpExpression a :: JSAnnot
a op :: JSBinOp
op lhs :: JSExpression
lhs rhs :: JSExpression
rhs = JSExpression -> JSBinOp -> JSExpression -> JSExpression
JSExpressionBinary (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
lhs) (JSBinOp -> JSBinOp
forall a. MinifyJS a => a -> a
fixEmpty JSBinOp
op) (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
rhs)
fixBinOpPlus :: JSAnnot -> JSExpression -> JSExpression -> JSExpression
fixBinOpPlus :: JSAnnot -> JSExpression -> JSExpression -> JSExpression
fixBinOpPlus a :: JSAnnot
a lhs :: JSExpression
lhs rhs :: JSExpression
rhs =
case (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
lhs, JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
rhs) of
(JSStringLiteral _ s1 :: String
s1, JSStringLiteral _ s2 :: String
s2) -> String -> String -> JSExpression
stringLitConcat (String -> String
normalizeToSQ String
s1) (String -> String
normalizeToSQ String
s2)
(nlhs :: JSExpression
nlhs, nrhs :: JSExpression
nrhs) -> JSExpression -> JSBinOp -> JSExpression -> JSExpression
JSExpressionBinary JSExpression
nlhs (JSAnnot -> JSBinOp
JSBinOpPlus JSAnnot
emptyAnnot) JSExpression
nrhs
stringLitConcat :: String -> String -> JSExpression
stringLitConcat :: String -> String -> JSExpression
stringLitConcat xs :: String
xs [] = JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot String
xs
stringLitConcat [] ys :: String
ys = JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot String
ys
stringLitConcat xall :: String
xall (_:yss :: String
yss) =
JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot (String -> String
forall a. [a] -> [a]
init String
xall String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
init String
yss String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'")
normalizeToSQ :: String -> String
normalizeToSQ :: String -> String
normalizeToSQ str :: String
str =
case String
str of
[] -> []
('\'' : _) -> String
str
('"' : xs :: String
xs) -> '\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertSQ String
xs
other :: String
other -> String
other
where
convertSQ :: String -> String
convertSQ [] = []
convertSQ [_] = "'"
convertSQ ('\'':xs :: String
xs) = '\\' Char -> String -> String
forall a. a -> [a] -> [a]
: '\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertSQ String
xs
convertSQ ('\\':'\"':xs :: String
xs) = '"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertSQ String
xs
convertSQ (x :: Char
x:xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertSQ String
xs
instance MinifyJS JSBinOp where
fix :: JSAnnot -> JSBinOp -> JSBinOp
fix _ (JSBinOpAnd _) = JSAnnot -> JSBinOp
JSBinOpAnd JSAnnot
emptyAnnot
fix _ (JSBinOpBitAnd _) = JSAnnot -> JSBinOp
JSBinOpBitAnd JSAnnot
emptyAnnot
fix _ (JSBinOpBitOr _) = JSAnnot -> JSBinOp
JSBinOpBitOr JSAnnot
emptyAnnot
fix _ (JSBinOpBitXor _) = JSAnnot -> JSBinOp
JSBinOpBitXor JSAnnot
emptyAnnot
fix _ (JSBinOpDivide _) = JSAnnot -> JSBinOp
JSBinOpDivide JSAnnot
emptyAnnot
fix _ (JSBinOpEq _) = JSAnnot -> JSBinOp
JSBinOpEq JSAnnot
emptyAnnot
fix _ (JSBinOpGe _) = JSAnnot -> JSBinOp
JSBinOpGe JSAnnot
emptyAnnot
fix _ (JSBinOpGt _) = JSAnnot -> JSBinOp
JSBinOpGt JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSBinOpIn _) = JSAnnot -> JSBinOp
JSBinOpIn JSAnnot
a
fix a :: JSAnnot
a (JSBinOpInstanceOf _) = JSAnnot -> JSBinOp
JSBinOpInstanceOf JSAnnot
a
fix _ (JSBinOpLe _) = JSAnnot -> JSBinOp
JSBinOpLe JSAnnot
emptyAnnot
fix _ (JSBinOpLsh _) = JSAnnot -> JSBinOp
JSBinOpLsh JSAnnot
emptyAnnot
fix _ (JSBinOpLt _) = JSAnnot -> JSBinOp
JSBinOpLt JSAnnot
emptyAnnot
fix _ (JSBinOpMinus _) = JSAnnot -> JSBinOp
JSBinOpMinus JSAnnot
emptyAnnot
fix _ (JSBinOpMod _) = JSAnnot -> JSBinOp
JSBinOpMod JSAnnot
emptyAnnot
fix _ (JSBinOpNeq _) = JSAnnot -> JSBinOp
JSBinOpNeq JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSBinOpOf _) = JSAnnot -> JSBinOp
JSBinOpOf JSAnnot
a
fix _ (JSBinOpOr _) = JSAnnot -> JSBinOp
JSBinOpOr JSAnnot
emptyAnnot
fix _ (JSBinOpPlus _) = JSAnnot -> JSBinOp
JSBinOpPlus JSAnnot
emptyAnnot
fix _ (JSBinOpRsh _) = JSAnnot -> JSBinOp
JSBinOpRsh JSAnnot
emptyAnnot
fix _ (JSBinOpStrictEq _) = JSAnnot -> JSBinOp
JSBinOpStrictEq JSAnnot
emptyAnnot
fix _ (JSBinOpStrictNeq _) = JSAnnot -> JSBinOp
JSBinOpStrictNeq JSAnnot
emptyAnnot
fix _ (JSBinOpTimes _) = JSAnnot -> JSBinOp
JSBinOpTimes JSAnnot
emptyAnnot
fix _ (JSBinOpUrsh _) = JSAnnot -> JSBinOp
JSBinOpUrsh JSAnnot
emptyAnnot
instance MinifyJS JSUnaryOp where
fix :: JSAnnot -> JSUnaryOp -> JSUnaryOp
fix _ (JSUnaryOpDecr _) = JSAnnot -> JSUnaryOp
JSUnaryOpDecr JSAnnot
emptyAnnot
fix _ (JSUnaryOpDelete _) = JSAnnot -> JSUnaryOp
JSUnaryOpDelete JSAnnot
emptyAnnot
fix _ (JSUnaryOpIncr _) = JSAnnot -> JSUnaryOp
JSUnaryOpIncr JSAnnot
emptyAnnot
fix _ (JSUnaryOpMinus _) = JSAnnot -> JSUnaryOp
JSUnaryOpMinus JSAnnot
emptyAnnot
fix _ (JSUnaryOpNot _) = JSAnnot -> JSUnaryOp
JSUnaryOpNot JSAnnot
emptyAnnot
fix _ (JSUnaryOpPlus _) = JSAnnot -> JSUnaryOp
JSUnaryOpPlus JSAnnot
emptyAnnot
fix _ (JSUnaryOpTilde _) = JSAnnot -> JSUnaryOp
JSUnaryOpTilde JSAnnot
emptyAnnot
fix _ (JSUnaryOpTypeof _) = JSAnnot -> JSUnaryOp
JSUnaryOpTypeof JSAnnot
emptyAnnot
fix _ (JSUnaryOpVoid _) = JSAnnot -> JSUnaryOp
JSUnaryOpVoid JSAnnot
emptyAnnot
fixUnaryOp :: JSAnnot -> JSUnaryOp -> (JSAnnot, JSUnaryOp)
fixUnaryOp :: JSAnnot -> JSUnaryOp -> (JSAnnot, JSUnaryOp)
fixUnaryOp a :: JSAnnot
a (JSUnaryOpDelete _) = (JSAnnot
spaceAnnot, JSAnnot -> JSUnaryOp
JSUnaryOpDelete JSAnnot
a)
fixUnaryOp a :: JSAnnot
a (JSUnaryOpTypeof _) = (JSAnnot
spaceAnnot, JSAnnot -> JSUnaryOp
JSUnaryOpTypeof JSAnnot
a)
fixUnaryOp a :: JSAnnot
a (JSUnaryOpVoid _) = (JSAnnot
spaceAnnot, JSAnnot -> JSUnaryOp
JSUnaryOpVoid JSAnnot
a)
fixUnaryOp a :: JSAnnot
a x :: JSUnaryOp
x = (JSAnnot
emptyAnnot, JSAnnot -> JSUnaryOp -> JSUnaryOp
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSUnaryOp
x)
instance MinifyJS JSAssignOp where
fix :: JSAnnot -> JSAssignOp -> JSAssignOp
fix a :: JSAnnot
a (JSAssign _) = JSAnnot -> JSAssignOp
JSAssign JSAnnot
a
fix a :: JSAnnot
a (JSTimesAssign _) = JSAnnot -> JSAssignOp
JSTimesAssign JSAnnot
a
fix a :: JSAnnot
a (JSDivideAssign _) = JSAnnot -> JSAssignOp
JSDivideAssign JSAnnot
a
fix a :: JSAnnot
a (JSModAssign _) = JSAnnot -> JSAssignOp
JSModAssign JSAnnot
a
fix a :: JSAnnot
a (JSPlusAssign _) = JSAnnot -> JSAssignOp
JSPlusAssign JSAnnot
a
fix a :: JSAnnot
a (JSMinusAssign _) = JSAnnot -> JSAssignOp
JSMinusAssign JSAnnot
a
fix a :: JSAnnot
a (JSLshAssign _) = JSAnnot -> JSAssignOp
JSLshAssign JSAnnot
a
fix a :: JSAnnot
a (JSRshAssign _) = JSAnnot -> JSAssignOp
JSRshAssign JSAnnot
a
fix a :: JSAnnot
a (JSUrshAssign _) = JSAnnot -> JSAssignOp
JSUrshAssign JSAnnot
a
fix a :: JSAnnot
a (JSBwAndAssign _) = JSAnnot -> JSAssignOp
JSBwAndAssign JSAnnot
a
fix a :: JSAnnot
a (JSBwXorAssign _) = JSAnnot -> JSAssignOp
JSBwXorAssign JSAnnot
a
fix a :: JSAnnot
a (JSBwOrAssign _) = JSAnnot -> JSAssignOp
JSBwOrAssign JSAnnot
a
instance MinifyJS JSModuleItem where
fix :: JSAnnot -> JSModuleItem -> JSModuleItem
fix _ (JSModuleImportDeclaration _ x1 :: JSImportDeclaration
x1) = JSAnnot -> JSImportDeclaration -> JSModuleItem
JSModuleImportDeclaration JSAnnot
emptyAnnot (JSImportDeclaration -> JSImportDeclaration
forall a. MinifyJS a => a -> a
fixEmpty JSImportDeclaration
x1)
fix _ (JSModuleExportDeclaration _ x1 :: JSExportDeclaration
x1) = JSAnnot -> JSExportDeclaration -> JSModuleItem
JSModuleExportDeclaration JSAnnot
emptyAnnot (JSExportDeclaration -> JSExportDeclaration
forall a. MinifyJS a => a -> a
fixEmpty JSExportDeclaration
x1)
fix a :: JSAnnot
a (JSModuleStatementListItem s :: JSStatement
s) = JSStatement -> JSModuleItem
JSModuleStatementListItem (JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
noSemi JSStatement
s)
instance MinifyJS JSImportDeclaration where
fix :: JSAnnot -> JSImportDeclaration -> JSImportDeclaration
fix _ (JSImportDeclaration imps :: JSImportClause
imps from :: JSFromClause
from _) = JSImportClause -> JSFromClause -> JSSemi -> JSImportDeclaration
JSImportDeclaration (JSImportClause -> JSImportClause
forall a. MinifyJS a => a -> a
fixEmpty JSImportClause
imps) (JSAnnot -> JSFromClause -> JSFromClause
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
annot JSFromClause
from) JSSemi
noSemi
where
annot :: JSAnnot
annot = case JSImportClause
imps of
JSImportClauseDefault {} -> JSAnnot
spaceAnnot
JSImportClauseNameSpace {} -> JSAnnot
spaceAnnot
JSImportClauseNamed {} -> JSAnnot
emptyAnnot
JSImportClauseDefaultNameSpace {} -> JSAnnot
spaceAnnot
JSImportClauseDefaultNamed {} -> JSAnnot
emptyAnnot
fix a :: JSAnnot
a (JSImportDeclarationBare _ m :: String
m _) = JSAnnot -> String -> JSSemi -> JSImportDeclaration
JSImportDeclarationBare JSAnnot
a String
m JSSemi
noSemi
instance MinifyJS JSImportClause where
fix :: JSAnnot -> JSImportClause -> JSImportClause
fix _ (JSImportClauseDefault n :: JSIdent
n) = JSIdent -> JSImportClause
JSImportClauseDefault (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
n)
fix _ (JSImportClauseNameSpace ns :: JSImportNameSpace
ns) = JSImportNameSpace -> JSImportClause
JSImportClauseNameSpace (JSImportNameSpace -> JSImportNameSpace
forall a. MinifyJS a => a -> a
fixSpace JSImportNameSpace
ns)
fix _ (JSImportClauseNamed named :: JSImportsNamed
named) = JSImportsNamed -> JSImportClause
JSImportClauseNamed (JSImportsNamed -> JSImportsNamed
forall a. MinifyJS a => a -> a
fixEmpty JSImportsNamed
named)
fix _ (JSImportClauseDefaultNameSpace def :: JSIdent
def _ ns :: JSImportNameSpace
ns) = JSIdent -> JSAnnot -> JSImportNameSpace -> JSImportClause
JSImportClauseDefaultNameSpace (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
def) JSAnnot
emptyAnnot (JSImportNameSpace -> JSImportNameSpace
forall a. MinifyJS a => a -> a
fixEmpty JSImportNameSpace
ns)
fix _ (JSImportClauseDefaultNamed def :: JSIdent
def _ ns :: JSImportsNamed
ns) = JSIdent -> JSAnnot -> JSImportsNamed -> JSImportClause
JSImportClauseDefaultNamed (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
def) JSAnnot
emptyAnnot (JSImportsNamed -> JSImportsNamed
forall a. MinifyJS a => a -> a
fixEmpty JSImportsNamed
ns)
instance MinifyJS JSFromClause where
fix :: JSAnnot -> JSFromClause -> JSFromClause
fix a :: JSAnnot
a (JSFromClause _ _ m :: String
m) = JSAnnot -> JSAnnot -> String -> JSFromClause
JSFromClause JSAnnot
a JSAnnot
emptyAnnot String
m
instance MinifyJS JSImportNameSpace where
fix :: JSAnnot -> JSImportNameSpace -> JSImportNameSpace
fix a :: JSAnnot
a (JSImportNameSpace _ _ ident :: JSIdent
ident) = JSBinOp -> JSAnnot -> JSIdent -> JSImportNameSpace
JSImportNameSpace (JSAnnot -> JSBinOp
JSBinOpTimes JSAnnot
a) JSAnnot
spaceAnnot (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
ident)
instance MinifyJS JSImportsNamed where
fix :: JSAnnot -> JSImportsNamed -> JSImportsNamed
fix _ (JSImportsNamed _ imps :: JSCommaList JSImportSpecifier
imps _) = JSAnnot
-> JSCommaList JSImportSpecifier -> JSAnnot -> JSImportsNamed
JSImportsNamed JSAnnot
emptyAnnot (JSCommaList JSImportSpecifier -> JSCommaList JSImportSpecifier
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSImportSpecifier
imps) JSAnnot
emptyAnnot
instance MinifyJS JSImportSpecifier where
fix :: JSAnnot -> JSImportSpecifier -> JSImportSpecifier
fix _ (JSImportSpecifier x1 :: JSIdent
x1) = JSIdent -> JSImportSpecifier
JSImportSpecifier (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
x1)
fix _ (JSImportSpecifierAs x1 :: JSIdent
x1 _ x2 :: JSIdent
x2) = JSIdent -> JSAnnot -> JSIdent -> JSImportSpecifier
JSImportSpecifierAs (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
x1) JSAnnot
spaceAnnot (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
x2)
instance MinifyJS JSExportDeclaration where
fix :: JSAnnot -> JSExportDeclaration -> JSExportDeclaration
fix a :: JSAnnot
a (JSExportFrom x1 :: JSExportClause
x1 from :: JSFromClause
from _) = JSExportClause -> JSFromClause -> JSSemi -> JSExportDeclaration
JSExportFrom (JSAnnot -> JSExportClause -> JSExportClause
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExportClause
x1) (JSAnnot -> JSFromClause -> JSFromClause
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSFromClause
from) JSSemi
noSemi
fix _ (JSExportLocals x1 :: JSExportClause
x1 _) = JSExportClause -> JSSemi -> JSExportDeclaration
JSExportLocals (JSAnnot -> JSExportClause -> JSExportClause
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
emptyAnnot JSExportClause
x1) JSSemi
noSemi
fix _ (JSExport x1 :: JSStatement
x1 _) = JSStatement -> JSSemi -> JSExportDeclaration
JSExport (JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
spaceAnnot JSSemi
noSemi JSStatement
x1) JSSemi
noSemi
instance MinifyJS JSExportClause where
fix :: JSAnnot -> JSExportClause -> JSExportClause
fix a :: JSAnnot
a (JSExportClause _ x1 :: JSCommaList JSExportSpecifier
x1 _) = JSAnnot
-> JSCommaList JSExportSpecifier -> JSAnnot -> JSExportClause
JSExportClause JSAnnot
emptyAnnot (JSCommaList JSExportSpecifier -> JSCommaList JSExportSpecifier
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExportSpecifier
x1) JSAnnot
a
instance MinifyJS JSExportSpecifier where
fix :: JSAnnot -> JSExportSpecifier -> JSExportSpecifier
fix _ (JSExportSpecifier x1 :: JSIdent
x1) = JSIdent -> JSExportSpecifier
JSExportSpecifier (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
x1)
fix _ (JSExportSpecifierAs x1 :: JSIdent
x1 _ x2 :: JSIdent
x2) = JSIdent -> JSAnnot -> JSIdent -> JSExportSpecifier
JSExportSpecifierAs (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
x1) JSAnnot
spaceAnnot (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
x2)
instance MinifyJS JSTryCatch where
fix :: JSAnnot -> JSTryCatch -> JSTryCatch
fix a :: JSAnnot
a (JSCatch _ _ x1 :: JSExpression
x1 _ x3 :: JSBlock
x3) = JSAnnot
-> JSAnnot -> JSExpression -> JSAnnot -> JSBlock -> JSTryCatch
JSCatch JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
x1) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
x3)
fix a :: JSAnnot
a (JSCatchIf _ _ x1 :: JSExpression
x1 _ ex :: JSExpression
ex _ x3 :: JSBlock
x3) = JSAnnot
-> JSAnnot
-> JSExpression
-> JSAnnot
-> JSExpression
-> JSAnnot
-> JSBlock
-> JSTryCatch
JSCatchIf JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
x1) JSAnnot
spaceAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
ex) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
x3)
instance MinifyJS JSTryFinally where
fix :: JSAnnot -> JSTryFinally -> JSTryFinally
fix a :: JSAnnot
a (JSFinally _ x :: JSBlock
x) = JSAnnot -> JSBlock -> JSTryFinally
JSFinally JSAnnot
a (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
x)
fix _ JSNoFinally = JSTryFinally
JSNoFinally
fixSwitchParts :: [JSSwitchParts] -> [JSSwitchParts]
fixSwitchParts :: [JSSwitchParts] -> [JSSwitchParts]
fixSwitchParts parts :: [JSSwitchParts]
parts =
case [JSSwitchParts]
parts of
[] -> []
[x :: JSSwitchParts
x] -> [JSSemi -> JSSwitchParts -> JSSwitchParts
fixPart JSSemi
noSemi JSSwitchParts
x]
(x :: JSSwitchParts
x:xs :: [JSSwitchParts]
xs) -> JSSemi -> JSSwitchParts -> JSSwitchParts
fixPart JSSemi
semi JSSwitchParts
x JSSwitchParts -> [JSSwitchParts] -> [JSSwitchParts]
forall a. a -> [a] -> [a]
: [JSSwitchParts] -> [JSSwitchParts]
fixSwitchParts [JSSwitchParts]
xs
where
fixPart :: JSSemi -> JSSwitchParts -> JSSwitchParts
fixPart s :: JSSemi
s (JSCase _ e :: JSExpression
e _ ss :: [JSStatement]
ss) = JSAnnot
-> JSExpression -> JSAnnot -> [JSStatement] -> JSSwitchParts
JSCase JSAnnot
emptyAnnot (JSExpression -> JSExpression
fixCase JSExpression
e) JSAnnot
emptyAnnot (JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList JSSemi
s [JSStatement]
ss)
fixPart s :: JSSemi
s (JSDefault _ _ ss :: [JSStatement]
ss) = JSAnnot -> JSAnnot -> [JSStatement] -> JSSwitchParts
JSDefault JSAnnot
emptyAnnot JSAnnot
emptyAnnot (JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList JSSemi
s [JSStatement]
ss)
fixCase :: JSExpression -> JSExpression
fixCase :: JSExpression -> JSExpression
fixCase (JSStringLiteral _ s :: String
s) = JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot String
s
fixCase e :: JSExpression
e = JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
spaceAnnot JSExpression
e
instance MinifyJS JSBlock where
fix :: JSAnnot -> JSBlock -> JSBlock
fix _ (JSBlock _ ss :: [JSStatement]
ss _) = JSAnnot -> [JSStatement] -> JSAnnot -> JSBlock
JSBlock JSAnnot
emptyAnnot (JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList JSSemi
noSemi [JSStatement]
ss) JSAnnot
emptyAnnot
instance MinifyJS JSObjectProperty where
fix :: JSAnnot -> JSObjectProperty -> JSObjectProperty
fix a :: JSAnnot
a (JSPropertyNameandValue n :: JSPropertyName
n _ vs :: [JSExpression]
vs) = JSPropertyName -> JSAnnot -> [JSExpression] -> JSObjectProperty
JSPropertyNameandValue (JSAnnot -> JSPropertyName -> JSPropertyName
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSPropertyName
n) JSAnnot
emptyAnnot ((JSExpression -> JSExpression) -> [JSExpression] -> [JSExpression]
forall a b. (a -> b) -> [a] -> [b]
map JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty [JSExpression]
vs)
fix a :: JSAnnot
a (JSPropertyIdentRef _ s :: String
s) = JSAnnot -> String -> JSObjectProperty
JSPropertyIdentRef JSAnnot
a String
s
fix a :: JSAnnot
a (JSObjectMethod m :: JSMethodDefinition
m) = JSMethodDefinition -> JSObjectProperty
JSObjectMethod (JSAnnot -> JSMethodDefinition -> JSMethodDefinition
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSMethodDefinition
m)
instance MinifyJS JSMethodDefinition where
fix :: JSAnnot -> JSMethodDefinition -> JSMethodDefinition
fix a :: JSAnnot
a (JSMethodDefinition n :: JSPropertyName
n _ ps :: JSCommaList JSExpression
ps _ b :: JSBlock
b) = JSPropertyName
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSMethodDefinition
JSMethodDefinition (JSAnnot -> JSPropertyName -> JSPropertyName
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSPropertyName
n) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
ps) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
b)
fix _ (JSGeneratorMethodDefinition _ n :: JSPropertyName
n _ ps :: JSCommaList JSExpression
ps _ b :: JSBlock
b) = JSAnnot
-> JSPropertyName
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSMethodDefinition
JSGeneratorMethodDefinition JSAnnot
emptyAnnot (JSPropertyName -> JSPropertyName
forall a. MinifyJS a => a -> a
fixEmpty JSPropertyName
n) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
ps) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
b)
fix a :: JSAnnot
a (JSPropertyAccessor s :: JSAccessor
s n :: JSPropertyName
n _ ps :: JSCommaList JSExpression
ps _ b :: JSBlock
b) = JSAccessor
-> JSPropertyName
-> JSAnnot
-> JSCommaList JSExpression
-> JSAnnot
-> JSBlock
-> JSMethodDefinition
JSPropertyAccessor (JSAnnot -> JSAccessor -> JSAccessor
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSAccessor
s) (JSPropertyName -> JSPropertyName
forall a. MinifyJS a => a -> a
fixSpace JSPropertyName
n) JSAnnot
emptyAnnot (JSCommaList JSExpression -> JSCommaList JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList JSExpression
ps) JSAnnot
emptyAnnot (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
b)
instance MinifyJS JSPropertyName where
fix :: JSAnnot -> JSPropertyName -> JSPropertyName
fix a :: JSAnnot
a (JSPropertyIdent _ s :: String
s) = JSAnnot -> String -> JSPropertyName
JSPropertyIdent JSAnnot
a String
s
fix a :: JSAnnot
a (JSPropertyString _ s :: String
s) = JSAnnot -> String -> JSPropertyName
JSPropertyString JSAnnot
a String
s
fix a :: JSAnnot
a (JSPropertyNumber _ s :: String
s) = JSAnnot -> String -> JSPropertyName
JSPropertyNumber JSAnnot
a String
s
fix _ (JSPropertyComputed _ x :: JSExpression
x _) = JSAnnot -> JSExpression -> JSAnnot -> JSPropertyName
JSPropertyComputed JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
x) JSAnnot
emptyAnnot
instance MinifyJS JSAccessor where
fix :: JSAnnot -> JSAccessor -> JSAccessor
fix a :: JSAnnot
a (JSAccessorGet _) = JSAnnot -> JSAccessor
JSAccessorGet JSAnnot
a
fix a :: JSAnnot
a (JSAccessorSet _) = JSAnnot -> JSAccessor
JSAccessorSet JSAnnot
a
instance MinifyJS JSArrayElement where
fix :: JSAnnot -> JSArrayElement -> JSArrayElement
fix _ (JSArrayElement e :: JSExpression
e) = JSExpression -> JSArrayElement
JSArrayElement (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e)
fix _ (JSArrayComma _) = JSAnnot -> JSArrayElement
JSArrayComma JSAnnot
emptyAnnot
instance MinifyJS a => MinifyJS (JSCommaList a) where
fix :: JSAnnot -> JSCommaList a -> JSCommaList a
fix _ (JSLCons xs :: JSCommaList a
xs _ x :: a
x) = JSCommaList a -> JSAnnot -> a -> JSCommaList a
forall a. JSCommaList a -> JSAnnot -> a -> JSCommaList a
JSLCons (JSCommaList a -> JSCommaList a
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList a
xs) JSAnnot
emptyAnnot (a -> a
forall a. MinifyJS a => a -> a
fixEmpty a
x)
fix _ (JSLOne a :: a
a) = a -> JSCommaList a
forall a. a -> JSCommaList a
JSLOne (a -> a
forall a. MinifyJS a => a -> a
fixEmpty a
a)
fix _ JSLNil = JSCommaList a
forall a. JSCommaList a
JSLNil
instance MinifyJS a => MinifyJS (JSCommaTrailingList a) where
fix :: JSAnnot -> JSCommaTrailingList a -> JSCommaTrailingList a
fix _ (JSCTLComma xs :: JSCommaList a
xs _) = JSCommaList a -> JSCommaTrailingList a
forall a. JSCommaList a -> JSCommaTrailingList a
JSCTLNone (JSCommaList a -> JSCommaList a
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList a
xs)
fix _ (JSCTLNone xs :: JSCommaList a
xs) = JSCommaList a -> JSCommaTrailingList a
forall a. JSCommaList a -> JSCommaTrailingList a
JSCTLNone (JSCommaList a -> JSCommaList a
forall a. MinifyJS a => a -> a
fixEmpty JSCommaList a
xs)
instance MinifyJS JSIdent where
fix :: JSAnnot -> JSIdent -> JSIdent
fix a :: JSAnnot
a (JSIdentName _ n :: String
n) = JSAnnot -> String -> JSIdent
JSIdentName JSAnnot
a String
n
fix _ JSIdentNone = JSIdent
JSIdentNone
instance MinifyJS (Maybe JSExpression) where
fix :: JSAnnot -> Maybe JSExpression -> Maybe JSExpression
fix a :: JSAnnot
a me :: Maybe JSExpression
me = JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a (JSExpression -> JSExpression)
-> Maybe JSExpression -> Maybe JSExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe JSExpression
me
instance MinifyJS JSVarInitializer where
fix :: JSAnnot -> JSVarInitializer -> JSVarInitializer
fix a :: JSAnnot
a (JSVarInit _ x :: JSExpression
x) = JSAnnot -> JSExpression -> JSVarInitializer
JSVarInit JSAnnot
a (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
emptyAnnot JSExpression
x)
fix _ JSVarInitNone = JSVarInitializer
JSVarInitNone
instance MinifyJS JSTemplatePart where
fix :: JSAnnot -> JSTemplatePart -> JSTemplatePart
fix _ (JSTemplatePart e :: JSExpression
e _ s :: String
s) = JSExpression -> JSAnnot -> String -> JSTemplatePart
JSTemplatePart (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot String
s
instance MinifyJS JSClassHeritage where
fix :: JSAnnot -> JSClassHeritage -> JSClassHeritage
fix _ JSExtendsNone = JSClassHeritage
JSExtendsNone
fix a :: JSAnnot
a (JSExtends _ e :: JSExpression
e) = JSAnnot -> JSExpression -> JSClassHeritage
JSExtends JSAnnot
a (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e)
instance MinifyJS [JSClassElement] where
fix :: JSAnnot -> [JSClassElement] -> [JSClassElement]
fix _ [] = []
fix a :: JSAnnot
a (JSClassInstanceMethod m :: JSMethodDefinition
m:t :: [JSClassElement]
t) = JSMethodDefinition -> JSClassElement
JSClassInstanceMethod (JSAnnot -> JSMethodDefinition -> JSMethodDefinition
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSMethodDefinition
m) JSClassElement -> [JSClassElement] -> [JSClassElement]
forall a. a -> [a] -> [a]
: [JSClassElement] -> [JSClassElement]
forall a. MinifyJS a => a -> a
fixEmpty [JSClassElement]
t
fix a :: JSAnnot
a (JSClassStaticMethod _ m :: JSMethodDefinition
m:t :: [JSClassElement]
t) = JSAnnot -> JSMethodDefinition -> JSClassElement
JSClassStaticMethod JSAnnot
a (JSMethodDefinition -> JSMethodDefinition
forall a. MinifyJS a => a -> a
fixSpace JSMethodDefinition
m) JSClassElement -> [JSClassElement] -> [JSClassElement]
forall a. a -> [a] -> [a]
: [JSClassElement] -> [JSClassElement]
forall a. MinifyJS a => a -> a
fixEmpty [JSClassElement]
t
fix a :: JSAnnot
a (JSClassSemi _:t :: [JSClassElement]
t) = JSAnnot -> [JSClassElement] -> [JSClassElement]
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a [JSClassElement]
t
spaceAnnot :: JSAnnot
spaceAnnot :: JSAnnot
spaceAnnot = TokenPosn -> [CommentAnnotation] -> JSAnnot
JSAnnot TokenPosn
tokenPosnEmpty [TokenPosn -> String -> CommentAnnotation
WhiteSpace TokenPosn
tokenPosnEmpty " "]
emptyAnnot :: JSAnnot
emptyAnnot :: JSAnnot
emptyAnnot = JSAnnot
JSNoAnnot
newlineAnnot :: JSAnnot
newlineAnnot :: JSAnnot
newlineAnnot = TokenPosn -> [CommentAnnotation] -> JSAnnot
JSAnnot TokenPosn
tokenPosnEmpty [TokenPosn -> String -> CommentAnnotation
WhiteSpace TokenPosn
tokenPosnEmpty "\n"]
semi :: JSSemi
semi :: JSSemi
semi = JSAnnot -> JSSemi
JSSemi JSAnnot
emptyAnnot
noSemi :: JSSemi
noSemi :: JSSemi
noSemi = JSSemi
JSSemiAuto