Add support for method definitions

src/Language/JavaScript/Parser/AST.hs

@@ -17,6 +17,7 @@ module Language.JavaScript.Parser.AST
     , JSPropertyName (..)
     , JSObjectPropertyList
     , JSAccessor (..)
+    , JSMethodDefinition (..)
     , JSIdent (..)
     , JSVarInitializer (..)
     , JSArrayElement (..)
@@ -287,9 +288,15 @@ data JSVarInitializer
     deriving (Data, Eq, Show, Typeable)
 
 data JSObjectProperty
-    = JSPropertyAccessor !JSAccessor !JSPropertyName !JSAnnot ![JSExpression] !JSAnnot !JSBlock -- ^(get|set), name, lb, params, rb, block
-    | JSPropertyNameandValue !JSPropertyName !JSAnnot ![JSExpression] -- ^name, colon, value
+    = JSPropertyNameandValue !JSPropertyName !JSAnnot ![JSExpression] -- ^name, colon, value
     | JSPropertyIdentRef !JSAnnot !String
+    | JSObjectMethod !JSMethodDefinition
+    deriving (Data, Eq, Show, Typeable)
+
+data JSMethodDefinition
+    = JSMethodDefinition !JSPropertyName !JSAnnot !(JSCommaList JSExpression) !JSAnnot !JSBlock -- name, lb, params, rb, block
+    | JSGeneratorMethodDefinition !JSAnnot !JSPropertyName !JSAnnot !(JSCommaList JSExpression) !JSAnnot !JSBlock -- ^*, name, lb, params, rb, block
+    | JSPropertyAccessor !JSAccessor !JSPropertyName !JSAnnot !(JSCommaList JSExpression) !JSAnnot !JSBlock -- ^get/set, name, lb, params, rb, block
     deriving (Data, Eq, Show, Typeable)
 
 data JSPropertyName
@@ -482,8 +489,13 @@ instance ShowStripped JSIdent where
 
 instance ShowStripped JSObjectProperty where
     ss (JSPropertyNameandValue x1 _colon x2s) = "JSPropertyNameandValue (" ++ ss x1 ++ ") " ++ ss x2s
-    ss (JSPropertyAccessor s x1 _lb1 x2s _rb1 x3) = "JSPropertyAccessor " ++ ss s ++ " (" ++ ss x1 ++ ") " ++ ss x2s ++ " (" ++ ss x3 ++ ")"
     ss (JSPropertyIdentRef _ s) = "JSPropertyIdentRef " ++ singleQuote s
+    ss (JSObjectMethod m) = ss m
+
+instance ShowStripped JSMethodDefinition where
+    ss (JSMethodDefinition x1 _lb1 x2s _rb1 x3) = "JSMethodDefinition (" ++ ss x1 ++ ") " ++ ss x2s ++ " (" ++ ss x3 ++ ")"
+    ss (JSPropertyAccessor s x1 _lb1 x2s _rb1 x3) = "JSPropertyAccessor " ++ ss s ++ " (" ++ ss x1 ++ ") " ++ ss x2s ++ " (" ++ ss x3 ++ ")"
+    ss (JSGeneratorMethodDefinition _ x1 _lb1 x2s _rb1 x3) = "JSGeneratorMethodDefinition (" ++ ss x1 ++ ") " ++ ss x2s ++ " (" ++ ss x3 ++ ")"
 
 instance ShowStripped JSPropertyName where
     ss (JSPropertyIdent _ s) = "JSIdentifier " ++ singleQuote s

src/Language/JavaScript/Parser/Grammar7.y

