language-js (empty) → 0.1.0
raw patch · 10 files changed
+1204/−0 lines, 10 filesdep +basedep +hspecdep +language-jssetup-changed
Dependencies added: base, hspec, language-js, parsec
Files
- Setup.hs +2/−0
- changelog.md +0/−0
- language-js.cabal +58/−0
- license.md +30/−0
- readme.md +13/−0
- src/Language/JS/Common.hs +48/−0
- src/Language/JS/Operators.hs +67/−0
- src/Language/JS/Parser.hs +303/−0
- src/Language/JS/Types.hs +126/−0
- test/Spec.hs +557/−0
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
+ language-js.cabal view
@@ -0,0 +1,58 @@+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 7591d251e3d3f32efcbaeb9a161dd808d91cb30863aa52efc5609f564b8b9bc6++name: language-js+version: 0.1.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+homepage: https://github.com/diasbruno/language-js#readme+bug-reports: https://github.com/diasbruno/language-js/issues+author: Bruno Dias <dias.h.bruno@gmail.com>+maintainer: Bruno Dias <dias.h.bruno@gmail.com>+copyright: 2018 Bruno Dias+license: BSD3+license-file: license.md+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ changelog.md+ readme.md++source-repository head+ type: git+ location: https://github.com/diasbruno/language-js++library+ exposed-modules:+ Language.JS.Common+ Language.JS.Operators+ Language.JS.Parser+ Language.JS.Types+ other-modules:+ Paths_language_js+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , parsec+ default-language: Haskell2010++test-suite language-js-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_language_js+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , hspec+ , language-js+ , parsec+ default-language: Haskell2010
+ license.md view
@@ -0,0 +1,30 @@+Copyright Bruno Dias (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ readme.md view
@@ -0,0 +1,13 @@+# language-js++javascript parser for es6 and es7.++## todo++- [] refactor.+- [] transform ast into json and/or xml.++## references++- [ECMAScript® 2017 Language Specification (ECMA-262, 8th edition, June 2017)](http://www.ecma-international.org/ecma-262/8.0/index.html)+- [MDN Operator precedence](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Operator_Precedence)
+ src/Language/JS/Common.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleContexts #-}+module Language.JS.Common where++import qualified Text.Parsec as P++parens, braces, angles, brackets :: P.Stream s m Char =>+ P.ParsecT s u m a -> P.ParsecT s u m a+parens = P.between (P.string "(") (P.string ")")+braces = P.between (P.string "{") (P.string "}")+angles = P.between (P.string "<") (P.string ">")+brackets = P.between (P.string "[") (P.string "]")++semi, comma, dot, colon :: P.Stream s m Char => P.ParsecT s u m String+semi = P.string ";"+comma = P.string ","+dot = P.string "."+colon = P.string ":"++dotSep, commaSep, semiSep :: P.Stream s m Char => P.ParsecT s u m a -> P.ParsecT s u m [a]+dotSep p = P.sepBy1 p dot+commaSep p = P.sepBy p comma+semiSep p = P.sepBy p semi++commaSep1, semiSep1 :: P.Stream s m Char => P.ParsecT s u m a -> P.ParsecT s u m [a]+commaSep1 p = P.sepBy1 p comma+semiSep1 p = P.sepBy1 p semi++whiteSpaces :: P.Stream s m Char => P.ParsecT s u m String+whiteSpaces = P.many (P.oneOf " \n\t")++lexeme :: P.Stream s m Char => P.ParsecT s u m a -> P.ParsecT s u m a+lexeme p = p <* whiteSpaces++keywordB :: P.Stream s m Char => String -> P.ParsecT s u m String+keywordB = P.try . lexeme . P.string++-- | reserved words+reservedWords :: [String]+reservedWords = ["function", "return", "var", "let", "const",+ "switch", "case", "break", "default",+ "for", "while", "do", "in", "of",+ "if", "else",+ "delete", "void", "typeof",+ "class", "extends", "staticn", "get", "set",+ "async",+ "import", "from", "export", "as",+ "instanceof"+ ]
+ src/Language/JS/Operators.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE FlexibleContexts #-}+module Language.JS.Operators where++import qualified Text.Parsec.Expr as P+import qualified Text.Parsec as P+import Language.JS.Types+import Language.JS.Common++opNotFollowedBy op p = keywordB op <* P.notFollowedBy p++table :: P.Stream s m Char => Bool -> P.ParsecT s u m Expression -> [[P.Operator s u m Expression]]+table withComma exp' = [[ P.Postfix (UnaryUpdate <$> keywordB "++" <*> pure False ) -- 17+ , P.Postfix (UnaryUpdate <$> keywordB "--" <*> pure False )]+ ,[ P.Prefix (Unary <$> P.try (opNotFollowedBy "!" (P.char '=')) ) -- 16+ , P.Prefix (Unary <$> keywordB "~" )+ , P.Prefix (Unary <$> P.try (opNotFollowedBy "+" (P.oneOf "+=")) )+ , P.Prefix (Unary <$> P.try (opNotFollowedBy "-" (P.oneOf "-=")) )+ , P.Prefix (UnaryUpdate <$> keywordB "++" <*> pure True )+ , P.Prefix (UnaryUpdate <$> keywordB "--" <*> pure True )+ , P.Prefix (Unary <$> keywordB "typeof" )+ , P.Prefix (Unary <$> keywordB "void" )+ , P.Prefix (Unary <$> keywordB "delete" )+ , P.Prefix (Unary <$> keywordB "await" )]+ ,[ P.Infix (Operation <$> P.try (opNotFollowedBy "**" (P.char '=')) ) P.AssocRight] -- 15+ ,[ P.Infix (Operation <$> P.try (opNotFollowedBy "*" (P.oneOf "*=")) ) P.AssocLeft -- 14+ , P.Infix (Operation <$> P.try (opNotFollowedBy "/" (P.oneOf "*=")) ) P.AssocLeft+ , P.Infix (Operation <$> P.try (opNotFollowedBy "%" (P.oneOf "/=")) ) P.AssocLeft]+ ,[ P.Infix (Operation <$> P.try (opNotFollowedBy "+" (P.oneOf "+=")) ) P.AssocLeft -- 13+ , P.Infix (Operation <$> P.try (opNotFollowedBy "-" (P.oneOf "-=")) ) P.AssocLeft]+ ,[ P.Infix (Operation <$> P.try (opNotFollowedBy "<<" (P.oneOf "=")) ) P.AssocLeft -- 12+ , P.Infix (Operation <$> P.try (opNotFollowedBy ">>" (P.oneOf ">=")) ) P.AssocLeft+ , P.Infix (Operation <$> P.try (opNotFollowedBy ">>>" (P.char '=')) ) P.AssocLeft]+ ,[ P.Infix (Operation <$> P.try (opNotFollowedBy "<" (P.oneOf "<=")) ) P.AssocLeft -- 11+ , P.Infix (Operation <$> keywordB "<=" ) P.AssocLeft+ , P.Infix (Operation <$> P.try (opNotFollowedBy ">" (P.oneOf ">=")) ) P.AssocLeft+ , P.Infix (Operation <$> keywordB ">=" ) P.AssocLeft+ , P.Infix (Operation <$> P.try (opNotFollowedBy "in" (P.char 's')) ) P.AssocLeft+ , P.Infix (Operation <$> keywordB "instanceof" ) P.AssocLeft]+ ,[ P.Infix (Operation <$> P.try (opNotFollowedBy "==" (P.char '=')) ) P.AssocLeft -- 10+ , P.Infix (Operation <$> P.try (opNotFollowedBy "!=" (P.char '=')) ) P.AssocLeft+ , P.Infix (Operation <$> keywordB "===" ) P.AssocLeft+ , P.Infix (Operation <$> keywordB "!==" ) P.AssocLeft]+ ,[ P.Infix (Operation <$> P.try (opNotFollowedBy "&" (P.oneOf "&=")) ) P.AssocLeft] -- 9+ ,[ P.Infix (Operation <$> keywordB "^" ) P.AssocLeft] -- 8+ ,[ P.Infix (Operation <$> P.try (opNotFollowedBy "|" (P.oneOf "|=")) ) P.AssocLeft] -- 7+ ,[ P.Infix (Operation <$> P.try (opNotFollowedBy "&&" (P.char '=')) ) P.AssocLeft] -- 6+ ,[ P.Infix (Operation <$> keywordB "||" ) P.AssocLeft] -- 5+ ,[ P.Infix (flip Condition <$> (keywordB "?" *> lexeme exp' <* keywordB ":")) P.AssocNone] -- 4+ ,[ P.Infix (Assignment <$> P.try (opNotFollowedBy "=" (P.oneOf ">=")) ) P.AssocRight -- 3+ , P.Infix (Assignment <$> keywordB "+=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB "-=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB "**=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB "*=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB "/=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB "%=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB "<<=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB ">>=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB ">>>=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB "&=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB "^=" ) P.AssocRight+ , P.Infix (Assignment <$> keywordB "|=" ) P.AssocRight]+ ,[ P.Prefix (Unary <$> keywordB "yield" )] -- 2+ ,if withComma then ([ P.Infix (Comma <$ keywordB ",") P.AssocLeft]) else [] -- 1+ ]++-- withComma = isLiteral (used when parsing arrays, objects and parenthesis expression)+operationExp withComma exp' p = P.buildExpressionParser (table withComma exp') (lexeme p) P.<?> "[operations]"
+ src/Language/JS/Parser.hs view
@@ -0,0 +1,303 @@+{-# LANGUAGE FlexibleContexts #-}+module Language.JS.Parser where++import Control.Applicative ((<|>))+import Control.Monad (liftM2)+import qualified Text.Parsec as P+import Language.JS.Types+import Language.JS.Common+import Language.JS.Operators++-- | identifier+identifier = do h <- P.many (P.oneOf "_$")+ t <- P.many1 P.alphaNum+ return (h ++ t)++identB = P.try (LI <$> (do i <- identifier+ case i `elem` reservedWords of+ True -> P.unexpected "reserved word"+ _ -> return i)) P.<?> "[identifier]"++-- | numbers+numberB = LN <$> (P.many1 P.digit) P.<?> "[number-literal]"++-- | booleans+boolB = P.try (boolA "true" <|> boolA "false") P.<?> "[boolean]"+ where+ boolA = fmap (LB . toHask) . keywordB+ toHask s | s == "true" = True+ | otherwise = False++-- | this+thisB = const LThis <$> keywordB "this" P.<?> "[this]"++-- | null+nullB = const LNull <$> keywordB "null" P.<?> "[null]"++stringA ctor wc p = ctor <$> (P.try (P.between (P.char wc) (P.char wc) (p wc)))++-- | strings literal+stringB = stringA LS '\"' allowed <|> stringA LS '\'' allowed P.<?> "[string-literal]"+ where+ allowed e = P.many (P.satisfy (\c -> c /= '\n' && c /= e))++-- | template strings+templateStringB = stringA LTS '`' allowed P.<?> "[template-string]"+ where+ allowed e = P.many (P.satisfy (\c -> c /= e))++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")++-- | array literal+arrayB = P.try (LA <$> brackets (commaSep (whiteSpaces *> checkSpread Spread (expressionNonEmpty False)))) P.<?> "[array]"++-- | parenthesis expression+parensB = LP <$> parens (whiteSpaces *> (expressionNonEmpty True)) P.<?> "[parenthesis]"++checkSpread ctor p = do i <- P.optionMaybe (keywordB "...")+ case i of+ Just _ -> ctor <$> p+ Nothing -> p++formalParameter = whiteSpaces *> bindExpression <* whiteSpaces+ 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]"++-- | arrow expression (function)+afunctionB = P.try (Arrow <$> (lexeme (parens manyParams <|> singleParam) <* keywordB "=>")+ <*> (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements)) <|> statements))+ P.<?> "[arrow-function]"+ where singleParam = Left <$> bindVar+ manyParams = Right <$> commaSep formalParameter++functionB = (afunctionB <|> functionDeclB)++propertyMethodDef = P.try (PropertyMethod <$> lexeme identB+ <*> lexeme (parens (commaSep formalParameter))+ <*> (SBlock <$> braces (whiteSpaces *> P.many (lexeme statements))))+ P.<?> "[class-method-definition]"++classStaticDef = lexeme (keywordB "static") *> (ClassStatic <$> (propertyMethodDef <|> classPropertyDef))++classGetSetMethodDef = (keywordB "set" *> (ClassSetMethod <$> propertyMethodDef)) <|>+ (keywordB "get" *> (ClassGetMethod <$> propertyMethodDef))+ P.<?> "[class-get-set-definition]"++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]"+ where classBlock = P.many (lexeme (toStatement <$> classBlockDecls))+ classBlockDecls = (classPropertyDef+ <|> asyncMethodDef+ <|> classStaticDef+ <|> 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))++-- | object literal+objectB = LO <$> lexeme (braces (P.sepBy (whiteSpaces *> kvB <* whiteSpaces) (P.char ','))) P.<?> "[object-literal]"++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]"++-- | new+newB = 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]"++literals = thisB <|> nullB <|> boolB+ <|> stringB <|> templateStringB+ <|> arrayB <|> objectB <|> regexB+ <|> numberB <|> identB++primaryExp = literals <|> functionB <|> classB <|> parensB++maybeSemi = P.optional (P.char ';')++emptyExp = (const Empty) <$> (P.char ';') P.<?> "[empty-expressions]"++leftHandSideExp = (newB <|> (Just <$> lexeme primaryExp)) >>= memberExp P.<?> "left-hand-side-expression"++-- | expressions+expressions = emptyExp <|> 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)))++expressionNonEmpty notComma = comment <|> multilineComment <|>+ functionB <|> classB <|>+ (operationExp notComma (expressionNonEmpty notComma) leftHandSideExp) <|>+ primaryExp+ P.<?> "[non-empty-expressions]"++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+toStatement a = SExp a++-- Statements++importNamespaceClause = Namespace <$> ((keywordB "*" *> keywordB "as") *> identB)+importBindClause = BindNames <$> braces (commaSep (whiteSpaces *> identB <* whiteSpaces))+importDefaultNameClause = DefaultName <$> lexeme identB++importManyClauses = commaSep1 (whiteSpaces *> (importBindClause <|> importDefaultNameClause))++importClauses = (importNamespaceClause >>= return . Left)+ <|> (importManyClauses >>= return . Right)++importFileStatement = SImportFile <$> lexeme stringB+importStatement = SImport <$> (lexeme importClauses <* keywordB "from") <*> lexeme stringB+importStatements = keywordB "import" *> (importStatement <|> importFileStatement)+ P.<?> "[import-statement]"++reexportStatement = P.try (SRExport <$> (lexeme (expressionNonEmpty False) <* keywordB "from") <*> lexeme stringB)+exportDefaultStatement = keywordB "default" *> (SExportDefault <$> expressionNonEmpty False)+exportStatement = SExport <$> 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]"++blockStatement allowedStmt = SBlock <$> (P.try (braces (whiteSpaces *> P.many allowedStmt <* whiteSpaces)))+ P.<?> "[block-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]"++catchB = SCatch <$> (keywordB "catch" *> lexeme (P.optionMaybe parensB))+ <*> blockStatement statements+ P.<?> "[try/catch-statement]"++finallyB = SFinally <$> (keywordB "finally" *> blockStatement statements)+ P.<?> "[try/catch/finally-statement]"++tryStatement = STry <$> (keywordB "try" *> lexeme (blockStatement statements))+ <*> catchB+ <*> P.optionMaybe finallyB P.<?> "[try-statement]"++throwStatement = SThrow <$> (keywordB "throw" *> expressionNonEmpty False)+ P.<?> "[throw-statement]"++returnStatement = SReturn <$> (keywordB "return" *> expressions)+ P.<?> "[return-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]"++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]"++caseClause = lexeme ((caseB <|> defaultCase) <* (P.char ':')) P.<?> "[switch/case-expression]"+ where defaultCase = const DefaultCase <$> (keywordB "default")+ caseB = Case <$> (keywordB "case" *> literals)++caseCase = 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]"++debuggerStatement = const SDebugger <$> keywordB "debugger"+ P.<?> "[debugger-statement]"++breakableStatement = blockStatement ((breakStatement <* maybeSemi) <|> statements) <|> statements++whileStatement = SWhile <$> (keywordB "while" *> 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]"++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++iterationStatement = forStatement <|> whileStatement <|> doWhileStatement++withStatement = SWith <$> (keywordB "with" *> 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]"++statements = ((blockStatement statements+ <|> ifStatement+ <|> iterationStatement+ <|> debuggerStatement+ <|> labelledStatement+ <|> continueStatement+ <|> tryStatement+ <|> throwStatement+ <|> returnStatement+ <|> switchStatement+ <|> withStatement+ <|> variableStatement+ <|> (fmap toStatement expressions)) <* maybeSemi) P.<?> "[statements]"++topLevelStatements = importStatements <|> exportStatements <|> statements++-- | parser+parseJs = P.many (whiteSpaces *> lexeme (topLevelStatements <* maybeSemi <* whiteSpaces))++parse :: String -> String -> Either P.ParseError [Statement]+parse filename source = P.parse parseJs filename source++parseFromFile :: String -> IO (Either P.ParseError [Statement])+parseFromFile filename = readFile filename >>= return . P.parse parseJs filename
+ src/Language/JS/Types.hs view
@@ -0,0 +1,126 @@+module Language.JS.Types where++data ObjectProperty = OPI Expression+ | OPKV Expression Expression+ | OP Expression+ | OPM Expression+ deriving (Show)++type IsPrefix = Bool++data SwitchCase = Case Expression | DefaultCase+ deriving (Show)++type ExpressionOpt = Maybe Expression+type StatementOpt = Maybe Statement++data ForStyle = ForIn BindExpression Expression+ | ForInV String BindExpression Expression+ | ForOf BindExpression Expression+ | ForOfV String BindExpression Expression+ | ForRegular (Maybe BindExpression) ExpressionOpt ExpressionOpt+ deriving (Show)++-- | import and export binds+-- * as identifier+-- A, ...+-- {x,...}+data ImportClause = Namespace Expression+ | DefaultName Expression+ | BindNames [Expression]+ deriving (Show)++-- possible binds+-- <<expty>>+-- a+-- a=1+-- {a}+-- {a}={a:1}+-- ...a+-- ...{a}+-- ...[a]+data BindExpression = BindVar Expression (Maybe Expression)+ | BindPattern Expression (Maybe Expression)+ | BindRest Expression+ deriving (Show)++data Expression = -- literals+ LThis+ | LNull+ | LI String+ | LN String+ | LS String+ | LTS String+ | LB Bool+ | RegExp String String+ | UnaryUpdate String IsPrefix Expression+ | Unary String Expression+ | Spread Expression+ | LA [Expression]+ | LO [ObjectProperty]+ | LP Expression+ | Condition Expression Expression Expression -- exp ? exp : exp+ | Assignment String Expression Expression+ | Operation String Expression Expression+ -- function expression+ | Function ExpressionOpt [BindExpression] Statement+ | Arrow (Either BindExpression [BindExpression]) Statement -- arrow function+ -- class expression+ | Class ExpressionOpt ExpressionOpt Statement+ | ClassProperty Expression Expression+ | PropertyMethod Expression [BindExpression] Statement+ | ClassStatic Expression+ | ClassGetMethod Expression+ | ClassSetMethod Expression+ -- async expression+ | Async Expression+ -- member expression+ | Dot Expression Expression+ | Acc Expression Expression+ | FCall Expression [Expression]+ | New Expression -- new + expression+ -- comma / sequence+ | Comma Expression Expression+ -- empty expression ;+ | Empty+ | Comment String+ | MultilineComment String+ deriving (Show)++data Statement = SExp Expression+ -- module statements+ | SImportFile Expression+ | SImport (Either ImportClause [ImportClause]) Expression+ | SRExport Expression Expression+ | SExport Statement+ | SExportDefault Expression+ -- function and class declaration+ | SC String ExpressionOpt Statement+ | SF String [BindExpression] Statement+ -- variable statements+ | SVariable String [BindExpression]+ -- iteration statements+ | SWhile [Expression] Statement+ | SDoWhile Statement [Expression]+ | SFor ForStyle Statement+ | SLabel Expression Statement -- identifier: statement+ | SDebugger+ -- control statements+ | SContinue ExpressionOpt+ | SBreak ExpressionOpt+ -- general block statement+ | SBlock [Statement]+ | SIf Expression Statement StatementOpt+ -- switch statement+ | SSwitch Expression [Statement]+ | SCase [SwitchCase] [Statement] -- cases + statementslist+ -- try/catch/finally/throw statement+ | SThrow Expression+ | STry Statement Statement StatementOpt+ | SCatch ExpressionOpt Statement+ | SFinally Statement+ -- return statement+ | SReturn Expression+ -- with statement+ | SWith Expression Statement+ deriving (Show)
+ test/Spec.hs view
@@ -0,0 +1,557 @@+import Control.Monad (when)+import System.Exit+import Test.Hspec+import Test.Hspec.Runner+import Text.Parsec (parse)+import Language.JS.Parser hiding (parse)+import qualified Language.JS.Parser as JS++testExpression = parse expressions "dummy.js" >>= return . show+testStatement = parse statements "dummy.js" >>= return . show+testTopLevelStatement = parse topLevelStatements "dummy.js" >>= return . show++testParseJs = JS.parse "dummy.js" >>= return . show++testExpressions :: Spec+testExpressions = describe "Parse literals:" $ do+ it "this" $ do+ shouldBe (testExpression "this")+ "Right LThis"++ it "undefined/null" $ do+ shouldBe (testExpression "null")+ "Right LNull"++ it "booleans" $ do+ shouldBe (testExpression "true")+ "Right (LB True)"++ shouldBe (testExpression "false")+ "Right (LB False)"++ it "ident" $ do+ shouldBe (testExpression "test")+ "Right (LI \"test\")"++ it "numbers" $ do+ shouldBe (testExpression "1")+ "Right (LN \"1\")"++ it "strings" $ do+ shouldBe (testExpression "\"test\"")+ "Right (LS \"test\")"+ shouldBe (testExpression "\'test\'")+ "Right (LS \"test\")"++ it "template string" $ do+ shouldBe (testExpression "`test`")+ "Right (LTS \"test\")"++ it "arrays" $ do+ shouldBe (testExpression "[]")+ "Right (LA [])"++ shouldBe (testExpression "[1,2]")+ "Right (LA [LN \"1\",LN \"2\"])"++ shouldBe (testExpression "[a,2]")+ "Right (LA [LI \"a\",LN \"2\"])"++ shouldBe (testExpression "[a,...b]")+ "Right (LA [LI \"a\",Spread (LI \"b\")])"++ shouldBe (testExpression "[a,...[1, 2]]")+ "Right (LA [LI \"a\",Spread (LA [LN \"1\",LN \"2\"])])"++ it "objects" $ do+ shouldBe (testExpression "{}")+ "Right (LO [])"++ shouldBe (testExpression "{a:1}")+ "Right (LO [OPKV (LI \"a\") (LN \"1\")])"++ shouldBe (testExpression "{b:2,c: \"d\"}")+ "Right (LO [OPKV (LI \"b\") (LN \"2\"),OPKV (LI \"c\") (LS \"d\")])"++ shouldBe (testExpression "{b:2, c:function() {}}")+ "Right (LO [OPKV (LI \"b\") (LN \"2\"),OPKV (LI \"c\") (Function Nothing [] (SBlock []))])"++ shouldBe (testExpression "{e}")+ "Right (LO [OPI (LI \"e\")])"++ shouldBe (testExpression "{e,f:1}")+ "Right (LO [OPI (LI \"e\"),OPKV (LI \"f\") (LN \"1\")])"++ shouldBe (testExpression "{e,...f}")+ "Right (LO [OPI (LI \"e\"),OPI (Spread (LI \"f\"))])"++ shouldBe (testExpression "{e,...{a:1}}")+ "Right (LO [OPI (LI \"e\"),OPI (Spread (LO [OPKV (LI \"a\") (LN \"1\")]))])"++ shouldBe (testExpression "{e,i:...{a:1}}")+ "Right (LO [OPI (LI \"e\"),OPKV (LI \"i\") (Spread (LO [OPKV (LI \"a\") (LN \"1\")]))])"++ shouldBe (testExpression "{e(){}}")+ "Right (LO [OPM (PropertyMethod (LI \"e\") [] (SBlock []))])"++ shouldBe (testExpression "{get e(){}}")+ "Right (LO [OPM (ClassGetMethod (PropertyMethod (LI \"e\") [] (SBlock [])))])"++ shouldBe (testExpression "{set e(){}}")+ "Right (LO [OPM (ClassSetMethod (PropertyMethod (LI \"e\") [] (SBlock [])))])"++ shouldBe (testExpression "{async e(){}}")+ "Right (LO [OPM (Async (PropertyMethod (LI \"e\") [] (SBlock [])))])"++ it "regular expression" $ do+ shouldBe (testExpression "/test\\/asdf/")+ "Right (RegExp \"test\\\\/asdf\" \"\")"++ shouldBe (testExpression "/test\\/asdf/gmi")+ "Right (RegExp \"test\\\\/asdf\" \"gmi\")"++ shouldBe (testExpression "/test\\/asdf/gmi.exec(test)")+ "Right (FCall (Dot (RegExp \"test\\\\/asdf\" \"gmi\") (LI \"exec\")) [LI \"test\"])"++ it "try dotted" $ do+ shouldBe (testExpression "a.b")+ "Right (Dot (LI \"a\") (LI \"b\"))"++ it "array accessor" $ do+ shouldBe (testExpression "a[0]")+ "Right (Acc (LI \"a\") (LN \"0\"))"++ shouldBe (testExpression "a[b.x]")+ "Right (Acc (LI \"a\") (Dot (LI \"b\") (LI \"x\")))"++ shouldBe (testExpression "a[b.x].c")+ "Right (Dot (Acc (LI \"a\") (Dot (LI \"b\") (LI \"x\"))) (LI \"c\"))"++ shouldBe (testExpression "a.c[b.x]")+ "Right (Acc (Dot (LI \"a\") (LI \"c\")) (Dot (LI \"b\") (LI \"x\")))"++ it "parens expression" $ do+ shouldBe (testExpression "(a,b)")+ "Right (LP (Comma (LI \"a\") (LI \"b\")))"++ it "function expression" $ do+ shouldBe (testExpression "function a() {}")+ "Right (Function (Just (LI \"a\")) [] (SBlock []))"++ shouldBe (testExpression "function() {}")+ "Right (Function Nothing [] (SBlock []))"++ shouldBe (testExpression "function(a, ...b) {}")+ "Right (Function Nothing [BindVar (LI \"a\") Nothing,BindRest (LI \"b\")] (SBlock []))"++ shouldBe (testExpression "function(a=1) {}")+ "Right (Function Nothing [BindVar (LI \"a\") (Just (LN \"1\"))] (SBlock []))"++ shouldBe (testExpression "function(a=1) { return 1; }")+ "Right (Function Nothing [BindVar (LI \"a\") (Just (LN \"1\"))] (SBlock [SReturn (LN \"1\")]))"++ shouldBe (testExpression "function(a=1) {\n function b() {} }")+ "Right (Function Nothing [BindVar (LI \"a\") (Just (LN \"1\"))] (SBlock [SF \"b\" [] (SBlock [])]))"++ shouldBe (testExpression "()=>x")+ "Right (Arrow (Right []) (SExp (LI \"x\")))"++ shouldBe (testExpression "()=>{x}")+ "Right (Arrow (Right []) (SBlock [SExp (LI \"x\")]))"++ shouldBe (testExpression "x=>{x}")+ "Right (Arrow (Left (BindVar (LI \"x\") Nothing)) (SBlock [SExp (LI \"x\")]))"++ it "class expression" $ do+ shouldBe (testExpression "class {}")+ "Right (Class Nothing Nothing (SBlock []))"++ shouldBe (testExpression "class test {}")+ "Right (Class (Just (LI \"test\")) Nothing (SBlock []))"++ shouldBe (testExpression "class test extends A {}")+ "Right (Class (Just (LI \"test\")) (Just (LI \"A\")) (SBlock []))"++ shouldBe (testExpression "class extends A {}")+ "Right (Class Nothing (Just (LI \"A\")) (SBlock []))"++ shouldBe (testExpression "class extends A { x = 1 }")+ "Right (Class Nothing (Just (LI \"A\")) (SBlock [SExp (ClassProperty (LI \"x\") (LN \"1\"))]))"++ shouldBe (testExpression "class extends A { x() {} }")+ "Right (Class Nothing (Just (LI \"A\")) (SBlock [SExp (PropertyMethod (LI \"x\") [] (SBlock []))]))"++ shouldBe (testExpression "class { static x = 1 }")+ "Right (Class Nothing Nothing (SBlock [SExp (ClassStatic (ClassProperty (LI \"x\") (LN \"1\")))]))"++ shouldBe (testExpression "class { set x() { return 1 } }")+ "Right (Class Nothing Nothing (SBlock [SExp (ClassSetMethod (PropertyMethod (LI \"x\") [] (SBlock [SReturn (LN \"1\")])))]))"++ shouldBe (testExpression "class { get x() { return 1 } }")+ "Right (Class Nothing Nothing (SBlock [SExp (ClassGetMethod (PropertyMethod (LI \"x\") [] (SBlock [SReturn (LN \"1\")])))]))"++ shouldBe (testExpression "class { async x() { return 1 } }")+ "Right (Class Nothing Nothing (SBlock [SExp (Async (PropertyMethod (LI \"x\") [] (SBlock [SReturn (LN \"1\")])))]))"++ it "new expression" $ do+ shouldBe (testExpression "new A")+ "Right (New (LI \"A\"))"++ shouldBe (testExpression "new A()")+ "Right (New (FCall (LI \"A\") []))"++ it "call expression" $ do+ shouldBe (testExpression "a()")+ "Right (FCall (LI \"a\") [])"++ shouldBe (testExpression "a.b()")+ "Right (FCall (Dot (LI \"a\") (LI \"b\")) [])"++ shouldBe (testExpression "a().b")+ "Right (Dot (FCall (LI \"a\") []) (LI \"b\"))"++ shouldBe (testExpression "a(1).b")+ "Right (Dot (FCall (LI \"a\") [LN \"1\"]) (LI \"b\"))"++ it "unary expression" $ do+ shouldBe (testExpression "+a")+ "Right (Unary \"+\" (LI \"a\"))"++ shouldBe (testExpression "-a")+ "Right (Unary \"-\" (LI \"a\"))"++ shouldBe (testExpression "~a")+ "Right (Unary \"~\" (LI \"a\"))"++ shouldBe (testExpression "!a")+ "Right (Unary \"!\" (LI \"a\"))"++ shouldBe (testExpression "delete a")+ "Right (Unary \"delete\" (LI \"a\"))"++ shouldBe (testExpression "typeof a")+ "Right (Unary \"typeof\" (LI \"a\"))"++ shouldBe (testExpression "void a")+ "Right (Unary \"void\" (LI \"a\"))"++ shouldBe (testExpression "++a")+ "Right (UnaryUpdate \"++\" True (LI \"a\"))"++ shouldBe (testExpression "a++")+ "Right (UnaryUpdate \"++\" False (LI \"a\"))"++ shouldBe (testExpression "--a")+ "Right (UnaryUpdate \"--\" True (LI \"a\"))"++ shouldBe (testExpression "a--")+ "Right (UnaryUpdate \"--\" False (LI \"a\"))"++ it "spread expression" $ do+ shouldBe (testExpression "{...a}")+ "Right (LO [OPI (Spread (LI \"a\"))])"++ it "assignment expression" $ do+ shouldBe (testExpression "x = 1")+ "Right (Assignment \"=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x += 1")+ "Right (Assignment \"+=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x -= 1")+ "Right (Assignment \"-=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x *= 1")+ "Right (Assignment \"*=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x /= 1")+ "Right (Assignment \"/=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x %= 1")+ "Right (Assignment \"%=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x &= 1")+ "Right (Assignment \"&=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x |= 1")+ "Right (Assignment \"|=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x **= 1")+ "Right (Assignment \"**=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x >>= 1")+ "Right (Assignment \">>=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x <<= 1")+ "Right (Assignment \"<<=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x >>>= 1")+ "Right (Assignment \">>>=\" (LI \"x\") (LN \"1\"))"++ shouldBe (testExpression "x.a += 1")+ "Right (Assignment \"+=\" (Dot (LI \"x\") (LI \"a\")) (LN \"1\"))"++ it "operation expressions" $ do+ shouldBe (testExpression "a + b")+ "Right (Operation \"+\" (LI \"a\") (LI \"b\"))"++ shouldBe (testExpression "a - b")+ "Right (Operation \"-\" (LI \"a\") (LI \"b\"))"++ shouldBe (testExpression "a * b")+ "Right (Operation \"*\" (LI \"a\") (LI \"b\"))"++ shouldBe (testExpression "a / b")+ "Right (Operation \"/\" (LI \"a\") (LI \"b\"))"++ shouldBe (testExpression "a = b - c")+ "Right (Assignment \"=\" (LI \"a\") (Operation \"-\" (LI \"b\") (LI \"c\")))"++ shouldBe (testExpression "a + b - c")+ "Right (Operation \"-\" (Operation \"+\" (LI \"a\") (LI \"b\")) (LI \"c\"))"++ shouldBe (testExpression "a + x.a - x.c")+ "Right (Operation \"-\" (Operation \"+\" (LI \"a\") (Dot (LI \"x\") (LI \"a\"))) (Dot (LI \"x\") (LI \"c\")))"++ shouldBe (testExpression "a + x.a && x.c")+ "Right (Operation \"&&\" (Operation \"+\" (LI \"a\") (Dot (LI \"x\") (LI \"a\"))) (Dot (LI \"x\") (LI \"c\")))"++ shouldBe (testExpression "a == x.a + x.c")+ "Right (Operation \"==\" (LI \"a\") (Operation \"+\" (Dot (LI \"x\") (LI \"a\")) (Dot (LI \"x\") (LI \"c\"))))"++ shouldBe (testExpression "!a")+ "Right (Unary \"!\" (LI \"a\"))"++ shouldBe (testExpression "a = x.a && x.c")+ "Right (Assignment \"=\" (LI \"a\") (Operation \"&&\" (Dot (LI \"x\") (LI \"a\")) (Dot (LI \"x\") (LI \"c\"))))"++ shouldBe (testExpression "a instanceof c")+ "Right (Operation \"instanceof\" (LI \"a\") (LI \"c\"))"++ shouldBe (testExpression "typeof a == \"number\"")+ "Right (Operation \"==\" (Unary \"typeof\" (LI \"a\")) (LS \"number\"))"++ shouldBe (testExpression "x ? y : z")+ "Right (Condition (LI \"x\") (LI \"y\") (LI \"z\"))"++ shouldBe (testExpression "x == 1 ? y : z")+ "Right (Condition (Operation \"==\" (LI \"x\") (LN \"1\")) (LI \"y\") (LI \"z\"))"++ shouldBe (testExpression "a = x == 1 ? y + 1 : z && 6")+ "Right (Assignment \"=\" (LI \"a\") (Condition (Operation \"==\" (LI \"x\") (LN \"1\")) (Operation \"+\" (LI \"y\") (LN \"1\")) (Operation \"&&\" (LI \"z\") (LN \"6\"))))"++ shouldBe (testExpression "a.b() || x")+ "Right (Operation \"||\" (FCall (Dot (LI \"a\") (LI \"b\")) []) (LI \"x\"))"++ shouldBe (testExpression "(x)\n.y")+ "Right (Dot (LP (LI \"x\")) (LI \"y\"))"++ it "empty expression" $ do+ shouldBe (testExpression ";")+ "Right Empty"++testStatements = describe "Statements" $ do+ it "empty statement" $ do+ shouldBe (testStatement ";")+ "Right (SExp Empty)"++ it "if statement" $ do+ shouldBe (testStatement "if (1) x = 1")+ "Right (SIf (LP (LN \"1\")) (SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))) Nothing)"++ shouldBe (testStatement "if (1)\nx = 1")+ "Right (SIf (LP (LN \"1\")) (SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))) Nothing)"++ shouldBe (testStatement "if (1) {x = 1}")+ "Right (SIf (LP (LN \"1\")) (SBlock [SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))]) Nothing)"++ shouldBe (testStatement "if (1) {x = 1} else x = 2")+ "Right (SIf (LP (LN \"1\")) (SBlock [SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))]) (Just (SExp (Assignment \"=\" (LI \"x\") (LN \"2\")))))"++ shouldBe (testStatement "if (a in [1, 2]) {}")+ "Right (SIf (LP (Operation \"in\" (LI \"a\") (LA [LN \"1\",LN \"2\"]))) (SBlock []) Nothing)"++ it "try statement" $ do+ shouldBe (testStatement "try {} catch {}")+ "Right (STry (SBlock []) (SCatch Nothing (SBlock [])) Nothing)"++ shouldBe (testStatement "try {} catch {} finally {}")+ "Right (STry (SBlock []) (SCatch Nothing (SBlock [])) Nothing)"++ shouldBe (testStatement "try {} catch (e) {} finally {}")+ "Right (STry (SBlock []) (SCatch (Just (LP (LI \"e\"))) (SBlock [])) Nothing)"++ shouldBe (testStatement "return 1")+ "Right (SReturn (LN \"1\"))"++ it "throw statements" $ do+ shouldBe (testStatement "throw x;")+ "Right (SThrow (LI \"x\"))"++ it "variable statements" $ do+ shouldBe (testStatement "var x;")+ "Right (SVariable \"var\" [BindVar (LI \"x\") Nothing])"++ shouldBe (testStatement "let x;")+ "Right (SVariable \"let\" [BindVar (LI \"x\") Nothing])"++ shouldBe (testStatement "var x = 1")+ "Right (SVariable \"var\" [BindVar (LI \"x\") (Just (LN \"1\"))])"++ shouldBe (testStatement "var x = 1, y;")+ "Right (SVariable \"var\" [BindVar (LI \"x\") (Just (LN \"1\")),BindVar (LI \"y\") Nothing])"++ shouldBe (testStatement "const x = 1;")+ "Right (SVariable \"const\" [BindVar (LI \"x\") (Just (LN \"1\"))])"++ shouldBe (testStatement "const x = 1, y = 2;")+ "Right (SVariable \"const\" [BindVar (LI \"x\") (Just (LN \"1\")),BindVar (LI \"y\") (Just (LN \"2\"))])"++ shouldBe (testStatement "const {a} = {a:1};")+ "Right (SVariable \"const\" [BindPattern (LO [OPI (LI \"a\")]) (Just (LO [OPKV (LI \"a\") (LN \"1\")]))])"++ it "switch statement" $ do+ shouldBe (testStatement "switch (a) {}")+ "Right (SSwitch (LP (LI \"a\")) [])"++ shouldBe (testStatement "switch (a) { case 1: { return; } }")+ "Right (SSwitch (LP (LI \"a\")) [SCase [Case (LN \"1\")] [SBlock [SReturn Empty]]])"++ shouldBe (testStatement "switch (a) { case 1: { return; } break }")+ "Right (SSwitch (LP (LI \"a\")) [SCase [Case (LN \"1\")] [SBlock [SReturn Empty],SBreak Nothing]])"++ shouldBe (testStatement "switch (a) { case 1: default: { return; } }")+ "Right (SSwitch (LP (LI \"a\")) [SCase [Case (LN \"1\"),DefaultCase] [SBlock [SReturn Empty]]])"++ shouldBe (testStatement "switch (a) { case 1: { return 1; } case 2: default: { return; } }")+ "Right (SSwitch (LP (LI \"a\")) [SCase [Case (LN \"1\")] [SBlock [SReturn (LN \"1\")]],SCase [Case (LN \"2\"),DefaultCase] [SBlock [SReturn Empty]]])"++ shouldBe (testStatement "switch (a) { case 1: { return 1; } break; default: return; }")+ "Right (SSwitch (LP (LI \"a\")) [SCase [Case (LN \"1\")] [SBlock [SReturn (LN \"1\")],SBreak Nothing],SCase [DefaultCase] [SReturn Empty]])"++ it "continue statement" $ do+ shouldBe (testStatement "continue")+ "Right (SContinue Nothing)"++ shouldBe (testStatement "continue x")+ "Right (SContinue (Just (LI \"x\")))"++ it "debugger statement" $ do+ shouldBe (testStatement "debugger")+ "Right SDebugger"++ it "iteration statement" $ do+ shouldBe (testStatement "while (1) {}")+ "Right (SWhile [LN \"1\"] (SBlock []))"++ -- break is allowed here+ shouldBe (testStatement "while (1) {break}")+ "Right (SWhile [LN \"1\"] (SBlock [SBreak Nothing]))"++ shouldBe (testStatement "while (1) {\nbreak\n;}")+ "Right (SWhile [LN \"1\"] (SBlock [SBreak Nothing]))"++ shouldBe (testStatement "while (1) x = 1")+ "Right (SWhile [LN \"1\"] (SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))))"++ shouldBe (testStatement "do {} while (1)")+ "Right (SDoWhile (SBlock []) [LN \"1\"])"++ shouldBe (testStatement "do {break} while (1)")+ "Right (SDoWhile (SBlock [SBreak Nothing]) [LN \"1\"])"++ shouldBe (testStatement "do x = 1; while (1)")+ "Right (SDoWhile (SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))) [LN \"1\"])"++ shouldBe (testStatement "for (;;) {}")+ "Right (SFor (ForRegular Nothing Nothing Nothing) (SBlock []))"++ shouldBe (testStatement "for (;;) {break}")+ "Right (SFor (ForRegular Nothing Nothing Nothing) (SBlock [SBreak Nothing]))"++ shouldBe (testStatement "for (;;) x = 1")+ "Right (SFor (ForRegular Nothing Nothing Nothing) (SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))))"++ shouldBe (testStatement "for (x;;) x = 1")+ "Right (SFor (ForRegular (Just (BindVar (LI \"x\") Nothing)) Nothing Nothing) (SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))))"++ shouldBe (testStatement "for (x;;x++) x = 1")+ "Right (SFor (ForRegular (Just (BindVar (LI \"x\") Nothing)) Nothing (Just (UnaryUpdate \"++\" False (LI \"x\")))) (SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))))"++ shouldBe (testStatement "for (x;;x+=1) x = 1")+ "Right (SFor (ForRegular (Just (BindVar (LI \"x\") Nothing)) Nothing (Just (Assignment \"+=\" (LI \"x\") (LN \"1\")))) (SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))))"++ shouldBe (testStatement "for (;x&&y;) {}")+ "Right (SFor (ForRegular Nothing (Just (Operation \"&&\" (LI \"x\") (LI \"y\"))) Nothing) (SBlock []))"++ shouldBe (testStatement "for (x in a) {}")+ "Right (SFor (ForIn (BindVar (LI \"x\") Nothing) (LI \"a\")) (SBlock []))"++ shouldBe (testStatement "for (let x in a) {}")+ "Right (SFor (ForInV \"let\" (BindVar (LI \"x\") Nothing) (LI \"a\")) (SBlock []))"++ shouldBe (testStatement "for (x of a) {}")+ "Right (SFor (ForOf (BindVar (LI \"x\") Nothing) (LI \"a\")) (SBlock []))"++ shouldBe (testStatement "for (let x of a) {}")+ "Right (SFor (ForOfV \"let\" (BindVar (LI \"x\") Nothing) (LI \"a\")) (SBlock []))"++ it "with statement" $ do+ shouldBe (testStatement "with (a) {}")+ "Right (SWith (LI \"a\") (SBlock []))"++ it "labelled statement" $ do+ shouldBe (testStatement "a: x = 1")+ "Right (SLabel (LI \"a\") (SExp (Assignment \"=\" (LI \"x\") (LN \"1\"))))"++ it "import statement" $ do+ shouldBe (testTopLevelStatement "import \"test.js\"")+ "Right (SImportFile (LS \"test.js\"))"++ shouldBe (testTopLevelStatement "import * as A from \"test.js\"")+ "Right (SImport (Left (Namespace (LI \"A\"))) (LS \"test.js\"))"++ shouldBe (testTopLevelStatement "import {x} from \"test.js\"")+ "Right (SImport (Right [BindNames [LI \"x\"]]) (LS \"test.js\"))"++ shouldBe (testTopLevelStatement "import B, {x} from \"test.js\"")+ "Right (SImport (Right [DefaultName (LI \"B\"),BindNames [LI \"x\"]]) (LS \"test.js\"))"++ it "export statement" $ do+ shouldBe (testTopLevelStatement "export {}")+ "Right (SExport (SBlock []))"++ shouldBe (testTopLevelStatement "export default {}")+ "Right (SExportDefault (LO []))"++ shouldBe (testTopLevelStatement "export {} from \"test.js\"")+ "Right (SRExport (LO []) (LS \"test.js\"))"++ shouldBe (testTopLevelStatement "export const a = 1;")+ "Right (SExport (SVariable \"const\" [BindVar (LI \"a\") (Just (LN \"1\"))]))"++ it "function declaration" $ do+ shouldBe (testTopLevelStatement "function a() {} function b() {}")+ "Right (SF \"a\" [] (SBlock []))"++ shouldBe (testTopLevelStatement "function a() { var i; return 1; }")+ "Right (SF \"a\" [] (SBlock [SVariable \"var\" [BindVar (LI \"i\") Nothing],SReturn (LN \"1\")]))"++ shouldBe (testTopLevelStatement "function a() { function b() { return () => 1; } return 1; }")+ "Right (SF \"a\" [] (SBlock [SF \"b\" [] (SBlock [SReturn (Arrow (Right []) (SExp (LN \"1\")))]),SReturn (LN \"1\")]))"++ it "class declaration" $ do+ shouldBe (testTopLevelStatement "class a {}")+ "Right (SC \"a\" Nothing (SBlock []))"++testAll :: Spec+testAll = do+ testExpressions+ testStatements++main :: IO ()+main = do+ summary <- hspecWithResult defaultConfig testAll+ when (summaryFailures summary == 0)+ exitSuccess+ exitFailure