{-# LANGUAGE CPP, FlexibleInstances #-}

module Language.JavaScript.Process.Minify
    ( -- * 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 [JSStatement]
xs JSAnnot
_) = [JSStatement] -> JSAnnot -> JSAST
JSAstProgram (JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList JSSemi
noSemi [JSStatement]
xs) JSAnnot
emptyAnnot
minifyJS (JSAstModule [JSModuleItem]
xs JSAnnot
_) = [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 JSAnnot
_ [JSStatement
s] JSAnnot
_ JSSemi
_) JSAnnot
_) = JSStatement -> JSAnnot -> JSAST
JSAstStatement (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
noSemi JSStatement
s) JSAnnot
emptyAnnot
minifyJS (JSAstStatement JSStatement
s JSAnnot
_) = JSStatement -> JSAnnot -> JSAST
JSAstStatement (JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
noSemi JSStatement
s) JSAnnot
emptyAnnot
minifyJS (JSAstExpression JSExpression
e JSAnnot
_) =  JSExpression -> JSAnnot -> JSAST
JSAstExpression (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot
minifyJS (JSAstLiteral JSExpression
s JSAnnot
_)  = 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 :: forall a. MinifyJS a => a -> a
fixEmpty = JSAnnot -> a -> a
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
emptyAnnot

fixSpace :: MinifyJS a => a -> a
fixSpace :: forall a. MinifyJS a => a -> a
fixSpace = JSAnnot -> a -> a
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
spaceAnnot

-- -----------------------------------------------------------------------------
-- During minification, Javascript statements may need to have explicit
-- semicolons inserted between them, so that simply adding a JSStatement
-- instance for the MinifyJS typeclass would not be sufficient.

fixStmt :: JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt :: JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
s (JSStatementBlock JSAnnot
_lb [JSStatement]
ss JSAnnot
_rb JSSemi
_) = JSAnnot -> JSSemi -> [JSStatement] -> JSStatement
fixStatementBlock JSAnnot
a JSSemi
s [JSStatement]
ss
fixStmt JSAnnot
a JSSemi
s (JSBreak JSAnnot
_ JSIdent
i JSSemi
_) = JSAnnot -> JSIdent -> JSSemi -> JSStatement
JSBreak JSAnnot
a (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
i) JSSemi
s
fixStmt JSAnnot
a JSSemi
s (JSClass JSAnnot
_ JSIdent
n JSClassHeritage
h JSAnnot
_ [JSClassElement]
ms JSAnnot
_ JSSemi
_) = 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 JSAnnot
a JSSemi
s (JSConstant JSAnnot
_ JSCommaList JSExpression
ss JSSemi
_) = JSAnnot -> JSCommaList JSExpression -> JSSemi -> JSStatement
JSConstant JSAnnot
a (JSCommaList JSExpression -> JSCommaList JSExpression
fixVarList JSCommaList JSExpression
ss) JSSemi
s
fixStmt JSAnnot
a JSSemi
s (JSContinue JSAnnot
_ JSIdent
i JSSemi
_) = JSAnnot -> JSIdent -> JSSemi -> JSStatement
JSContinue JSAnnot
a (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
i) JSSemi
s
fixStmt JSAnnot
a JSSemi
s (JSDoWhile JSAnnot
_ JSStatement
st JSAnnot
_ JSAnnot
_ JSExpression
e JSAnnot
_ JSSemi
_) = 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 JSAnnot
a JSSemi
s (JSFor JSAnnot
_ JSAnnot
_ JSCommaList JSExpression
el1 JSAnnot
_ JSCommaList JSExpression
el2 JSAnnot
_ JSCommaList JSExpression
el3 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForIn JSAnnot
_ JSAnnot
_ JSExpression
e1 JSBinOp
op JSExpression
e2 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForVar JSAnnot
_ JSAnnot
_ JSAnnot
_ JSCommaList JSExpression
el1 JSAnnot
_ JSCommaList JSExpression
el2 JSAnnot
_ JSCommaList JSExpression
el3 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForVarIn JSAnnot
_ JSAnnot
_ JSAnnot
_ JSExpression
e1 JSBinOp
op JSExpression
e2 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForLet JSAnnot
_ JSAnnot
_ JSAnnot
_ JSCommaList JSExpression
el1 JSAnnot
_ JSCommaList JSExpression
el2 JSAnnot
_ JSCommaList JSExpression
el3 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForLetIn JSAnnot
_ JSAnnot
_ JSAnnot
_ JSExpression
e1 JSBinOp
op JSExpression
e2 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForLetOf JSAnnot
_ JSAnnot
_ JSAnnot
_ JSExpression
e1 JSBinOp
op JSExpression
e2 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForConst JSAnnot
_ JSAnnot
_ JSAnnot
_ JSCommaList JSExpression
el1 JSAnnot
_ JSCommaList JSExpression
el2 JSAnnot
_ JSCommaList JSExpression
el3 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForConstIn JSAnnot
_ JSAnnot
_ JSAnnot
_ JSExpression
e1 JSBinOp
op JSExpression
e2 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForConstOf JSAnnot
_ JSAnnot
_ JSAnnot
_ JSExpression
e1 JSBinOp
op JSExpression
e2 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForOf JSAnnot
_ JSAnnot
_ JSExpression
e1 JSBinOp
op JSExpression
e2 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSForVarOf JSAnnot
_ JSAnnot
_ JSAnnot
_ JSExpression
e1 JSBinOp
op JSExpression
e2 JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSAsyncFunction JSAnnot
_ JSAnnot
_ JSIdent
n JSAnnot
_ JSCommaList JSExpression
ps JSAnnot
_ JSBlock
blk JSSemi
_) = 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 JSAnnot
a JSSemi
s (JSFunction JSAnnot
_ JSIdent
n JSAnnot
_ JSCommaList JSExpression
ps JSAnnot
_ JSBlock
blk JSSemi
_) = 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 JSAnnot
a JSSemi
s (JSGenerator JSAnnot
_ JSAnnot
_ JSIdent
n JSAnnot
_ JSCommaList JSExpression
ps JSAnnot
_ JSBlock
blk JSSemi
_) = 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 JSAnnot
a JSSemi
s (JSIf JSAnnot
_ JSAnnot
_ JSExpression
e JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSIfElse JSAnnot
_ JSAnnot
_ JSExpression
e JSAnnot
_ (JSEmptyStatement JSAnnot
_) JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSIfElse JSAnnot
_ JSAnnot
_ JSExpression
e JSAnnot
_ JSStatement
st JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSLabelled JSIdent
e JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSLet JSAnnot
_ JSCommaList JSExpression
xs JSSemi
_) = JSAnnot -> JSCommaList JSExpression -> JSSemi -> JSStatement
JSLet JSAnnot
a (JSCommaList JSExpression -> JSCommaList JSExpression
fixVarList JSCommaList JSExpression
xs) JSSemi
s
fixStmt JSAnnot
_ JSSemi
_ (JSEmptyStatement JSAnnot
_) = JSAnnot -> JSStatement
JSEmptyStatement JSAnnot
emptyAnnot
fixStmt JSAnnot
a JSSemi
s (JSExpressionStatement JSExpression
e JSSemi
_) = JSExpression -> JSSemi -> JSStatement
JSExpressionStatement (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
a JSExpression
e) JSSemi
s
fixStmt JSAnnot
a JSSemi
s (JSAssignStatement JSExpression
lhs JSAssignOp
op JSExpression
rhs JSSemi
_) = 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 JSAnnot
a JSSemi
s (JSMethodCall JSExpression
e JSAnnot
_ JSCommaList JSExpression
args JSAnnot
_ JSSemi
_) = 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 JSAnnot
a JSSemi
s (JSReturn JSAnnot
_ Maybe JSExpression
me JSSemi
_) = 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 JSAnnot
a JSSemi
s (JSSwitch JSAnnot
_ JSAnnot
_ JSExpression
e JSAnnot
_ JSAnnot
_ [JSSwitchParts]
sps JSAnnot
_ JSSemi
_) = 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 JSAnnot
a JSSemi
s (JSThrow JSAnnot
_ JSExpression
e JSSemi
_) = JSAnnot -> JSExpression -> JSSemi -> JSStatement
JSThrow JSAnnot
a (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e) JSSemi
s
fixStmt JSAnnot
a JSSemi
_ (JSTry JSAnnot
_ JSBlock
b [JSTryCatch]
tc 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 JSAnnot
a JSSemi
s (JSVariable JSAnnot
_ JSCommaList JSExpression
ss JSSemi
_) = JSAnnot -> JSCommaList JSExpression -> JSSemi -> JSStatement
JSVariable JSAnnot
a (JSCommaList JSExpression -> JSCommaList JSExpression
fixVarList JSCommaList JSExpression
ss) JSSemi
s
fixStmt JSAnnot
a JSSemi
s (JSWhile JSAnnot
_ JSAnnot
_ JSExpression
e JSAnnot
_ 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 JSAnnot
a JSSemi
s (JSWith JSAnnot
_ JSAnnot
_ JSExpression
e JSAnnot
_ JSStatement
st JSSemi
_) = 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 JSAnnot
_ JSSemi
_ (JSStatementBlock JSAnnot
_ [] JSAnnot
_ JSSemi
_) = JSAnnot -> JSStatement
JSEmptyStatement JSAnnot
emptyAnnot
fixIfElseBlock JSAnnot
a JSSemi
s 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

-- Turn a single JSStatement into a JSStatementBlock.
mkStatementBlock :: JSSemi -> JSStatement -> JSStatement
mkStatementBlock :: JSSemi -> JSStatement -> JSStatement
mkStatementBlock JSSemi
s (JSStatementBlock JSAnnot
_ [JSStatement]
blk JSAnnot
_ JSSemi
_) = JSAnnot -> [JSStatement] -> JSAnnot -> JSSemi -> JSStatement
JSStatementBlock JSAnnot
emptyAnnot (JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList JSSemi
noSemi [JSStatement]
blk) JSAnnot
emptyAnnot JSSemi
s
mkStatementBlock JSSemi
s JSStatement
x = JSAnnot -> [JSStatement] -> JSAnnot -> JSSemi -> JSStatement
JSStatementBlock JSAnnot
emptyAnnot [JSSemi -> JSStatement -> JSStatement
fixStmtE JSSemi
noSemi JSStatement
x] JSAnnot
emptyAnnot JSSemi
s

-- Filter a list of JSStatment, dropping JSEmptyStatement and empty
-- JSStatementBlocks. If the resulting list contains only a single element,
-- remove the enclosing JSStatementBlock and return the inner JSStatement.
fixStatementBlock :: JSAnnot -> JSSemi -> [JSStatement] -> JSStatement
fixStatementBlock :: JSAnnot -> JSSemi -> [JSStatement] -> JSStatement
fixStatementBlock JSAnnot
a JSSemi
s [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
        [JSStatement
sx] -> JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
s JSStatement
sx
        [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 JSAnnot
_) = Bool
True
    isEmpty (JSStatementBlock JSAnnot
_ [] JSAnnot
_ JSSemi
_) = Bool
True
    isEmpty JSStatement
_ = Bool
False

-- Force semi-colons between statements, and make sure the last statement in a
-- block has no semi-colon.
fixStatementList :: JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList :: JSSemi -> [JSStatement] -> [JSStatement]
fixStatementList 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 JSAnnot
_ [] JSAnnot
_ JSSemi
_) = Bool
True
    isRedundant (JSEmptyStatement JSAnnot
_) = Bool
True
    isRedundant JSStatement
_ = Bool
False

    fixList :: JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
_ JSSemi
_ [] = []
    fixList JSAnnot
a JSSemi
s [JSStatementBlock JSAnnot
_ [JSStatement]
blk JSAnnot
_ JSSemi
_] = JSAnnot -> JSSemi -> [JSStatement] -> [JSStatement]
fixList JSAnnot
a JSSemi
s [JSStatement]
blk
    fixList JSAnnot
a JSSemi
s [JSStatement
x] = [JSAnnot -> JSSemi -> JSStatement -> JSStatement
fixStmt JSAnnot
a JSSemi
s JSStatement
x]
    fixList JSAnnot
_ JSSemi
s (JSStatementBlock JSAnnot
_ [JSStatement]
blk JSAnnot
_ JSSemi
_:[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 JSAnnot
a JSSemi
s (JSConstant JSAnnot
_ JSCommaList JSExpression
vs1 JSSemi
_:JSConstant JSAnnot
_ JSCommaList JSExpression
vs2 JSSemi
_: [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 JSAnnot
a JSSemi
s (JSVariable JSAnnot
_ JSCommaList JSExpression
vs1 JSSemi
_:JSVariable JSAnnot
_ JSCommaList JSExpression
vs2 JSSemi
_: [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 JSAnnot
a JSSemi
s (x1 :: JSStatement
x1@JSFunction{}:x2 :: JSStatement
x2@JSFunction{}:[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 JSAnnot
a JSSemi
s (JSStatement
x:[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 :: forall a. JSCommaList a -> JSCommaList a -> JSCommaList a
concatCommaList JSCommaList a
xs JSCommaList a
JSLNil = JSCommaList a
xs
concatCommaList JSCommaList a
JSLNil JSCommaList a
ys = JSCommaList a
ys
concatCommaList JSCommaList a
xs (JSLOne 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 JSCommaList a
xs JSCommaList a
ys =
    let recurse :: (a, JSCommaList a) -> JSCommaList a
recurse (a
z, 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 :: forall a. JSCommaList a -> Maybe (a, JSCommaList a)
headCommaList JSCommaList a
JSLNil = Maybe (a, JSCommaList a)
forall a. Maybe a
Nothing
headCommaList (JSLOne 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 a
x) JSAnnot
_ 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 JSCommaList a
xs JSAnnot
_ a
y) =
    let rebuild :: (a, JSCommaList a) -> (a, JSCommaList a)
rebuild (a
x, 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

-- -----------------------------------------------------------------------------
-- JSExpression and the rest can use the MinifyJS typeclass.

instance MinifyJS JSExpression where
    -- Terminals
    fix :: JSAnnot -> JSExpression -> JSExpression
fix JSAnnot
a (JSIdentifier     JSAnnot
_ String
s) = JSAnnot -> String -> JSExpression
JSIdentifier JSAnnot
a String
s
    fix JSAnnot
a (JSDecimal        JSAnnot
_ String
s) = JSAnnot -> String -> JSExpression
JSDecimal JSAnnot
a String
s
    fix JSAnnot
a (JSLiteral        JSAnnot
_ String
s) = JSAnnot -> String -> JSExpression
JSLiteral JSAnnot
a String
s
    fix JSAnnot
a (JSHexInteger     JSAnnot
_ String
s) = JSAnnot -> String -> JSExpression
JSHexInteger JSAnnot
a String
s
    fix JSAnnot
a (JSOctal          JSAnnot
_ String
s) = JSAnnot -> String -> JSExpression
JSOctal JSAnnot
a String
s
    fix JSAnnot
_ (JSStringLiteral  JSAnnot
_ String
s) = JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot String
s
    fix JSAnnot
_ (JSRegEx          JSAnnot
_ String
s) = JSAnnot -> String -> JSExpression
JSRegEx JSAnnot
emptyAnnot String
s

    -- Non-Terminals
    fix JSAnnot
_ (JSArrayLiteral         JSAnnot
_ [JSArrayElement]
xs JSAnnot
_)             = 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 JSAnnot
a (JSArrowExpression JSArrowParameterList
ps JSAnnot
_ 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 JSAnnot
a (JSAssignExpression     JSExpression
lhs JSAssignOp
op 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 JSAnnot
a (JSAwaitExpression      JSAnnot
_ JSExpression
ex)               = JSAnnot -> JSExpression -> JSExpression
JSAwaitExpression JSAnnot
a (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
ex)
    fix JSAnnot
a (JSCallExpression       JSExpression
ex JSAnnot
_ JSCommaList JSExpression
xs JSAnnot
_)          = 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 JSAnnot
a (JSCallExpressionDot    JSExpression
ex JSAnnot
_ 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 JSAnnot
a (JSCallExpressionSquare JSExpression
ex JSAnnot
_ JSExpression
xs JSAnnot
_)          = 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 JSAnnot
a (JSClassExpression      JSAnnot
_ JSIdent
n JSClassHeritage
h JSAnnot
_ [JSClassElement]
ms JSAnnot
_)       = 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 JSAnnot
a (JSCommaExpression      JSExpression
le JSAnnot
_ 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 JSAnnot
a (JSExpressionBinary     JSExpression
lhs JSBinOp
op JSExpression
rhs)         = JSAnnot -> JSBinOp -> JSExpression -> JSExpression -> JSExpression
fixBinOpExpression JSAnnot
a JSBinOp
op JSExpression
lhs JSExpression
rhs
    fix JSAnnot
_ (JSExpressionParen      JSAnnot
_ JSExpression
e JSAnnot
_)              = JSAnnot -> JSExpression -> JSAnnot -> JSExpression
JSExpressionParen JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e) JSAnnot
emptyAnnot
    fix JSAnnot
a (JSExpressionPostfix    JSExpression
e 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 JSAnnot
a (JSExpressionTernary    JSExpression
cond JSAnnot
_ JSExpression
v1 JSAnnot
_ 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 JSAnnot
a (JSFunctionExpression   JSAnnot
_ JSIdent
n JSAnnot
_ JSCommaList JSExpression
x2s JSAnnot
_ 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 JSAnnot
a (JSGeneratorExpression  JSAnnot
_ JSAnnot
_ JSIdent
n JSAnnot
_ JSCommaList JSExpression
x2s JSAnnot
_ 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 JSAnnot
a (JSMemberDot            JSExpression
xs JSAnnot
_ 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 JSAnnot
a (JSMemberExpression     JSExpression
e JSAnnot
_ JSCommaList JSExpression
args JSAnnot
_)         = 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 JSAnnot
a (JSMemberNew            JSAnnot
_ JSExpression
n JSAnnot
_ JSCommaList JSExpression
s JSAnnot
_)          = 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 JSAnnot
a (JSMemberSquare         JSExpression
xs JSAnnot
_ JSExpression
e JSAnnot
_)           = 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 JSAnnot
a (JSNewExpression        JSAnnot
_ JSExpression
e)                = JSAnnot -> JSExpression -> JSExpression
JSNewExpression JSAnnot
a (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
e)
    fix JSAnnot
_ (JSObjectLiteral        JSAnnot
_ JSObjectPropertyList
xs JSAnnot
_)             = JSAnnot -> JSObjectPropertyList -> JSAnnot -> JSExpression
JSObjectLiteral JSAnnot
emptyAnnot (JSObjectPropertyList -> JSObjectPropertyList
forall a. MinifyJS a => a -> a
fixEmpty JSObjectPropertyList
xs) JSAnnot
emptyAnnot
    fix JSAnnot
a (JSTemplateLiteral      Maybe JSExpression
t JSAnnot
_ String
s [JSTemplatePart]
ps)           = Maybe JSExpression
-> JSAnnot -> String -> [JSTemplatePart] -> JSExpression
JSTemplateLiteral ((JSExpression -> JSExpression)
-> Maybe JSExpression -> Maybe JSExpression
forall a b. (a -> b) -> Maybe a -> Maybe b
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 JSAnnot
a (JSUnaryExpression      JSUnaryOp
op JSExpression
x)               = let (JSAnnot
ta, 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 JSAnnot
a (JSVarInitExpression    JSExpression
x1 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 JSAnnot
a (JSYieldExpression      JSAnnot
_ 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 JSAnnot
a (JSYieldFromExpression  JSAnnot
_ JSAnnot
_ JSExpression
x)              = JSAnnot -> JSAnnot -> JSExpression -> JSExpression
JSYieldFromExpression JSAnnot
a JSAnnot
emptyAnnot (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
x)
    fix JSAnnot
a (JSSpreadExpression     JSAnnot
_ 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 JSAnnot
_ (JSUnparenthesizedArrowParameter JSIdent
p)         = JSIdent -> JSArrowParameterList
JSUnparenthesizedArrowParameter (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
p)
    fix JSAnnot
_ (JSParenthesizedArrowParameterList JSAnnot
_ JSCommaList JSExpression
ps JSAnnot
_)  = 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 JSCommaList JSExpression
h JSAnnot
_ 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 JSExpression
a) = JSExpression -> JSCommaList JSExpression
forall a. a -> JSCommaList a
JSLOne (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixSpace JSExpression
a)
fixVarList JSCommaList JSExpression
JSLNil = JSCommaList JSExpression
forall a. JSCommaList a
JSLNil

fixBinOpExpression :: JSAnnot -> JSBinOp -> JSExpression -> JSExpression -> JSExpression
fixBinOpExpression :: JSAnnot -> JSBinOp -> JSExpression -> JSExpression -> JSExpression
fixBinOpExpression JSAnnot
a (JSBinOpPlus JSAnnot
_) JSExpression
lhs JSExpression
rhs = JSAnnot -> JSExpression -> JSExpression -> JSExpression
fixBinOpPlus JSAnnot
a JSExpression
lhs JSExpression
rhs
fixBinOpExpression JSAnnot
a (JSBinOpIn JSAnnot
_) JSExpression
lhs 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 JSAnnot
a (JSBinOpInstanceOf JSAnnot
_) JSExpression
lhs 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 JSAnnot
a JSBinOp
op JSExpression
lhs 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 JSAnnot
a JSExpression
lhs 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 JSAnnot
_ String
s1, JSStringLiteral JSAnnot
_ String
s2) -> String -> String -> JSExpression
stringLitConcat (String -> String
normalizeToSQ String
s1) (String -> String
normalizeToSQ String
s2)
        (JSExpression
nlhs, JSExpression
nrhs) -> JSExpression -> JSBinOp -> JSExpression -> JSExpression
JSExpressionBinary JSExpression
nlhs (JSAnnot -> JSBinOp
JSBinOpPlus JSAnnot
emptyAnnot) JSExpression
nrhs

-- Concatenate two JSStringLiterals. Since the strings will include the string
-- terminators (either single or double quotes) we use whatever terminator is
-- used by the first string.
stringLitConcat :: String -> String -> JSExpression
stringLitConcat :: String -> String -> JSExpression
stringLitConcat String
xs [] = JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot String
xs
stringLitConcat [] String
ys = JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot String
ys
stringLitConcat String
xall (Char
_:String
yss) =
    JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot (String -> String
forall a. HasCallStack => [a] -> [a]
init String
xall String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. HasCallStack => [a] -> [a]
init String
yss String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'")

-- Normalize a String. If its single quoted, just return it and its double quoted
-- convert it to single quoted.
normalizeToSQ :: String -> String
normalizeToSQ :: String -> String
normalizeToSQ String
str =
    case String
str of
        [] -> []
        (Char
'\'' : String
_) -> String
str
        (Char
'"' : String
xs) -> Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertSQ String
xs
        String
other -> String
other -- Should not happen.
  where
    convertSQ :: String -> String
convertSQ [] = []
    convertSQ [Char
_] = String
"'"
    convertSQ (Char
'\'':String
xs) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertSQ String
xs
    convertSQ (Char
'\\':Char
'\"':String
xs) = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertSQ String
xs
    convertSQ (Char
x: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 JSAnnot
_ (JSBinOpAnd        JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpAnd JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpBitAnd     JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpBitAnd JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpBitOr      JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpBitOr JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpBitXor     JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpBitXor JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpDivide     JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpDivide JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpEq         JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpEq JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpGe         JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpGe JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpGt         JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpGt JSAnnot
emptyAnnot
    fix JSAnnot
a (JSBinOpIn         JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpIn JSAnnot
a
    fix JSAnnot
a (JSBinOpInstanceOf JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpInstanceOf JSAnnot
a
    fix JSAnnot
_ (JSBinOpLe         JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpLe JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpLsh        JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpLsh JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpLt         JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpLt JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpMinus      JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpMinus JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpMod        JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpMod JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpNeq        JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpNeq JSAnnot
emptyAnnot
    fix JSAnnot
a (JSBinOpOf         JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpOf JSAnnot
a
    fix JSAnnot
_ (JSBinOpOr         JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpOr JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpPlus       JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpPlus JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpRsh        JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpRsh JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpStrictEq   JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpStrictEq JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpStrictNeq  JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpStrictNeq JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpTimes      JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpTimes JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSBinOpUrsh       JSAnnot
_) = JSAnnot -> JSBinOp
JSBinOpUrsh JSAnnot
emptyAnnot


instance MinifyJS JSUnaryOp where
    fix :: JSAnnot -> JSUnaryOp -> JSUnaryOp
fix JSAnnot
_ (JSUnaryOpDecr   JSAnnot
_) = JSAnnot -> JSUnaryOp
JSUnaryOpDecr JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSUnaryOpDelete JSAnnot
_) = JSAnnot -> JSUnaryOp
JSUnaryOpDelete JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSUnaryOpIncr   JSAnnot
_) = JSAnnot -> JSUnaryOp
JSUnaryOpIncr JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSUnaryOpMinus  JSAnnot
_) = JSAnnot -> JSUnaryOp
JSUnaryOpMinus JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSUnaryOpNot    JSAnnot
_) = JSAnnot -> JSUnaryOp
JSUnaryOpNot JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSUnaryOpPlus   JSAnnot
_) = JSAnnot -> JSUnaryOp
JSUnaryOpPlus JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSUnaryOpTilde  JSAnnot
_) = JSAnnot -> JSUnaryOp
JSUnaryOpTilde JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSUnaryOpTypeof JSAnnot
_) = JSAnnot -> JSUnaryOp
JSUnaryOpTypeof JSAnnot
emptyAnnot
    fix JSAnnot
_ (JSUnaryOpVoid   JSAnnot
_) = JSAnnot -> JSUnaryOp
JSUnaryOpVoid JSAnnot
emptyAnnot

fixUnaryOp :: JSAnnot -> JSUnaryOp -> (JSAnnot, JSUnaryOp)
fixUnaryOp :: JSAnnot -> JSUnaryOp -> (JSAnnot, JSUnaryOp)
fixUnaryOp JSAnnot
a (JSUnaryOpDelete JSAnnot
_) = (JSAnnot
spaceAnnot, JSAnnot -> JSUnaryOp
JSUnaryOpDelete JSAnnot
a)
fixUnaryOp JSAnnot
a (JSUnaryOpTypeof JSAnnot
_) = (JSAnnot
spaceAnnot, JSAnnot -> JSUnaryOp
JSUnaryOpTypeof JSAnnot
a)
fixUnaryOp JSAnnot
a (JSUnaryOpVoid   JSAnnot
_) = (JSAnnot
spaceAnnot, JSAnnot -> JSUnaryOp
JSUnaryOpVoid JSAnnot
a)
fixUnaryOp JSAnnot
a 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 JSAnnot
a (JSAssign       JSAnnot
_) = JSAnnot -> JSAssignOp
JSAssign JSAnnot
a
    fix JSAnnot
a (JSTimesAssign  JSAnnot
_) = JSAnnot -> JSAssignOp
JSTimesAssign JSAnnot
a
    fix JSAnnot
a (JSDivideAssign JSAnnot
_) = JSAnnot -> JSAssignOp
JSDivideAssign JSAnnot
a
    fix JSAnnot
a (JSModAssign    JSAnnot
_) = JSAnnot -> JSAssignOp
JSModAssign JSAnnot
a
    fix JSAnnot
a (JSPlusAssign   JSAnnot
_) = JSAnnot -> JSAssignOp
JSPlusAssign JSAnnot
a
    fix JSAnnot
a (JSMinusAssign  JSAnnot
_) = JSAnnot -> JSAssignOp
JSMinusAssign JSAnnot
a
    fix JSAnnot
a (JSLshAssign    JSAnnot
_) = JSAnnot -> JSAssignOp
JSLshAssign JSAnnot
a
    fix JSAnnot
a (JSRshAssign    JSAnnot
_) = JSAnnot -> JSAssignOp
JSRshAssign JSAnnot
a
    fix JSAnnot
a (JSUrshAssign   JSAnnot
_) = JSAnnot -> JSAssignOp
JSUrshAssign JSAnnot
a
    fix JSAnnot
a (JSBwAndAssign  JSAnnot
_) = JSAnnot -> JSAssignOp
JSBwAndAssign JSAnnot
a
    fix JSAnnot
a (JSBwXorAssign  JSAnnot
_) = JSAnnot -> JSAssignOp
JSBwXorAssign JSAnnot
a
    fix JSAnnot
a (JSBwOrAssign   JSAnnot
_) = JSAnnot -> JSAssignOp
JSBwOrAssign JSAnnot
a

instance MinifyJS JSModuleItem where
    fix :: JSAnnot -> JSModuleItem -> JSModuleItem
fix JSAnnot
_ (JSModuleImportDeclaration JSAnnot
_ JSImportDeclaration
x1) = JSAnnot -> JSImportDeclaration -> JSModuleItem
JSModuleImportDeclaration JSAnnot
emptyAnnot (JSImportDeclaration -> JSImportDeclaration
forall a. MinifyJS a => a -> a
fixEmpty JSImportDeclaration
x1)
    fix JSAnnot
_ (JSModuleExportDeclaration JSAnnot
_ JSExportDeclaration
x1) = JSAnnot -> JSExportDeclaration -> JSModuleItem
JSModuleExportDeclaration JSAnnot
emptyAnnot (JSExportDeclaration -> JSExportDeclaration
forall a. MinifyJS a => a -> a
fixEmpty JSExportDeclaration
x1)
    fix JSAnnot
a (JSModuleStatementListItem 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 JSAnnot
_ (JSImportDeclaration JSImportClause
imps JSFromClause
from JSSemi
_) = 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 JSAnnot
a (JSImportDeclarationBare JSAnnot
_ String
m JSSemi
_) = JSAnnot -> String -> JSSemi -> JSImportDeclaration
JSImportDeclarationBare JSAnnot
a String
m JSSemi
noSemi

instance MinifyJS JSImportClause where
    fix :: JSAnnot -> JSImportClause -> JSImportClause
fix JSAnnot
_ (JSImportClauseDefault JSIdent
n) = JSIdent -> JSImportClause
JSImportClauseDefault (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixSpace JSIdent
n)
    fix JSAnnot
_ (JSImportClauseNameSpace JSImportNameSpace
ns) = JSImportNameSpace -> JSImportClause
JSImportClauseNameSpace (JSImportNameSpace -> JSImportNameSpace
forall a. MinifyJS a => a -> a
fixSpace JSImportNameSpace
ns)
    fix JSAnnot
_ (JSImportClauseNamed JSImportsNamed
named) = JSImportsNamed -> JSImportClause
JSImportClauseNamed (JSImportsNamed -> JSImportsNamed
forall a. MinifyJS a => a -> a
fixEmpty JSImportsNamed
named)
    fix JSAnnot
_ (JSImportClauseDefaultNameSpace JSIdent
def JSAnnot
_ 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 JSAnnot
_ (JSImportClauseDefaultNamed JSIdent
def JSAnnot
_ 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 JSAnnot
a (JSFromClause JSAnnot
_ JSAnnot
_ String
m) = JSAnnot -> JSAnnot -> String -> JSFromClause
JSFromClause JSAnnot
a JSAnnot
emptyAnnot String
m

instance MinifyJS JSImportNameSpace where
    fix :: JSAnnot -> JSImportNameSpace -> JSImportNameSpace
fix JSAnnot
a (JSImportNameSpace JSBinOp
_ JSAnnot
_ 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 JSAnnot
_ (JSImportsNamed JSAnnot
_ JSCommaList JSImportSpecifier
imps JSAnnot
_) = 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 JSAnnot
_ (JSImportSpecifier JSIdent
x1) = JSIdent -> JSImportSpecifier
JSImportSpecifier (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
x1)
    fix JSAnnot
_ (JSImportSpecifierAs JSIdent
x1 JSAnnot
_ 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 JSAnnot
a (JSExportFrom JSExportClause
x1 JSFromClause
from JSSemi
_) = 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 JSAnnot
_ (JSExportLocals JSExportClause
x1 JSSemi
_) = JSExportClause -> JSSemi -> JSExportDeclaration
JSExportLocals (JSAnnot -> JSExportClause -> JSExportClause
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
emptyAnnot JSExportClause
x1) JSSemi
noSemi
    fix JSAnnot
_ (JSExport JSStatement
x1 JSSemi
_) = 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 JSAnnot
a (JSExportClause JSAnnot
_ JSCommaList JSExportSpecifier
x1 JSAnnot
_) = 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 JSAnnot
_ (JSExportSpecifier JSIdent
x1) = JSIdent -> JSExportSpecifier
JSExportSpecifier (JSIdent -> JSIdent
forall a. MinifyJS a => a -> a
fixEmpty JSIdent
x1)
    fix JSAnnot
_ (JSExportSpecifierAs JSIdent
x1 JSAnnot
_ 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 JSAnnot
a (JSCatch JSAnnot
_ JSAnnot
_ JSExpression
x1 JSAnnot
_ 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 JSAnnot
a (JSCatchIf JSAnnot
_ JSAnnot
_ JSExpression
x1 JSAnnot
_ JSExpression
ex JSAnnot
_ 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 JSAnnot
a (JSFinally JSAnnot
_ JSBlock
x) = JSAnnot -> JSBlock -> JSTryFinally
JSFinally JSAnnot
a (JSBlock -> JSBlock
forall a. MinifyJS a => a -> a
fixEmpty JSBlock
x)
    fix JSAnnot
_ JSTryFinally
JSNoFinally = JSTryFinally
JSNoFinally


fixSwitchParts :: [JSSwitchParts] -> [JSSwitchParts]
fixSwitchParts :: [JSSwitchParts] -> [JSSwitchParts]
fixSwitchParts [JSSwitchParts]
parts =
    case [JSSwitchParts]
parts of
        [] -> []
        [JSSwitchParts
x] -> [JSSemi -> JSSwitchParts -> JSSwitchParts
fixPart JSSemi
noSemi JSSwitchParts
x]
        (JSSwitchParts
x:[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 JSSemi
s (JSCase JSAnnot
_ JSExpression
e JSAnnot
_ [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 JSSemi
s (JSDefault JSAnnot
_ JSAnnot
_ [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 JSAnnot
_ String
s) = JSAnnot -> String -> JSExpression
JSStringLiteral JSAnnot
emptyAnnot String
s
fixCase 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 JSAnnot
_ (JSBlock JSAnnot
_ [JSStatement]
ss JSAnnot
_) = 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 JSAnnot
a (JSPropertyNameandValue JSPropertyName
n JSAnnot
_ [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 JSAnnot
a (JSPropertyIdentRef     JSAnnot
_ String
s)          = JSAnnot -> String -> JSObjectProperty
JSPropertyIdentRef JSAnnot
a String
s
    fix JSAnnot
a (JSObjectMethod         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 JSAnnot
a (JSMethodDefinition          JSPropertyName
n JSAnnot
_ JSCommaList JSExpression
ps JSAnnot
_ 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 JSAnnot
_ (JSGeneratorMethodDefinition JSAnnot
_ JSPropertyName
n JSAnnot
_ JSCommaList JSExpression
ps JSAnnot
_ 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 JSAnnot
a (JSPropertyAccessor          JSAccessor
s JSPropertyName
n JSAnnot
_ JSCommaList JSExpression
ps JSAnnot
_ 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 JSAnnot
a (JSPropertyIdent JSAnnot
_ String
s)  = JSAnnot -> String -> JSPropertyName
JSPropertyIdent JSAnnot
a String
s
    fix JSAnnot
a (JSPropertyString JSAnnot
_ String
s) = JSAnnot -> String -> JSPropertyName
JSPropertyString JSAnnot
a String
s
    fix JSAnnot
a (JSPropertyNumber JSAnnot
_ String
s) = JSAnnot -> String -> JSPropertyName
JSPropertyNumber JSAnnot
a String
s
    fix JSAnnot
_ (JSPropertyComputed JSAnnot
_ JSExpression
x JSAnnot
_) = 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 JSAnnot
a (JSAccessorGet JSAnnot
_) = JSAnnot -> JSAccessor
JSAccessorGet JSAnnot
a
    fix JSAnnot
a (JSAccessorSet JSAnnot
_) = JSAnnot -> JSAccessor
JSAccessorSet JSAnnot
a


instance MinifyJS JSArrayElement where
    fix :: JSAnnot -> JSArrayElement -> JSArrayElement
fix JSAnnot
_ (JSArrayElement JSExpression
e) = JSExpression -> JSArrayElement
JSArrayElement (JSExpression -> JSExpression
forall a. MinifyJS a => a -> a
fixEmpty JSExpression
e)
    fix JSAnnot
_ (JSArrayComma JSAnnot
_)   = JSAnnot -> JSArrayElement
JSArrayComma JSAnnot
emptyAnnot


instance MinifyJS a => MinifyJS (JSCommaList a) where
    fix :: JSAnnot -> JSCommaList a -> JSCommaList a
fix JSAnnot
_ (JSLCons JSCommaList a
xs JSAnnot
_ 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 JSAnnot
_ (JSLOne a
a)       = a -> JSCommaList a
forall a. a -> JSCommaList a
JSLOne (a -> a
forall a. MinifyJS a => a -> a
fixEmpty a
a)
    fix JSAnnot
_ JSCommaList a
JSLNil           = JSCommaList a
forall a. JSCommaList a
JSLNil


instance MinifyJS a => MinifyJS (JSCommaTrailingList a) where
    fix :: JSAnnot -> JSCommaTrailingList a -> JSCommaTrailingList a
fix JSAnnot
_ (JSCTLComma JSCommaList a
xs JSAnnot
_) = 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 JSAnnot
_ (JSCTLNone 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 JSAnnot
a (JSIdentName JSAnnot
_ String
n) = JSAnnot -> String -> JSIdent
JSIdentName JSAnnot
a String
n
    fix JSAnnot
_ JSIdent
JSIdentNone = JSIdent
JSIdentNone


instance MinifyJS (Maybe JSExpression) where
    fix :: JSAnnot -> Maybe JSExpression -> Maybe JSExpression
fix JSAnnot
a 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 JSAnnot
a (JSVarInit JSAnnot
_ JSExpression
x) = JSAnnot -> JSExpression -> JSVarInitializer
JSVarInit JSAnnot
a (JSAnnot -> JSExpression -> JSExpression
forall a. MinifyJS a => JSAnnot -> a -> a
fix JSAnnot
emptyAnnot JSExpression
x)
    fix JSAnnot
_ JSVarInitializer
JSVarInitNone = JSVarInitializer
JSVarInitNone


instance MinifyJS JSTemplatePart where
    fix :: JSAnnot -> JSTemplatePart -> JSTemplatePart
fix JSAnnot
_ (JSTemplatePart JSExpression
e JSAnnot
_ 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 JSAnnot
_ JSClassHeritage
JSExtendsNone = JSClassHeritage
JSExtendsNone
    fix JSAnnot
a (JSExtends JSAnnot
_ 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 JSAnnot
_ [] = []
    fix JSAnnot
a (JSClassInstanceMethod JSMethodDefinition
m:[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 JSAnnot
a (JSClassStaticMethod JSAnnot
_ JSMethodDefinition
m:[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 JSAnnot
a (JSClassSemi JSAnnot
_:[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 String
" "]

emptyAnnot :: JSAnnot
emptyAnnot :: JSAnnot
emptyAnnot = JSAnnot
JSNoAnnot

newlineAnnot :: JSAnnot
newlineAnnot :: JSAnnot
newlineAnnot = TokenPosn -> [CommentAnnotation] -> JSAnnot
JSAnnot TokenPosn
tokenPosnEmpty [TokenPosn -> String -> CommentAnnotation
WhiteSpace TokenPosn
tokenPosnEmpty String
"\n"]

semi :: JSSemi
semi :: JSSemi
semi = JSAnnot -> JSSemi
JSSemi JSAnnot
emptyAnnot

noSemi :: JSSemi
noSemi :: JSSemi
noSemi = JSSemi
JSSemiAuto