language-js 0.1.0 → 0.2.0

raw patch · 7 files changed

+458/−209 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• language-js.cabal +2/−2
• readme.md +2/−5
• src/Language/JS/Common.hs +16/−8
• src/Language/JS/Operators.hs +1/−1
• src/Language/JS/Parser.hs +403/−191
• src/Language/JS/Types.hs +6/−1
• test/Spec.hs +28/−1

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7591d251e3d3f32efcbaeb9a161dd808d91cb30863aa52efc5609f564b8b9bc6+-- hash: f70584b078bd494fad79a4ae3eb3040e96ec6c49e2ef67cc8774889e5827bafc  name:           language-js-version:        0.1.0+version:        0.2.0 synopsis:       javascript parser for es6 and es7. description:    Please see the README on Github at <https://github.com/diasbruno/language-js#README.md> category:       Language

@@ -1,11 +1,8 @@-# language-js+# language-js [![Build Status](https://travis-ci.org/diasbruno/language-js.svg?branch=master)](https://travis-ci.org/diasbruno/language-js)  javascript parser for es6 and es7. -## todo--- [] refactor.-- [] transform ast into json and/or xml.+NOTE: work in progress...  ## references 

@@ -25,9 +25,15 @@ commaSep1 p = P.sepBy1 p comma semiSep1  p = P.sepBy1 p semi +whiteSpace :: P.Stream s m Char => P.ParsecT s u m Char+whiteSpace = P.oneOf " \n\t"+ whiteSpaces :: P.Stream s m Char => P.ParsecT s u m String-whiteSpaces = P.many (P.oneOf " \n\t")+whiteSpaces = P.many whiteSpace +betweenSpaces :: P.Stream s m Char => P.ParsecT s u m a -> P.ParsecT s u m a+betweenSpaces p = whiteSpaces *> p <* whiteSpaces+ lexeme :: P.Stream s m Char => P.ParsecT s u m a -> P.ParsecT s u m a lexeme p = p <* whiteSpaces @@ -36,13 +42,15 @@  -- | reserved words reservedWords :: [String]-reservedWords = ["function", "return", "var", "let", "const",+reservedWords = ["async", "await", "yield", "delete", "void", "typeof",+                 "instanceof", "new", "debugger",+                 "var", "let", "const",                  "switch", "case", "break", "default",-                 "for", "while", "do", "in", "of",+                 "try", "catch", "finally",+                 "for", "while", "do", "in", "of", "continue",                  "if", "else",-                 "delete", "void", "typeof",-                 "class", "extends", "staticn", "get", "set",-                 "async",-                 "import", "from", "export", "as",-                 "instanceof"+                 "with",+                 "function", "return",+                 "class", "extends", "static", "get", "set", "super",+                 "import", "from", "export", "as"                 ]

@@ -64,4 +64,4 @@              ]  -- withComma = isLiteral (used when parsing arrays, objects and parenthesis expression)-operationExp withComma exp' p = P.buildExpressionParser (table withComma exp') (lexeme p) P.<?> "[operations]"+operationExpression withComma exp' p = P.buildExpressionParser (table withComma exp') (lexeme p) P.<?> "[operations]"

