diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -25,6 +25,12 @@ ./dist/build/runtests/runtests +Changes +------- + +0.0.11 - Worked in language-javascript 0.4.*, with source locations in the AST + Worked in processing of property get/set in object literals +0.0.10 - Removed attoparsec dependency and historical Parse/Token diff --git a/Text/Jasmine.hs b/Text/Jasmine.hs --- a/Text/Jasmine.hs +++ b/Text/Jasmine.hs @@ -42,8 +42,8 @@ lbToStr :: S8.ByteString -> [Char] lbToStr str = S8.unpack str -strToLb :: String -> S8.ByteString -strToLb str = S8.pack str ---strToLb str = (LB.fromChunks [(E.encodeUtf8 $ T.pack str)]) +_strToLb :: String -> S8.ByteString +_strToLb str = S8.pack str + -- EOF diff --git a/Text/Jasmine/Parse.hs b/Text/Jasmine/Parse.hs deleted file mode 100644 --- a/Text/Jasmine/Parse.hs +++ /dev/null @@ -1,1186 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -module Text.Jasmine.Parse - ( - readJs - , readJsm - , JasmineSettings (..) - , defaultJasmineSettings - , JSNode(..) - , parseFile - , parseString - -- For testing - , parseProgram - {- - , doParse - , program - , functionDeclaration - , identifier - , statementList - , iterationStatement - , main - -} - ) where - --- --------------------------------------------------------------------- - -import Control.Applicative ( (<|>) ) -import Control.Monad -import Data.Attoparsec.Lazy (eitherResult,parse,Result(..)) -import Data.Attoparsec.Char8 (char, satisfy, try, Parser, (), endOfInput, many, sepBy, sepBy1, many1, takeWhile) -import Data.Char -import Data.Data -import Data.List hiding (takeWhile) -import Prelude hiding (catch, takeWhile) -import System.Environment -import qualified Data.ByteString.Lazy as LB -import qualified Data.Text as T -import qualified Data.Text.Encoding as E -import qualified Text.Jasmine.Token as P -import qualified Data.ByteString.Char8 as S8 - --- --------------------------------------------------------------------- -{- -data Result v = Error String | Ok v - deriving (Show, Eq, Read, Data, Typeable) -instance Monad Result where - return = Ok - Error s >>= _ = Error s - Ok v >>= f = f v - fail = Error -instance Functor Result where - fmap = liftM -instance Applicative Result where - pure = return - (<*>) = ap --} - --- --------------------------------------------------------------------- - -data JSNode = JSArguments [[JSNode]] - | JSArrayLiteral [JSNode] - | JSBlock JSNode - | JSBreak [JSNode] [JSNode] - | JSCallExpression String [JSNode] -- type : ., (), []; rest - | JSCase JSNode JSNode - | JSCatch JSNode [JSNode] JSNode - | JSContinue [JSNode] - | JSDecimal Integer - | JSDefault JSNode - | JSDoWhile JSNode JSNode JSNode - | JSElement String [JSNode] - | JSElementList [JSNode] - | JSElision [JSNode] - | JSEmpty JSNode - | JSExpression [JSNode] - | JSExpressionBinary String [JSNode] [JSNode] - | JSExpressionParen JSNode - | JSExpressionPostfix String [JSNode] - | JSExpressionTernary [JSNode] [JSNode] [JSNode] - | JSFinally JSNode - | JSFor [JSNode] [JSNode] [JSNode] JSNode - | JSForIn [JSNode] JSNode JSNode - | JSForVar [JSNode] [JSNode] [JSNode] JSNode - | JSForVarIn JSNode JSNode JSNode - | JSFunction JSNode [JSNode] JSNode -- name, parameter list, body - | JSFunctionBody [JSNode] - | JSFunctionExpression [JSNode] JSNode -- name, parameter list, body - | JSHexInteger Integer - | JSIdentifier String - | JSIf JSNode JSNode - | JSIfElse JSNode JSNode JSNode - | JSLabelled JSNode JSNode - | JSLiteral String - | JSMemberDot [JSNode] - | JSMemberSquare JSNode [JSNode] - | JSObjectLiteral [JSNode] - | JSOperator String - | JSPropertyNameandValue JSNode [JSNode] - | JSRegEx String - | JSReturn [JSNode] - | JSSourceElements [JSNode] - | JSSourceElementsTop [JSNode] - | JSStatementList [JSNode] - | JSStringLiteral Char [Char] - | JSSwitch JSNode [JSNode] - | JSThrow JSNode - | JSTry JSNode [JSNode] - | JSUnary String - | JSVarDecl JSNode [JSNode] - | JSVariables String [JSNode] - | JSWhile JSNode JSNode - | JSWith JSNode [JSNode] - deriving (Show, Eq, Read, Data, Typeable) - - --- --------------------------------------------------------------------- --- | Settings for parsing of a javascript document. -data JasmineSettings = JasmineSettings - { - -- | Placeholder in the structure, no actual settings yet - hjsminPlaceholder :: String - } - --- --------------------------------------------------------------------- --- | Defaults settings: settings not currently used -defaultJasmineSettings :: JasmineSettings -defaultJasmineSettings = JasmineSettings "foo" - --- --------------------------------------------------------------------- --- Interface to the Tokeniser - -identifier :: Parser JSNode -identifier = do{ val <- P.identifier; - return (JSIdentifier val)} - -autoSemi :: Parser JSNode -autoSemi = fmap JSLiteral P.autoSemi - -autoSemi' :: Parser JSNode -autoSemi' = fmap JSLiteral P.autoSemi' - --- TODO: Maybe? get rid of these, and call them directly via the full name. --- BUT, compiler optimisation should get rid of them anyway -rOp :: String -> Parser () -rOp = P.rOp - -lChar :: Char -> Parser () -lChar = P.lChar - --- --------------------------------------------------------------------- --- Make Attoparsec work with parsec - -letter :: Parser Char -letter = satisfy isAlpha "letter" - -eof :: Parser () -eof = endOfInput - --- --------------------------------------------------------------------- --- The parser, based on the gold parser for Javascript --- http://www.devincook.com/GOLDParser/grammars/files/JavaScript.zip - --- ------------------------------------------------------------ ---Modified from HJS - -stringLiteral :: Parser JSNode -stringLiteral = - P.lexeme $ go '"' <|> go '\'' - where - go c = do - _ <- char c - s <- takeWhile $ \x -> isPrint x && x /= c - _ <- char c - return $ JSStringLiteral c $ S8.unpack s - --- ------------------------------------------------------------ - - -decimalLiteral :: Parser Integer -decimalLiteral = P.dec - -hexIntegerLiteral :: Parser Integer -hexIntegerLiteral = P.hex - --- {String Chars1} = {Printable} + {HT} - ["\] --- {RegExp Chars} = {Letter}+{Digit}+['^']+['$']+['*']+['+']+['?']+['{']+['}']+['|']+['-']+['.']+[',']+['#']+['[']+[']']+['_']+['<']+['>'] --- {Non Terminator} = {String Chars1} - {CR} - {LF} --- RegExp = '/' ({RegExp Chars} | '\' {Non Terminator})+ '/' ( 'g' | 'i' | 'm' )* - --- --------------------------------------------------------------------- --- From HJS - -regex :: Parser [Char] -regex = do { _ <- char '/'; body <- do { c <- firstchar; cs <- many otherchar; return $ concat (c:cs) }; _ <- char '/'; - flg <- identPart; return $ ("/"++body++"/"++flg) } - -firstchar :: Parser [Char] -firstchar = do { c <- satisfy (\c -> isPrint c && c /= '*' && c /= '\\' && c /= '/'); - return [c]} <|> escapeseq - -escapeseq :: Parser [Char] -escapeseq = do { _ <- char '\\'; c <- satisfy (\cc -> isPrint cc); return ['\\',c]} - -otherchar :: Parser [Char] -otherchar = do { c <- satisfy (\c -> isPrint c && c /= '\\' && c /= '/'); - return [c]} <|> escapeseq - -identPart :: Parser [Char] -identPart = many letter - --- --------------------------------------------------------------------- - - -regExp :: Parser JSNode -regExp = P.lexeme $ do { v1 <- regex; - return (JSRegEx v1)} - --- ::= --- | --- | --- | StringLiteral -literal :: Parser JSNode -literal = nullLiteral - <|> booleanLiteral - <|> numericLiteral - <|> stringLiteral - --- ::= null -nullLiteral :: Parser JSNode -nullLiteral = do { _ <- P.reserved "null"; - return (JSLiteral "null")} - --- ::= 'true' --- | 'false' -booleanLiteral :: Parser JSNode -booleanLiteral = do{ _ <- P.reserved "true" ; - return (JSLiteral "true")} - <|> do{ P.reserved "false"; - return (JSLiteral "false")} - --- ::= DecimalLiteral --- | HexIntegerLiteral -numericLiteral :: Parser JSNode -numericLiteral = do {val <- decimalLiteral; - return (JSDecimal val)} - <|> do {val <- hexIntegerLiteral; - return (JSHexInteger val)} - - --- ::= RegExp -regularExpressionLiteral :: Parser JSNode -regularExpressionLiteral = regExp - - --- ::= 'this' --- | Identifier --- | --- | --- | --- | '(' ')' --- | -primaryExpression :: Parser JSNode -primaryExpression = do {P.reserved "this"; - -- return [""]} - return (JSLiteral "this")} - <|> identifier - <|> literal - <|> arrayLiteral - <|> objectLiteral - <|> do{ rOp "("; val <- expression; rOp ")"; - return (JSExpressionParen val)} - <|> regularExpressionLiteral - --- --------------------------------------------------------------------- --- Rework array literal - - --- ::= '[' ']' --- | '[' ']' --- | '[' ']' --- | '[' ',' ']' - --- ::= ',' --- | ',' - --- ::= --- | ',' --- | ',' --- | - --------- ---so - --- ::= '[' many (',' <|> assignment) ']' - - --- --------------------------------------------------------------------- - --- ::= '[' ']' --- | '[' ']' --- | '[' ']' --- | '[' ',' ']' -arrayLiteral :: Parser JSNode -arrayLiteral = do {rOp "["; v1 <- many (do { rOp ","; return [(JSElision [])]} <|> assignmentExpression); rOp "]"; - return (JSArrayLiteral (flatten v1)) } - -{- -arrayLiteral :: GenParser Char P.JSPState JSNode -arrayLiteral = do {rOp "["; - do { - do { rOp "]"; - return (JSArrayLiteral [])} - <|> do { v1 <- elision; rOp "]"; - return (JSArrayLiteral [v1])} - <|> do { v1 <- elementList; rOp "]"; - do { - do { rOp ","; v2 <- elision; rOp "]"; - return (JSArrayLiteral (v1++[v2]))} - <|> return (JSArrayLiteral v1) - } - } - } - } - - --- ::= ',' --- | ',' -elision :: GenParser Char P.JSPState JSNode -elision = do{ rOp ","; - return (JSElision [])} - <|> do{ v1 <- elision; rOp ","; - return (JSElision [v1])} - - --- ::= --- | ',' --- | ',' --- | -elementList :: GenParser Char P.JSPState [JSNode] -elementList = do { v1 <- elision; v2 <- assignmentExpression; v3 <-rest; - return [(JSElementList (v1:(v2++v3)))] } - <|> do { v1 <- assignmentExpression; v2 <- rest; - return [(JSElementList (v1++v2))]} - where - rest = - do {rOp ","; - do { - do { v2 <- elision; v3 <- assignmentExpression; - return [] {- ([v2]++v3)-}} - <|> do { v2 <- assignmentExpression; - return [] {-v2-}} - } - } - <|> do {return []} --} - --- ::= '{' '}' -objectLiteral :: Parser JSNode -objectLiteral = do{ rOp "{"; val <- propertyNameandValueList; rOp "}"; - return (JSObjectLiteral val)} - --- ::= ':' --- | ',' ':' -propertyNameandValueList :: Parser [JSNode] -propertyNameandValueList = do{ val <- sepBy propertyNameandValue (rOp ","); -- Note: can be zero elements - return val} - --- Seems we can have function declarations in the value part too -propertyNameandValue :: Parser JSNode -propertyNameandValue = do{ v1 <- propertyName; rOp ":"; - do { - do {v2 <- assignmentExpression; - return (JSPropertyNameandValue v1 v2)} - <|> do {v2 <- functionDeclaration; - return (JSPropertyNameandValue v1 [v2])} - } - } - --- ::= Identifier --- | StringLiteral --- | -propertyName :: Parser JSNode -propertyName = identifier - <|> stringLiteral - <|> numericLiteral - - --- ::= --- | --- | '[' ']' --- | '.' Identifier --- | 'new' -memberExpression :: Parser [JSNode] -memberExpression = (do{ P.reserved "new"; v1 <- memberExpression; v2 <- arguments; - return (((JSLiteral "new "):v1)++[v2])}) -- xxxx - <|> memberExpression' - ---memberExpression' :: GenParser Char P.JSPState [JSNode] -memberExpression' :: Parser [JSNode] -memberExpression' = do - v1 <- functionExpression <|> primaryExpression - v2 <- rest - return $ v1 : v2 - - where - rest = do{ rOp "["; v1 <- expression; rOp "]"; v2 <- rest; - return [JSMemberSquare v1 v2]} - <|> do{ rOp "."; v1 <- identifier ; v2 <- rest; - return [JSMemberDot (v1:v2)]} - <|> return [] - - - --- ::= --- | new -newExpression :: Parser [JSNode] -newExpression = memberExpression - <|> do{ P.reserved "new"; val <- newExpression; - return ((JSLiteral "new "):val)} - --- ::= --- | --- | '[' ']' --- | '.' Identifier - -callExpression :: Parser [JSNode] -callExpression = do{ v1 <- memberExpression; v2 <- arguments; - do { v3 <- rest; - return (v1++[v2]++v3)} - <|> do {return (v1++[v2] )} - } - where - rest = - do{ v4 <- arguments ; v5 <- rest; - return ([(JSCallExpression "()" [v4])]++v5)} - <|> do{ rOp "["; v4 <- expression; rOp "]"; v5 <- rest; - return ([JSCallExpression "[]" [v4]]++v5)} - <|> do{ rOp "."; v4 <- identifier; v5 <- rest; - return ([JSCallExpression "." [v4]]++v5)} - <|> return [] -- As per HJS, seems to extend the syntax - --- --------------------------------------------------------------------- --- From HJS -{- -callExpr = do { x <- memberExpr; - do {rOp "("; whiteSpace; args <- commaSep assigne; whiteSpace; rOp ")"; rest $ CallMember x args } - <|> do { return $ CallPrim x } - <|> do { rOp "++"; return $ CallPrim x } - } - where - rest x = - try (do { rOp "("; args <- commaSep assigne; rOp ")" ; rest $ CallCall x args }) - <|> try (do { rOp "."; i <- identifier; rest $ CallDot x i }) - <|> try (do { rOp "["; e <- expr; rOp "]"; rest $ CallSquare x e }) - <|> return x --} --- --------------------------------------------------------------------- - -lparen, rparen, comma :: Char -lparen = '(' -rparen = ')' -comma = ',' - --- ::= '(' ')' --- | '(' ')' -arguments :: Parser JSNode -arguments = do - _ <- lChar lparen - x <- ((lChar rparen) >> return [[]]) - <|> (do x <- argumentList - _ <- lChar rparen - return x) - return $ JSArguments x - --- ::= --- | ',' -argumentList :: Parser [[JSNode]] -argumentList = sepBy1 assignmentExpression $ lChar comma - --- ::= --- | -leftHandSideExpression :: Parser [JSNode] -leftHandSideExpression = callExpression - <|> newExpression - "leftHandSideExpression" - - --- ::= --- | '++' --- | '--' -postfixExpression :: Parser [JSNode] -postfixExpression = do{ v1 <- leftHandSideExpression; - do { - do{ rOp "++"; return [(JSExpressionPostfix "++" v1)]} - <|> do{ rOp "--"; return [(JSExpressionPostfix "--" v1)]} - <|> return v1 - } - } - --- ::= --- | 'delete' --- | 'void' --- | 'typeof' --- | '++' --- | '--' --- | '+' --- | '-' --- | '~' --- | '!' -unaryExpression :: Parser [JSNode] -unaryExpression = do{ v1 <- postfixExpression; - return v1} - <|> do{ P.reserved "delete"; v1 <- unaryExpression; - return ((JSUnary "delete "):v1)} - <|> do{ P.reserved "void"; v1 <- unaryExpression; - return ((JSUnary "void"):v1)} - <|> do{ P.reserved "typeof"; v1 <- unaryExpression; - return ((JSUnary "typeof "):v1)} -- TODO: should the space always be there? - <|> do{ rOp "++"; v1 <- unaryExpression; - return ((JSUnary "++"):v1)} - <|> do{ rOp "--"; v1 <- unaryExpression; - return ((JSUnary "--"):v1)} - <|> do{ rOp "+"; v1 <- unaryExpression; - return ((JSUnary "+"):v1)} - <|> do{ rOp "-"; v1 <- unaryExpression; - return ((JSUnary "-"):v1)} - <|> do{ rOp "~"; v1 <- unaryExpression; - return ((JSUnary "~"):v1)} - <|> do{ rOp "!"; v1 <- unaryExpression; - return ((JSUnary "!"):v1)} - --- ::= --- | '*' --- | '/' --- | '%' -multiplicativeExpression :: Parser [JSNode] -multiplicativeExpression = do{ v1 <- unaryExpression; v2 <- rest; - return (v1++v2)} - where - rest = - do{ rOp "*"; v2 <- multiplicativeExpression; v3 <- rest; - return [(JSExpressionBinary "*" v2 v3)]} - <|> do{ rOp "/"; v2 <- multiplicativeExpression; v3 <- rest; - return [(JSExpressionBinary "/" v2 v3)]} - <|> do{ rOp "%"; v2 <- multiplicativeExpression; v3 <- rest; - return [(JSExpressionBinary "%" v2 v3)]} - <|> return [] - - --- ::= '+' --- | '-' --- | -additiveExpression :: Parser [JSNode] -additiveExpression = do{ v1 <- multiplicativeExpression; v2 <- rest; - return (v1++v2)} - where - rest = - do { rOp "+"; v2 <- multiplicativeExpression; v3 <- rest; - return ([(JSExpressionBinary "+" v2 v3)])} - <|> do { rOp "-"; v2 <- multiplicativeExpression; v3 <- rest; - return ([(JSExpressionBinary "-" v2 v3)])} - <|> return [] - - --- ::= '<<' --- | '>>' --- | '>>>' --- | -shiftExpression :: Parser [JSNode] -shiftExpression = do{ v1 <- additiveExpression; v2 <- rest; - return (v1++v2)} - where - rest = - do{ rOp "<<"; v2 <- additiveExpression; v3 <- rest; - return [(JSExpressionBinary "<<" v2 v3)]} - <|> do{ rOp ">>>"; v2 <- additiveExpression; v3 <- rest; - return [(JSExpressionBinary ">>>" v2 v3)]} - <|> do{ rOp ">>"; v2 <- additiveExpression; v3 <- rest; - return [(JSExpressionBinary ">>" v2 v3)]} - <|> return [] - - --- ::= --- | '<' --- | '>' --- | '<=' --- | '>=' --- | 'instanceof' -relationalExpression :: Parser [JSNode] -relationalExpression = do{ v1 <- shiftExpression; v2 <- rest; - return (v1++v2)} - where - rest = - do{ rOp "<="; v2 <- shiftExpression; v3 <- rest; - return [(JSExpressionBinary "<=" v2 v3)]} - <|> do{ rOp ">="; v2 <- shiftExpression; v3 <- rest; - return [(JSExpressionBinary ">=" v2 v3)]} - - <|> do{ rOp "<"; v2 <- shiftExpression; v3 <- rest; - return [(JSExpressionBinary "<" v2 v3)]} - <|> do{ rOp ">"; v2 <- shiftExpression; v3 <- rest; - return [(JSExpressionBinary ">" v2 v3)]} - <|> do{ P.reserved "instanceof"; v2 <- shiftExpression; v3 <- rest; - return [(JSExpressionBinary " instanceof " v2 v3)]} - -- Strictly speaking should have all the NoIn variants of expressions, - -- but we assume syntax is checked so no problem. Cross fingers. - <|> do{ P.reserved "in"; v2 <- shiftExpression; v3 <- rest; - return [(JSExpressionBinary " in " v2 v3)]} - <|> return [] - - - --- ::= --- | '==' --- | '!=' --- | '===' --- | '!==' -equalityExpression :: Parser [JSNode] -equalityExpression = do - v1 <- relationalExpression - v2 <- rest - return $ v1 ++ v2 - where - rest = equals <|> exclaim <|> return [] - equals = do - _ <- char '=' - _ <- char '=' - sign <- P.lexeme $ (char '=' >> return "===") <|> return "==" - v2 <- relationalExpression - v3 <- rest - return [JSExpressionBinary sign v2 v3] - exclaim = do - _ <- char '!' - _ <- char '=' - sign <- P.lexeme $ (char '=' >> return "!==") <|> return "!=" - v2 <- relationalExpression - v3 <- rest - return [JSExpressionBinary sign v2 v3] - -bitwiseExpression :: Parser [JSNode] -> Char -> Parser [JSNode] -bitwiseExpression prev op = do - v1 <- prev - v2 <- rest - return $ v1 ++ v2 - where - rest = (do - _ <- P.lexeme $ char op - v2 <- equalityExpression - v3 <- rest - return [JSExpressionBinary [op] v2 v3]) <|> return [] - --- ::= --- | '&' -bitwiseAndExpression :: Parser [JSNode] -bitwiseAndExpression = bitwiseExpression equalityExpression '&' - --- ::= --- | '^' -bitwiseXOrExpression :: Parser [JSNode] -bitwiseXOrExpression = bitwiseExpression bitwiseAndExpression '^' - --- ::= --- | '|' -bitwiseOrExpression :: Parser [JSNode] -bitwiseOrExpression = bitwiseExpression bitwiseXOrExpression '|' - --- ::= --- | '&&' -logicalAndExpression :: Parser [JSNode] -logicalAndExpression = do{ v1 <- bitwiseOrExpression; v2 <- rest; - return (v1++v2)} - where - rest = - do{ rOp "&&"; v2 <- bitwiseOrExpression; v3 <- rest; - return [(JSExpressionBinary "&&" v2 v3)]} - <|> return [] - - - - --- ::= --- | '||' -logicalOrExpression :: Parser [JSNode] -logicalOrExpression = do{ v1 <- logicalAndExpression; v2 <- rest; - return (v1++v2)} - where - rest = - (do{ rOp "||"; v2 <- logicalAndExpression; v3 <- rest; - return [(JSExpressionBinary "||" v2 v3)]}) - <|> return [] - - --- ::= --- | '?' ':' -conditionalExpression :: Parser [JSNode] -conditionalExpression = do{ v1 <- logicalOrExpression; - do { - do{ rOp "?"; v2 <- assignmentExpression; rOp ":"; v3 <- assignmentExpression; - return [(JSExpressionTernary v1 v2 v3)]} - <|> return v1 - } - } - - --- ::= --- | -assignmentExpression :: Parser [JSNode] -assignmentExpression = try (do {v1 <- assignmentStart; v2 <- assignmentExpression; -- FIXME unintuitive, but tests pass after removing this try - return [(JSElement "assignmentExpression" (v1++v2))]}) - <|> conditionalExpression - -assignmentStart :: Parser [JSNode] -assignmentStart = do {v1 <- leftHandSideExpression; v2 <- assignmentOperator; - return (v1++[v2])} - --- ::= '=' | '*=' | '/=' | '%=' | '+=' | '-=' | '<<=' | '>>=' | '>>>=' | '&=' | '^=' | '|=' --- TODO : unwind this lot into some sort of deterministic processing, DFA style. -assignmentOperator :: Parser JSNode -assignmentOperator = rOp' "=" <|> rOp' "*=" <|> rOp' "/=" <|> rOp' "%=" <|> rOp' "+=" <|> rOp' "-=" - <|> rOp' "<<=" <|> rOp' ">>=" <|> rOp' ">>>=" <|> rOp' "&=" <|> rOp' "^=" <|> rOp' "|=" - -rOp' :: String -> Parser JSNode -rOp' x = do{ rOp x; return $ JSOperator x} - --- ::= --- | ',' -expression :: Parser JSNode -expression = do{ val <- sepBy1 assignmentExpression (rOp ","); - return (JSExpression (flattenExpression val))} - - -flattenExpression :: [[JSNode]] -> [JSNode] -flattenExpression val = flatten $ intersperse litComma val - where - litComma :: [JSNode] - litComma = [(JSLiteral ",")] - --- ::= --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | -statement :: Parser JSNode -statement = statementBlock - <|> labelledStatement - <|> expression - <|> variableStatement - <|> emptyStatement - <|> ifElseStatement - <|> ifStatement - <|> iterationStatement - <|> continueStatement - <|> breakStatement - <|> returnStatement - <|> withStatement - <|> switchStatement - <|> throwStatement - <|> tryStatement - "statement" - - -statementBlock :: Parser JSNode -statementBlock = do {v1 <- statementBlock'; return (if (v1 == []) then (JSLiteral ";") else (head v1))} - --- ::= '{' '}' --- | '{' '}' -statementBlock' :: Parser [JSNode] -statementBlock' = (do - _ <- P.lexeme $ char '{' - (P.lexeme (char '}') >> return []) <|> (do - val <- statementList - _ <- P.lexeme $ char '}' - return $ - if val == JSStatementList [JSLiteral ";"] - then [] - else [JSBlock val]) - ) "statementBlock" - --- ::= '{' '}' --- | '{' '}' -block :: Parser JSNode -block = (do - _ <- P.lexeme $ char '{' - x <- (P.lexeme (char '}') >> return (JSStatementList [])) <|> (do - val <- statementList - _ <- P.lexeme $ char '}' - return val) - return $ JSBlock x) "block" - --- ::= --- | -statementList :: Parser JSNode -statementList = do {v1 <- many1 statement; - return (JSStatementList v1)} - - --- ::= var ';' --- Note: Mozilla introduced const declarations, not part of official spec -variableStatement :: Parser JSNode -variableStatement = do {P.reserved "var"; val <- variableDeclarationList; - return (JSVariables "var" val)} - <|> do {P.reserved "const"; val <- variableDeclarationList; - return (JSVariables "const" val)} - - --- ::= --- | ',' -variableDeclarationList :: Parser [JSNode] -variableDeclarationList = do{ val <- sepBy1 variableDeclaration (rOp ","); - return val } - - --- ::= Identifier --- | Identifier -variableDeclaration :: Parser JSNode -variableDeclaration = do{ v1 <- identifier; - do { - do {v2 <- initializer; - return (JSVarDecl v1 v2)} - <|> return (JSVarDecl v1 []) - } - } - --- ::= '=' -initializer :: Parser [JSNode] -initializer = do {rOp "="; val <- assignmentExpression; - return val} - --- ::= ';' -emptyStatement :: Parser JSNode ---emptyStatement = do { v1 <- autoSemi'; return (JSEmpty v1)} -emptyStatement = do { v1 <- autoSemi'; return v1} - - --- ::= 'if' '(' ')' -ifStatement :: Parser JSNode -ifStatement = do{ P.reserved "if"; rOp "("; v1 <- expression; rOp ")"; v2 <- statement; - return (JSIf v1 v2) } - --- ::= 'if' '(' ')' 'else' -ifElseStatement :: Parser JSNode -ifElseStatement = do{ try $ P.reserved "if"; rOp "("; v1 <- expression; rOp ")"; v2 <- statementSemi; P.reserved "else"; v3 <- statement ; -- FIXME can this try be removed? - return (JSIfElse v1 v2 v3) } - -statementSemi :: Parser JSNode -statementSemi = do { v1 <- statement; - do { - do { rOp ";"; return (JSBlock (JSStatementList [v1]))} - <|> return v1 - } - } - - --- ::= 'do' 'while' '(' ')' ';' --- | 'while' '(' ')' --- | 'for' '(' ';' ';' ')' --- | 'for' '(' 'var' ';' ';' ')' --- | 'for' '(' in ')' --- | 'for' '(' 'var' in ')' -iterationStatement :: Parser JSNode -iterationStatement = do{ P.reserved "do"; v1 <- statement; P.reserved "while"; rOp "("; v2 <- expression; rOp ")"; v3 <- autoSemi ; - return (JSDoWhile v1 v2 v3)} - <|> do{ P.reserved "while"; rOp "("; v1 <- expression; rOp ")"; v2 <- statement; - return (JSWhile v1 v2)} - - <|> do{ P.reserved "for"; rOp "("; - do { - do{ P.reserved "var"; v1 <- variableDeclaration; - do { - do { rOp ","; v1' <- variableDeclarationList; rOp ";"; v2 <- optionalExpression ";"; - v3 <- optionalExpression ")"; v4 <- statement; - return (JSForVar (v1:v1') v2 v3 v4)} - <|> do { rOp ";"; v2 <- optionalExpression ";"; - v3 <- optionalExpression ")"; v4 <- statement; - return (JSForVar [v1] v2 v3 v4)} - <|> do { P.reserved "in"; v2 <- expression; rOp ")"; v3 <- statement; - return (JSForVarIn v1 v2 v3)} - } - } - <|> try(do{ v1 <- leftHandSideExpression; P.reserved "in"; v2 <- expression; rOp ")"; - v3 <- statement; - return (JSForIn v1 v2 v3)}) - <|> do { v1 <- optionalExpression ";"; v2 <- optionalExpression ";"; - v3 <- optionalExpression ")"; v4 <- statement; - return (JSFor v1 v2 v3 v4)} - } - } - "iterationStatement" - -optionalExpression :: [Char] -> Parser [JSNode] -optionalExpression s = do { rOp s; - return []} - <|> do { v1 <- expression; rOp s ; - return [v1]} - --- ::= 'continue' ';' --- | 'continue' Identifier ';' -continueStatement :: Parser JSNode -continueStatement = do {P.reserved "continue"; v1 <- autoSemi; - return (JSContinue [v1])} - <|> do {P.reserved "continue"; v1 <- identifier; v2 <- autoSemi; - return (JSContinue [v1,v2])} - - --- ::= 'break' ';' --- | 'break' Identifier ';' -breakStatement :: Parser JSNode -breakStatement = do {P.reserved "break"; - do { - do {v1 <- identifier; v2 <- autoSemi; - return (JSBreak [v1] [v2])} - <|> do {v1 <- autoSemi; - return (if (v1 == JSLiteral "") then (JSBreak [] []) else (JSBreak [] [v1]))} - } - } - - --- ::= 'return' ';' --- | 'return' ';' -returnStatement :: Parser JSNode -returnStatement = do {P.reserved "return"; - do{ - do {v1 <- expression; v2 <- autoSemi; - return (JSReturn [v1,v2])} - <|> do {v1 <- autoSemi; return (JSReturn [v1])} - - } - } - - --- ::= 'with' '(' ')' ';' -withStatement :: Parser JSNode -withStatement = do{ P.reserved "with"; rOp "("; v1 <- expression; rOp ")"; v2 <- statement; v3 <- autoSemi; - return (JSWith v1 [v2,v3])} - - --- ::= 'switch' '(' ')' -switchStatement :: Parser JSNode -switchStatement = do{ P.reserved "switch"; rOp "("; v1 <- expression; rOp ")"; v2 <- caseBlock; - return (JSSwitch v1 v2)} - --- ::= '{' '}' --- | '{' '}' --- | '{' '}' --- | '{' '}' --- | '{' '}' --- | '{' '}' --- TODO: get rid of the try clauses by unwinding this -caseBlock :: Parser [JSNode] -caseBlock = do - _ <- P.lexeme $ char '{' - a <- caseClauses <|> return [] - b <- fmap return defaultClause <|> return [] - c <- caseClauses <|> return [] - _ <- P.lexeme $ char '}' - return $ concat [a, b, c] - --- ::= --- | -caseClauses :: Parser [JSNode] -caseClauses = do{ val <- many1 caseClause; - return val} - --- ::= 'case' ':' --- | 'case' ':' -caseClause :: Parser JSNode -caseClause = do { P.reserved "case"; v1 <- expression; rOp ":"; - do { - do { v2 <- statementList; - return (JSCase v1 v2)} - <|> return (JSCase v1 (JSStatementList [])) - } - } - --- ::= 'default' ':' --- | 'default' ':' -defaultClause :: Parser JSNode -defaultClause = do{ P.reserved "default"; rOp ":"; v1 <- statementList; - return (JSDefault v1)} - <|> do{ P.reserved "default"; rOp ":"; - return (JSDefault (JSStatementList []))} - --- ::= Identifier ':' -labelledStatement :: Parser JSNode -labelledStatement = do { v1 <- try identifier; rOp ":"; v2 <- statement; -- FIXME can this try be removed? - return (JSLabelled v1 v2)} - --- ::= 'throw' -throwStatement :: Parser JSNode -throwStatement = do{ P.reserved "throw"; val <- expression; - return (JSThrow val)} - --- Note: worked in updated syntax as per https://developer.mozilla.org/en/JavaScript/Reference/Statements/try...catch --- ::= 'try' --- | 'try' --- | 'try' -tryStatement :: Parser JSNode -tryStatement = do{ P.reserved "try"; v1 <- block; - do { - do { v2 <- many1 catch; - do { v3 <- finally; - return (JSTry v1 (v2++[v3]))} - <|> return (JSTry v1 v2) - } - <|> do{ v2 <- finally; - return (JSTry v1 [v2])} - } - } - --- Note: worked in updated syntax as per https://developer.mozilla.org/en/JavaScript/Reference/Statements/try...catch --- ::= 'catch' '(' Identifier ')' --- becomes --- ::= 'catch' '(' Identifier ')' --- | 'catch' '(' Identifier 'if' Condition ')' -catch :: Parser JSNode -catch = do{ P.reserved "catch"; rOp "("; v1 <- identifier; - do { - do { rOp ")"; v3 <- block; - return (JSCatch v1 [] v3)} - <|> do { P.reserved "if"; v2 <- conditionalExpression; rOp ")"; v3 <- block; - return (JSCatch v1 v2 v3)} - } - } - --- ::= 'finally' -finally :: Parser JSNode -finally = do{ P.reserved "finally"; v1 <- block; - return (JSFinally v1)} - --- ::= 'function' Identifier '(' ')' '{' '}' --- | 'function' Identifier '(' ')' '{' '}' -functionDeclaration :: Parser JSNode -functionDeclaration = do {P.reserved "function"; v1 <- identifier; rOp "("; v2 <- formalParameterList; rOp ")"; - v3 <- functionBody; - return (JSFunction v1 v2 v3) } - "functionDeclaration" - - --- ::= 'function' '(' ')' '{' '}' ---- | 'function' '(' ')' '{' '}' -functionExpression :: Parser JSNode -functionExpression = do{ P.reserved "function"; rOp "("; - do { - do { rOp ")"; v2 <- functionBody; - return (JSFunctionExpression [] v2)} - <|> do {v1 <- formalParameterList; rOp ")"; v2 <- functionBody; - return (JSFunctionExpression v1 v2)} - } - } - --- ::= Identifier --- | ',' Identifier -formalParameterList :: Parser [JSNode] -formalParameterList = sepBy identifier (rOp ",") - --- ::= '{' '}' --- | '{' '}' -functionBody :: Parser JSNode -functionBody = do{ rOp "{"; - do { - do{ rOp "}"; - return (JSFunctionBody []) } - <|> do{ v1 <- sourceElements; rOp "}"; - return (JSFunctionBody [v1]) } - } - } - "functionBody" - --- ::= -program :: Parser JSNode -program = do {P.whiteSpace; val <- sourceElementsTop; eof; - return val} - - --- ::= --- | -sourceElements :: Parser JSNode -sourceElements = do{ val <- many1 sourceElement; - return (JSSourceElements val)} - -sourceElementsTop :: Parser JSNode -sourceElementsTop = do{ val <- many1 sourceElement; - return (JSSourceElementsTop val)} - - --- ::= --- | -sourceElement :: Parser JSNode -sourceElement = functionDeclaration - <|> statement - "sourceElement" - - - --- --------------------------------------------------------------- --- Testing - --- --------------------------------------------------------------------- - -flatten :: [[a]] -> [a] -flatten xs = foldl' (++) [] xs - --- --------------------------------------------------------------------- - -main :: IO () -main = - do args <- getArgs - x <- LB.readFile (args !! 0) - putStrLn (show $ doParse program x) - - --- --------------------------------------------------------------------- - -readJs :: LB.ByteString -> JSNode -readJs input = case doParse program input of - Fail _unparsed contexts err -> error("Parse failed" ++ show(contexts) ++ ":" ++ show err) - -- Partial _f -> error("Unexpected partial") - Done _unparsed val -> val - --- --------------------------------------------------------------------- - -{- -readJsm :: (Monad m) => B.ByteString -> m JSNode -readJsm input = case eitherResult $ doParse program input of - Left msg -> fail ("Parse failed:" ++ msg) - Right val -> return val --} - -readJsm :: LB.ByteString -> Either String JSNode -readJsm input = eitherResult $ doParse program input - --- --------------------------------------------------------------------- - -{- -_doParse' :: Parser a -> String -> a -_doParse' p input = case parse (p' p) (LB.fromChunks [E.encodeUtf8 $ T.pack input]) of - Fail _unparsed contexts err -> error("Parse failed" ++ show(contexts) ++ ":" ++ show err) - Partial _f -> error("Unexpected partial") - Done _unparsed val -> val --} - -{- -doParseStrict :: Parser r -> B.ByteString -> Result r -doParseStrict p input = {-maybeResult $-} feed (parse (p' p) input) LB.empty --} - -doParse :: Parser r -> LB.ByteString -> Result r -doParse p input = parse (p' p) input - -parseString :: Parser r -> String -> Result r -parseString p input = doParse p (LB.fromChunks [E.encodeUtf8 $ T.pack input]) - -parseProgram :: String -> Result JSNode -parseProgram input = doParse program (LB.fromChunks [E.encodeUtf8 $ T.pack input]) - --- --------------------------------------------------------------------- - -p' :: Parser b -> Parser b -p' p = do {val <- p; eof; return val} - --- --------------------------------------------------------------------- - -_showFile :: FilePath -> IO String -_showFile filename = - do - x <- readFile (filename) - return $ (show x) - --- --------------------------------------------------------------------- - -parseFile :: FilePath -> IO JSNode -parseFile filename = - do - x <- LB.readFile (filename) - return $ (readJs x) - --- EOF diff --git a/Text/Jasmine/Pretty.hs b/Text/Jasmine/Pretty.hs --- a/Text/Jasmine/Pretty.hs +++ b/Text/Jasmine/Pretty.hs @@ -41,101 +41,113 @@ -- --------------------------------------------------------------------- - renderJS :: JSNode -> BB.Builder -renderJS (JSEmpty l) = (renderJS l) -renderJS (JSIdentifier s) = text s -renderJS (JSDecimal i) = text i -renderJS (JSOperator s) = text s -renderJS (JSExpression xs) = rJS xs -renderJS (JSSourceElements xs) = rJS (map fixBlock $ fixSourceElements xs) -renderJS (JSSourceElementsTop xs)= rJS (fixTop $ map fixBlock $ fixSourceElements xs) -renderJS (JSFunction s p xs) = (text "function") <+> (renderJS s) <> (text "(") <> (commaList p) <> (text ")") <> (renderJS xs) -renderJS (JSFunctionBody xs) = (text "{") <> (rJS xs) <> (text "}") -renderJS (JSFunctionExpression [] p xs) = (text "function") <> (text "(") <> (commaList p) <> (text ")") <> (renderJS xs) -renderJS (JSFunctionExpression s p xs) = (text "function") <+> (rJS s) <> (text "(") <> (commaList p) <> (text ")") <> (renderJS xs) -renderJS (JSArguments xs) = (text "(") <> (commaListList $ map fixLiterals xs) <> (text ")") +renderJS (NS node _) = rn node -renderJS (JSBlock x) = (text "{") <> (renderJS x) <> (text "}") +rn :: Node -> BB.Builder +rn (JSEmpty l) = (renderJS l) +rn (JSIdentifier s) = text s +rn (JSDecimal i) = text i +rn (JSOperator s) = text s +rn (JSExpression xs) = rJS xs -renderJS (JSIf c (JSLiteral ";"))= (text "if") <> (text "(") <> (renderJS c) <> (text ")") -renderJS (JSIf c t) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS $ fixBlock t) +--rn (JSSourceElements xs) = rJS (map fixBlock $ fixSourceElements xs) +rn (JSSourceElements xs) = rJS (fixSourceElements $ map fixBlock xs) -renderJS (JSIfElse c t (JSLiteral ";")) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS t) +--rn (JSSourceElementsTop xs)= rJS (fixTop $ map fixBlock $ fixSourceElements xs) +rn (JSSourceElementsTop xs)= rJS (fixTop $ fixSourceElements $ map fixBlock xs) + + +rn (JSFunction s p xs) = (text "function") <+> (renderJS s) <> (text "(") <> (commaList p) <> (text ")") <> (renderJS xs) +rn (JSFunctionBody xs) = (text "{") <> (rJS xs) <> (text "}") +rn (JSFunctionExpression [] p xs) = (text "function") <> (text "(") <> (commaList p) <> (text ")") <> (renderJS xs) +rn (JSFunctionExpression s p xs) = (text "function") <+> (rJS s) <> (text "(") <> (commaList p) <> (text ")") <> (renderJS xs) +rn (JSArguments xs) = (text "(") <> (commaListList $ map fixLiterals xs) <> (text ")") + +rn (JSBlock x) = (text "{") <> (renderJS x) <> (text "}") + +rn (JSIf c (NS (JSLiteral ";") _))= (text "if") <> (text "(") <> (renderJS c) <> (text ")") +rn (JSIf c t) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS $ fixBlock t) + +rn (JSIfElse c t (NS (JSLiteral ";") _)) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS t) <> (text "else") -renderJS (JSIfElse c t e) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS t) +rn (JSIfElse c t e) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS t) <> (text "else") <> (spaceOrBlock $ fixBlock e) -renderJS (JSMemberDot xs y) = (rJS xs) <> (text ".") <> (renderJS y) -renderJS (JSMemberSquare xs x) = (rJS xs) <> (text "[") <> (renderJS x) <> (text "]") -renderJS (JSLiteral l) = (text l) -renderJS (JSStringLiteral s l) = empty <> (char s) <> (text l) <> (char s) -renderJS (JSUnary l ) = text l -renderJS (JSArrayLiteral xs) = (text "[") <> (rJS xs) <> (text "]") +rn (JSMemberDot xs y) = (rJS xs) <> (text ".") <> (renderJS y) +rn (JSMemberSquare xs x) = (rJS xs) <> (text "[") <> (renderJS x) <> (text "]") +rn (JSLiteral l) = (text l) +rn (JSStringLiteral s l) = empty <> (char s) <> (text l) <> (char s) +rn (JSUnary l ) = text l +rn (JSArrayLiteral xs) = (text "[") <> (rJS xs) <> (text "]") -renderJS (JSBreak [] []) = (text "break") -renderJS (JSBreak [] _xs) = (text "break") -- <> (rJS xs) -- <> (text ";") -renderJS (JSBreak is _xs) = (text "break") <+> (rJS is) -- <> (rJS xs) +rn (JSBreak [] []) = (text "break") +rn (JSBreak [] _xs) = (text "break") -- <> (rJS xs) -- <> (text ";") +rn (JSBreak is _xs) = (text "break") <+> (rJS is) -- <> (rJS xs) -renderJS (JSCallExpression "()" xs) = (rJS xs) -renderJS (JSCallExpression t xs) = (char $ head t) <> (rJS xs) <> (if ((length t) > 1) then (char $ last t) else empty) +rn (JSCallExpression "()" xs) = (rJS xs) +rn (JSCallExpression t xs) = (char $ head t) <> (rJS xs) <> (if ((length t) > 1) then (char $ last t) else empty) -- No space between 'case' and string literal. TODO: what about expression in parentheses? -renderJS (JSCase (JSExpression [JSStringLiteral sepa s]) xs) = (text "case") <> (renderJS (JSStringLiteral sepa s)) +--rn (JSCase (JSExpression [JSStringLiteral sepa s]) xs) = (text "case") <> (renderJS (JSStringLiteral sepa s)) +rn (JSCase (NS (JSExpression [(NS (JSStringLiteral sepa s) s1)]) _) xs) = (text "case") <> (renderJS (NS (JSStringLiteral sepa s) s1)) <> (char ':') <> (renderJS xs) -renderJS (JSCase e xs) = (text "case") <+> (renderJS e) <> (char ':') <> (renderJS xs) -- <> (text ";"); +rn (JSCase e xs) = (text "case") <+> (renderJS e) <> (char ':') <> (renderJS xs) -- <> (text ";"); -renderJS (JSCatch i [] s) = (text "catch") <> (char '(') <> (renderJS i) <> (char ')') <> (renderJS s) -renderJS (JSCatch i c s) = (text "catch") <> (char '(') <> (renderJS i) <> +rn (JSCatch i [] s) = (text "catch") <> (char '(') <> (renderJS i) <> (char ')') <> (renderJS s) +rn (JSCatch i c s) = (text "catch") <> (char '(') <> (renderJS i) <> (text " if ") <> (rJS c) <> (char ')') <> (renderJS s) -renderJS (JSContinue is) = (text "continue") <> (rJS is) -- <> (char ';') -renderJS (JSDefault xs) = (text "default") <> (char ':') <> (renderJS xs) -renderJS (JSDoWhile s e _ms) = (text "do") <> (renderJS s) <> (text "while") <> (char '(') <> (renderJS e) <> (char ')') -- <> (renderJS ms) ---renderJS (JSElementList xs) = rJS xs -renderJS (JSElision xs) = (char ',') <> (rJS xs) -renderJS (JSExpressionBinary o e1 e2) = (rJS e1) <> (text o) <> (rJS e2) ---renderJS (JSExpressionBinary o e1 e2) = (text o) <> (rJS e1) <> (rJS e2) -renderJS (JSExpressionParen e) = (char '(') <> (renderJS e) <> (char ')') -renderJS (JSExpressionPostfix o e) = (rJS e) <> (text o) -renderJS (JSExpressionTernary c v1 v2) = (rJS c) <> (char '?') <> (rJS v1) <> (char ':') <> (rJS v2) -renderJS (JSFinally b) = (text "finally") <> (renderJS b) +rn (JSContinue is) = (text "continue") <> (rJS is) -- <> (char ';') +rn (JSDefault xs) = (text "default") <> (char ':') <> (renderJS xs) +rn (JSDoWhile s e _ms) = (text "do") <> (renderJS s) <> (text "while") <> (char '(') <> (renderJS e) <> (char ')') -- <> (renderJS ms) +--rn (JSElementList xs) = rJS xs +rn (JSElision xs) = (char ',') <> (rJS xs) +rn (JSExpressionBinary o e1 e2) = (rJS e1) <> (text o) <> (rJS e2) +--rn (JSExpressionBinary o e1 e2) = (text o) <> (rJS e1) <> (rJS e2) +rn (JSExpressionParen e) = (char '(') <> (renderJS e) <> (char ')') +rn (JSExpressionPostfix o e) = (rJS e) <> (text o) +rn (JSExpressionTernary c v1 v2) = (rJS c) <> (char '?') <> (rJS v1) <> (char ':') <> (rJS v2) +rn (JSFinally b) = (text "finally") <> (renderJS b) -renderJS (JSFor e1 e2 e3 s) = (text "for") <> (char '(') <> (commaList e1) <> (char ';') +rn (JSFor e1 e2 e3 s) = (text "for") <> (char '(') <> (commaList e1) <> (char ';') <> (rJS e2) <> (char ';') <> (rJS e3) <> (char ')') <> (renderJS $ fixBlock s) -renderJS (JSForIn e1 e2 s) = (text "for") <> (char '(') <> (rJS e1) <+> (text "in") +rn (JSForIn e1 e2 s) = (text "for") <> (char '(') <> (rJS e1) <+> (text "in") <+> (renderJS e2) <> (char ')') <> (renderJS $ fixBlock s) -renderJS (JSForVar e1 e2 e3 s) = (text "for") <> (char '(') <> (text "var") <+> (commaList e1) <> (char ';') +rn (JSForVar e1 e2 e3 s) = (text "for") <> (char '(') <> (text "var") <+> (commaList e1) <> (char ';') <> (rJS e2) <> (char ';') <> (rJS e3) <> (char ')') <> (renderJS $ fixBlock s) -renderJS (JSForVarIn e1 e2 s) = (text "for") <> (char '(') <> (text "var") <+> (renderJS e1) <+> (text "in") +rn (JSForVarIn e1 e2 s) = (text "for") <> (char '(') <> (text "var") <+> (renderJS e1) <+> (text "in") <+> (renderJS e2) <> (char ')') <> (renderJS $ fixBlock s) -renderJS (JSHexInteger i) = (text $ show i) -- TODO: need to tweak this -renderJS (JSLabelled l v) = (renderJS l) <> (text ":") <> (renderJS v) -renderJS (JSObjectLiteral xs) = (text "{") <> (commaList xs) <> (text "}") -renderJS (JSPropertyNameandValue n vs) = (renderJS n) <> (text ":") <> (rJS vs) -renderJS (JSRegEx s) = (text s) +rn (JSHexInteger i) = (text $ show i) -- TODO: need to tweak this +rn (JSLabelled l v) = (renderJS l) <> (text ":") <> (rJS $ fixSourceElements [fixBlock v]) +rn (JSObjectLiteral xs) = (text "{") <> (commaList xs) <> (text "}") +rn (JSPropertyAccessor s n ps b) = (text s) <+> (renderJS n) <> (char '(') <> (rJS ps) <> (text ")") <> (renderJS b) +rn (JSPropertyNameandValue n vs) = (renderJS n) <> (text ":") <> (rJS vs) +rn (JSRegEx s) = (text s) -renderJS (JSReturn []) = (text "return") -renderJS (JSReturn [JSLiteral ";"]) = (text "return;") -renderJS (JSReturn xs) = (text "return") <> (if (spaceNeeded xs) then (text " ") else (empty)) <> (rJS $ fixSourceElements xs) +rn (JSReturn []) = (text "return") +rn (JSReturn [(NS (JSLiteral ";") _)]) = (text "return;") +rn (JSReturn xs) = (text "return") <> (if (spaceNeeded xs) then (text " ") else (empty)) <> (rJS $ fixSourceElements xs) -renderJS (JSThrow e) = (text "throw") <+> (renderJS e) +rn (JSThrow e) = (text "throw") <+> (renderJS e) -renderJS (JSStatementList xs) = rJS (fixSourceElements $ map fixBlock xs) +rn (JSStatementBlock x) = (text "{") <> (renderJS x) <> (text "}") -renderJS (JSSwitch e xs) = (text "switch") <> (char '(') <> (renderJS e) <> (char ')') <> +rn (JSStatementList xs) = rJS (fixSourceElements $ map fixBlock xs) + +rn (JSSwitch e xs) = (text "switch") <> (char '(') <> (renderJS e) <> (char ')') <> (char '{') <> (rJS $ fixSemis xs) <> (char '}') -renderJS (JSTry e xs) = (text "try") <> (renderJS e) <> (rJS xs) +rn (JSTry e xs) = (text "try") <> (renderJS e) <> (rJS xs) -renderJS (JSVarDecl i []) = (renderJS i) -renderJS (JSVarDecl i xs) = (renderJS i) <> (text "=") <> (rJS xs) +rn (JSVarDecl i []) = (renderJS i) +rn (JSVarDecl i xs) = (renderJS i) <> (text "=") <> (rJS xs) -renderJS (JSVariables kw xs) = (text kw) <+> (commaList xs) +rn (JSVariables kw xs) = (text kw) <+> (commaList xs) -renderJS (JSWhile e (JSLiteral ";")) = (text "while") <> (char '(') <> (renderJS e) <> (char ')') -- <> (renderJS s) -renderJS (JSWhile e s) = (text "while") <> (char '(') <> (renderJS e) <> (char ')') <> (renderJS s) +rn (JSWhile e (NS (JSLiteral ";") _)) = (text "while") <> (char '(') <> (renderJS e) <> (char ')') -- <> (renderJS s) +rn (JSWhile e s) = (text "while") <> (char '(') <> (renderJS e) <> (char ')') <> (renderJS s) -renderJS (JSWith e s) = (text "with") <> (char '(') <> (renderJS e) <> (char ')') <> (rJS s) +rn (JSWith e s) = (text "with") <> (char '(') <> (renderJS e) <> (char ')') <> (rJS s) -- Helper functions rJS :: [JSNode] -> BB.Builder @@ -145,8 +157,10 @@ commaList [] = empty commaList xs = (hcat $ (punctuate comma (toDoc xs') ++ trail)) where - (xs', trail) = if (last xs == JSLiteral ",") then (init xs, [comma]) else (xs,[]) - + -- (xs', trail) = if (last xs == JSLiteral ",") then (init xs, [comma]) else (xs,[]) + (xs', trail) = if (x' == JSLiteral ",") then (init xs, [comma]) else (xs,[]) + (NS x' _) = last xs + commaListList :: [[JSNode]] -> BB.Builder commaListList xs = (hcat $ punctuate comma $ map rJS xs) @@ -154,16 +168,26 @@ toDoc xs = map renderJS xs spaceOrBlock :: JSNode -> BB.Builder -spaceOrBlock (JSBlock xs) = renderJS (JSBlock xs) +spaceOrBlock (NS (JSBlock xs) _) = rn (JSBlock xs) +spaceOrBlock (NS (JSStatementBlock xs) _) = rn (JSStatementBlock xs) spaceOrBlock x = (text " ") <> (renderJS x) + +{- + +TODO: Collapse this into JSLiteral ";" + +JSStatementBlock (JSStatementList [JSStatementBlock (JSStatementList [])]) +-} -- --------------------------------------------------------------- -- Utility stuff fixTop :: [JSNode] -> [JSNode] fixTop [] = [] -fixTop xs = if (last xs == (JSLiteral ";")) then (init xs) else (xs) +fixTop xs = if (n == (JSLiteral ";")) then (init xs) else (xs) + where + (NS n _) = last xs -- Fix semicolons in output of sourceelements and statementlist @@ -172,67 +196,96 @@ myFix :: [JSNode] -> [JSNode] myFix [] = [] + +-- Sort out empty IF statements +myFix ((NS (JSIf c (NS (JSStatementBlock (NS (JSStatementList []) s1)) s2)) _s3):xs) = (NS (JSIf c (NS (JSLiteral "") s1)) s2) : myFix (xs) + myFix [x] = [x] -myFix (x:(JSFunction v1 v2 v3):xs) = x : (JSLiteral "\n") : myFix ((JSFunction v1 v2 v3) : xs) + +myFix (x:(NS (JSFunction v1 v2 v3) s1):xs) = x : (NS (JSLiteral "\n") s1) : myFix ((NS (JSFunction v1 v2 v3) s1) : xs) -- Messy way, but it works, until the 3rd element arrives .. -myFix ((JSExpression x):(JSExpression y):xs) = (JSExpression x):(JSLiteral ";"):myFix ((JSExpression y):xs) -myFix ((JSExpression x):(JSBlock y):xs) = (JSExpression x):(JSLiteral ";"):myFix ((JSBlock y):xs) -myFix ((JSBlock x) :(JSBlock y):xs) = (JSBlock x) :(JSLiteral ";"):myFix ((JSBlock y):xs) -myFix ((JSBlock x) :(JSExpression y):xs) = (JSBlock x) :(JSLiteral ";"):myFix ((JSExpression y):xs) +-- TODO: JSStatementBlock. Damn. +myFix ((NS (JSExpression x) s1):(NS (JSExpression y) s2):xs) = (NS (JSExpression x) s1):(NS (JSLiteral ";") s1):myFix ((NS (JSExpression y) s2):xs) +myFix ((NS (JSExpression x) s1):(NS (JSBlock y) s2):xs) = (NS (JSExpression x) s1):(NS (JSLiteral ";") s1):myFix ((NS (JSBlock y) s2):xs) +myFix ((NS (JSBlock x) s1) :(NS (JSBlock y) s2):xs) = (NS (JSBlock x) s1) :(NS (JSLiteral ";") s1):myFix ((NS (JSBlock y) s2):xs) +myFix ((NS (JSBlock x) s1) :(NS (JSExpression y) s2):xs) = (NS (JSBlock x) s1) :(NS (JSLiteral ";") s1):myFix ((NS (JSExpression y) s2):xs) +myFix ((NS (JSExpression x) s1):(NS (JSStatementBlock y) s2):xs) = + (NS (JSExpression x) s1):(NS (JSLiteral ";") s1):myFix ((NS (JSStatementBlock y) s2):xs) +myFix ((NS (JSStatementBlock x) s1) :(NS (JSStatementBlock y) s2):xs) = + (NS (JSStatementBlock x) s1) :(NS (JSLiteral ";") s1):myFix ((NS (JSStatementBlock y) s2):xs) +myFix ((NS (JSStatementBlock x) s1) :(NS (JSExpression y) s2):xs) = + (NS (JSStatementBlock x) s1) :(NS (JSLiteral ";") s1):myFix ((NS (JSExpression y) s2):xs) + -- Merge adjacent variable declarations, but only of the same type -myFix ((JSVariables t1 x1s):(JSLiteral l):(JSVariables t2 x2s):xs) - | t1 == t2 = myFix ((JSVariables t1 (x1s++x2s)):xs) - | otherwise = (JSVariables t1 x1s):myFix ((JSLiteral l):(JSVariables t2 x2s):xs) +myFix ((NS (JSVariables t1 x1s) s1):(NS (JSLiteral l) s2):(NS (JSVariables t2 x2s) s3):xs) + | t1 == t2 = myFix ((NS (JSVariables t1 (x1s++x2s)) s1):xs) + | otherwise = (NS (JSVariables t1 x1s) s1):myFix ((NS (JSLiteral l) s2):(NS (JSVariables t2 x2s) s3):xs) -myFix ((JSVariables t1 x1s):(JSVariables t2 x2s):xs) - | t1 == t2 = myFix ((JSVariables t1 (x1s++x2s)):xs) - | otherwise = (JSVariables t1 x1s):myFix ((JSVariables t2 x2s):xs) +myFix ((NS (JSVariables t1 x1s) s1):(NS (JSVariables t2 x2s) s2):xs) + | t1 == t2 = myFix ((NS (JSVariables t1 (x1s++x2s)) s1):xs) + | otherwise = (NS (JSVariables t1 x1s) s1):myFix ((NS (JSVariables t2 x2s) s2):xs) -- Merge adjacent semi colons -myFix ((JSLiteral ";"):(JSLiteral ";"):xs) = myFix ((JSLiteral ";"):xs) -myFix ((JSLiteral ";"):(JSLiteral "" ):xs) = myFix ((JSLiteral ""):xs) +myFix ((NS (JSLiteral ";") s1):(NS (JSLiteral ";") _s2):xs) = myFix ((NS (JSLiteral ";") s1):xs) +myFix ((NS (JSLiteral ";") s1):(NS (JSLiteral "" ) _s2):xs) = myFix ((NS (JSLiteral "") s1):xs) + myFix (x:xs) = x : myFix xs -- Merge strings split over lines and using "+" fixLiterals :: [JSNode] -> [JSNode] fixLiterals [] = [] -- Old version -fixLiterals ((JSStringLiteral d1 s1):(JSExpressionBinary "+" [JSStringLiteral d2 s2] r):xs) - | d1 == d2 = fixLiterals ((JSStringLiteral d1 (s1++s2)):(r++xs)) - | otherwise = (JSStringLiteral d1 s1):fixLiterals ((JSExpressionBinary "+" [JSStringLiteral d2 s2] r):xs) - -fixLiterals ((JSExpressionBinary "+" [JSStringLiteral d1 s1] [JSStringLiteral d2 s2]):xs) - | d1 == d2 = fixLiterals ((JSStringLiteral d1 (s1++s2)):xs) - | otherwise = (JSExpressionBinary "+" [JSStringLiteral d1 s1] [JSStringLiteral d2 s2]):fixLiterals xs +fixLiterals ((NS (JSStringLiteral d1 s1) ss1):(NS (JSExpressionBinary "+" [(NS (JSStringLiteral d2 s2) ss2)] r) ss3):xs) + | d1 == d2 = fixLiterals ((NS (JSStringLiteral d1 (s1++s2)) ss1):(r++xs)) + | otherwise = (NS (JSStringLiteral d1 s1) ss1):fixLiterals ((NS (JSExpressionBinary "+" [(NS (JSStringLiteral d2 s2) ss2)] r) ss3):xs) +fixLiterals ((NS (JSExpressionBinary "+" [(NS (JSStringLiteral d1 s1) ss2)] [(NS (JSStringLiteral d2 s2) ss3)]) ss4):xs) + | d1 == d2 = fixLiterals ((NS (JSStringLiteral d1 (s1++s2)) ss2):xs) + | otherwise = (NS (JSExpressionBinary "+" [(NS (JSStringLiteral d1 s1) ss2)] [(NS (JSStringLiteral d2 s2) ss3)]) ss4):fixLiterals xs fixLiterals (x:xs) = x:fixLiterals xs -- Sort out Semicolons fixSemis :: [JSNode] -> [JSNode] -fixSemis xs = fixSemis' $ filter (\x -> x /= JSLiteral ";" && x /= JSLiteral "") xs +--fixSemis xs = fixSemis' $ filter (\x -> x /= JSLiteral ";" && x /= JSLiteral "") xs +fixSemis xs = fixSemis' $ filter (\(NS x _) -> x /= JSLiteral ";" && x /= JSLiteral "") xs fixSemis' :: [JSNode] -> [JSNode] fixSemis' [] = [] -fixSemis' [JSContinue [JSLiteral ";"]] = [JSContinue []] +fixSemis' [(NS (JSContinue [(NS (JSLiteral ";") _)]) s2)] = [(NS (JSContinue []) s2)] fixSemis' [x] = [x] -fixSemis' ((JSIf c (JSReturn [JSLiteral ";"])):xs) = (JSIf c (JSReturn [JSLiteral ";"])):(fixSemis' xs) -fixSemis' ((JSIf c (JSContinue [JSLiteral ";"])):xs) = (JSIf c (JSContinue [JSLiteral ";"])):(fixSemis' xs) -fixSemis' (x:(JSLiteral "\n"):xs) = x:(JSLiteral "\n"):(fixSemis' xs) -fixSemis' ((JSCase e1 ((JSStatementList []))):(JSCase e2 x):xs) = (JSCase e1 ((JSStatementList []))):fixSemis' ((JSCase e2 x):xs) -fixSemis' (x:xs) = x:(JSLiteral ";"):fixSemis' xs +fixSemis' ((NS (JSIf c (NS (JSReturn [(NS (JSLiteral ";") s1)]) s2) ) s3):xs) = + (NS (JSIf c (NS (JSReturn [(NS (JSLiteral ";") s1)]) s2)) s3):(fixSemis' xs) +fixSemis' ((NS (JSIf c (NS (JSContinue [(NS (JSLiteral ";") s1)]) s2) ) s3):xs) = + (NS (JSIf c (NS (JSContinue [(NS (JSLiteral ";") s1)]) s2)) s3):(fixSemis' xs) +fixSemis' (x:(NS (JSLiteral "\n") s1):xs) = x:(NS (JSLiteral "\n") s1):(fixSemis' xs) -- TODO: is this needed? +fixSemis' ((NS (JSCase e1 ((NS (JSStatementList []) s1))) s2):(NS (JSCase e2 x) s3):xs) = + (NS (JSCase e1 ((NS (JSStatementList []) s1))) s2):fixSemis' ((NS (JSCase e2 x) s3):xs) +fixSemis' (x:xs) = x:(NS (JSLiteral ";") SpanEmpty):fixSemis' xs -- Remove extraneous braces around blocks fixBlock :: JSNode -> JSNode -fixBlock (JSBlock (JSStatementList [x])) = x -fixBlock (JSBlock (JSStatementList xs)) = fixBlock' (JSBlock (JSStatementList (fixSourceElements xs))) + +fixBlock (NS (JSBlock (NS (JSStatementList []) s1) ) _) = (NS (JSLiteral ";") s1) +fixBlock (NS (JSStatementBlock (NS (JSStatementList []) s1) ) _) = (NS (JSLiteral ";") s1) + +fixBlock (NS (JSBlock (NS (JSStatementList [x]) _) ) _) = fixBlock x +fixBlock (NS (JSStatementBlock (NS (JSStatementList [x]) _) ) _) = fixBlock x + +fixBlock (NS (JSBlock (NS (JSStatementList xs) s1) ) s2) = + fixBlock' (NS (JSBlock (NS (JSStatementList (fixSourceElements xs)) s1)) s2) + +fixBlock (NS (JSStatementBlock (NS (JSStatementList xs) s1) ) s2) = + fixBlock' (NS (JSStatementBlock (NS (JSStatementList (fixSourceElements xs)) s1)) s2) + fixBlock x = x fixBlock' :: JSNode -> JSNode -fixBlock' (JSBlock (JSStatementList [x])) = x -fixBlock' (JSBlock (JSStatementList [x,JSLiteral ""])) = x -- TODO: fix parser to not emit this case +fixBlock' (NS (JSBlock (NS (JSStatementList [x]) _)) _) = x +fixBlock' (NS (JSStatementBlock (NS (JSStatementList [x]) _)) _) = x +--fixBlock' (JSBlock (JSStatementList [x,JSLiteral ""])) = x -- TODO: fix parser to not emit this case fixBlock' x = x -- A space is needed if this expression starts with an identifier etc, but not if with a '(' @@ -247,362 +300,29 @@ -- --------------------------------------------------------------------- -- Test stuff --- readJs "x=1;" -_case0 :: JSNode -_case0 = JSSourceElements - [ - JSExpression [JSIdentifier "x",JSOperator "=",JSDecimal "1"], - JSEmpty (JSLiteral ";") - ] - --- doParse statementList "a=1;" -_case1 :: [JSNode] -_case1 = [JSExpression - [JSIdentifier "a",JSOperator "=",JSDecimal "1"] - ,JSEmpty (JSLiteral ";") - ] - - --- doParse expression "opTypeNames={'\\n':\"NEWLINE\",';':\"SEMICOLON\",',':\"COMMA\"}" -_case4 :: JSNode -_case4 = JSExpression - [ - JSIdentifier "opTypeNames", - JSOperator "=", - JSObjectLiteral - [JSPropertyNameandValue (JSStringLiteral '\'' "\\n") [JSStringLiteral '"' "NEWLINE"], - JSPropertyNameandValue (JSStringLiteral '\'' ";") [JSStringLiteral '"' "SEMICOLON"], - JSPropertyNameandValue (JSStringLiteral '\'' ",") [JSStringLiteral '"' "COMMA"] - ] - ] - - --- doParse program "function load(s){if(typeof s!=\"string\")return s;a=1}" -_case5 :: JSNode -_case5 = JSSourceElements - [JSFunction (JSIdentifier "load") - [JSIdentifier "s"] - (JSFunctionBody - [ - JSSourceElements - [ - JSIf - (JSExpression [JSUnary "typeof ",JSIdentifier "s", - JSExpressionBinary "!=" [JSStringLiteral '"' "string"] []]) - (JSReturn [JSExpression [JSIdentifier "s"],JSLiteral ";"]) - ,JSLiteral ";" - ,JSExpression [JSIdentifier "a",JSOperator "=",JSDecimal "1"] - ] - ] - ) - ] - --- doParse program "{if(typeof s!=\"string\")return s;evaluate(1)}" -_case6 :: JSNode -_case6 = JSSourceElements [] +_r :: JSNode -> [Char] +_r js = map (\x -> chr (fromIntegral x)) $ LB.unpack $ BB.toLazyByteString $ renderJS js ---doParse program "function load(s){if(typeof s!=\"string\")return s;evaluate(1)}" -_case7 :: JSNode -_case7 = JSSourceElements - [ - JSFunction (JSIdentifier "load") [JSIdentifier "s"] - (JSFunctionBody - [JSSourceElements - [JSIf - (JSExpression [JSUnary "typeof ",JSIdentifier "s",JSExpressionBinary "!=" [JSStringLiteral '"' "string"] []]) - (JSReturn [JSExpression [JSIdentifier "s"],JSLiteral ";"]) - , - JSExpression [JSIdentifier "evaluate",JSArguments [[JSDecimal "1"]]] - ] - ] - ) - ] +--readJs "{{{}}}" +_case0 :: JSNode +_case0 = NS (JSSourceElementsTop [NS (JSStatementBlock (NS (JSStatementList [NS (JSStatementBlock (NS (JSStatementList [NS (JSStatementBlock (NS (JSStatementList []) (SpanPoint {span_filename = "", span_row = 1, span_column = 3}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 3})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 3}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 2})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 2}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 1})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 1}) ---doParse program "for(i=0,j=assignOps.length;i=0)s+=t;" -_case18 :: JSNode -_case18 = JSSourceElementsTop - [ - JSIf - (JSExpression [JSUnary "typeof ",JSIdentifier "s",JSExpressionBinary "!=" [JSStringLiteral '"' "string"] []]) - (JSReturn [JSLiteral ";"]), - JSWhile (JSExpression [JSUnary "--",JSIdentifier "n",JSExpressionBinary ">=" [JSDecimal "0"] []]) - (JSExpression - [JSIdentifier "s",JSOperator "+=",JSIdentifier "t"] - ), - JSLiteral ";" - ] - --- doParse program "function f(){return n;\nx=1}" -_case19 :: JSNode -_case19 = JSSourceElementsTop - [ - JSFunction (JSIdentifier "f") [] - (JSFunctionBody - [ - JSSourceElements - [ - JSReturn [JSExpression [JSIdentifier "n"],JSLiteral ";"], - JSExpression - [ - JSIdentifier "x",JSOperator "=",JSDecimal "1" - ] - ] - ] - ) - ] - ---fixSourceElements ([JSReturn [JSExpression [JSIdentifier "n"],JSLiteral ";"],JSExpression [JSElement "assignmentExpression" [JSIdentifier "x",JSOperator "=",JSDecimal 1]]]) -_case20 :: [JSNode] -_case20 = [ - JSReturn [JSExpression [JSIdentifier "n"],JSLiteral ";"], - JSExpression - [JSIdentifier "x",JSOperator "=",JSDecimal "1"] - ] - ---doParse program "if(!u)continue;t=n" -_case21 :: JSNode -_case21 = JSSourceElementsTop - [ - JSIf (JSExpression [JSUnary "!",JSIdentifier "u"]) - (JSContinue [JSLiteral ";"]), - JSExpression [JSIdentifier "t",JSOperator "=",JSIdentifier "n"] - ] - ---doParse program "if (!v.base){throw new ReferenceError(v.propertyName + \" is not defined\");};x=1" -_case22 :: JSNode -_case22 = undefined - ---parseString program "{throw new TypeError(\"Function.prototype.apply called on\"+\n\" uncallable object\");}" -_case23 :: JSNode -_case23 = JSSourceElementsTop - [ - JSBlock - ( - JSStatementList - [ - JSThrow - (JSExpression - [ - JSLiteral "new ", - JSIdentifier "TypeError", - JSArguments - [ - [ - JSStringLiteral '"' "Function.prototype.apply called on", - JSExpressionBinary "+" - [ - JSStringLiteral '"' " uncallable object" - ] - [] - ] - ] - ] - ), - JSLiteral "" - ] - ) - ] +_case12 = (NS (JSIf (NS (JSExpression [NS (JSIdentifier "x") (SpanPoint {span_filename = "", span_row = 1, span_column = 4})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 4})) (NS (JSLiteral "") (SpanPoint {span_filename = "", span_row = 1, span_column = 6}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 6})) - ---doParse program "x=\"hello \" + \"world\";" -_case24 :: JSNode -_case24 = JSSourceElementsTop - [ - JSExpression - [JSIdentifier "x", - JSOperator "=", - JSStringLiteral '"' "hello ", - JSExpressionBinary "+" - [JSStringLiteral '"' "world"] [] - ] - , - JSLiteral ";" - ] - ---doParse program (U.fromString "try{}catch(e){continue;}") -_case25 :: JSNode -_case25 = JSSourceElementsTop - [ - JSTry - (JSBlock (JSStatementList [])) - [ - JSCatch - (JSIdentifier "e") - [] - (JSBlock - (JSStatementList - [ - JSContinue [JSLiteral ";"] - ] - ) - ) - ] - ] +-- readJs "bob:if(x){}\n{a}" +_case2 :: JSNode +_case2 = NS (JSSourceElementsTop [NS (JSLabelled (NS (JSIdentifier "bob") (SpanPoint {span_filename = "", span_row = 1, span_column = 1})) (NS (JSIf (NS (JSExpression [NS (JSIdentifier "x") (SpanPoint {span_filename = "", span_row = 1, span_column = 8})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 8})) (NS (JSStatementBlock (NS (JSStatementList []) (SpanPoint {span_filename = "", span_row = 1, span_column = 10}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 10}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 5}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 1}),NS (JSStatementBlock (NS (JSStatementList [NS (JSExpression [NS (JSIdentifier "a") (SpanPoint {span_filename = "", span_row = 2, span_column = 2})]) (SpanPoint {span_filename = "", span_row = 2, span_column = 2})]) (SpanPoint {span_filename = "", span_row = 2, span_column = 2}))) (SpanPoint {span_filename = "", span_row = 2, span_column = 1})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 1}) --- readJs "var newlines=spaces.match(/\\n/g);var newlines=spaces.match(/\\n/g);" -_case26 :: JSNode -_case26 = JSSourceElementsTop - [ - JSVariables "var" - [ - JSVarDecl (JSIdentifier "newlines") - [JSMemberDot [JSIdentifier "spaces"] (JSIdentifier "match"),JSArguments [[JSRegEx "/\\n/g"]]] - ], - JSVariables "var" - [ - JSVarDecl (JSIdentifier "newlines") [JSMemberDot [JSIdentifier "spaces"] (JSIdentifier "match"), - JSArguments [[JSRegEx "/\\n/g"]]] - ] - ] - --- readJs "\"mary\"+\"had\"" -_case27 :: JSNode -_case27 = JSSourceElementsTop - [ - JSExpression [JSExpressionBinary "+" [JSStringLiteral '"' "mary"] [JSStringLiteral '"' "had"]] - ] - --- readJs "throw new TypeError(\"Function.prototype.apply called on\"+\" uncallable object\")" -_case28 :: JSNode -_case28 = JSSourceElementsTop - [ - JSThrow - ( - JSExpression - [ - JSLiteral "new ", - JSIdentifier "TypeError", - JSArguments - [ - [ - JSExpressionBinary "+" - [JSStringLiteral '"' "Function.prototype.apply called on"] - [JSStringLiteral '"' " uncallable object"] - ] - ] - ] - ) - ] -- EOF diff --git a/Text/Jasmine/Token.hs b/Text/Jasmine/Token.hs deleted file mode 100644 --- a/Text/Jasmine/Token.hs +++ /dev/null @@ -1,267 +0,0 @@ -module Text.Jasmine.Token - ( - identifier - , reserved - , whiteSpace - , dec - , hex - , autoSemi - , autoSemi' - , rOp - , lChar - , lexeme - -- Testing - , isAlpha - ) where - --- --------------------------------------------------------------------- - -import Control.Applicative ( (<|>) ) -import Data.Attoparsec.Char8 (hexadecimal, decimal, char, Parser, satisfy, try, many, (), skipMany, skipMany1, isDigit, string, skipWhile, anyChar) -import Data.Char ( isAlpha, isSpace ) -import qualified Data.Set as Set -import qualified Data.ByteString.Char8 as S8 - --- --------------------------------------------------------------------- - --- Do not use the lexer, it is greedy and consumes subsequent symbols, --- e.g. "!" in a==!b -rOp :: String -> Parser () -rOp x = lexeme $ do { _ <- string $ S8.pack x; return () } - -lChar :: Char -> Parser () -lChar x = lexeme $ do { _ <- char x; return () } - --- --------------------------------------------------------------------- - --- Need to deal with the following cases --- 1. Missing semi, because following } => empty --- 2. Additional semi, with following } => empty --- 3. semi with no following } => semi --- 4. no semi, but prior NL => semi - -autoSemi :: Parser [Char] -autoSemi = do{ _ <- rOp ";"; return (";");} - <|> return ("") - - -autoSemi' :: Parser [Char] -autoSemi' = do{ _ <- rOp ";"; return (";");} - --- --------------------------------------------------------------------- - ---identifier = lexeme $ many1 (letter <|> oneOf "_") -identifier :: Parser String -identifier = - lexeme $ try $ - do{ name <- ident - ; if (isReservedName name) - then fail ("reserved word " ++ show name) - else return name - } - -ident :: Parser [Char] -ident - = do{ c <- identStart - ; cs <- many identLetter - ; return (c:cs) - } - "identifier" - -isReservedName :: String -> Bool -isReservedName = flip Set.member reservedNames - --- TODO: fix trailing characters test -reserved :: String -> Parser () -reserved name = lexeme $ do { _ <- string $ S8.pack name; return () } -{- -reserved name = - lexeme $ try $ - do{ _ <- string name - ; notFollowedBy identLetter ("end of " ++ show name) - } --} - ---whiteSpace = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment "") ---whiteSpace = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <|> do { _ <- char '\n'; setNLFlag} "") -whiteSpace :: Parser () -whiteSpace = skipMany (do { _ <- string $ S8.pack "\n"; return ()} <|> simpleSpace <|> comment "") --- whiteSpace = try $ many $ (do { equal TokenWhite } <|> do { (equal TokenNL); setNLFlag}) - - -simpleSpace :: Parser () --- Note : Data.Char.isSpace includes a variety of non-breaking space chars, and unicode variants -simpleSpace = skipMany1 $ (satisfy isSpace) - -comment :: Parser () -comment = do - isMulti <- try $ do - _ <- char fslash - (char asterisk >> return True) <|> (char fslash >> return False) - if isMulti then inComment else skipWhile (/= linefeed) - -inComment :: Parser () -inComment = - theEnd <|> (anyChar >> inComment) "end of comment" - where - theEnd = char asterisk >> (char fslash >> return ()) <|> inComment - -fslash, asterisk, linefeed :: Char -fslash = '/' -asterisk = '*' -linefeed = '\n' - -identLetter :: Parser Char -identLetter = alphaNum <|> oneOf "_" - -identStart :: Parser Char -identStart = letter <|> oneOf "_$" - -reservedNames :: Set.Set String -reservedNames = Set.fromAscList [ - "break", - "case", "catch", "const", "continue", - "debugger", "default", "delete", "do", - "else", "enum", - "false", "finally", "for", "function", - "if", "in", "instanceof", - "new", "null", - "return", - "switch", - "this", "throw", "true", "try", "typeof", - "var", "void", - "while", "with" - ] - - -hex :: Parser Integer -hex = lexeme $ do{ _ <- oneOf "xX"; hexadecimal } - -dec :: Parser Integer -dec = lexeme $ decimal - --- | @lexeme p@ first applies parser @p@ and than the 'whiteSpace' --- parser, returning the value of @p@. Every lexical --- token (lexeme) is defined using @lexeme@, this way every parse --- starts at a point without white space. Parsers that use @lexeme@ are --- called /lexeme/ parsers in this document. --- --- The only point where the 'whiteSpace' parser should be --- called explicitly is the start of the main parser in order to skip --- any leading white space. --- --- > mainParser = do{ whiteSpace --- > ; ds <- many (lexeme digit) --- > ; eof --- > ; return (sum ds) --- > } - -lexeme :: Parser b -> Parser b -lexeme p = do{ x <- p; whiteSpace; return x } - --- --------------------------------------------------------------------- --- Stuff from Parsec needed to make Attoparsec work - - --- | @oneOf cs@ succeeds if the current character is in the supplied --- list of characters @cs@. Returns the parsed character. See also --- 'satisfy'. --- --- > vowel = oneOf "aeiou" - -oneOf :: String -> Parser Char -oneOf = satisfy . flip elem - - --- | Parses a letter or digit (a character between \'0\' and \'9\'). --- Returns the parsed character. - -alphaNum :: Parser Char -alphaNum = satisfy isAlphaNum "letter or digit" - --- | Parses a letter (an upper case or lower case character). Returns the --- parsed character. - -letter :: Parser Char -letter = satisfy isAlpha "letter" - --- | Parses a digit. Returns the parsed character. - - --- | Parses a hexadecimal digit (a digit or a letter between \'a\' and --- \'f\' or \'A\' and \'F\'). Returns the parsed character. - -isAlphaNum :: Char -> Bool -isAlphaNum c = isAlpha c || isDigit c - --- --------------------------------------------------------------------- -{- -javascriptDef :: LanguageDef st -javascriptDef = javaStyle - { reservedNames = [ - "break", - "case", "catch", "const", "continue", - "debugger", "default", "delete", "do", - "else", "enum", - "false", "finally", "for", "function", - "if", "in", "instanceof", - "new", "null", - "return", - "switch", - "this", "throw", "true", "try", "typeof", - "var", "void", - "while", "with" - ] - -- TODO: make the following constants, so the parser defn is simpler. e,g op_COMMA = "," - , reservedOpNames= [ - ";" , -- "SEMICOLON", - "," , -- "COMMA", - "?" , -- "HOOK", - ":" , -- "COLON", - "||" , -- "OR", - "&&" , -- "AND", - "|" , -- "BITWISE_OR", - "^" , -- "BITWISE_XOR", - "&" , -- "BITWISE_AND", - "===" , -- "STRICT_EQ", - "==" , -- "EQ", - "=" , -- "ASSIGN", - "!==" , -- "STRICT_NE", - "!=" , -- "NE", - "<<" , -- "LSH", - "<=" , -- "LE", - "<" , -- "LT", - ">>>" , -- "URSH", - ">>" , -- "RSH", - ">=" , -- "GE", - ">" , -- "GT", - "++" , -- "INCREMENT", - "--" , -- "DECREMENT", - "+" , -- "PLUS", - "-" , -- "MINUS", - "*" , -- "MUL", - "/" , -- "DIV", - "%" , -- "MOD", - "!" , -- "NOT", - "~" , -- "BITWISE_NOT", - "." , -- "DOT", - "[" , -- "LEFT_BRACKET", - "]" , -- "RIGHT_BRACKET", - "{" , -- "LEFT_CURLY", - "}" , -- "RIGHT_CURLY", - "(" , -- "LEFT_PAREN", - ")" , -- "RIGHT_PAREN", - "@*/" -- "CONDCOMMENT_END" - ] - , opLetter = oneOf "!%&()*+,-./:;<=>?[]^{|}~" - , opStart = opLetter javascriptDef - , identStart = letter <|> oneOf "_" - , identLetter = alphaNum <|> oneOf "_" - - , caseSensitive = True - } - - --} - --- EOF diff --git a/hjsmin.cabal b/hjsmin.cabal --- a/hjsmin.cabal +++ b/hjsmin.cabal @@ -1,5 +1,5 @@ name: hjsmin -version: 0.0.9 +version: 0.0.11 license: BSD3 license-file: LICENSE author: Alan Zimmerman @@ -26,13 +26,12 @@ library build-depends: base >= 4 && < 5 , bytestring >= 0.9 && < 0.10 - , attoparsec >= 0.8 && < 0.9 , blaze-builder >= 0.2 && < 1 , text >= 0.8 && < 1 , containers >= 0.2 && < 0.5 - , language-javascript >= 0.3 && < 0.5 + , language-javascript >= 0.4 && < 0.5 exposed-modules: Text.Jasmine - other-modules: Text.Jasmine.Parse, Text.Jasmine.Pretty, Text.Jasmine.Token + other-modules: Text.Jasmine.Pretty ghc-options: -Wall executable runtests diff --git a/runtests.hs b/runtests.hs --- a/runtests.hs +++ b/runtests.hs @@ -30,6 +30,7 @@ , testCase "min_100_animals" case_min_100_animals , testCase "mergeStrings" caseMergeStrings , testCase "TrailingCommas" caseTrailingCommas + , testCase "GetSet" caseGetSet ] testSuiteMin :: Test @@ -47,6 +48,7 @@ , testCase "EitherLeft" caseEitherLeft , testCase "EitherRight" caseEitherRight , testCase "TrailingCommas" caseMinTrailingCommas + , testCase "GetSet" caseMinGetSet ] testSuiteFiles :: Test @@ -116,7 +118,7 @@ srcHelloWorld = "function Hello(a) {}" caseHelloWorld = "Right (JSSourceElementsTop [JSFunction (JSIdentifier \"Hello\") [JSIdentifier \"a\"] (JSFunctionBody [])])" - @=? (show $ parseProgram srcHelloWorld) + @=? (showStrippedMaybe $ parseProgram srcHelloWorld) caseMinHelloWorld = -- "function Hello(a){}" @=? (minify (U.fromString srcHelloWorld)) testMinify "function Hello(a){}" srcHelloWorld @@ -124,7 +126,7 @@ srcHelloWorld2 = "function Hello(a) {b=1}" caseHelloWorld2 = "Right (JSSourceElementsTop [JSFunction (JSIdentifier \"Hello\") [JSIdentifier \"a\"] (JSFunctionBody [JSSourceElements [JSExpression [JSIdentifier \"b\",JSOperator \"=\",JSDecimal \"1\"]]])])" - @=? (show $ parseProgram srcHelloWorld2) + @=? (showStrippedMaybe $ parseProgram srcHelloWorld2) caseMinHelloWorld2 = -- "function Hello(a){b=1}" @=? (minify (U.fromString srcHelloWorld2)) testMinify "function Hello(a){b=1}" srcHelloWorld2 @@ -132,37 +134,35 @@ srcSimpleAssignment = "a=1;" caseSimpleAssignment = "Right (JSSourceElementsTop [JSExpression [JSIdentifier \"a\",JSOperator \"=\",JSDecimal \"1\"],JSLiteral \";\"])" - @=? (show $ parseProgram srcSimpleAssignment) + @=? (showStrippedMaybe $ parseProgram srcSimpleAssignment) caseMinSimpleAssignment = testMinify "a=1" srcSimpleAssignment srcEmptyFor = "for (i = 0;;){}" caseEmptyFor = - "Right (JSSourceElementsTop [JSFor [JSExpression [JSIdentifier \"i\",JSOperator \"=\",JSDecimal \"0\"]] [] [] (JSLiteral \";\")])" - @=? (show $ parseProgram srcEmptyFor) + "Right (JSSourceElementsTop [JSFor [JSExpression [JSIdentifier \"i\",JSOperator \"=\",JSDecimal \"0\"]] [] [] (JSStatementBlock (JSStatementList []))])" + @=? (showStrippedMaybe $ parseProgram srcEmptyFor) srcFullFor = "for (i = 0;i<10;i++){}" caseFullFor = - "Right (JSSourceElementsTop [JSFor [JSExpression [JSIdentifier \"i\",JSOperator \"=\",JSDecimal \"0\"]] [JSExpression [JSExpressionBinary \"<\" [JSIdentifier \"i\"] [JSDecimal \"10\"]]] [JSExpression [JSExpressionPostfix \"++\" [JSIdentifier \"i\"]]] (JSLiteral \";\")])" - @=? (show $ parseProgram srcFullFor) + "Right (JSSourceElementsTop [JSFor [JSExpression [JSIdentifier \"i\",JSOperator \"=\",JSDecimal \"0\"]] [JSExpression [JSExpressionBinary \"<\" [JSIdentifier \"i\"] [JSDecimal \"10\"]]] [JSExpression [JSExpressionPostfix \"++\" [JSIdentifier \"i\"]]] (JSStatementBlock (JSStatementList []))])" + @=? (showStrippedMaybe $ parseProgram srcFullFor) srcForVarFull = "for(var i=0,j=tokens.length;i