@@ -576,16 +576,27 @@ PropertyNameandValueList : PropertyAssignment                                { A
 --        PropertyName : AssignmentExpression
 --        get PropertyName() { FunctionBody }
 --        set PropertyName( PropertySetParameterList ) { FunctionBody }
--- TODO: not clear if get/set are keywords, or just used in a specific context. Puzzling.
 PropertyAssignment :: { AST.JSObjectProperty }
 PropertyAssignment : PropertyName Colon AssignmentExpression { AST.JSPropertyNameandValue $1 $2 [$3] }
                    | IdentifierName { identifierToProperty $1 }
-                   -- Should be "get" in next, but is not a Token
-                   | 'get' PropertyName LParen RParen FunctionBody
-                       { AST.JSPropertyAccessor (AST.JSAccessorGet (mkJSAnnot $1)) $2 $3 [] $4 $5 }
-                   -- Should be "set" in next, but is not a Token
-                   | 'set' PropertyName LParen PropertySetParameterList RParen FunctionBody
-                       { AST.JSPropertyAccessor (AST.JSAccessorSet (mkJSAnnot $1)) $2 $3 [$4] $5 $6 }
+                   | MethodDefinition { AST.JSObjectMethod $1 }
+
+-- TODO: not clear if get/set are keywords, or just used in a specific context. Puzzling.
+MethodDefinition :: { AST.JSMethodDefinition }
+MethodDefinition : PropertyName LParen RParen FunctionBody
+                     { AST.JSMethodDefinition $1 $2 AST.JSLNil $3 $4 }
+                 | PropertyName LParen FormalParameterList RParen FunctionBody
+                     { AST.JSMethodDefinition $1 $2 $3 $4 $5 }
+                 | '*' PropertyName LParen RParen FunctionBody
+                     { AST.JSGeneratorMethodDefinition (mkJSAnnot $1) $2 $3 AST.JSLNil $4 $5 }
+                 | '*' PropertyName LParen FormalParameterList RParen FunctionBody
+                     { AST.JSGeneratorMethodDefinition (mkJSAnnot $1) $2 $3 $4 $5 $6 }
+                 -- Should be "get" in next, but is not a Token
+                 | 'get' PropertyName LParen RParen FunctionBody
+                     { AST.JSPropertyAccessor (AST.JSAccessorGet (mkJSAnnot $1)) $2 $3 AST.JSLNil $4 $5 }
+                 -- Should be "set" in next, but is not a Token
+                 | 'set' PropertyName LParen PropertySetParameterList RParen FunctionBody
+                     { AST.JSPropertyAccessor (AST.JSAccessorSet (mkJSAnnot $1)) $2 $3 (AST.JSLOne $4) $5 $6 }
 
 -- PropertyName :                                                        See 11.1.5
 --        IdentifierName

src/Language/JavaScript/Pretty/Printer.hs

@@ -272,9 +272,14 @@ instance RenderJS JSBlock where
     (|>) pacc (JSBlock alb ss arb) = pacc |> alb |> "{" |> ss |> arb |> "}"
 
 instance RenderJS JSObjectProperty where
-    (|>) pacc (JSPropertyAccessor     s n alp ps arp b)       = pacc |> s |> n |> alp |> "(" |> ps |> arp |> ")" |> b
     (|>) pacc (JSPropertyNameandValue n c vs)                 = pacc |> n |> c |> ":" |> vs
     (|>) pacc (JSPropertyIdentRef     a s)                    = pacc |> a |> s
+    (|>) pacc (JSObjectMethod         m)                      = pacc |> m
+
+instance RenderJS JSMethodDefinition where
+    (|>) pacc (JSMethodDefinition          n alp ps arp b)   = pacc |> n |> alp |> "(" |> ps |> arp |> ")" |> b
+    (|>) pacc (JSGeneratorMethodDefinition s n alp ps arp b) = pacc |> s |> "*" |> n |> alp |> "(" |> ps |> arp |> ")" |> b
+    (|>) pacc (JSPropertyAccessor          s n alp ps arp b) = pacc |> s |> n |> alp |> "(" |> ps |> arp |> ")" |> b
 
 instance RenderJS JSPropertyName where
     (|>) pacc (JSPropertyIdent a s)  = pacc |> a |> s

src/Language/JavaScript/Process/Minify.hs

@@ -361,9 +361,14 @@ instance MinifyJS JSBlock where
 
 
 instance MinifyJS JSObjectProperty where
-    fix a (JSPropertyAccessor     s n _ ps _ b) = JSPropertyAccessor (fix a s) (fixSpace n) emptyAnnot (map fixEmpty ps) emptyAnnot (fixEmpty b)
     fix a (JSPropertyNameandValue n _ vs)       = JSPropertyNameandValue (fix a n) emptyAnnot (map fixEmpty vs)
     fix a (JSPropertyIdentRef     _ s)          = JSPropertyIdentRef a s
+    fix a (JSObjectMethod         m)            = JSObjectMethod (fix a m)
+
+instance MinifyJS JSMethodDefinition where
+    fix a (JSMethodDefinition          n _ ps _ b)   = JSMethodDefinition                     (fix a n)    emptyAnnot (fixEmpty ps) emptyAnnot (fixEmpty b)
+    fix _ (JSGeneratorMethodDefinition _ n _ ps _ b) = JSGeneratorMethodDefinition emptyAnnot (fixEmpty n) emptyAnnot (fixEmpty ps) emptyAnnot (fixEmpty b)
+    fix a (JSPropertyAccessor          s n _ ps _ b) = JSPropertyAccessor          (fix a s)  (fixSpace n) emptyAnnot (fixEmpty ps) emptyAnnot (fixEmpty b)
 
 instance MinifyJS JSPropertyName where
     fix a (JSPropertyIdent _ s)  = JSPropertyIdent a s

test/Test/Language/Javascript/ExpressionParser.hs

@@ -54,13 +54,17 @@ testExpressionParser = describe "Parse expressions:" $ do
         testExpr "{yield:1}"    `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'yield') [JSDecimal '1']]))"
         testExpr "{x}"          `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyIdentRef 'x']))"
         testExpr "{x,}"         `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyIdentRef 'x',JSComma]))"
-        testExpr "{set x([a,b]=y) {this.a=a;this.b=b}}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyAccessor JSAccessorSet (JSIdentifier 'x') [JSOpAssign ('=',JSArrayLiteral [JSIdentifier 'a',JSComma,JSIdentifier 'b'],JSIdentifier 'y')] (JSBlock [JSOpAssign ('=',JSMemberDot (JSLiteral 'this',JSIdentifier 'a'),JSIdentifier 'a'),JSSemicolon,JSOpAssign ('=',JSMemberDot (JSLiteral 'this',JSIdentifier 'b'),JSIdentifier 'b')])]))"
+        testExpr "{set x([a,b]=y) {this.a=a;this.b=b}}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyAccessor JSAccessorSet (JSIdentifier 'x') (JSOpAssign ('=',JSArrayLiteral [JSIdentifier 'a',JSComma,JSIdentifier 'b'],JSIdentifier 'y')) (JSBlock [JSOpAssign ('=',JSMemberDot (JSLiteral 'this',JSIdentifier 'a'),JSIdentifier 'a'),JSSemicolon,JSOpAssign ('=',JSMemberDot (JSLiteral 'this',JSIdentifier 'b'),JSIdentifier 'b')])]))"
         testExpr "a={if:1,interface:2}" `shouldBe` "Right (JSAstExpression (JSOpAssign ('=',JSIdentifier 'a',JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'if') [JSDecimal '1'],JSPropertyNameandValue (JSIdentifier 'interface') [JSDecimal '2']])))"
         testExpr "a={\n  values: 7,\n}\n"   `shouldBe` "Right (JSAstExpression (JSOpAssign ('=',JSIdentifier 'a',JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'values') [JSDecimal '7'],JSComma])))"
-        testExpr "x={get foo() {return 1},set foo(a) {x=a}}" `shouldBe` "Right (JSAstExpression (JSOpAssign ('=',JSIdentifier 'x',JSObjectLiteral [JSPropertyAccessor JSAccessorGet (JSIdentifier 'foo') [] (JSBlock [JSReturn JSDecimal '1' ]),JSPropertyAccessor JSAccessorSet (JSIdentifier 'foo') [JSIdentifier 'a'] (JSBlock [JSOpAssign ('=',JSIdentifier 'x',JSIdentifier 'a')])])))"
+        testExpr "x={get foo() {return 1},set foo(a) {x=a}}" `shouldBe` "Right (JSAstExpression (JSOpAssign ('=',JSIdentifier 'x',JSObjectLiteral [JSPropertyAccessor JSAccessorGet (JSIdentifier 'foo') () (JSBlock [JSReturn JSDecimal '1' ]),JSPropertyAccessor JSAccessorSet (JSIdentifier 'foo') (JSIdentifier 'a') (JSBlock [JSOpAssign ('=',JSIdentifier 'x',JSIdentifier 'a')])])))"
         testExpr "{evaluate:evaluate,load:function load(s){if(x)return s;1}}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'evaluate') [JSIdentifier 'evaluate'],JSPropertyNameandValue (JSIdentifier 'load') [JSFunctionExpression 'load' (JSIdentifier 's') (JSBlock [JSIf (JSIdentifier 'x') (JSReturn JSIdentifier 's' JSSemicolon),JSDecimal '1'])]]))"
         testExpr "obj = { name : 'A', 'str' : 'B', 123 : 'C', }" `shouldBe` "Right (JSAstExpression (JSOpAssign ('=',JSIdentifier 'obj',JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'name') [JSStringLiteral 'A'],JSPropertyNameandValue (JSIdentifier ''str'') [JSStringLiteral 'B'],JSPropertyNameandValue (JSIdentifier '123') [JSStringLiteral 'C'],JSComma])))"
         testExpr "{[x]:1}"      `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyNameandValue (JSPropertyComputed (JSIdentifier 'x')) [JSDecimal '1']]))"