@@ -8,103 +8,189 @@ import Language.JS.Common import Language.JS.Operators --- | identifier-identifier = do h <- P.many (P.oneOf "_$")-                t <- P.many1 P.alphaNum-                return (h ++ t)+-- | Identifier name.+identifierName =+  liftM2 (++) (P.many (P.oneOf "_$")) (P.many1 P.alphaNum) -identB = P.try (LI <$> (do i <- identifier-                           case i `elem` reservedWords of-                             True -> P.unexpected "reserved word"-                             _    -> return i)) P.<?> "[identifier]"+-- | Parse identifier (no reserved words).+identifier =+  P.try (LI <$> (do i <- identifierName+                    case i `elem` reservedWords of+                      True -> P.unexpected "reserved word"+                      _    -> return i)) P.<?> "[identifier]" --- | numbers-numberB = LN <$> (P.many1 P.digit) P.<?> "[number-literal]"+-- | Parse numeric literal.+-- Here we don't distinguish between kinds.+numericLiteral =+  LN <$> (binN <|> octN <|> hexN <|> decN)+  P.<?> "[number-literal]"+  where prefix p = do+          i <- P.char '0'+          x <- P.oneOf p+          return [i, x]+        combine = liftM2 (++)+        hexN = combine (P.try (prefix "xX")) (P.many1 (P.oneOf "0123456789abcdefABCDEF"))+        octN = combine (P.try (prefix "oO")) (P.many1 (P.oneOf "01234567"))+        binN = combine (P.try (prefix "bB")) (P.many1 (P.oneOf "01"))+        decN = do+          lead <- P.many1 P.digit+          fraction <- liftM2 (:) (P.char '.') (P.many P.digit) <|> return ""+          expo <- expoN+          return (lead ++ fraction ++ expo)+        expoN = liftM2 (:) (P.oneOf "eE") (P.many P.digit) <|> return "" --- | booleans-boolB = P.try (boolA "true" <|> boolA "false") P.<?> "[boolean]"+-- | Parse boolean literal.+booleanLiteral =+  P.try (boolA "true" <|> boolA "false")+  P.<?> "[boolean]"+  where boolA = fmap (LB . toHask) . keywordB+        toHask s | s == "true" = True+                 | otherwise = False++-- | this identifier+thisIdent =+  const LThis <$> keywordB "this" P.<?> "[this]"++-- | null identifier+nullIdent =+  const LNull <$> keywordB "null" P.<?> "[null]"++-- | Parse string literal.+stringLiteral =+  buildExpression LS '\"' withoutNewLineAllowed+  <|> buildExpression LS '\'' withoutNewLineAllowed+  <|> LTS <$> (P.char '`' *> templateString "" [])+  P.<?> "[string-literal]"   where-    boolA = fmap (LB . toHask) . keywordB-    toHask s | s == "true" = True-             | otherwise = False+    withoutNewLineAllowed e = P.many (P.satisfy (\c -> c /= '\n' && c /= e))+    buildExpression ctor wc p = ctor <$> P.try (P.between (P.char wc) (P.char wc) (p wc)) --- | this-thisB = const LThis <$> keywordB "this" P.<?> "[this]"+-- | Parse template strings.+templateString str ls = (do+  t <- P.anyToken+  case t of+    '$' -> do+      e <- TExpression <$> braces (expressionNonEmpty True)+      let s' = if length str > 0 then [TString str, e] else [e]+      templateString "" (ls ++ s')+    '`' -> return (ls ++ (if length str > 0 then [TString str] else []))+    _   -> templateString (str ++ [t]) ls) <|> return ls --- | null-nullB = const LNull <$> keywordB "null" P.<?> "[null]"+-- | Parse regular expression literal.+regexLiteral =+  let re = (P.string "/" >> return "") <|>+           (do es <- P.char '\\' -- escaped char+               t <- P.anyToken+               n <- re+               return (es:t:n)) <|>+           (liftM2 (:) P.anyToken re)+  in RegExp <$> ((P.char '/') *> re) <*> P.many (P.oneOf "mgi") -stringA ctor wc p = ctor <$> (P.try (P.between (P.char wc) (P.char wc) (p wc)))+-- | Parse elision (aka ',' without a value on array).+elision =+  const Elision <$> keywordB ","+  P.<?> "elision" --- | strings literal-stringB = stringA LS '\"' allowed <|> stringA LS '\'' allowed P.<?> "[string-literal]"-  where-    allowed e = P.many (P.satisfy (\c -> c /= '\n' && c /= e))+-- | Parse many items on a array declaration.+arrayItems ls =+  (lexeme (elision <|> item) >>= \x -> arrayItems (ls ++ [x])) <|> return ls+  where item = checkSpread Spread (expressionNonEmpty False) <* P.optional (P.char ',') --- | template strings-templateStringB = stringA LTS '`' allowed P.<?> "[template-string]"-  where-    allowed e = P.many (P.satisfy (\c -> c /= e))+-- | Parse array literal.+arrayLiteral =+  P.try (LA <$> brackets (betweenSpaces (arrayItems [])))+  P.<?> "[array]" -regexB :: (P.Stream s m Char) => P.ParsecT s u m Expression-regexB = let re = (P.string "/" >> return "") <|>-                 (do es <- P.char '\\' -- escaped char-                     t <- P.anyToken-                     n <- re-                     return (es:t:n)) <|>-                 (liftM2 (:) P.anyToken re)-        in RegExp <$> ((P.char '/') *> re) <*> P.many (P.oneOf "mgi")+-- | key and/or value property pair.+objectBinds = do+  sp <- P.optionMaybe (keywordB "...")+  case sp of+    Just _ -> OPI . Spread <$> literals+    Nothing -> (OPM <$> (asyncMethodDef <|> classGetSetMethodDef <|> propertyMethodDef)) <|> (do+      k <- identifier+      x <- P.try (P.lookAhead (P.oneOf ",:}"))+      case x of+        ':' -> P.try (OPKV k <$> (lexeme (P.char ':') *> lexeme (checkSpread Spread (expressionNonEmpty False)) P.<?> "[object-value-expression]"))+        _ -> return (OPI k)) --- | array literal-arrayB = P.try (LA <$> brackets (commaSep (whiteSpaces *> checkSpread Spread (expressionNonEmpty False)))) P.<?> "[array]"+-- | Parse object literal.+-- objectLiteral :: P.ParsecT s u m Expression+objectLiteral =+  LO <$> lexeme (braces (P.sepBy (betweenSpaces objectBinds) (P.char ',')))+  P.<?> "[object-literal]" --- | parenthesis expression-parensB = LP <$> parens (whiteSpaces *> (expressionNonEmpty True)) P.<?> "[parenthesis]"+-- | Parse parenthesis expression.+parensExpression =+  LP <$> parens (betweenSpaces (expressionNonEmpty True))+  P.<?> "[parenthesis]" -checkSpread ctor p = do i <- P.optionMaybe (keywordB "...")-                        case i of-                          Just _ -> ctor <$> p-                          Nothing -> p+-- | Check for spread operation before parse 'p'.+checkSpread ctor p =+  do i <- P.optionMaybe (keywordB "...")+     case i of+       Just _ -> ctor <$> p+       Nothing -> p -formalParameter = whiteSpaces *> bindExpression <* whiteSpaces-                  P.<?> "[formal-parameters]"+-- | Parse used by function declarations.+formalParameter =+  betweenSpaces bindExpression+  P.<?> "[formal-parameters]" --- | function expression-functionDeclB = Function <$> (keywordB "function" *> lexeme (P.optionMaybe identB))-                         <*> lexeme (parens (commaSep formalParameter))-                         <*> lexeme (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements)))-                P.<?> "[function]"+-- | Parse function declaration+functionDeclaration =+  keywordB "function" *>+    (Function <$> lexeme (P.optionMaybe identifier)+              <*> lexeme (parens (commaSep formalParameter))+              <*> lexeme (SBlock <$> braces (betweenSpaces (P.many (lexeme statements)))))+  P.<?> "[function]" --- | arrow expression (function)-afunctionB = P.try (Arrow <$> (lexeme (parens manyParams <|> singleParam) <* keywordB "=>")-                          <*> (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements)) <|> statements))-             P.<?> "[arrow-function]"+-- | Prase arrow function declaration.+arrowFunctionDeclaration =+  P.try (Arrow <$> (lexeme (parens manyParams <|> singleParam) <* keywordB "=>")+               <*> blockOrStatements)+  P.<?> "[arrow-function]"   where singleParam = Left <$> bindVar         manyParams = Right <$> commaSep formalParameter -functionB = (afunctionB <|> functionDeclB)+-- | Parse any kind of funcion declaration (function or arrow function).+functionExpression =+  arrowFunctionDeclaration <|> functionDeclaration -propertyMethodDef = P.try (PropertyMethod <$> lexeme identB-                                          <*> lexeme (parens (commaSep formalParameter))-                                          <*> (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements))))-                    P.<?> "[class-method-definition]"+-- | Parse property method of a class or object literal.+propertyMethodDef =+  P.try (PropertyMethod <$> lexeme identifier+                        <*> lexeme (parens (commaSep formalParameter))+                        <*> (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements))))+  P.<?> "[class-method-definition]" -classStaticDef = lexeme (keywordB "static") *> (ClassStatic <$> (propertyMethodDef <|> classPropertyDef))+-- | Parse a static property of a class.+classStaticDef =+  lexeme (keywordB "static") *>+    (ClassStatic <$> (propertyMethodDef <|> classPropertyDef)) -classGetSetMethodDef = (keywordB "set" *> (ClassSetMethod <$> propertyMethodDef)) <|>-                       (keywordB "get" *> (ClassGetMethod <$> propertyMethodDef))-                       P.<?> "[class-get-set-definition]"+-- | Parse a getter or setter method.+classGetSetMethodDef =+  (keywordB "set" *> (ClassSetMethod <$> propertyMethodDef)) <|>+  (keywordB "get" *> (ClassGetMethod <$> propertyMethodDef))+  P.<?> "[class-get-set-definition]" -asyncMethodDef = keywordB "async" *> (Async <$> propertyMethodDef)-                 P.<?> "[async-definition]"+-- | Check for a async property method.+asyncMethodDef =+  keywordB "async" *> (Async <$> propertyMethodDef)+  P.<?> "[async-definition]" -classPropertyDef = P.try (ClassProperty <$> (lexeme identB <* P.char '=' <* whiteSpaces)-                                        <*> lexeme (expressionNonEmpty False))-                   P.<?> "[class-property]"-classB = keywordB "class" *> (Class <$> (lexeme (P.optionMaybe identB))-                                    <*> P.optionMaybe (keywordB "extends" *> lexeme identB)-                                    <*> (SBlock <$> braces (whiteSpaces *> classBlock)))-         P.<?> "[class-expression]"+-- | Parse a class property definition.+classPropertyDef =+  P.try (ClassProperty <$> (lexeme identifier <* P.char '=' <* whiteSpaces)+                       <*> lexeme (expressionNonEmpty False))+  P.<?> "[class-property]"++-- | Parse a class declaration.+classDeclaration =+  keywordB "class" *> (Class <$> (lexeme (P.optionMaybe identifier))+                             <*> P.optionMaybe (keywordB "extends" *> lexeme identifier)+                             <*> (SBlock <$> braces (whiteSpaces *> classBlock)))+  P.<?> "[class-expression]"   where classBlock = P.many (lexeme (toStatement <$> classBlockDecls))         classBlockDecls = (classPropertyDef                             <|> asyncMethodDef@@ -112,57 +198,92 @@                             <|> classGetSetMethodDef                             <|> propertyMethodDef) --- | key and/or value property pair-kvB = do-  sp <- P.optionMaybe (keywordB "...")-  case sp of-    Just _ -> OPI . Spread <$> literals-    Nothing -> (OPM <$> (asyncMethodDef <|> classGetSetMethodDef <|> propertyMethodDef)) <|> (do-      k <- identB-      x <- P.try (P.lookAhead (P.oneOf ",:}"))-      case x of-        ':' -> P.try (OPKV k <$> (lexeme (P.char ':') *> lexeme (checkSpread Spread (expressionNonEmpty False)) P.<?> "[object-value-expression]"))-        _ -> return (OPI k))+-- | Dot member.+dotMember p =+  Dot p <$> (lexeme (P.char '.') *> identifier)+  P.<?> "[dot-expression]" --- | object literal-objectB = LO <$> lexeme (braces (P.sepBy (whiteSpaces *> kvB <* whiteSpaces) (P.char ','))) P.<?> "[object-literal]"+-- | Array like accessor.+accessor p =+  Acc p <$> brackets (betweenSpaces (expressionNonEmpty True))+  P.<?> "[array-expression]" -dotMember p = Dot p <$> (lexeme (P.char '.') *> identB) P.<?> "[dot-expression]"-accessor p = Acc p <$> brackets (whiteSpaces *> (expressionNonEmpty True) <* whiteSpaces) P.<?> "[array-expression]"-callExp p = FCall p <$> lexeme (parens (commaSep (whiteSpaces *> expressionNonEmpty False))) P.<?> "[function-call]"+-- | Function call.+functionCall p =+  FCall p <$> lexeme (parens (commaSep (whiteSpaces *> expressionNonEmpty False)))+  P.<?> "[function-call]"  -- | new-newB = const Nothing <$> keywordB "new" P.<?> "[new]"+newIdent =+  const Nothing <$> keywordB "new" P.<?> "[new]" -memberExp (Just p) = (do dt <- (callExp p <|> dotMember p <|> accessor p) P.<?> "[member-expression]"-                         memberExp (Just dt)) <|> return p-memberExp Nothing = (New <$> expressions) P.<?> "[new-expression]"+-- | Parse member expression.+memberExpression (Just p) =+  (do dt <- (functionCall p <|> dotMember p <|> accessor p) P.<?> "[member-expression]"+      memberExpression (Just dt)) <|> return p+memberExpression Nothing =+  (New <$> expressions) P.<?> "[new-expression]" -literals = thisB <|> nullB <|> boolB-           <|> stringB <|> templateStringB-           <|> arrayB  <|> objectB <|> regexB-           <|> numberB <|> identB+-- | Parse literals.+literals =+  thisIdent+  <|> nullIdent+  <|> booleanLiteral+  <|> stringLiteral+  <|> arrayLiteral+  <|> objectLiteral+  <|> regexLiteral+  <|> numericLiteral+  <|> identifier -primaryExp = literals <|> functionB <|> classB <|> parensB+-- | Parse primary expressions.+primaryExpression =+  literals+  <|> functionDeclaration+  <|> classDeclaration+  <|> parensExpression -maybeSemi = P.optional (P.char ';')+-- | Check for maybe semi.+-- TODO: There are some rules for expression termination...need to check that.+maybeSemi =+  P.optional (P.char ';') -emptyExp = (const Empty) <$> (P.char ';') P.<?> "[empty-expressions]"+-- | Parse a empty expression.+emptyExpression =+  (const Empty) <$> (P.char ';')+  P.<?> "[empty-expressions]" -leftHandSideExp = (newB <|> (Just <$> lexeme primaryExp)) >>= memberExp P.<?> "left-hand-side-expression"+-- | Parse rules for left hand side expression.+leftHandSideExpression =+  (newIdent <|> (Just <$> lexeme primaryExpression)) >>= memberExpression+  P.<?> "left-hand-side-expression" --- | expressions-expressions = emptyExp <|> expressionNonEmpty True P.<?> "[expressions]"+-- | Parse expressions.+expressions =+  emptyExpression <|> expressionNonEmpty True P.<?> "[expressions]" -comment = P.try (Comment <$> (P.string "//" *> P.many (P.satisfy (\c -> c /= '\n'))))-multilineComment = P.try (MultilineComment <$> (P.between (P.string "/*") (P.string "*/") (P.many P.anyToken)))+-- | Parse single line comment.+comment =+  P.try (Comment <$> (P.string "//" *> P.many (P.satisfy (\c -> c /= '\n')))) -expressionNonEmpty notComma = comment <|> multilineComment <|>-                              functionB <|> classB <|>-                              (operationExp notComma (expressionNonEmpty notComma) leftHandSideExp) <|>-                              primaryExp-                              P.<?> "[non-empty-expressions]"+-- | Parse multiline comment.+multilineComment =+  P.try (MultilineComment <$> (P.between (P.string "/*") (P.string "*/") (P.many P.anyToken))) +-- | Parse comment like an expression.+commentExpression =+  comment <|> multilineComment++-- | Parse expressions excluding emptyExpression.+expressionNonEmpty notComma =+  commentExpression+  <|> functionExpression+  <|> classDeclaration+  <|> (operationExpression notComma (expressionNonEmpty notComma) leftHandSideExpression)+  <|> primaryExpression+  P.<?> "[non-empty-expressions]"++-- | Convert a expression into a statement. toStatement :: Expression -> Statement toStatement (Function (Just (LI a)) b c) = SF a b c toStatement (Class (Just (LI a)) b c)    = SC a b c@@ -170,113 +291,201 @@  -- Statements -importNamespaceClause = Namespace <$> ((keywordB "*" *> keywordB "as") *> identB)-importBindClause = BindNames <$> braces (commaSep (whiteSpaces *> identB <* whiteSpaces))-importDefaultNameClause = DefaultName <$> lexeme identB+-- | Parse import namespace clauses.+importNamespaceClause =+  Namespace <$> ((keywordB "*" *> keywordB "as") *> identifier) -importManyClauses = commaSep1 (whiteSpaces *> (importBindClause <|> importDefaultNameClause))+-- | Parse import bind clauses.+importBindClause =+  BindNames <$> braces (commaSep (betweenSpaces identifier)) -importClauses = (importNamespaceClause >>= return . Left)-                <|> (importManyClauses >>=  return . Right)+-- | Parse default clauses.+importDefaultNameClause =+  DefaultName <$> lexeme identifier -importFileStatement = SImportFile <$> lexeme stringB-importStatement = SImport <$> (lexeme importClauses <* keywordB "from") <*> lexeme stringB-importStatements = keywordB "import" *> (importStatement <|> importFileStatement)-                   P.<?> "[import-statement]"+-- | Parse import clauses excluding namespace clause.+importManyClauses =+  commaSep1 (whiteSpaces *> (importBindClause <|> importDefaultNameClause)) -reexportStatement = P.try (SRExport <$> (lexeme (expressionNonEmpty False) <* keywordB "from") <*> lexeme stringB)+-- | Parse all import clauses.+importClauses =+  (Left <$> importNamespaceClause) <|>+  (Right <$> importManyClauses)++-- | Parse import file statement.+importFileStatement =+  SImportFile <$> lexeme stringLiteral++-- | Parse import statement.+importStatement =+  SImport <$> (lexeme importClauses <* keywordB "from") <*> lexeme stringLiteral++-- | Parse import statements.+importStatements =+  keywordB "import" *> (importStatement <|> importFileStatement)+  P.<?> "[import-statement]"++reexportStatement = P.try (SRExport <$> (lexeme (expressionNonEmpty False) <* keywordB "from") <*> lexeme stringLiteral) exportDefaultStatement = keywordB "default" *> (SExportDefault <$> expressionNonEmpty False) exportStatement = SExport <$> statements++-- | Parse export statements. exportStatements = keywordB "export" *> (reexportStatement <|> exportDefaultStatement <|> exportStatement)                    P.<?> "[export-statement]" -continueStatement = SContinue <$> (keywordB "continue" *> P.optionMaybe identB)-                    P.<?> "[continue-statement]"-breakStatement = SBreak <$> (keywordB "break" *> P.optionMaybe identB)-                 P.<?> "[break-statement]"+-- | Parse continue statement.+continueStatement =+  keywordB "continue" *> (SContinue <$> (P.optionMaybe identifier))+  P.<?> "[continue-statement]" -blockStatement allowedStmt = SBlock <$> (P.try (braces (whiteSpaces *> P.many allowedStmt <* whiteSpaces)))-                             P.<?> "[block-statement]"+-- | Parse break statement.+breakStatement =+  keywordB "break" *> (SBreak <$> (P.optionMaybe identifier))+  P.<?> "[break-statement]" -ifStatement = SIf <$> (keywordB "if" *> lexeme parensB)-                  <*> lexeme (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements)) <|> statements)-                  <*> P.optionMaybe (keywordB "else" *> (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements)) <|> statements))-              P.<?> "[if-statement]"+-- | Parse block statement.+blockStatement allowedStmt =+  SBlock <$> P.try (braces (betweenSpaces (P.many allowedStmt)))+  P.<?> "[block-statement]" -catchB = SCatch <$> (keywordB "catch" *> lexeme (P.optionMaybe parensB))-                <*> blockStatement statements-         P.<?> "[try/catch-statement]"+blockOrStatements =+  SBlock <$> braces (whiteSpaces *> P.many (lexeme statements)) <|> statements -finallyB = SFinally <$> (keywordB "finally" *> blockStatement statements)-           P.<?> "[try/catch/finally-statement]"+-- | Parse if statement.+ifStatement =+  keywordB "if" *> (SIf <$> (lexeme parensExpression)+                        <*> lexeme blockOrStatements+                        <*> P.optionMaybe (keywordB "else" *> blockOrStatements))+  P.<?> "[if-statement]" -tryStatement = STry <$> (keywordB "try" *> lexeme (blockStatement statements))-                    <*> catchB-                    <*> P.optionMaybe finallyB P.<?> "[try-statement]"+-- | Parse catch part of try statement.+catchBlock =+  keywordB "catch" *> (SCatch <$> lexeme (P.optionMaybe parensExpression)+                              <*> blockStatement statements)+  P.<?> "[try/catch-statement]" -throwStatement = SThrow <$> (keywordB "throw" *> expressionNonEmpty False)-                 P.<?> "[throw-statement]"+-- | Parse finally part of try statement.+finallyBlock =+  keywordB "finally" *> (SFinally <$> (blockStatement statements))+  P.<?> "[try/catch/finally-statement]" -returnStatement = SReturn <$> (keywordB "return" *> expressions)-                  P.<?> "[return-statement]"+-- | Parse try statement.+tryStatement =+  keywordB "try" *> (STry <$> lexeme (blockStatement statements)+                          <*> catchBlock+                          <*> P.optionMaybe finallyBlock)+  P.<?> "[try-statement]" -bindVar = BindVar <$> lexeme identB <*> P.optionMaybe (P.notFollowedBy (keywordB "=>") *> (lexeme (P.char '=') *> (expressionNonEmpty False)))-bindPatternDecl = BindPattern <$> (lexeme (objectB <|> arrayB)) <*> P.optionMaybe (lexeme (P.char '=') *> (expressionNonEmpty False))-bindSpread = BindRest <$> (keywordB "..." *> leftHandSideExp)-bindExpression = (bindVar <|> bindPatternDecl <|> bindSpread) P.<?> "[var-binds]"+-- | Parse throw statement.+throwStatement =+  keywordB "throw" *> (SThrow <$> (expressionNonEmpty False))+  P.<?> "[throw-statement]" -constVariableStatement = P.try (SVariable <$> (keywordB "const") <*> commaSep1 (whiteSpaces *> bindExpression <* whiteSpaces))-notConstVariableStatement = P.try (SVariable <$> (keywordB "let" <|> keywordB "var") <*> commaSep1 (whiteSpaces *> bindExpression <* whiteSpaces))-variableStatement = constVariableStatement <|> notConstVariableStatement P.<?> "[variable-statement]"+-- | Parse return statement.+returnStatement =+  keywordB "return" *> (SReturn <$> expressions)+  P.<?> "[return-statement]" -caseClause = lexeme ((caseB <|> defaultCase) <* (P.char ':')) P.<?> "[switch/case-expression]"+bindVar =+  BindVar <$> lexeme identifier <*> P.optionMaybe (P.notFollowedBy (keywordB "=>") *> (lexeme (P.char '=') *> (expressionNonEmpty False)))+bindPatternDecl =+  BindPattern <$> (lexeme (objectLiteral <|> arrayLiteral)) <*> P.optionMaybe (lexeme (P.char '=') *> (expressionNonEmpty False))+bindSpread =+  BindRest <$> (keywordB "..." *> leftHandSideExpression)+bindExpression =+  (bindVar <|> bindPatternDecl <|> bindSpread) P.<?> "[var-binds]"++constVariableStatement =+  P.try (SVariable <$> (keywordB "const") <*> commaSep1 (betweenSpaces bindExpression))+notConstVariableStatement =+  P.try (SVariable <$> (keywordB "let" <|> keywordB "var") <*> commaSep1 (betweenSpaces bindExpression))++-- | Parse variable statement.+variableStatement =+  constVariableStatement <|> notConstVariableStatement P.<?> "[variable-statement]"++-- | Parse case clause switch statement.+caseClause =+  lexeme ((caseB <|> defaultCase) <* (P.char ':'))+  P.<?> "[switch/case-expression]"   where defaultCase = const DefaultCase <$> (keywordB "default")-        caseB       = Case <$> (keywordB "case" *> literals)+        caseB       = keywordB "case" *> (Case <$> literals) -caseCase = SCase <$> lexeme (P.many1 caseClause)-                 <*> P.many (lexeme ((breakStatement <* maybeSemi) <|> statements))+-- | Parse case clause switch statement.+caseDeclaration =+  SCase <$> lexeme (P.many1 caseClause)+        <*> P.many (lexeme ((breakStatement <* maybeSemi) <|> statements)) -caseBlock = braces (whiteSpaces *> P.many caseCase <* whiteSpaces)-switchStatement = SSwitch <$> (keywordB "switch" *> lexeme parensB)-                          <*> caseBlock-                  P.<?> "[switch-statement]"+-- | Parse switch statement.+switchStatement =+  keywordB "switch" *>+    (SSwitch <$> lexeme parensExpression+             <*> braces (betweenSpaces (P.many caseDeclaration)))+  P.<?> "[switch-statement]" -debuggerStatement = const SDebugger <$> keywordB "debugger"-                    P.<?> "[debugger-statement]"+-- | Parse debugger statement.+debuggerStatement =+  const SDebugger <$> keywordB "debugger"+  P.<?> "[debugger-statement]" -breakableStatement = blockStatement ((breakStatement <* maybeSemi) <|> statements) <|> statements+-- | Parse breakable statement.+-- TODO: this parser can be improved to parse vaild javascript code+-- by passing to the break statement to subsequent statements.+breakableStatement =+  blockStatement ((breakStatement <* maybeSemi) <|> statements) <|> statements -whileStatement = SWhile <$> (keywordB "while" *> lexeme (parens (P.many1 expressions)))-                        <*> breakableStatement-                 P.<?> "[while-statement]"+-- | Parse while statement.+whileStatement =+  keywordB "while" *>+    (SWhile <$> lexeme (parens (P.many1 expressions))+            <*> breakableStatement)+  P.<?> "[while-statement]" -doWhileStatement = SDoWhile <$> (keywordB "do" *> lexeme breakableStatement)-                            <*> (keywordB "while" *> parens (P.many1 expressions))-                   P.<?> "[do/while-statement]"+-- | parse do-while statement.+doWhileStatement =+  keywordB "do" *>+    (SDoWhile <$> lexeme breakableStatement+              <*> (keywordB "while" *> parens (P.many1 expressions)))+  P.<?> "[do/while-statement]" -forInVStyle = P.try (ForInV <$> lexeme (keywordB "let" <|> keywordB "const" <|> keywordB "var")-                            <*> bindExpression-                            <*> (keywordB "in" *> (expressionNonEmpty False)))-forOfVStyle = P.try (ForOfV <$> lexeme (keywordB "let" <|> keywordB "const" <|> keywordB "var")-                            <*> bindExpression-                            <*> (keywordB "of" *> expressionNonEmpty False ))-forInStyle = P.try (ForIn <$> bindExpression <*> (keywordB "in" *> expressionNonEmpty False))-forOfStyle = P.try (ForOf <$> bindExpression <*> (keywordB "of" *> expressionNonEmpty False))-forRegularStyle = ForRegular <$> P.try (P.optionMaybe bindExpression <* (P.char ';'))-                             <*> P.try (P.optionMaybe (expressionNonEmpty True) <* (P.char ';'))-                             <*> P.optionMaybe (expressionNonEmpty True)-forStyle = forInVStyle <|> forOfVStyle <|> forInStyle <|> forOfStyle <|> forRegularStyle P.<?> "[for-style]"-forStatement = SFor <$> lexeme (keywordB "for" *> (parens forStyle)) <*> breakableStatement+forInVStyle =+  P.try (ForInV <$> lexeme (keywordB "let" <|> keywordB "const" <|> keywordB "var")+                <*> bindExpression+                <*> (keywordB "in" *> (expressionNonEmpty False)))+forOfVStyle =+  P.try (ForOfV <$> lexeme (keywordB "let" <|> keywordB "const" <|> keywordB "var")+                <*> bindExpression+                <*> (keywordB "of" *> expressionNonEmpty False ))+forInStyle =+  P.try (ForIn <$> bindExpression <*> (keywordB "in" *> expressionNonEmpty False))+forOfStyle =+  P.try (ForOf <$> bindExpression <*> (keywordB "of" *> expressionNonEmpty False))+forRegularStyle =+  ForRegular <$> P.try (P.optionMaybe bindExpression <* (P.char ';'))+             <*> P.try (P.optionMaybe (expressionNonEmpty True) <* (P.char ';'))+             <*> P.optionMaybe (expressionNonEmpty True)+forStyle =+  forInVStyle <|> forOfVStyle <|> forInStyle <|> forOfStyle <|> forRegularStyle P.<?> "[for-style]" +-- | Parse for statement.+forStatement =+  SFor <$> lexeme (keywordB "for" *> (parens forStyle)) <*> breakableStatement++-- | Parse iteration statements (for, white, do/while). iterationStatement = forStatement <|> whileStatement <|> doWhileStatement -withStatement = SWith <$> (keywordB "with" *> lexeme (parens (expressionNonEmpty True)))-                      <*> (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements)) <|> statements)-                P.<?> "[with-statement]"+-- | Parse with statement.+withStatement =+  keywordB "with" *> (SWith <$> lexeme (parens (expressionNonEmpty True))+                            <*> (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements)) <|> statements))+  P.<?> "[with-statement]" -labelledStatement = SLabel <$> P.try (lexeme (identB <* P.char ':')) <*> statements-                    P.<?> "[labelled-statement]"+-- | Parse labelled statement.+labelledStatement =+  SLabel <$> P.try (lexeme (identifier <* P.char ':')) <*> statements+  P.<?> "[labelled-statement]" +-- | Parse statements. statements = ((blockStatement statements                <|> ifStatement                <|> iterationStatement@@ -289,15 +498,18 @@                <|> switchStatement                <|> withStatement                <|> variableStatement-               <|> (fmap toStatement expressions)) <* maybeSemi) P.<?> "[statements]"+               <|> fmap toStatement expressions) <* maybeSemi) P.<?> "[statements]" +-- | Parse all statements allowed to be on top level.+-- This helps to not allow import and export expressions+-- in any other part of the code. topLevelStatements = importStatements <|> exportStatements <|> statements  -- | parser-parseJs = P.many (whiteSpaces *> lexeme (topLevelStatements <* maybeSemi <* whiteSpaces))+parseJs = P.many (betweenSpaces (topLevelStatements <* maybeSemi)) -parse :: String -> String -> Either P.ParseError [Statement]-parse filename source = P.parse parseJs filename source+-- | Parse a script with a filename.+parse = P.parse parseJs -parseFromFile :: String -> IO (Either P.ParseError [Statement])-parseFromFile filename = readFile filename >>= return . P.parse parseJs filename+-- | Parse a script from a file. Just for convinience.+parseFromFile filename = P.parse parseJs filename <$> readFile filename

