hjsmin (empty) → 0.0.1
raw patch · 11 files changed
+2654/−0 lines, 11 filesdep +HUnitdep +QuickCheckdep +attoparsecsetup-changed
Dependencies added: HUnit, QuickCheck, attoparsec, base, blaze-builder, bytestring, test-framework, test-framework-hunit, text
Files
- LICENSE +30/−0
- README.markdown +31/−0
- Setup.hs +2/−0
- TODO.txt +67/−0
- Text/Jasmine.hs +32/−0
- Text/Jasmine/Parse.hs +1175/−0
- Text/Jasmine/Pretty.hs +701/−0
- Text/Jasmine/Token.hs +324/−0
- buildall.sh +6/−0
- hjsmin.cabal +50/−0
- runtests.hs +236/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Alan Zimmerman++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 Alan Zimmerman 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.markdown view
@@ -0,0 +1,31 @@+hjsmin+======++Haskell implementation of a javascript minifier++It is intended to be used in conjunction with Hamlet, part of Yesod.++As such, much of the structure of the package is shamelessly copied from Hamlet.++See http://github.com/snoyberg/hamlet+++How to build+------------++Library:++cabal clean && cabal configure && cabal build++Tests:++cabal clean && cabal configure -fbuildtests && cabal build++Running the tests++./dist/build/runtests/runtests+++++
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TODO.txt view
@@ -0,0 +1,67 @@+Testing:++The following Lint has a sctrict parser+ http://www.javascriptlint.com/online_lint.php++This one does not+ http://www.jslint.com/++---++Language reference https://developer.mozilla.org/en/JavaScript/Reference+http://msdn.microsoft.com/en-us/library/ttyab5c8.aspx++--- ++Look at ++ http://dean.edwards.name/download/#packer++ http://code.google.com/p/minify/++Examples of parsers++ JSon parser in Parsec+ http://snippets.dzone.com/posts/show/3660++GOLD Parser, using the Javascript.grm from+http://www.devincook.com/GOLDParser/grammars/index.htm++http://oss.org.cn/ossdocs/web/js/js20/formal/parser-grammar.html++-------------------------++- Generate output using standard pretty print library, so it can be+ used with various backends+++- Sort out semicolon insertion, as per http://oss.org.cn/ossdocs/web/js/js20/rationale/syntax.html+ Also: http://inimino.org/~inimino/blog/javascript_semicolons++ Grammatical Semicolon Insertion++ Semicolons before a closing } and the end of the program are+ optional in both JavaScript 1.5 and 2.0. In addition, the+ JavaScript 2.0 parser allows semicolons to be omitted before the+ else of an if-else statement and before the while of a do-while+ statement.++ Line-Break Semicolon Insertion++ If the first through the nth tokens of a JavaScript program form+ are grammatically valid but the first through the n+1st tokens are+ not and there is a line break between the nth tokens and the n+1st+ tokens, then the parser tries to parse the program again after+ inserting a VirtualSemicolon token between the nth and the n+1st+ tokens.++- remove un-needed semicolons in pretty printer++- put in tests for all cases of elementList++-- Look at "in" keyword, as used : if (x in list) {}++------------+++EOF
+ Text/Jasmine.hs view
@@ -0,0 +1,32 @@+module Text.Jasmine+ ( + minify+ , minifym + , minifyFile + ) where + +import Text.Jasmine.Parse+import Text.Jasmine.Pretty+import qualified Blaze.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString as B++-- TODO: consider using option 4 of http://www.randomhacks.net/articles/2007/03/10/haskell-8-ways-to-report-errors+minifym :: B.ByteString -> Either String LB.ByteString+minifym s = case readJsm s of+ Left msg -> Left msg+ Right p -> Right $ BB.toLazyByteString $ renderJS p ++minify :: B.ByteString -> LB.ByteString+minify s = BB.toLazyByteString $ renderJS $ readJs s++_minify' :: B.ByteString -> BB.Builder+_minify' s = renderJS $ readJs s++minifyFile :: FilePath -> IO LB.ByteString+minifyFile filename =+ do + x <- B.readFile (filename)+ return $ minify x+ +-- EOF
+ Text/Jasmine/Parse.hs view
@@ -0,0 +1,1175 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Text.Jasmine.Parse+ ( + readJs+ , readJsm + , JasmineSettings (..)+ , defaultJasmineSettings+ , JSNode(..) + , parseFile + , parseString + -- For testing + , doParse+ , program + , functionDeclaration+ , identifier+ , statementList + , iterationStatement + , main + ) where++-- ---------------------------------------------------------------------++import Control.Applicative ( (<|>) )+import Control.Monad+import Data.Attoparsec (eitherResult)+import Data.Attoparsec.Char8 (char, satisfy, try, feed, Parser, Result(..), (<?>), endOfInput, many, parse, sepBy, sepBy1, many1)+import Data.Char+import Data.Data+import Data.List +import Prelude hiding (catch)+import System.Environment+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as E+import qualified Text.Jasmine.Token as P++-- ---------------------------------------------------------------------+{-+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 = try (do { v1 <- P.autoSemi;+ return (JSLiteral v1);})++autoSemi' :: Parser JSNode+autoSemi' = try (do { v1 <- P.autoSemi';+ return (JSLiteral v1);})++rOp :: String -> Parser ()+rOp = P.rOp+++-- ---------------------------------------------------------------------+-- 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 $ + try( do { _ <- char '"'; val<- many stringCharDouble; _ <- char '"';+ return (JSStringLiteral '"' val)})+ <|> do { _ <- char '\''; val<- many stringCharSingle; _ <- char '\'';+ return (JSStringLiteral '\'' val)}++stringCharDouble :: Parser Char+stringCharDouble = satisfy (\c -> isPrint c && c /= '"')++stringCharSingle :: Parser Char+stringCharSingle = satisfy (\c -> isPrint c && c /= '\'')++++-- ------------------------------------------------------------+++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)}++-- <Literal> ::= <Null Literal>+-- | <Boolean Literal>+-- | <Numeric Literal>+-- | StringLiteral+literal :: Parser JSNode+literal = nullLiteral+ <|> booleanLiteral+ <|> numericLiteral+ <|> stringLiteral++-- <Null Literal> ::= null+nullLiteral :: Parser JSNode+nullLiteral = do { _ <- P.reserved "null"; + return (JSLiteral "null")}++-- <Boolean Literal> ::= 'true'+-- | 'false'+booleanLiteral :: Parser JSNode+booleanLiteral = do{ _ <- P.reserved "true" ; + return (JSLiteral "true")}+ <|> do{ P.reserved "false"; + return (JSLiteral "false")}++-- <Numeric Literal> ::= DecimalLiteral+-- | HexIntegerLiteral+numericLiteral :: Parser JSNode+numericLiteral = do {val <- decimalLiteral; + return (JSDecimal val)}+ <|> do {val <- hexIntegerLiteral; + return (JSHexInteger val)}+++-- <Regular Expression Literal> ::= RegExp +regularExpressionLiteral :: Parser JSNode+regularExpressionLiteral = regExp+++-- <Primary Expression> ::= 'this'+-- | Identifier+-- | <Literal> +-- | <Array Literal>+-- | <Object Literal>+-- | '(' <Expression> ')'+-- | <Regular Expression Literal>+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+++-- <Array Literal> ::= '[' ']'+-- | '[' <Elision> ']'+-- | '[' <Element List> ']'+-- | '[' <Element List> ',' <Elision> ']'++-- <Elision> ::= ','+-- | <Elision> ','++-- <Element List> ::= <Elision> <Assignment Expression>+-- | <Element List> ',' <Elision> <Assignment Expression>+-- | <Element List> ',' <Assignment Expression>+-- | <Assignment Expression>++--------+--so++-- <Array Literal> ::= '[' many (',' <|> assignment) ']'+++-- ---------------------------------------------------------------------++-- <Array Literal> ::= '[' ']'+-- | '[' <Elision> ']'+-- | '[' <Element List> ']'+-- | '[' <Element List> ',' <Elision> ']'+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> ::= ','+-- | <Elision> ','+elision :: GenParser Char P.JSPState JSNode+elision = do{ rOp ",";+ return (JSElision [])}+ <|> do{ v1 <- elision; rOp ",";+ return (JSElision [v1])}+ ++-- <Element List> ::= <Elision> <Assignment Expression>+-- | <Element List> ',' <Elision> <Assignment Expression>+-- | <Element List> ',' <Assignment Expression>+-- | <Assignment Expression>+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 []}+-} ++-- <Object Literal> ::= '{' <Property Name and Value List> '}'+objectLiteral :: Parser JSNode+objectLiteral = do{ rOp "{"; val <- propertyNameandValueList; rOp "}"; + return (JSObjectLiteral val)}++-- <Property Name and Value List> ::= <Property Name> ':' <Assignment Expression>+-- | <Property Name and Value List> ',' <Property Name> ':' <Assignment Expression>+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])}+ }+ }++-- <Property Name> ::= Identifier+-- | StringLiteral+-- | <Numeric Literal>+propertyName :: Parser JSNode+propertyName = identifier+ <|> stringLiteral+ <|> numericLiteral+++-- <Member Expression > ::= <Primary Expression>+-- | <Function Expression>+-- | <Member Expression> '[' <Expression> ']'+-- | <Member Expression> '.' Identifier+-- | 'new' <Member Expression> <Arguments>+memberExpression :: Parser [JSNode]+memberExpression = try(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' = try(do{v1 <- primaryExpression; v2 <- rest;+ return (v1:v2)})+ <|> try(do{v1 <- functionExpression; 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 Expression> ::= <Member Expression>+-- | new <New Expression>+newExpression :: Parser [JSNode]+newExpression = memberExpression+ <|> do{ P.reserved "new"; val <- newExpression;+ return ((JSLiteral "new "):val)}++-- <Call Expression> ::= <Member Expression> <Arguments>+-- | <Call Expression> <Arguments> +-- | <Call Expression> '[' <Expression> ']'+-- | <Call Expression> '.' 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 +-}+-- ---------------------------------------------------------------------+++-- <Arguments> ::= '(' ')'+-- | '(' <Argument List> ')'+arguments :: Parser JSNode+arguments = try(do{ rOp "("; rOp ")";+ return (JSArguments [[]])})+ <|> do{ rOp "("; v1 <- argumentList; rOp ")";+ return (JSArguments v1)}++-- <Argument List> ::= <Assignment Expression>+-- | <Argument List> ',' <Assignment Expression>+argumentList :: Parser [[JSNode]]+argumentList = do{ vals <- sepBy1 assignmentExpression (rOp ",");+ return vals}+++-- <Left Hand Side Expression> ::= <New Expression> +-- | <Call Expression>+leftHandSideExpression :: Parser [JSNode]+leftHandSideExpression = try (callExpression)+ <|> newExpression+ <?> "leftHandSideExpression"+++-- <Postfix Expression> ::= <Left Hand Side Expression>+-- | <Postfix Expression> '++'+-- | <Postfix Expression> '--'+postfixExpression :: Parser [JSNode]+postfixExpression = do{ v1 <- leftHandSideExpression;+ do {+ do{ rOp "++"; return [(JSExpressionPostfix "++" v1)]}+ <|> do{ rOp "--"; return [(JSExpressionPostfix "--" v1)]}+ <|> return v1+ }+ }++-- <Unary Expression> ::= <Postfix Expression>+-- | 'delete' <Unary Expression>+-- | 'void' <Unary Expression>+-- | 'typeof' <Unary Expression>+-- | '++' <Unary Expression>+-- | '--' <Unary Expression>+-- | '+' <Unary Expression>+-- | '-' <Unary Expression>+-- | '~' <Unary Expression>+-- | '!' <Unary Expression>+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)}++-- <Multiplicative Expression> ::= <Unary Expression>+-- | <Unary Expression> '*' <Multiplicative Expression> +-- | <Unary Expression> '/' <Multiplicative Expression> +-- | <Unary Expression> '%' <Multiplicative Expression> +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 []+++-- <Additive Expression> ::= <Additive Expression>'+'<Multiplicative Expression> +-- | <Additive Expression>'-'<Multiplicative Expression> +-- | <Multiplicative Expression>+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 []+++-- <Shift Expression> ::= <Shift Expression> '<<' <Additive Expression>+-- | <Shift Expression> '>>' <Additive Expression>+-- | <Shift Expression> '>>>' <Additive Expression>+-- | <Additive Expression>+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 []+++-- <Relational Expression>::= <Shift Expression> +-- | <Relational Expression> '<' <Shift Expression> +-- | <Relational Expression> '>' <Shift Expression> +-- | <Relational Expression> '<=' <Shift Expression> +-- | <Relational Expression> '>=' <Shift Expression> +-- | <Relational Expression> 'instanceof' <Shift Expression> +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 []++++-- <Equality Expression> ::= <Relational Expression>+-- | <Equality Expression> '==' <Relational Expression>+-- | <Equality Expression> '!=' <Relational Expression>+-- | <Equality Expression> '===' <Relational Expression>+-- | <Equality Expression> '!==' <Relational Expression>+equalityExpression :: Parser [JSNode]+equalityExpression = do{ v1 <- relationalExpression; v2 <- rest;+ return (v1++v2)}+ -- TODO: more efficient parsing here, without all the backtracking+ where+ rest =+ try(do{ rOp "=="; v2 <- relationalExpression; v3 <- rest;+ return [(JSExpressionBinary "==" v2 v3)]})+ <|> try(do{ rOp "!="; v2 <- relationalExpression; v3 <- rest;+ return [(JSExpressionBinary "!=" v2 v3)]})+ <|> try(do{ rOp "==="; v2 <- relationalExpression; v3 <- rest;+ return [(JSExpressionBinary "===" v2 v3)]})+ <|> try(do{ rOp "!=="; v2 <- relationalExpression; v3 <- rest;+ return [(JSExpressionBinary "!==" v2 v3)]})+ <|> return []+ ++-- <Bitwise And Expression> ::= <Equality Expression>+-- | <Bitwise And Expression> '&' <Equality Expression>+bitwiseAndExpression :: Parser [JSNode]+bitwiseAndExpression = do{ v1 <- equalityExpression; v2 <- rest;+ return (v1++v2)}+ where+ rest =+ try(do{ rOp "&"; v2 <- equalityExpression; v3 <- rest;+ return [(JSExpressionBinary "&" v2 v3)]})+ <|> return []+++-- <Bitwise XOr Expression> ::= <Bitwise And Expression>+-- | <Bitwise XOr Expression> '^' <Bitwise And Expression>+bitwiseXOrExpression :: Parser [JSNode]+bitwiseXOrExpression = do{ v1 <- bitwiseAndExpression; v2 <- rest;+ return (v1++v2)}+ where+ rest =+ do{ rOp "^"; v2 <- bitwiseAndExpression; v3 <- rest;+ return [(JSExpressionBinary "^" v2 v3)]}+ <|> return []+++-- <Bitwise Or Expression> ::= <Bitwise XOr Expression>+-- | <Bitwise Or Expression> '|' <Bitwise XOr Expression>+bitwiseOrExpression :: Parser [JSNode]+bitwiseOrExpression = do{ v1 <- bitwiseXOrExpression; v2 <- rest;+ return (v1++v2)}+ where+ rest =+ try(do{ rOp "|"; v2 <- bitwiseXOrExpression; v3 <- rest;+ return [(JSExpressionBinary "|" v2 v3)]})+ <|> return []++++-- <Logical And Expression> ::= <Bitwise Or Expression>+-- | <Logical And Expression> '&&' <Bitwise Or Expression>+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 []+++++-- <Logical Or Expression> ::= <Logical And Expression>+-- | <Logical Or Expression> '||' <Logical And Expression>+logicalOrExpression :: Parser [JSNode]+logicalOrExpression = do{ v1 <- logicalAndExpression; v2 <- rest;+ return (v1++v2)}+ where+ rest =+ try(do{ rOp "||"; v2 <- logicalAndExpression; v3 <- rest;+ return [(JSExpressionBinary "||" v2 v3)]})+ <|> return []+++-- <Conditional Expression> ::= <Logical Or Expression> +-- | <Logical Or Expression> '?' <Assignment Expression> ':' <Assignment Expression>+conditionalExpression :: Parser [JSNode]+conditionalExpression = do{ v1 <- logicalOrExpression;+ do {+ do{ rOp "?"; v2 <- assignmentExpression; rOp ":"; v3 <- assignmentExpression;+ return [(JSExpressionTernary v1 v2 v3)]}+ <|> return v1+ }+ }+++-- <Assignment Expression> ::= <Conditional Expression>+-- | <Left Hand Side Expression> <Assignment Operator> <Assignment Expression> +assignmentExpression :: Parser [JSNode]+assignmentExpression = try (do {v1 <- assignmentStart; v2 <- assignmentExpression;+ return [(JSElement "assignmentExpression" (v1++v2))]})+ <|> conditionalExpression+ +assignmentStart :: Parser [JSNode]+assignmentStart = do {v1 <- leftHandSideExpression; v2 <- assignmentOperator; + return (v1++[v2])}++-- <Assignment Operator> ::= '=' | '*=' | '/=' | '%=' | '+=' | '-=' | '<<=' | '>>=' | '>>>=' | '&=' | '^=' | '|='+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> ::= <Assignment Expression>+-- | <Expression> ',' <Assignment Expression>+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> ::= <Block>+-- | <Variable Statement>+-- | <Empty Statement>+-- | <If Statement>+-- | <If Else Statement>+-- | <Iteration Statement>+-- | <Continue Statement>+-- | <Break Statement>+-- | <Return Statement>+-- | <With Statement>+-- | <Labelled Statement>+-- | <Switch Statement>+-- | <Throw Statement>+-- | <Try Statement>+-- | <Expression> +statement :: Parser JSNode+statement = statementBlock+ <|> try(labelledStatement)+ <|> expression + <|> variableStatement+ <|> emptyStatement + <|> try(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))}++-- <Block > ::= '{' '}'+-- | '{' <Statement List> '}'+statementBlock' :: Parser [JSNode]+statementBlock' = try (do {rOp "{"; rOp "}"; + return []})+ <|> do {rOp "{"; val <- statementList; rOp "}"; + return (if (val == (JSStatementList [JSLiteral ";"])) then ([]) else [(JSBlock val)])}+ <?> "statementBlock"++-- <Block > ::= '{' '}'+-- | '{' <Statement List> '}'+block :: Parser JSNode+block = try (do {rOp "{"; rOp "}"; + return (JSBlock (JSStatementList []))})+ <|> do {rOp "{"; val <- statementList; rOp "}"; + return (JSBlock val)}+ <?> "block"+++-- <Statement List> ::= <Statement>+-- | <Statement List> <Statement>+statementList :: Parser JSNode+statementList = do {v1 <- many1 statement;+ return (JSStatementList v1)}+++-- <Variable Statement> ::= var <Variable Declaration List> ';'+-- 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)}++ +-- <Variable Declaration List> ::= <Variable Declaration>+-- | <Variable Declaration List> ',' <Variable Declaration>+variableDeclarationList :: Parser [JSNode]+variableDeclarationList = do{ val <- sepBy1 variableDeclaration (rOp ","); + return val }+++-- <Variable Declaration> ::= Identifier+-- | Identifier <Initializer>+variableDeclaration :: Parser JSNode+variableDeclaration = do{ v1 <- identifier; + do {+ do {v2 <- initializer; + return (JSVarDecl v1 v2)}+ <|> return (JSVarDecl v1 [])+ }+ }++-- <Initializer> ::= '=' <Assignment Expression>+initializer :: Parser [JSNode]+initializer = do {rOp "="; val <- assignmentExpression; + return val}++-- <Empty Statement> ::= ';'+emptyStatement :: Parser JSNode+--emptyStatement = do { v1 <- autoSemi'; return (JSEmpty v1)}+emptyStatement = do { v1 <- autoSemi'; return v1}+++-- <If Statement> ::= 'if' '(' <Expression> ')' <Statement> +ifStatement :: Parser JSNode+ifStatement = do{ P.reserved "if"; rOp "("; v1 <- expression; rOp ")"; v2 <- statement;+ return (JSIf v1 v2) }++-- <If Else Statement> ::= 'if' '(' <Expression> ')' <Statement> 'else' <Statement>+ifElseStatement :: Parser JSNode+ifElseStatement = do{ P.reserved "if"; rOp "("; v1 <- expression; rOp ")"; v2 <- statementSemi; P.reserved "else"; v3 <- statement ;+ return (JSIfElse v1 v2 v3) }++statementSemi :: Parser JSNode+statementSemi = do { v1 <- statement;+ do { + do { rOp ";"; return (JSBlock (JSStatementList [v1]))} + <|> return v1+ }+ }+++-- <Iteration Statement> ::= 'do' <Statement> 'while' '(' <Expression> ')' ';'+-- | 'while' '(' <Expression> ')' <Statement> +-- | 'for' '(' <Expression> ';' <Expression> ';' <Expression> ')' <Statement> +-- | 'for' '(' 'var' <Variable Declaration List> ';' <Expression> ';' <Expression> ')' <Statement> +-- | 'for' '(' <Left Hand Side Expression> in <Expression> ')' <Statement> +-- | 'for' '(' 'var' <Variable Declaration> in <Expression> ')' <Statement> +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 Statement> ::= '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 Statement> ::= '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 Statement> ::= 'return' ';'+-- | 'return' <Expression> ';'+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 Statement> ::= 'with' '(' <Expression> ')' <Statement> ';'+withStatement :: Parser JSNode+withStatement = do{ P.reserved "with"; rOp "("; v1 <- expression; rOp ")"; v2 <- statement; v3 <- autoSemi; + return (JSWith v1 [v2,v3])}+++-- <Switch Statement> ::= 'switch' '(' <Expression> ')' <Case Block> +switchStatement :: Parser JSNode+switchStatement = do{ P.reserved "switch"; rOp "("; v1 <- expression; rOp ")"; v2 <- caseBlock;+ return (JSSwitch v1 v2)}++-- <Case Block> ::= '{' '}'+-- | '{' <Case Clauses> '}'+-- | '{' <Case Clauses> <Default Clause> '}'+-- | '{' <Case Clauses> <Default Clause> <Case Clauses> '}'+-- | '{' <Default Clause> <Case Clauses> '}'+-- | '{' <Default Clause> '}'+-- TODO: get rid of the try clauses by unwinding this+caseBlock :: Parser [JSNode]+caseBlock = try(do{ rOp "{"; rOp "}"; + return []})+ <|> try(do{ rOp "{"; v1 <- caseClauses; rOp "}"; + return v1})+ <|> try(do{ rOp "{"; v1 <- caseClauses; v2 <- defaultClause; rOp "}"; + return (v1++[v2])})+ <|> try(do{ rOp "{"; v1 <- caseClauses; v2 <- defaultClause; v3 <- caseClauses; rOp "}"; + return (v1++[v2]++v3)})+ <|> try(do{ rOp "{"; v1 <- defaultClause; v2 <- caseClauses; rOp "}"; + return (v1:v2)})+ <|> do{ rOp "{"; v1 <- defaultClause; rOp "}"; + return [v1]}+++-- <Case Clauses> ::= <Case Clause>+-- | <Case Clauses> <Case Clause>+caseClauses :: Parser [JSNode]+caseClauses = do{ val <- many1 caseClause;+ return val}++-- <Case Clause> ::= 'case' <Expression> ':' <Statement List>+-- | 'case' <Expression> ':'+caseClause :: Parser JSNode+caseClause = do { P.reserved "case"; v1 <- expression; rOp ":"; + do {+ do { v2 <- statementList;+ return (JSCase v1 v2)}+ <|> return (JSCase v1 (JSStatementList []))+ }+ }++-- <Default Clause> ::= 'default' ':' +-- | 'default' ':' <Statement List>+defaultClause :: Parser JSNode+defaultClause = do{ P.reserved "default"; rOp ":"; v1 <- statementList;+ return (JSDefault v1)}+ <|> do{ P.reserved "default"; rOp ":"; + return (JSDefault (JSStatementList []))}++-- <Labelled Statement> ::= Identifier ':' <Statement> +labelledStatement :: Parser JSNode+labelledStatement = do { v1 <- identifier; rOp ":"; v2 <- statement;+ return (JSLabelled v1 v2)}++-- <Throw Statement> ::= 'throw' <Expression>+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 Statement> ::= 'try' <Block> <Catch>+-- | 'try' <Block> <Finally>+-- | 'try' <Block> <Catch> <Finally>+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> ::= 'catch' '(' Identifier ')' <Block>+-- becomes+-- <Catch> ::= 'catch' '(' Identifier ')' <Block>+-- | 'catch' '(' Identifier 'if' Condition ')' <Block>+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' <Block>+finally :: Parser JSNode+finally = do{ P.reserved "finally"; v1 <- block;+ return (JSFinally v1)}++-- <Function Declaration> ::= 'function' Identifier '(' <Formal Parameter List> ')' '{' <Function Body> '}'+-- | 'function' Identifier '(' ')' '{' <Function Body> '}'+functionDeclaration :: Parser JSNode+functionDeclaration = do {P.reserved "function"; v1 <- identifier; rOp "("; v2 <- formalParameterList; rOp ")"; + v3 <- functionBody; + return (JSFunction v1 v2 v3) } + <?> "functionDeclaration"+++-- <Function Expression> ::= 'function' '(' ')' '{' <Function Body> '}'+--- | 'function' '(' <Formal Parameter List> ')' '{' <Function Body> '}'+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)}+ }+ }++-- <Formal Parameter List> ::= Identifier+-- | <Formal Parameter List> ',' Identifier+formalParameterList :: Parser [JSNode]+formalParameterList = sepBy identifier (rOp ",")++-- <Function Body> ::= '{' <Source Elements> '}'+-- | '{' '}'+functionBody :: Parser JSNode+functionBody = do{ rOp "{"; + do { + do{ rOp "}";+ return (JSFunctionBody []) }+ <|> do{ v1 <- sourceElements; rOp "}";+ return (JSFunctionBody [v1]) }+ }+ }+ <?> "functionBody" ++-- <Program> ::= <Source Elements>+program :: Parser JSNode+program = do {P.whiteSpace; val <- sourceElementsTop; eof; + return val}+++-- <Source Elements> ::= <Source Element>+-- | <Source Elements> <Source Element>+sourceElements :: Parser JSNode+sourceElements = do{ val <- many1 sourceElement;+ return (JSSourceElements val)}+ +sourceElementsTop :: Parser JSNode+sourceElementsTop = do{ val <- many1 sourceElement;+ return (JSSourceElementsTop val)}+++-- <Source Element> ::= <Statement>+-- | <Function Declaration>+sourceElement :: Parser JSNode+sourceElement = functionDeclaration+ <|> statement+ <?> "sourceElement"++ + +-- ---------------------------------------------------------------+-- Testing++-- ---------------------------------------------------------------------++flatten :: [[a]] -> [a]+flatten xs = foldl' (++) [] xs++-- ---------------------------------------------------------------------++main :: IO ()+main =+ do args <- getArgs+ x <- B.readFile (args !! 0)+ putStrLn (show $ doParse program x) ++ +-- --------------------------------------------------------------------- + +readJs :: B.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 :: (Monad m) => B.ByteString -> m JSNode+readJsm :: B.ByteString -> Either String JSNode+readJsm input = eitherResult $ doParse program input ++-- ---------------------------------------------------------------------+ +_doParse' :: Parser a -> String -> a+_doParse' p input = case parse (p' p) (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++doParse :: Parser r -> B.ByteString -> Result r+doParse p input = {-maybeResult $-} feed (parse (p' p) input) B.empty+ +parseString :: Parser r -> String -> Result r+parseString p input = doParse p (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 <- B.readFile (filename)+ return $ (readJs x)++-- EOF
+ Text/Jasmine/Pretty.hs view
@@ -0,0 +1,701 @@+module Text.Jasmine.Pretty+ ( + renderJS+ ) where++import Data.Char+import Data.List+import Data.Monoid+import Text.Jasmine.Parse+import qualified Blaze.ByteString.Builder as BB+import qualified Blaze.ByteString.Builder.Char.Utf8 as BS+import qualified Data.ByteString.Lazy as LB++-- ---------------------------------------------------------------------+-- Pretty printer stuff via blaze-builder++(<>) :: BB.Builder -> BB.Builder -> BB.Builder+(<>) a b = mappend a b++(<+>) :: BB.Builder -> BB.Builder -> BB.Builder+(<+>) a b = mconcat [a, (text " "), b]++hcat :: (Monoid a) => [a] -> a+hcat xs = mconcat xs++empty :: BB.Builder+empty = mempty++text :: String -> BB.Builder+text s = BS.fromString s++char :: Char -> BB.Builder+char c = BS.fromChar c++comma :: BB.Builder+comma = BS.fromChar ','++punctuate :: a -> [a] -> [a]+punctuate p xs = intersperse p xs++-- ---------------------------------------------------------------------+++renderJS :: JSNode -> BB.Builder+renderJS (JSEmpty l) = (renderJS l)+renderJS (JSIdentifier s) = text s+renderJS (JSDecimal i) = text $ show 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 (JSElement _s xs) = rJS $ fixLiterals 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 as s) = (text "function") <> (text "(") <> (commaList as) <> (text ")") <> (renderJS s)+renderJS (JSArguments xs) = (text "(") <> (commaListList $ map fixLiterals xs) <> (text ")")++renderJS (JSBlock x) = (text "{") <> (renderJS x) <> (text "}")++renderJS (JSIf c (JSLiteral ";"))= (text "if") <> (text "(") <> (renderJS c) <> (text ")") +renderJS (JSIf c t) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS $ fixBlock t)++renderJS (JSIfElse c t (JSLiteral ";")) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS t) + <> (text "else") +renderJS (JSIfElse c t e) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS t) + <> (text "else") <> (spaceOrBlock $ fixBlock e)+renderJS (JSMemberDot xs) = (text ".") <> (rJS xs)+renderJS (JSMemberSquare x xs) = (text "[") <> (renderJS x) <> (text "]") <> (rJS xs)+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 "]")++renderJS (JSBreak [] []) = (text "break")+renderJS (JSBreak [] _xs) = (text "break") -- <> (rJS xs) -- <> (text ";")+renderJS (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)++-- 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)) + <> (char ':') <> (renderJS xs) +renderJS (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) <> + (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)++renderJS (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")+ <+> (renderJS e2) <> (char ')') <> (renderJS $ fixBlock s)+renderJS (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") + <+> (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)++renderJS (JSReturn []) = (text "return")+renderJS (JSReturn [JSLiteral ";"]) = (text "return;")+renderJS (JSReturn xs) = (text "return") <> (if (spaceNeeded xs) then (text " ") else (empty)) <> (rJS $ fixSourceElements xs) ++renderJS (JSThrow e) = (text "throw") <+> (renderJS e)++renderJS (JSStatementList xs) = rJS (fixSourceElements $ map fixBlock xs)++renderJS (JSSwitch e xs) = (text "switch") <> (char '(') <> (renderJS e) <> (char ')') <> + (char '{') <> (rJS $ fixSemis xs) <> (char '}')+renderJS (JSTry e xs) = (text "try") <> (renderJS e) <> (rJS xs)++renderJS (JSVarDecl i []) = (renderJS i) +renderJS (JSVarDecl i xs) = (renderJS i) <> (text "=") <> (rJS xs)++renderJS (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)++renderJS (JSWith e s) = (text "with") <> (char '(') <> (renderJS e) <> (char ')') <> (rJS s)+ +-- Helper functions+rJS :: [JSNode] -> BB.Builder+rJS xs = hcat $ map renderJS xs++commaList :: [JSNode] -> BB.Builder+commaList xs = (hcat $ (punctuate comma (toDoc xs)))++commaListList :: [[JSNode]] -> BB.Builder+commaListList xs = (hcat $ punctuate comma $ map rJS xs)++toDoc :: [JSNode] -> [BB.Builder]+toDoc xs = map renderJS xs++spaceOrBlock :: JSNode -> BB.Builder+spaceOrBlock (JSBlock xs) = renderJS (JSBlock xs)+spaceOrBlock x = (text " ") <> (renderJS x)++-- ---------------------------------------------------------------+-- Utility stuff+++fixTop :: [JSNode] -> [JSNode]+fixTop [] = []+fixTop xs = if (last xs == (JSLiteral ";")) then (init xs) else (xs)++-- Fix semicolons in output of sourceelements and statementlist++fixSourceElements :: [JSNode] -> [JSNode]+fixSourceElements xs = fixSemis $ myFix xs+ +myFix :: [JSNode] -> [JSNode]+myFix [] = []+myFix [x] = [x]+myFix (x:(JSFunction v1 v2 v3):xs) = x : (JSLiteral "\n") : myFix ((JSFunction v1 v2 v3) : 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)++-- 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)++-- Merge adjacent semi colons+myFix ((JSLiteral ";"):(JSLiteral ";"):xs) = myFix ((JSLiteral ";"):xs)+myFix ((JSLiteral ";"):(JSLiteral "" ):xs) = myFix ((JSLiteral ""):xs)++myFix (x:xs) = x : myFix xs++-- Merge strings split over lines and using "+"+fixLiterals :: [JSNode] -> [JSNode]+fixLiterals [] = []+fixLiterals [x] = [x]+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 (x:xs) = x:fixLiterals xs++-- Sort out Semicolons+fixSemis :: [JSNode] -> [JSNode]+fixSemis xs = fixSemis' $ filter (\x -> x /= JSLiteral ";" && x /= JSLiteral "") xs++fixSemis' :: [JSNode] -> [JSNode]+fixSemis' [] = []+fixSemis' [JSContinue [JSLiteral ";"]] = [JSContinue []]+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++-- Remove extraneous braces around blocks+fixBlock :: JSNode -> JSNode+fixBlock (JSBlock (JSStatementList [x])) = x+fixBlock (JSBlock (JSStatementList xs)) = fixBlock' (JSBlock (JSStatementList (fixSourceElements xs)))+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' x = x++-- A space is needed if this expression starts with an identifier etc, but not if with a '('+spaceNeeded :: [JSNode] -> Bool+spaceNeeded xs = + let+ -- str = show $ rJS xs+ str = LB.unpack $ BB.toLazyByteString $ rJS xs+ in + head str /= (fromIntegral $ ord '(')++-- ---------------------------------------------------------------------+-- Test stuff++-- readJs "x=1;"+_case0 :: JSNode+_case0 = JSSourceElements + [+ JSExpression [JSElement "assignmentExpression" [JSIdentifier "x",JSOperator "=",JSDecimal 1]],+ JSEmpty (JSLiteral ";")+ ]++-- doParse statementList "a=1;" +_case1 :: [JSNode]+_case1 = [JSExpression + [JSElement "assignmentExpression" + [JSIdentifier "a",JSOperator "=",JSDecimal 1]+ ]+ ,JSEmpty (JSLiteral ";")+ ]+ +_case2 :: JSNode +_case2 = JSFunctionExpression [] (JSFunctionBody + [JSSourceElements + [JSReturn [JSExpression + [JSLiteral "this",JSMemberDot [JSIdentifier "name"]],+ JSLiteral ""]]]+ )+ -- ]],JSEmpty (JSLiteral ";") + + +-- doParse expression "opTypeNames={'\\n':\"NEWLINE\",';':\"SEMICOLON\",',':\"COMMA\"}" +_case4 :: JSNode+_case4 = JSExpression + [+ JSElement "assignmentExpression" + [+ 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 [JSElement "assignmentExpression" [JSIdentifier "a",JSOperator "=",JSDecimal 1]]+ ]+ ]+ )+ ]+ +-- doParse program "{if(typeof s!=\"string\")return s;evaluate(1)}"+_case6 :: JSNode+_case6 = JSSourceElements [] ++--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]]]+ ]+ ]+ )+ ]++--doParse program "for(i=0,j=assignOps.length;i<j;i++){}"+_case8 :: JSNode+_case8 = JSSourceElements + [+ JSFor + [JSExpression + [JSElement "assignmentExpression" + [JSIdentifier "i",JSOperator "=",JSDecimal 0],+ JSElement "assignmentExpression" + [JSIdentifier "j",JSOperator "=",JSIdentifier "assignOps",JSMemberDot [JSIdentifier "length"]]+ ]+ ] + + [JSExpression + [JSIdentifier "i",JSExpressionBinary "<" [JSIdentifier "j"] []]+ ] + + [JSExpression [JSExpressionPostfix "++" [JSIdentifier "i"]]] + + (JSLiteral ";")+ ] + +_case01_semi1 :: JSNode+_case01_semi1 = JSSourceElements + [+ JSBlock (JSStatementList + [+ JSExpression [JSIdentifier "zero",JSMemberDot [JSIdentifier "one"]],+ JSLiteral ";",+ JSExpression [JSIdentifier "zero"]+ ]),+ JSExpression [JSIdentifier "one"],+ JSExpression [JSIdentifier "two"],+ JSLiteral ";",+ JSExpression [JSIdentifier "three"],+ JSLiteral ";",+ JSExpression [JSIdentifier "four"],+ JSLiteral ";",+ JSExpression [JSIdentifier "five"]+ ] + +-- doParse returnStatement "return this.name;"+_case9 :: JSNode+_case9 = JSReturn [JSExpression [JSLiteral "this",JSMemberDot [JSIdentifier "name"]],JSLiteral ";"] ++_case9a :: [JSNode]+_case9a = [JSExpression [JSLiteral "this",JSMemberDot [JSIdentifier "name"]],JSLiteral ";"]++--parseFile "./test/parsingonly/02_sm.js"+{-++{zero}+one;two+{+ three+ four;five;+ {+ six;{seven;}+ }+}++-}+_case10 :: JSNode+_case10 = JSSourceElements + [+ JSBlock (JSStatementList [JSExpression [JSIdentifier "zero"]]),+ JSExpression [JSIdentifier "one"],+ JSLiteral ";",+ JSExpression [JSIdentifier "two"],+ JSBlock (JSStatementList + [JSExpression [JSIdentifier "three"],+ JSExpression [JSIdentifier "four"],+ JSLiteral ";",+ JSExpression [JSIdentifier "five"],+ JSLiteral ";",+ JSBlock (JSStatementList + [JSExpression [JSIdentifier "six"],+ JSLiteral ";",+ JSBlock (JSStatementList + [+ JSExpression [JSIdentifier "seven"],+ JSLiteral ""+ ]+ )+ ]+ )+ ]+ )+ ]+ +--parseFile "./test/parsingonly/05_comments_simple.js"+_case11 :: JSNode+_case11 = JSSourceElements + [+ JSExpression [JSIdentifier "a",JSExpressionBinary "+" [JSDecimal 1] []],+ JSLiteral ";",+ JSLiteral ";"+ ] + +--doParse program "var newlines=spaces.match(/\\n/g);var newlines=spaces.match(/\\n/g);"+_case12 :: JSNode+_case12 = JSSourceElements + [+ JSVariables "var" [JSVarDecl (JSIdentifier "newlines") + [JSIdentifier "spaces",JSMemberDot [JSIdentifier "match"],+ JSArguments [[JSRegEx "/\\n/g"]]]],+ JSLiteral ";",+ JSVariables "var" [JSVarDecl (JSIdentifier "newlines") + [JSIdentifier "spaces",JSMemberDot [JSIdentifier "match"],+ JSArguments [[JSRegEx "/\\n/g"]]]],+ JSLiteral ";"+ ] ++--doParse program "for(i=0;;){var t=1};for(var i=0,j=1;;){x=1}"+_case13 :: JSNode+_case13 = JSSourceElements + [+ JSFor [JSExpression [JSElement "assignmentExpression" [JSIdentifier "i",JSOperator "=",JSDecimal 0]]] + [] + [] + (JSBlock (+ JSStatementList [JSVariables "var" [JSVarDecl (JSIdentifier "t") [JSDecimal 1]]]+ )+ ),+ JSLiteral ";",+ JSForVar [JSVarDecl (JSIdentifier "i") [JSDecimal 0],JSVarDecl (JSIdentifier "j") [JSDecimal 1]] + [] + [] + (JSBlock (+ JSStatementList [JSExpression [JSElement "assignmentExpression" [JSIdentifier "x",JSOperator "=",JSDecimal 1]]]+ )+ )+ ] + +-- doParse program "if (/^[a-z]/.test(t)) {consts += t.toUpperCase();keywords[t] = i;} else {consts += (/^\\W/.test(t) ? opTypeNames[t] : t);}consts += \" = \" + x;"+_case14 :: JSNode+_case14 = JSSourceElements + [+ JSIfElse + (JSExpression [JSRegEx "/^[a-z]/",JSMemberDot [JSIdentifier "test"],JSArguments [[JSIdentifier "t"]]]) + (JSBlock (JSStatementList + [+ JSExpression [+ JSElement "assignmentExpression" + [JSIdentifier "consts",JSOperator "+=",JSIdentifier "t",+ JSMemberDot [JSIdentifier "toUpperCase"],JSArguments [[]]]+ ],+ JSLiteral ";",+ JSExpression [+ JSElement "assignmentExpression" [JSIdentifier "keywords",+ JSMemberSquare (JSExpression [JSIdentifier "t"]) [],+ JSOperator "=",JSIdentifier "i"]],+ JSLiteral ""])) + (JSBlock (JSStatementList + [+ JSExpression + [+ JSElement "assignmentExpression" + [+ JSIdentifier "consts",JSOperator "+=",+ JSExpressionParen + (+ JSExpression + [+ JSExpressionTernary + [+ JSRegEx "/^\\W/",+ JSMemberDot [JSIdentifier "test"],+ JSArguments [[JSIdentifier "t"]]+ ] + [+ JSIdentifier "opTypeNames",+ JSMemberSquare (JSExpression [JSIdentifier "t"]) + []+ ] + [JSIdentifier "t"]+ ]+ )+ ]+ ],+ JSLiteral ""+ ]+ )+ ),+ JSExpression [JSElement "assignmentExpression" + [JSIdentifier "consts",JSOperator "+=",JSStringLiteral '"' " = ",+ JSExpressionBinary "+" [JSIdentifier "x"] []]],+ JSLiteral ";"] + +-- doParse program "a+1;{}"+_case15 :: JSNode+_case15 = JSSourceElements + [+ JSExpression [JSIdentifier "a",JSExpressionBinary "+" [JSDecimal 1] []],+ JSLiteral ";",+ JSLiteral ";"+ ]+ +-- doParse program "for (i = 0;;){var t=1;;}\nx=1;"+-- (renderJS _case16) should become "for (i = 0;;)var t=1;x=1"+_case16 :: JSNode+_case16 = JSSourceElementsTop + [+ JSFor [JSExpression [JSElement "assignmentExpression" [JSIdentifier "i",JSOperator "=",JSDecimal 0]]] [] [] + (JSBlock + (JSStatementList + [+ JSVariables "var" [JSVarDecl (JSIdentifier "t") [JSDecimal 1]],+ JSLiteral ";",+ JSLiteral ""+ ]+ )+ ),+ JSExpression [JSElement "assignmentExpression" [JSIdentifier "x",JSOperator "=",JSDecimal 1]],+ JSLiteral ";"+ ]++-- doParse program "return new global.Boolean(v);"+_case17 :: JSNode+_case17 = JSSourceElementsTop + [+ JSReturn + [+ JSExpression [JSLiteral "new ",JSIdentifier "global",JSMemberDot [JSIdentifier "Boolean"],JSArguments [[JSIdentifier "v"]]],+ JSLiteral ";"]+ ]+ +--doParse program "if(typeof s!=\"string\")return;while(--n>=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 + [+ JSElement "assignmentExpression" + [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 + [JSElement "assignmentExpression" + [+ 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 + [JSElement "assignmentExpression" [JSIdentifier "x",JSOperator "=",JSDecimal 1]]+ ] + +--doParse program "if(!u)continue;t=n"+_case21 :: JSNode+_case21 = JSSourceElementsTop + [+ JSIf (JSExpression [JSUnary "!",JSIdentifier "u"]) + (JSContinue [JSLiteral ";"]),+ JSExpression [JSElement "assignmentExpression" [JSIdentifier "t",JSOperator "=",JSIdentifier "n"]]+ ] + +--doParse program "if (!v.base){throw new ReferenceError(v.propertyName + \" is not defined\");};x=1"+_case22 :: JSNode+_case22 = JSSourceElementsTop + [+ JSIf (JSExpression [JSUnary "!",JSIdentifier "v",JSMemberDot [JSIdentifier "base"]]) + (JSBlock (JSStatementList + [+ JSThrow (JSExpression + [+ JSLiteral "new ",+ JSIdentifier "ReferenceError",+ JSArguments + [+ [+ JSIdentifier "v",+ JSMemberDot [JSIdentifier "propertyName"],+ JSExpressionBinary "+" [JSStringLiteral '"' " is not defined"] []+ ]+ ]+ ]+ ),+ JSLiteral ""+ ]+ )+ ),+ JSLiteral ";",JSExpression [JSElement "assignmentExpression" [JSIdentifier "x",JSOperator "=",JSDecimal 1]]] ++--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 ""+ ]+ )+ ]++ +--doParse program "x=\"hello \" + \"world\";"+_case24 :: JSNode+_case24 = JSSourceElementsTop + [+ JSExpression + [+ JSElement "assignmentExpression" + [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 ";"]+ ]+ )+ )+ ]+ ]++-- EOF+
+ Text/Jasmine/Token.hs view
@@ -0,0 +1,324 @@+module Text.Jasmine.Token+ (+ identifier + , reserved + , whiteSpace + , dec + , hex + , autoSemi + , autoSemi' + , rOp + , lexeme + -- Testing + , oneLineComment + , isAlpha + ) where++-- ---------------------------------------------------------------------++import Control.Applicative ( (<|>) )+import Data.Attoparsec.Char8 (isSpace, hexadecimal, decimal, char, Parser, satisfy, try, many, (<?>), skipMany, skipMany1, isDigit)+import Data.Char ( isAlpha )+import Data.List ( nub, sort)++-- ---------------------------------------------------------------------++-- Do not use the lexer, it is greedy and consumes subsequent symbols, +-- e.g. "!" in a==!b+rOp :: String -> Parser ()+rOp x = lexeme $ do { _ <- myString 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 name = isReserved theReservedNames name+++isReserved :: [String] -> String -> Bool +isReserved names name+ = scan names+ where+ scan [] = False+ scan (r:rs) = case (compare r name) of+ LT -> scan rs+ EQ -> True+ GT -> False++theReservedNames :: [String]+theReservedNames = sort reservedNames++-- TODO: fix trailing characters test +reserved :: String -> Parser ()+reserved name = lexeme $ do { _ <- myString 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 { _ <- myString "\n"; return ()} <|> simpleSpace <|> oneLineComment <|> multiLineComment <?> "")+-- whiteSpace = try $ many $ (do { equal TokenWhite } <|> do { (equal TokenNL); setNLFlag})+++--simpleSpace = skipMany1 (satisfy isSpace)+simpleSpace :: Parser ()+simpleSpace = skipMany1 (satisfy (\c -> isSpace c && c /= '\n')) -- From HJS+++oneLineComment :: Parser ()+oneLineComment =+ do{ _ <- myString commentLine+ ; skipMany (satisfy (/= '\n'))+ -- ; word8 10 + ; return ()+ }++multiLineComment :: Parser ()+multiLineComment =+ do { _ <- try (myString commentStart)+ ; inComment+ }++inComment :: Parser ()+inComment+ | nestedComments = inCommentMulti+ | otherwise = inCommentSingle++inCommentMulti :: Parser ()+inCommentMulti+ = do{ _ <- try (myString commentEnd) ; return () }+ <|> do{ multiLineComment ; inCommentMulti }+ <|> do{ skipMany1 (noneOf startEnd) ; inCommentMulti }+ <|> do{ _ <- oneOf startEnd ; inCommentMulti }+ <?> "end of comment"+ where+ startEnd = nub (commentEnd ++ commentStart)++inCommentSingle :: Parser ()+inCommentSingle+ = do{ _ <- try (myString commentEnd) ; return () }+ <|> do{ skipMany1 (noneOf startEnd) ; inCommentSingle }+ <|> do{ _ <- oneOf startEnd ; inCommentSingle }+ <?> "end of comment"+ where+ startEnd = nub (commentEnd ++ commentStart)++commentStart :: [Char]+commentStart = "/*"++commentEnd :: [Char]+commentEnd = "*/"++commentLine :: [Char]+commentLine = "//"++nestedComments :: Bool+nestedComments = True++identLetter :: Parser Char+identLetter = alphaNum <|> oneOf "_"++identStart :: Parser Char+identStart = letter <|> oneOf "_$"++reservedNames :: [String]+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"+ ]+++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 p = do{ x <- p; whiteSpace; return x }+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 cs = satisfy (\c -> elem c cs)+++-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current+-- character /not/ in the supplied list of characters @cs@. Returns the+-- parsed character.+--+-- > consonant = noneOf "aeiou"++noneOf :: String -> Parser Char+noneOf cs = satisfy (\c -> not (elem c cs))++-- | 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. ++myString :: String -> Parser String+myString s = mapM (\c -> char c) s++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
+ buildall.sh view
@@ -0,0 +1,6 @@+#!/bin/sh++# do a clean build of all, including the tests+cabal clean && cabal configure -fbuildtests && cabal build && cabal haddock++
+ hjsmin.cabal view
@@ -0,0 +1,50 @@+name: hjsmin+version: 0.0.1+license: BSD3+license-file: LICENSE+author: Alan Zimmerman <alan.zimm@gmail.com>+maintainer: Alan Zimmerman <alan.zimm@gmail.com>+synopsis: Haskell implementation of a javascript minifier+description:+ Reduces size of javascript files by stripping out extraneous whitespace and + other syntactic elements, without changing the semantics.+category: Web+stability: unstable+cabal-version: >= 1.6+build-type: Simple+homepage: http://github.com/alanz/hjsmin+bug-reports: http://github.com/alanz/hjsmin/issues++Extra-source-files: + TODO.txt, README.markdown, buildall.sh+++flag buildtests+ description: Build the executable to run unit tests+ default: False++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+ exposed-modules: Text.Jasmine+ other-modules: Text.Jasmine.Parse, Text.Jasmine.Pretty, Text.Jasmine.Token+ ghc-options: -Wall++executable runtests+ if flag(buildtests)+ Buildable: True+ cpp-options: -DTEST+ build-depends: QuickCheck >= 2 && < 3,+ HUnit,+ test-framework-hunit,+ test-framework+ else+ Buildable: False+ main-is: runtests.hs++source-repository head+ type: git+ location: git://github.com/alanz/hjsmin.git
+ runtests.hs view
@@ -0,0 +1,236 @@++import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)++import Data.Char+import Text.Jasmine+import Text.Jasmine.Parse hiding (main)+import Text.Jasmine.Pretty+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as T+import qualified Data.Text.Encoding as E++main :: IO ()+main = defaultMain [testSuite,testSuiteMin,testSuiteFiles,testSuiteFilesUnminified]++testSuite :: Test+testSuite = testGroup "Text.Jasmine.Parse"+ [ + testCase "helloWorld" caseHelloWorld + , testCase "helloWorld2" caseHelloWorld2 + , testCase "simpleAssignment" caseSimpleAssignment+ , testCase "emptyFor" caseEmptyFor + , testCase "fullFor" caseFullFor + , testCase "forVarFull" caseForVarFull + , testCase "ifelse1" caseIfElse1+ , testCase "ifelse2" caseIfElse2+ , testCase "0_f.js" case0_f+ , testCase "01_semi1.js" case01_semi1 + , testCase "min_100_animals" case_min_100_animals+ , testCase "nestedSquare" caseNestedSquare+ ]++testSuiteMin :: Test+testSuiteMin = testGroup "Text.Jasmine.Pretty"+ [ testCase "helloWorld" caseMinHelloWorld + , testCase "helloWorld2" caseMinHelloWorld2 + , testCase "simpleAssignment" caseMinSimpleAssignment+ , testCase "ifelse1" caseMinIfElse1+ , testCase "ifelse2" caseMinIfElse2+ , testCase "0_f.js" caseMin0_f+ , testCase "01_semi1.js" caseMin01_semi1 + , testCase "min_100_animals" caseMin_min_100_animals+ , testCase "minNestedSquare" caseMinNestedSquare+ , testCase "EitherLeft" caseEitherLeft + , testCase "EitherRight" caseEitherRight + ]++testSuiteFiles :: Test+testSuiteFiles = testGroup "Text.Jasmine.Pretty files"+ [ testCase "00_f.js" (testFile "./test/pminified/00_f.js")+ , testCase "01_semi1.js" (testFile "./test/pminified/01_semi1.js") + , testCase "02_sm.js" (testFile "./test/pminified/02_sm.js") + , testCase "03_sm.js" (testFile "./test/pminified/03_sm.js") + , testCase "04_if.js" (testFile "./test/pminified/04_if.js") + , testCase "05_comments_simple.js" (testFile "./test/pminified/05_comments_simple.js") + , testCase "05_regex.js" (testFile "./test/pminified/05_regex.js") + , testCase "06_callexpr.js" (testFile "./test/pminified/06_callexpr.js") + , testCase "06_newexpr.js" (testFile "./test/pminified/06_newexpr.js") + , testCase "06_var.js" (testFile "./test/pminified/06_var.js") + , testCase "07_expr.js" (testFile "./test/pminified/07_expr.js") + , testCase "10_switch.js" (testFile "./test/pminified/10_switch.js") + , testCase "14_labelled_stmts.js" (testFile "./test/pminified/14_labelled_stmts.js") + , testCase "15_literals.js" (testFile "./test/pminified/15_literals.js") + , testCase "16_literals.js" (testFile "./test/pminified/16_literals.js") + , testCase "20_statements.js" (testFile "./test/pminified/20_statements.js") + , testCase "25_trycatch.js" (testFile "./test/pminified/25_trycatch.js") + , testCase "40_functions.js" (testFile "./test/pminified/40_functions.js") + , testCase "67_bob.js" (testFile "./test/pminified/67_bob.js") + , testCase "110_perfect.js" (testFile "./test/pminified/110_perfect.js") + , testCase "120_js.js" (testFile "./test/pminified/120_js.js") + , testCase "121_jsdefs.js" (testFile "./test/pminified/121_jsdefs.js") + , testCase "122_jsexec.js" (testFile "./test/pminified/122_jsexec.js") + , testCase "122_jsexec2.js" (testFile "./test/pminified/122_jsexec2.js") + , testCase "122_jsexec3.js" (testFile "./test/pminified/122_jsexec3.js") + -- , testCase "123_jsparse.js" (testFile "./test/pminified/123_jsparse.js") + -- TODO: something strange here, assigning code block to variable?+ -- See http://msdn.microsoft.com/en-us/library/77kz8hy0.aspx, get/set keywords for object accessors+ + --, testCase "130_htojs2.js" (testFile "./test/parsingonly/130_htojs2.js") + --, testCase "" (testFile "./test/pminified/") + ] ++testSuiteFilesUnminified :: Test+testSuiteFilesUnminified = testGroup "Text.Jasmine.Pretty filesUnminified"+ [ testCase "00_f.js" (testFileUnminified "00_f.js")+ , testCase "01_semi1.js" (testFileUnminified "01_semi1.js") + , testCase "02_sm.js" (testFileUnminified "02_sm.js") + , testCase "03_sm.js" (testFileUnminified "03_sm.js") + , testCase "04_if.js" (testFileUnminified "04_if.js") + , testCase "05_comments_simple.js" (testFileUnminified "05_comments_simple.js") + , testCase "05_regex.js" (testFileUnminified "05_regex.js") + , testCase "06_callexpr.js" (testFileUnminified "06_callexpr.js") + , testCase "06_newexpr.js" (testFileUnminified "06_newexpr.js") + , testCase "06_var.js" (testFileUnminified "06_var.js") + , testCase "07_expr.js" (testFileUnminified "07_expr.js") + , testCase "10_switch.js" (testFileUnminified "10_switch.js") + , testCase "14_labelled_stmts.js" (testFileUnminified "14_labelled_stmts.js") + , testCase "15_literals.js" (testFileUnminified "15_literals.js") + , testCase "16_literals.js" (testFileUnminified "16_literals.js") + , testCase "20_statements.js" (testFileUnminified "20_statements.js") + , testCase "25_trycatch.js" (testFileUnminified "25_trycatch.js") + , testCase "40_functions.js" (testFileUnminified "40_functions.js") + , testCase "67_bob.js" (testFileUnminified "67_bob.js") + , testCase "110_perfect.js" (testFileUnminified "110_perfect.js") + , testCase "120_js.js" (testFileUnminified "120_js.js") + , testCase "121_jsdefs.js" (testFileUnminified "121_jsdefs.js") + , testCase "122_jsexec.js" (testFileUnminified "122_jsexec.js") + + --, testCase "122_jsexec2.js" (testFileUnminified "122_jsexec2.js") + ] ++srcHelloWorld = "function Hello(a) {}"+caseHelloWorld = + "Done \"\" JSFunction (JSIdentifier \"Hello\") [JSIdentifier \"a\"] (JSFunctionBody [])"+ @=? (show $ parseString functionDeclaration srcHelloWorld)+caseMinHelloWorld = + -- "function Hello(a){}" @=? (minify (U.fromString srcHelloWorld))+ testMinify "function Hello(a){}" srcHelloWorld+ +srcHelloWorld2 = "function Hello(a) {b=1}" +caseHelloWorld2 = + "Done \"\" JSFunction (JSIdentifier \"Hello\") [JSIdentifier \"a\"] (JSFunctionBody [JSSourceElements [JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"b\",JSOperator \"=\",JSDecimal 1]]]])"+ @=? (show $ parseString functionDeclaration srcHelloWorld2)+caseMinHelloWorld2 = + -- "function Hello(a){b=1}" @=? (minify (U.fromString srcHelloWorld2))+ testMinify "function Hello(a){b=1}" srcHelloWorld2++srcSimpleAssignment = "a=1;" +caseSimpleAssignment = + "Done \"\" JSStatementList [JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"a\",JSOperator \"=\",JSDecimal 1]],JSLiteral \";\"]"+ @=? (show $ parseString statementList srcSimpleAssignment)+caseMinSimpleAssignment =+ testMinify "a=1" srcSimpleAssignment++srcEmptyFor = "for (i = 0;;){}"+caseEmptyFor =+ "Done \"\" JSFor [JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"i\",JSOperator \"=\",JSDecimal 0]]] [] [] (JSLiteral \";\")"+ @=? (show $ parseString iterationStatement srcEmptyFor) +srcFullFor = "for (i = 0;i<10;i++){}"+caseFullFor =+ "Done \"\" JSFor [JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"i\",JSOperator \"=\",JSDecimal 0]]] [JSExpression [JSIdentifier \"i\",JSExpressionBinary \"<\" [JSDecimal 10] []]] [JSExpression [JSExpressionPostfix \"++\" [JSIdentifier \"i\"]]] (JSLiteral \";\")"+ @=? (show $ parseString iterationStatement srcFullFor)+ +srcForVarFull = "for(var i=0,j=tokens.length;i<j;i++){}"+caseForVarFull =+ "Done \"\" JSForVar [JSVarDecl (JSIdentifier \"i\") [JSDecimal 0],JSVarDecl (JSIdentifier \"j\") [JSIdentifier \"tokens\",JSMemberDot [JSIdentifier \"length\"]]] [JSExpression [JSIdentifier \"i\",JSExpressionBinary \"<\" [JSIdentifier \"j\"] []]] [JSExpression [JSExpressionPostfix \"++\" [JSIdentifier \"i\"]]] (JSLiteral \";\")"+ @=? (show $ parseString iterationStatement srcForVarFull)++srcIfElse1 = "if(a){b=1}else c=2";+caseIfElse1 =+ "Done \"\" JSSourceElementsTop [JSIfElse (JSExpression [JSIdentifier \"a\"]) (JSBlock (JSStatementList [JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"b\",JSOperator \"=\",JSDecimal 1]]])) (JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"c\",JSOperator \"=\",JSDecimal 2]])]"+ @=? (show $ parseString program srcIfElse1)+caseMinIfElse1 =+ testMinify "if(a){b=1}else c=2" srcIfElse1++srcIfElse2 = "if(a){b=1}else {c=2;d=4}";+caseIfElse2 =+ "Done \"\" JSSourceElementsTop [JSIfElse (JSExpression [JSIdentifier \"a\"]) (JSBlock (JSStatementList [JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"b\",JSOperator \"=\",JSDecimal 1]]])) (JSBlock (JSStatementList [JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"c\",JSOperator \"=\",JSDecimal 2]],JSLiteral \";\",JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"d\",JSOperator \"=\",JSDecimal 4]]]))]"+ @=? (show $ parseString program srcIfElse2)+caseMinIfElse2 =+ testMinify "if(a){b=1}else{c=2;d=4}" srcIfElse2++src0_f = "function Hello(a) {ExprArray(1,1);}"+case0_f =+ -- "Done \"\" JSSourceElementsTop [JSFunction (JSIdentifier \"Hello\") [JSIdentifier \"a\"] (JSFunctionBody [JSSourceElements [JSExpression [JSIdentifier \"ExprArray\",JSArguments [[JSDecimal 1],[JSDecimal 1]]],JSLiteral \"\"]])]"+ "Done \"\" JSSourceElementsTop [JSFunction (JSIdentifier \"Hello\") [JSIdentifier \"a\"] (JSFunctionBody [JSSourceElements [JSExpression [JSIdentifier \"ExprArray\",JSArguments [[JSDecimal 1],[JSDecimal 1]]],JSLiteral \";\"]])]"+ @=? (show $ parseString program src0_f)+caseMin0_f =+ testMinify "function Hello(a){ExprArray(1,1)}" src0_f+ +src01_semi1 = (+ "{zero.one;zero}\n"+++ "one\n"+++ "two;three\n"+++ "{{}} four;\n"+++ "// five\n"+++ "five") +case01_semi1 =+ "Done \"\" JSSourceElementsTop [JSBlock (JSStatementList [JSExpression [JSIdentifier \"zero\",JSMemberDot [JSIdentifier \"one\"]],JSLiteral \";\",JSExpression [JSIdentifier \"zero\"]]),JSExpression [JSIdentifier \"one\"],JSExpression [JSIdentifier \"two\"],JSLiteral \";\",JSExpression [JSIdentifier \"three\"],JSLiteral \";\",JSExpression [JSIdentifier \"four\"],JSLiteral \";\",JSExpression [JSIdentifier \"five\"]]"+ @=? (show $ parseString program src01_semi1)+caseMin01_semi1 =+ testMinify "{zero.one;zero};one;two;three;four;five" src01_semi1+ +src_min_100_animals = "function Animal(name){if(!name)throw new Error('Must specify an animal name');this.name=name};Animal.prototype.toString=function(){return this.name};o=new Animal(\"bob\");o.toString()==\"bob\"" +case_min_100_animals =+ "Done \"\" JSSourceElementsTop [JSFunction (JSIdentifier \"Animal\") [JSIdentifier \"name\"] (JSFunctionBody [JSSourceElements [JSIf (JSExpression [JSUnary \"!\",JSIdentifier \"name\"]) (JSThrow (JSExpression [JSLiteral \"new \",JSIdentifier \"Error\",JSArguments [[JSStringLiteral '\\'' \"Must specify an animal name\"]]])),JSLiteral \";\",JSExpression [JSElement \"assignmentExpression\" [JSLiteral \"this\",JSMemberDot [JSIdentifier \"name\"],JSOperator \"=\",JSIdentifier \"name\"]]]]),JSLiteral \";\",JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"Animal\",JSMemberDot [JSIdentifier \"prototype\",JSMemberDot [JSIdentifier \"toString\"]],JSOperator \"=\",JSFunctionExpression [] (JSFunctionBody [JSSourceElements [JSReturn [JSExpression [JSLiteral \"this\",JSMemberDot [JSIdentifier \"name\"]],JSLiteral \"\"]]])]],JSLiteral \";\",JSExpression [JSElement \"assignmentExpression\" [JSIdentifier \"o\",JSOperator \"=\",JSLiteral \"new \",JSIdentifier \"Animal\",JSArguments [[JSStringLiteral '\"' \"bob\"]]]],JSLiteral \";\",JSExpression [JSIdentifier \"o\",JSMemberDot [JSIdentifier \"toString\"],JSArguments [[]],JSExpressionBinary \"==\" [JSStringLiteral '\"' \"bob\"] []]]"+ @=? (show $ parseString program src_min_100_animals)+caseMin_min_100_animals =+ testMinify src_min_100_animals src_min_100_animals+ +srcNestedSquare = "this.cursor+=match[0].length;"+caseNestedSquare =+ "Done \"\" JSSourceElementsTop [JSExpression [JSElement \"assignmentExpression\" [JSLiteral \"this\",JSMemberDot [JSIdentifier \"cursor\"],JSOperator \"+=\",JSIdentifier \"match\",JSMemberSquare (JSExpression [JSDecimal 0]) [JSMemberDot [JSIdentifier \"length\"]]]],JSLiteral \";\"]"+ @=? (show $ parseString program srcNestedSquare)+caseMinNestedSquare = + testMinify "this.cursor+=match[0].length" srcNestedSquare+ +caseEitherLeft = + Left "endOfInput" @=? minifym ((E.encodeUtf8 $ T.pack "a=*SYNTAX*ERROR*"))+ +caseEitherRight = + Right (LB.fromChunks [(E.encodeUtf8 $ T.pack "a=\"no syntax error\"")]) @=? minifym ((E.encodeUtf8 $ T.pack "a=\"no syntax error\";"))+ +-- ---------------------------------------------------------------------+-- utilities++--testMinify expected src = (LB.fromChunks [(U.fromString expected)]) @=? (minify (U.fromString src))+testMinify expected src = (LB.fromChunks [(E.encodeUtf8 $ T.pack expected)]) @=? (minify (E.encodeUtf8 $ T.pack src))++testFile :: FilePath -> IO ()+testFile filename =+ do + x <- readFile (filename)+ let x' = trim x+ -- x' @=? (minify (U.fromString x') )+ testMinify x' x' +++testFileUnminified :: FilePath -> IO ()+testFileUnminified filename =+ do + x <- readFile ("./test/pminified/" ++ filename)+ y <- readFile ("./test/parsingonly/" ++ filename)+ let x' = trim x+ -- x' @=? (minify (U.fromString y))+ testMinify x' y+++++trim :: String -> String+trim = f . f+ where f = reverse . dropWhile isSpace++-- EOF