+        testExpr "{ a(x,y) {}, 'blah blah'() {} }" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSMethodDefinition (JSIdentifier 'a') (JSIdentifier 'x',JSIdentifier 'y') (JSBlock []),JSMethodDefinition (JSIdentifier ''blah blah'') () (JSBlock [])]))"
+        testExpr "{[x]() {}}"   `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSMethodDefinition (JSPropertyComputed (JSIdentifier 'x')) () (JSBlock [])]))"
+        testExpr "{*a(x,y) {yield y;}}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSGeneratorMethodDefinition (JSIdentifier 'a') (JSIdentifier 'x',JSIdentifier 'y') (JSBlock [JSYieldExpression (JSIdentifier 'y'),JSSemicolon])]))"
+        testExpr "{*[x]({y},...z) {}}"  `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSGeneratorMethodDefinition (JSPropertyComputed (JSIdentifier 'x')) (JSObjectLiteral [JSPropertyIdentRef 'y'],JSSpreadExpression (JSIdentifier 'z')) (JSBlock [])]))"
 
     it "unary expression" $ do
         testExpr "delete y" `shouldBe` "Right (JSAstExpression (JSUnaryExpression ('delete',JSIdentifier 'y')))"

test/Test/Language/Javascript/Minify.hs

@@ -43,6 +43,9 @@ testMinifyExpr = describe "Minify expressions:" $ do
         minifyExpr " { 'str' : true , 42 : false , } " `shouldBe` "{'str':true,42:false}"
         minifyExpr " { x , } " `shouldBe` "{x}"
         minifyExpr " { [ x + y ] : 1 } " `shouldBe` "{[x+y]:1}"