@@ -44,18 +44,23 @@                     | BindRest Expression                     deriving (Show) +data TemplateString = TString String+                    | TExpression Expression+                    deriving (Show)+ data Expression = -- literals   LThis   | LNull   | LI String   | LN String   | LS String-  | LTS String+  | LTS [TemplateString] -- LS + Expression   | LB Bool   | RegExp String String   | UnaryUpdate String IsPrefix Expression   | Unary String Expression   | Spread Expression+  | Elision -- single comma   | LA [Expression]   | LO [ObjectProperty]   | LP Expression

@@ -37,6 +37,18 @@     shouldBe (testExpression "1")       "Right (LN \"1\")" +    shouldBe (testExpression "1.10")+      "Right (LN \"1.10\")"++    shouldBe (testExpression "0.10e3")+      "Right (LN \"0.10e3\")"++    shouldBe (testExpression "0x11")+      "Right (LN \"0x11\")"++    shouldBe (testExpression "0b11")+      "Right (LN \"0b11\")"+   it "strings" $ do     shouldBe (testExpression "\"test\"")       "Right (LS \"test\")"@@ -45,12 +57,24 @@    it "template string" $ do     shouldBe (testExpression "`test`")-      "Right (LTS \"test\")"+      "Right (LTS [TString \"test\"])" +    shouldBe (testExpression "`${\"a\"}`")+      "Right (LTS [TExpression (LS \"a\")])"++    shouldBe (testExpression "`test ${a + 1} test`")+      "Right (LTS [TString \"test \",TExpression (Operation \"+\" (LI \"a\") (LN \"1\")),TString \" test\"])"++    shouldBe (testExpression "`${a} test ${b}`")+      "Right (LTS [TExpression (LI \"a\"),TString \" test \",TExpression (LI \"b\")])"+   it "arrays" $ do     shouldBe (testExpression "[]")       "Right (LA [])" +    shouldBe (testExpression "[,]")+      "Right (LA [Elision])"+     shouldBe (testExpression "[1,2]")       "Right (LA [LN \"1\",LN \"2\"])" @@ -62,6 +86,9 @@      shouldBe (testExpression "[a,...[1, 2]]")       "Right (LA [LI \"a\",Spread (LA [LN \"1\",LN \"2\"])])"++    shouldBe (testExpression "[a,,b]")+      "Right (LA [LI \"a\",Elision,LI \"b\"])"    it "objects" $ do     shouldBe (testExpression "{}")