+        minifyExpr " { a ( x, y ) { } } " `shouldBe` "{a(x,y){}}"
+        minifyExpr " { [ x + y ] ( ) { } } " `shouldBe` "{[x+y](){}}"
+        minifyExpr " { * a ( x, y ) { } } " `shouldBe` "{*a(x,y){}}"
 
     it "parentheses" $ do
         minifyExpr " ( 'hello' ) " `shouldBe` "('hello')"

test/Test/Language/Javascript/RoundTrip.hs

@@ -45,6 +45,9 @@ testRoundTrip = describe "Roundtrip:" $ do
         testRT "x=/*a*/{/*b*/x/*c*/:/*d*/1/*e*/,/*f*/y/*g*/:/*h*/2/*i*/,/*j*/z/*k*/:/*l*/3/*m*/}"
         testRT "a=/*a*/{/*b*/x/*c*/:/*d*/1/*e*/,/*f*/}"
         testRT "/*a*/{/*b*/[/*c*/x/*d*/+/*e*/y/*f*/]/*g*/:/*h*/1/*i*/}"
+        testRT "/*a*/{/*b*/a/*c*/(/*d*/x/*e*/,/*f*/y/*g*/)/*h*/{/*i*/}/*j*/}"
+        testRT "/*a*/{/*b*/[/*c*/x/*d*/+/*e*/y/*f*/]/*g*/(/*h*/)/*i*/{/*j*/}/*k*/}"
+        testRT "/*a*/{/*b*/*/*c*/a/*d*/(/*e*/x/*f*/,/*g*/y/*h*/)/*i*/{/*j*/}/*k*/}"
 
     it "miscellaneous" $ do
         testRT "/*a*/(/*b*/56/*c*/)"