hjsmin-0.1.4.1/0000755000000000000000000000000012111226225011323 5ustar0000000000000000hjsmin-0.1.4.1/README.markdown0000644000000000000000000000315612111226223014027 0ustar0000000000000000hjsmin ====== [![Build Status](https://secure.travis-ci.org/alanz/hjsmin.png?branch=master)](http://travis-ci.org/alanz/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 Changes ------- 0.1.4.1 - Bump upper bound for containers to < 0.6 for the tests as well as the library 0.1.4 - Include test assets in cabal to allow cabal test to pass. Courtesy of @snoyberg 0.1.3 - Update version ranges for GHC 7.6.1, courtesy of @mietek 0.1.2 - More general fix to the space after 'new' keyword, for issue #8 & #9 0.1.1 - Fixed problem with missing space after 'new' keyword, in issue #8. 0.1.0 - Major update to work with language-javascript 0.5.1. All changes should be internal. Update of build process to make use of Cabal testing support, and Travis CI. 0.0.15 - Fix GHC 7.4.1 compile compatibility. Patch accepted from github.com/luite 0.0.14 - Allow unicode characters in comments 0.0.13 - Error in parsing numbers with zeros before decimal point 0.0.12 - Worked in Michael Snoyman's fix for unicode output 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 hjsmin-0.1.4.1/runtests.hs0000644000000000000000000005321712111226223013554 0ustar0000000000000000module Main where import Test.Framework (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) import Data.Char import Text.Jasmine import Language.JavaScript.Parser 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 "mergeStrings" caseMergeStrings , testCase "TrailingCommas" caseTrailingCommas , testCase "GetSet" caseGetSet , testCase "Unicode" caseUnicode , testCase "Issue3" caseIssue3 , testCase "Issue4" caseIssue4 , testCase "Switch1" caseSwitch1 , testCase "If1" caseIf1 , testCase "If2" caseIf2 , testCase "If3" caseIf3 , testCase "BootstrapDropdown" caseBootstrapDropdown , testCase "Issue8" caseIssue8 , testCase "Issue9" caseIssue9 ] testSuiteMin :: Test testSuiteMin = testGroup "Text.Jasmine.Pretty Min" [ 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 "minMergeStrings" caseMinMergeStrings , testCase "EitherLeft" caseEitherLeft , testCase "EitherRight" caseEitherRight , testCase "TrailingCommas" caseMinTrailingCommas , testCase "GetSet" caseMinGetSet , testCase "Unicode" caseMinUnicode , testCase "MinIssue3" caseMinIssue3 , testCase "MinIssue4" caseMinIssue4 , testCase "MinSwitch1" caseMinSwitch1 , testCase "MinIf1" caseMinIf1 , testCase "MinIf2" caseMinIf2 , testCase "MinIf3" caseMinIf3 , testCase "MinBootstrapDropdown" caseMinBootstrapDropdown , testCase "MinIssue8" caseMinIssue8 , testCase "MinIssue9" caseMinIssue9 ] 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 = "Right (JSSourceElementsTop [JSFunction (JSIdentifier \"Hello\") [JSIdentifier \"a\"] (JSBlock ([])),JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcHelloWorld) caseMinHelloWorld = -- "function Hello(a){}" @=? (minify (U.fromString srcHelloWorld)) testMinify "function Hello(a){}" srcHelloWorld srcHelloWorld2 = "function Hello(a) {b=1}" caseHelloWorld2 = "Right (JSSourceElementsTop [JSFunction (JSIdentifier \"Hello\") [JSIdentifier \"a\"] (JSBlock ([JSExpression [JSIdentifier \"b\",JSOperator JSLiteral \"=\",JSDecimal \"1\"]])),JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcHelloWorld2) caseMinHelloWorld2 = -- "function Hello(a){b=1}" @=? (minify (U.fromString srcHelloWorld2)) testMinify "function Hello(a){b=1}" srcHelloWorld2 srcSimpleAssignment = "a=1;" caseSimpleAssignment = "Right (JSSourceElementsTop [JSExpression [JSIdentifier \"a\",JSOperator JSLiteral \"=\",JSDecimal \"1\"],JSLiteral \";\",JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcSimpleAssignment) caseMinSimpleAssignment = testMinify "a=1" srcSimpleAssignment srcEmptyFor = "for (i = 0;;){}" caseEmptyFor = "Right (JSSourceElementsTop [JSFor [JSExpression [JSIdentifier \"i\",JSOperator JSLiteral \"=\",JSDecimal \"0\"]] [] [] (JSBlock ([])),JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcEmptyFor) srcFullFor = "for (i = 0;i<10;i++){}" caseFullFor = "Right (JSSourceElementsTop [JSFor [JSExpression [JSIdentifier \"i\",JSOperator JSLiteral \"=\",JSDecimal \"0\"]] [JSExpression [JSExpressionBinary \"<\" [JSIdentifier \"i\"] [JSDecimal \"10\"]]] [JSExpression [JSExpressionPostfix \"++\" [JSIdentifier \"i\"]]] (JSBlock ([])),JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcFullFor) srcForVarFull = "for(var i=0,j=tokens.length;i\" [JSIdentifier \"i\"] [JSDecimal \"0\"]]) ([JSExpression [JSIdentifier \"consts\",JSOperator JSLiteral \"+=\",JSStringLiteral '\"' \", \"],JSLiteral \";\"]) ([]),JSVariables JSLiteral \"var\" [JSVarDecl (JSIdentifier \"t\") [JSLiteral \"=\",JSMemberSquare [JSIdentifier \"tokens\"] (JSExpression [JSIdentifier \"i\"])]],JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcIf1) caseMinIf1 = testMinify "if(i>0)consts+=\", \";var t=tokens[i]" srcIf1 srcIf2 = "if (getValue)\n execute;\nelse {\n execute;\n}" caseIf2 = "Right (JSSourceElementsTop [JSIf (JSExpression [JSIdentifier \"getValue\"]) ([JSExpression [JSIdentifier \"execute\"],JSLiteral \";\"]) ([JSLiteral \"else\",JSBlock ([JSExpression [JSIdentifier \"execute\"],JSLiteral \";\"])]),JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcIf2) caseMinIf2 = testMinify "if(getValue){execute}else execute" srcIf2 srcIf3 = "if(getValue){execute}else execute" caseIf3 = "Right (JSSourceElementsTop [JSIf (JSExpression [JSIdentifier \"getValue\"]) ([JSExpression [JSIdentifier \"execute\"],JSLiteral \";\"]) ([JSLiteral \"else\",JSBlock ([JSExpression [JSIdentifier \"execute\"],JSLiteral \";\"])]),JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcIf2) caseMinIf3 = testMinify "if(getValue){execute}else execute" srcIf3 srcBootstrapDropdown = "clearMenus()\n!isActive && $parent.toggleClass('open')" caseBootstrapDropdown = "Right (JSSourceElementsTop [JSExpression [JSIdentifier \"clearMenus\",JSArguments []],JSExpression [JSExpressionBinary \"&&\" [JSUnary \"!\",JSIdentifier \"isActive\"] [JSMemberDot [JSIdentifier \"$parent\"] (JSIdentifier \"toggleClass\"),JSArguments [JSStringLiteral '\\'' \"open\"]]],JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcBootstrapDropdown) caseMinBootstrapDropdown = testMinify "clearMenus();!isActive&&$parent.toggleClass('open')" srcBootstrapDropdown srcIssue8 = "(function(){new nicEditor({fullPanel:true}).panelInstance('h4')})();" caseIssue8 = "Right (JSSourceElementsTop [JSExpression [JSExpressionParen (JSExpression [JSFunctionExpression [] [] (JSBlock ([JSExpression [JSMemberDot [JSLiteral \"new\",JSIdentifier \"nicEditor\",JSArguments [JSObjectLiteral [JSPropertyNameandValue (JSIdentifier \"fullPanel\") [JSLiteral \"true\"]]]] (JSIdentifier \"panelInstance\"),JSArguments [JSStringLiteral '\\'' \"h4\"]]]))]),JSArguments []],JSLiteral \";\",JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcIssue8) caseMinIssue8 = testMinify "(function(){new nicEditor({fullPanel:true}).panelInstance('h4')})()" srcIssue8 srcIssue9 = "var x = [new friend(5)];" caseIssue9 = "Right (JSSourceElementsTop [JSVariables JSLiteral \"var\" [JSVarDecl (JSIdentifier \"x\") [JSLiteral \"=\",JSArrayLiteral [JSLiteral \"new\",JSIdentifier \"friend\",JSArguments [JSDecimal \"5\"]]]],JSLiteral \"\"])" @=? (showStrippedMaybe $ parseProgram srcIssue9) caseMinIssue9 = testMinify "var x=[new friend(5)]" srcIssue9 -- --------------------------------------------------------------------- -- utilities --testMinify expected src = (LB.fromChunks [(U.fromString expected)]) @=? (minify (U.fromString src)) testMinify expected src = (LB.fromChunks [(E.encodeUtf8 $ T.pack expected)]) @=? (minify $ LB.fromChunks [(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 -- For language-javascript parseProgram src = parse src "src" -- EOF hjsmin-0.1.4.1/LICENSE0000644000000000000000000000276512111226223012340 0ustar0000000000000000Copyright (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. hjsmin-0.1.4.1/hjsmin.cabal0000644000000000000000000000354512111226225013606 0ustar0000000000000000name: hjsmin version: 0.1.4.1 license: BSD3 license-file: LICENSE author: Alan Zimmerman maintainer: Alan Zimmerman 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.9.2 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 , test/pminified/*.js , test/parsingonly/*.js library build-depends: base >= 4 && < 5 , bytestring >= 0.9 && < 0.11 , blaze-builder >= 0.2 && < 1 , text >= 0.8 && < 1 , containers >= 0.2 && < 0.6 , language-javascript >= 0.5.1 && < 0.6 exposed-modules: Text.Jasmine other-modules: Text.Jasmine.Pretty ghc-options: -Wall Test-Suite test-hjsmin Type: exitcode-stdio-1.0 Main-is: runtests.hs build-depends: Cabal >= 1.9.2 , QuickCheck >= 2 && < 3 , HUnit , test-framework , test-framework-hunit , base >= 4 && < 5 , bytestring >= 0.9 && < 0.11 , blaze-builder >= 0.2 && < 1 , text >= 0.8 && < 1 , containers >= 0.2 && < 0.6 , language-javascript >= 0.5.4 && < 0.6 source-repository head type: git location: git://github.com/alanz/hjsmin.git hjsmin-0.1.4.1/buildall.sh0000755000000000000000000000034312111226223013450 0ustar0000000000000000#!/bin/sh # do a clean build of all, including the tests #cabal clean && cabal configure -fbuildtests && cabal build && cabal haddock cabal clean && cabal configure --enable-tests && cabal build && cabal test && cabal haddock hjsmin-0.1.4.1/TODO.txt0000644000000000000000000000425212111226223012632 0ustar0000000000000000Testing: 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) {} ------------ Integrating language-haskell. ----------------------------- Baseline before starting, on my laptop (intel Core2 Duo SU7300) $ time ./dist/build/runtests/runtests real 0m1.625s user 0m1.616s sys 0m0.016s Baseline 2010-12-20, after getting all tests to pass at last real 0m0.209s user 0m0.196s sys 0m0.004s After working in unicode, in language-javascript-0.0.3 [2010-12-28] real 0m0.236s user 0m0.224s sys 0m0.012s EOF hjsmin-0.1.4.1/Setup.hs0000644000000000000000000000005612111226225012760 0ustar0000000000000000import Distribution.Simple main = defaultMain hjsmin-0.1.4.1/Text/0000755000000000000000000000000012111226223012245 5ustar0000000000000000hjsmin-0.1.4.1/Text/Jasmine.hs0000644000000000000000000000276412111226223014200 0ustar0000000000000000module Text.Jasmine ( minify , minifym , minifyBb , minifyFile ) where --import Text.Jasmine.Parse import Language.JavaScript.Parser (readJs, parse, JSNode(..)) import Text.Jasmine.Pretty import qualified Blaze.ByteString.Builder as BB import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Lazy.Char8 as S8 import Data.Text.Lazy (unpack) import Data.Text.Lazy.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) minifym :: LB.ByteString -> Either String LB.ByteString minifym s = case parse' s of Left msg -> Left (show msg) Right p -> Right $ BB.toLazyByteString $ renderJS p minifyBb :: LB.ByteString -> Either String BB.Builder minifyBb s = case parse' s of Left msg -> Left (show msg) Right p -> Right (renderJS p) minify :: LB.ByteString -> LB.ByteString --minify s = BB.toLazyByteString $ renderJS $ readJs s minify s = BB.toLazyByteString $ renderJS $ readJs (lbToStr s) _minify' :: LB.ByteString -> BB.Builder _minify' s = renderJS $ readJs (lbToStr s) minifyFile :: FilePath -> IO LB.ByteString minifyFile filename = do x <- LB.readFile (filename) return $ minify x --parse' :: S8.ByteString -> Either ParseError JSNode parse' :: S8.ByteString -> Either String JSNode parse' input = parse (lbToStr input) "src" lbToStr :: S8.ByteString -> [Char] lbToStr = unpack . decodeUtf8With lenientDecode _strToLb :: String -> S8.ByteString _strToLb str = S8.pack str -- EOF hjsmin-0.1.4.1/Text/Jasmine/0000755000000000000000000000000012111226223013633 5ustar0000000000000000hjsmin-0.1.4.1/Text/Jasmine/Pretty.hs0000644000000000000000000004730512111226223015467 0ustar0000000000000000module Text.Jasmine.Pretty ( renderJS ) where import Data.Char import Data.List import Data.Monoid (Monoid, mappend, mempty, mconcat) import Language.JavaScript.Parser (JSNode(..),Node(..),tokenPosnEmpty,readJs,CommentAnnotation(..),TokenPosn(..)) 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 (NN node ) = rn node renderJS (NT node _ _) = rn node rn :: Node -> BB.Builder --rn (JSEmpty l) = (renderJS l) -- Terminals rn (JSIdentifier s) = text s rn (JSDecimal i) = text i rn (JSLiteral "new") = (text "new ") rn (JSLiteral l) = (text l) rn (JSHexInteger i) = (text $ show i) -- TODO: need to tweak this rn (JSStringLiteral s l) = empty <> (char s) <> (text l) <> (char s) rn (JSRegEx s) = (text s) -- Non Terminals rn (JSOperator x) = renderJS x rn (JSExpression xs) = rJS xs --rn (JSSourceElements xs) = rJS (fixSourceElements $ map fixBlock xs) --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 "(") <> (rJS p) <> (text ")") <> (renderJS xs) rn (JSFunction _f s _lb p _rb x) = (text "function") <+> (renderJS s) <> (text "(") <> (rJS p) <> (text ")") <> (renderJS $ fixFnBlock x) -- rn (JSFunctionBody xs) = (text "{") <> (rJS xs) <> (text "}") --rn (JSFunctionExpression [] p xs) = (text "function") <> (text "(") <> (rJS p) <> (text ")") <> (renderJS xs) --rn (JSFunctionExpression s p xs) = (text "function") <+> (rJS s) <> (text "(") <> (rJS p) <> (text ")") <> (renderJS xs) rn (JSFunctionExpression _f [] _lb p _rb x) = (text "function") <> (text "(") <> (rJS p) <> (text ")") <> (renderJS $ fixFnBlock x) rn (JSFunctionExpression _f s _lb p _rb x) = (text "function") <+> (rJS s) <> (text "(") <> (rJS p) <> (text ")") <> (renderJS $ fixFnBlock x) --rn (JSArguments xs ) = (text "(") <> (rJSList $ map fixLiterals xs) <> (text ")") rn (JSArguments _lb xs _rb) = (text "(") <> (rJS $ fixLiterals xs) <> (text ")") rn (JSBlock lb xs rb) = (rJS lb) <> (rJS xs) <> (rJS rb) rn (JSIf _i _lb c _rb [(NT (JSLiteral ";") _ _)] []) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") --rn (JSIf _i _lb c _rb t []) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (renderJS $ fixBlock t) rn (JSIf _i _lb c _rb t []) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (rJS $ fixSourceElements $ map fixBlock t) rn (JSIf _i _lb c _rb t [_e,(NT (JSLiteral ";") _ _)]) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (rJS $ fixIfBlock t) <> (text "else") rn (JSIf _i _lb c _rb t [_e,e]) = (text "if") <> (text "(") <> (renderJS c) <> (text ")") <> (rJS $ fixIfElse $ fixSourceElements t) <> (text "else") <> (spaceOrBlock $ fixBlock e) rn (JSMemberDot xs _d y) = (rJS $ fixLiterals xs) <> (text ".") <> (renderJS y) rn (JSMemberSquare xs _lb x _rb) = (rJS $ fixLiterals xs) <> (text "[") <> (renderJS x) <> (text "]") rn (JSUnary l _s ) = text l rn (JSArrayLiteral _lb xs _rb) = (text "[") <> (rJS xs) <> (text "]") rn (JSBreak _b [] as) = (text "break") -- <> (renderJS as) rn (JSBreak _b is as) = (text "break") <+> (rJS $ fixSourceElements $ map fixFnBlock is) -- <> (renderJS as) rn (JSCallExpression "()" _os xs _cs) = (rJS xs) rn (JSCallExpression t _os xs _cs) = (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? --rn (JSCase (JSExpression [JSStringLiteral sepa s]) xs) = (text "case") <> (renderJS (JSStringLiteral sepa s)) rn (JSCase _ca (NN (JSExpression [(NT (JSStringLiteral sepa s) s1 c1)])) _c xs) = (text "case") <> (renderJS (NT (JSStringLiteral sepa s) s1 c1)) <> (char ':') <> (rJS $ fixSourceElements $ map fixFnBlock xs) rn (JSCase _ca e _c xs) = (text "case") <+> (renderJS e) <> (char ':') <> (rJS $ fixSourceElements $ map fixFnBlock xs) -- <> (text ";"); rn (JSCatch _c _lb i [] _rb s) = (text "catch") <> (char '(') <> (renderJS i) <> (char ')') <> (renderJS $ fixFnBlock s) rn (JSCatch _c _lb i c _rb s) = (text "catch") <> (char '(') <> (renderJS i) <> (text " if ") <> (rJS $ tail c) <> (char ')') <> (renderJS $ fixFnBlock s) rn (JSContinue _c is _as) = (text "continue") <> (rJS is) -- <> (char ';') rn (JSDefault _d _c xs) = (text "default") <> (char ':') <> (rJS $ fixSourceElements xs) rn (JSDoWhile _d s _w _lb e _rb as) = (text "do") <> (renderJS $ fixFnBlock s) <> (text "while") <> (char '(') <> (renderJS e) <> (char ')') -- <> (renderJS as) --rn (JSElementList xs) = rJS xs --rn (JSElision xs) = (char ',') <> (rJS xs) rn (JSElision x) = renderJS x rn (JSExpressionBinary o e1 _op e2) = (rJS e1) <> (text o) <> (rJS e2) rn (JSExpressionParen _lp e _rp) = (char '(') <> (renderJS e) <> (char ')') rn (JSExpressionPostfix o e _op) = (rJS e) <> (text o) rn (JSExpressionTernary c _q v1 _c v2) = (rJS c) <> (char '?') <> (rJS v1) <> (char ':') <> (rJS v2) rn (JSFinally _f b) = (text "finally") <> (renderJS $ fixFnBlock b) rn (JSFor _f _lb e1 _s1 e2 _s2 e3 _rb s) = (text "for") <> (char '(') <> (rJS e1) <> (char ';') <> (rJS e2) <> (char ';') <> (rJS e3) <> (char ')') <> (renderJS $ fixBlock s) rn (JSForIn _f _lb e1 _i e2 _rb s) = (text "for") <> (char '(') <> (rJS e1) <+> (text "in") <+> (renderJS e2) <> (char ')') <> (renderJS $ fixBlock s) rn (JSForVar _f _lb _v e1 _s1 e2 _s3 e3 _rb s) = (text "for") <> (char '(') <> (text "var") <+> (rJS e1) <> (char ';') <> (rJS e2) <> (char ';') <> (rJS e3) <> (char ')') <> (renderJS $ fixBlock s) rn (JSForVarIn _f _lb _v e1 _i e2 _rb s) = (text "for") <> (char '(') <> (text "var") <+> (renderJS e1) <+> (text "in") <+> (renderJS e2) <> (char ')') <> (renderJS $ fixBlock s) rn (JSLabelled l _c v) = (renderJS l) <> (text ":") <> (rJS $ fixSourceElements [fixBlock v]) rn (JSObjectLiteral _lb xs _rb) = (text "{") <> (rJS xs) <> (text "}") rn (JSPropertyAccessor s n _lb1 ps _rb1 b) = (renderJS s) <+> (renderJS n) <> (char '(') <> (rJS ps) <> (text ")") <> (renderJS $ fixFnBlock b) rn (JSPropertyNameandValue n _c vs) = (renderJS n) <> (text ":") <> (rJS vs) rn (JSReturn _r [] _as) = (text "return") rn (JSReturn _r [(NT (JSLiteral ";") _ _)] _as) = (text "return;++foobar+will_never_happen++") -- ++AZ++ get rid of this rn (JSReturn _r xs as) = (text "return") <> (if (spaceNeeded xs) then (text " ") else (empty)) <> (rJS $ fixSourceElements xs) -- <> (renderJS as) rn (JSThrow _t e) = (text "throw") <+> (renderJS $ fixBlock e) rn (JSSwitch _s _lb e _rb x) = (text "switch") <> (char '(') <> (renderJS e) <> (char ')') <> (renderJS $ fixFnBlock x) rn (JSTry _t e xs) = (text "try") <> (renderJS $ fixFnBlock e) <> (rJS xs) rn (JSVarDecl i []) = (renderJS i) rn (JSVarDecl i xs) = (renderJS i) <> (rJS xs) rn (JSVariables kw xs _as) = (renderJS kw) <+> (rJS xs) rn (JSWhile _w _lb e _rb (NT (JSLiteral ";") _ _)) = (text "while") <> (char '(') <> (renderJS e) <> (char ')') -- <> (renderJS s) rn (JSWhile _w _lb e _rb s) = (text "while") <> (char '(') <> (renderJS e) <> (char ')') <> (renderJS $ fixFnBlock s) rn (JSWith _w _lb e _rb 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 [] = empty commaList xs = rJS xs extractNode :: JSNode -> Node extractNode (NT x _ _) = x extractNode (NN x ) = x --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 (NN (JSBlock lb xs rb)) = rn (JSBlock lb xs rb) --spaceOrBlock (NN (JSStatementBlock lb xs rb)) = rn (JSStatementBlock lb xs rb) spaceOrBlock x = (text " ") <> (renderJS x) {- TODO: Collapse this into JSLiteral ";" JSStatementBlock (JSStatementList [JSStatementBlock (JSStatementList [])]) -} -- --------------------------------------------------------------- -- Utility stuff fixTop :: [JSNode] -> [JSNode] fixTop [] = [] fixTop xs = if (n == (JSLiteral ";")) then (init xs) else (xs) where n = extractNode $ last xs {- -- The "new" literal always need a space after it fixNew :: [JSNode] -> [JSNode] fixNew [] = [] fixNew ((NT (JSLiteral "new") p cs):xs) = (NT (JSLiteral "new ") p cs) : fixNew xs fixNew (x :xs) = x : fixNew xs -} -- Fix semicolons in output of sourceelements and statementlist fixSourceElements :: [JSNode] -> [JSNode] fixSourceElements xs = fixSemis $ myFix xs myFix :: [JSNode] -> [JSNode] myFix [] = [] -- Sort out empty IF statements --myFix ((NN (JSIf i lb c rb (NN (JSStatementBlock _lb (NN (JSStatementList []) ) _rb) ) e)):xs) = (NN (JSIf i lb c rb (NT (JSLiteral "") tokenPosnEmpty []) e) ) : myFix (xs) myFix [x] = [x] myFix (x:(NN (JSFunction v1 v2 v3 v4 v5 v6) ):xs) = x : (NT (JSLiteral "\n") tokenPosnEmpty []) : myFix ((NN (JSFunction v1 v2 v3 v4 v5 v6) ) : xs) -- Messy way, but it works, until the 3rd element arrives .. -- TODO: JSStatementBlock. Damn. myFix ((NN (JSExpression x) ):(NN (JSExpression y) ):xs) = (NN (JSExpression x) ):(NT (JSLiteral ";") tokenPosnEmpty []):myFix ((NN (JSExpression y) ):xs) myFix ((NN (JSExpression x) ):(NN (JSBlock l y r) ):xs) = (NN (JSExpression x) ):(NT (JSLiteral ";") tokenPosnEmpty []):myFix ((NN (JSBlock l y r) ):xs) myFix ((NN (JSBlock x1 x2 x3) ) :(NN (JSBlock y1 y2 y3) ):xs) = (NN (JSBlock x1 x2 x3) ) :(NT (JSLiteral ";") tokenPosnEmpty []):myFix ((NN (JSBlock y1 y2 y3) ):xs) myFix ((NN (JSBlock x1 x2 x3) ) :(NN (JSExpression y) ):xs) = (NN (JSBlock x1 x2 x3) ) :(NT (JSLiteral ";") tokenPosnEmpty []):myFix ((NN (JSExpression y) ):xs) -- myFix ((NN (JSExpression x) ):(NN (JSStatementBlock y1 y2 y3) ):xs) = -- (NN (JSExpression x) ):(NT (JSLiteral ";") tokenPosnEmpty []):myFix ((NN (JSStatementBlock y1 y2 y3) ):xs) -- myFix ((NN (JSStatementBlock x1 x2 x3) ) :(NN (JSStatementBlock y1 y2 y3) ):xs) = -- (NN (JSStatementBlock x1 x2 x3) ) :(NT (JSLiteral ";") tokenPosnEmpty []):myFix ((NN (JSStatementBlock y1 y2 y3) ):xs) -- myFix ((NN (JSStatementBlock x1 x2 x3) ) :(NN (JSExpression y) ):xs) = -- (NN (JSStatementBlock x1 x2 x3) ) :(NT (JSLiteral ";") tokenPosnEmpty []):myFix ((NN (JSExpression y) ):xs) -- Merge adjacent variable declarations, but only of the same type myFix ((NN (JSVariables t1 x1s a1) ):(NT (JSLiteral l) s2 c2):(NN (JSVariables t2 x2s a2) ):xs) | extractNode t1 == extractNode t2 = myFix ((NN (JSVariables t1 (x1s++[(NT (JSLiteral ",") tokenPosnEmpty [])]++x2s) a2) ):xs) | otherwise = (NN (JSVariables t1 x1s a1) ):myFix ((NT (JSLiteral l) s2 c2):(NN (JSVariables t2 x2s a2) ):xs) myFix ((NN (JSVariables t1 x1s a1) ):(NN (JSVariables t2 x2s a2) ):xs) | extractNode t1 == extractNode t2 = myFix ((NN (JSVariables t1 (x1s++[(NT (JSLiteral ",") tokenPosnEmpty [])]++x2s) a2) ):xs) | otherwise = (NN (JSVariables t1 x1s a1) ):myFix ((NN (JSVariables t2 x2s a2) ):xs) -- Merge adjacent semi colons myFix ((NT (JSLiteral ";") s1 c1):(NT (JSLiteral ";") _s2 _c2):xs) = myFix ((NT (JSLiteral ";") s1 c1):xs) myFix ((NT (JSLiteral ";") s1 c1):(NT (JSLiteral "" ) _s2 _c2):xs) = myFix ((NT (JSLiteral "" ) s1 c1):xs) myFix (x:xs) = x : myFix xs -- Merge strings split over lines and using "+" fixLiterals :: [JSNode] -> [JSNode] fixLiterals [] = [] -- Old version fixLiterals ((NT (JSStringLiteral d1 s1) ss1 c1):(NN (JSExpressionBinary "+" [(NT (JSStringLiteral d2 s2) ss2 c2)] op r) ):xs) | d1 == d2 = fixLiterals ((NT (JSStringLiteral d1 (s1++s2)) ss1 c1):(r++xs)) | otherwise = (NT (JSStringLiteral d1 s1) ss1 c1):fixLiterals ((NN (JSExpressionBinary "+" [(NT (JSStringLiteral d2 s2) ss2 c2)] op r) ):xs) fixLiterals ((NN (JSExpressionBinary "+" [(NT (JSStringLiteral d1 s1) ss2 c2)] o1 [(NT (JSStringLiteral d2 s2) ss3 c3)]) ):xs) | d1 == d2 = fixLiterals ((NT (JSStringLiteral d1 (s1++s2)) ss2 c2):xs) | otherwise = (NN (JSExpressionBinary "+" [(NT (JSStringLiteral d1 s1) ss2 c2)] o1 [(NT (JSStringLiteral d2 s2) ss3 c3)]) ):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' $ stripSemis xs stripSemis :: [JSNode] -> [JSNode] stripSemis xs = filter (\x -> (extractNode x) /= JSLiteral ";" && (extractNode x) /= JSLiteral "") xs fixSemis' :: [JSNode] -> [JSNode] fixSemis' [] = [] fixSemis' [(NN (JSContinue c [(NT (JSLiteral ";") _ _)] as) )] = [(NN (JSContinue c [] as) )] fixSemis' [x] = [x] fixSemis' ((NN (JSIf i lb c rb [NN (JSBlock [NT (JSLiteral "{") p1 cs1] [] [NT (JSLiteral "}") p2 cs2])] []) ):xs) = (NN (JSIf i lb c rb [NN (JSBlock [NT (JSLiteral "{") p1 cs1] [] [NT (JSLiteral "}") p2 cs2])] []) ):(fixSemis' xs) fixSemis' ((NN (JSIf i lb c rb [(NT (JSLiteral ";") s1 c1)] []) ):xs) = (NN (JSIf i lb c rb [(NT (JSLiteral ";") s1 c1)] []) ):(fixSemis' xs) fixSemis' ((NN (JSIf i lb c rb [(NN (JSReturn r [(NT (JSLiteral ";") s1 c1)] as) )] e) ):xs) = (NN (JSIf i lb c rb [(NN (JSReturn r [(NT (JSLiteral ";") s1 c1)] as) )] e) ):(fixSemis' xs) fixSemis' ((NN (JSIf i lb c rb [(NN (JSContinue co [(NT (JSLiteral ";") s1 c1)] as) )] e) ):xs) = (NN (JSIf i lb c rb [(NN (JSContinue co [(NT (JSLiteral ";") s1 c1)] as) )] e) ):(fixSemis' xs) fixSemis' (x:(NT (JSLiteral "\n") s1 c1):xs) = x:(NT (JSLiteral "\n") s1 c1):(fixSemis' xs) -- TODO: is this needed? fixSemis' ((NN (JSCase ca1 e1 c1 [] ) ):(NN (JSCase ca2 e2 c2 x) ):xs) = (NN (JSCase ca1 e1 c1 [] ) ):fixSemis' ((NN (JSCase ca2 e2 c2 x) ):xs) fixSemis' (x:xs) = x:(NT (JSLiteral ";") tokenPosnEmpty []):fixSemis' xs fixIfElse :: [JSNode] -> [JSNode] fixIfElse [(NN (JSBlock lb xs rb))] = [(NN (JSBlock lb (fixSourceElements xs) rb))] fixIfElse [x] = [(NN (JSBlock [(NT (JSLiteral "{") tokenPosnEmpty [])] (fixSourceElements [x]) [(NT (JSLiteral "}") tokenPosnEmpty [])]))] fixIfElse xs = xs fixFnBlock :: JSNode -> JSNode -- fixFnBlock (NN (JSBlock lb [] rb)) = (NT (JSLiteral ";") tokenPosnEmpty []) fixFnBlock (NN (JSBlock lb xs rb)) = (NN (JSBlock lb (fixSourceElements xs) rb)) fixFnBlock x = fixBlock x fixIfBlock :: [JSNode] -> [JSNode] fixIfBlock xs = case xs' of [(NT (JSLiteral ";") p cs)] -> [] -- rely on fixSemis to add this again [(NT (JSLiteral ";") p cs)] [(NN (JSBlock lb [] rb))] -> [] -- rely on fixSemis to add this again [(NT (JSLiteral ";") tokenPosnEmpty [])] -- [(NN (JSBlock lb [y] rb))] -> [fixBlock y] [(NN (JSBlock lb x2s rb))] -> [(NN (JSBlock lb ((fixSourceElements $ map fixBlock x2s)) rb))] [x] -> fixSourceElements [x] where xs' = stripSemis xs -- Remove extraneous braces around blocks fixBlock :: JSNode -> JSNode fixBlock (NN (JSBlock lb xs rb)) = case xs' of [] -> (NT (JSLiteral ";") tokenPosnEmpty []) -- [(NN (JSExpression [y]))] -> fixBlock (NN (JSExpression [y])) -- [(NN (JSExpression xs))] -> (NN (JSBlock lb (fixSourceElements $ map fixBlock xs') rb)) [x] -> fixBlock x _ -> (NN (JSBlock lb (fixSourceElements $ map fixBlock xs') rb)) where xs' = stripSemis xs 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 _r :: JSNode -> [Char] _r js = map (\x -> chr (fromIntegral x)) $ LB.unpack $ BB.toLazyByteString $ renderJS js --readJs "{{{}}}" _case0 :: JSNode _case0 = undefined -- -- readJs "if(x){}{a=2}" _case1 :: JSNode _case1 = undefined -- _case11 :: [JSNode] _case11 = undefined -- [NN (JSIf (NN (JSExpression [NS (JSIdentifier "x") (SpanPoint {span_filename = "", span_row = 1, span_column = 4})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 4})) (NN (JSStatementBlock (NN (JSStatementList []) (SpanPoint {span_filename = "", span_row = 1, span_column = 6}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 6}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 1}),NN (JSStatementBlock (NN (JSStatementList [NS (JSExpression [NS (JSIdentifier "a") (SpanPoint {span_filename = "", span_row = 1, span_column = 9}),NS (JSOperator "=") (SpanPoint {span_filename = "", span_row = 1, span_column = 10}),NS (JSDecimal "2") (SpanPoint {span_filename = "", span_row = 1, span_column = 11})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 9})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 9}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 8})] _case12 :: JSNode _case12 = undefined -- (NN (JSIf (NN (JSExpression [NS (JSIdentifier "x") (SpanPoint {span_filename = "", span_row = 1, span_column = 4})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 4})) (NT (JSLiteral "") (SpanPoint {span_filename = "", span_row = 1, span_column = 6}))) (SpanPoint {span_filename = "", span_row = 1, span_column = 6})) -- readJs "bob:if(x){}\n{a}" _case2 :: JSNode _case2 = undefined -- NS (JSSourceElementsTop [NS (JSLabelled (NS (JSIdentifier "bob") (SpanPoint {span_filename = "", span_row = 1, span_column = 1})) (NN (JSIf (NN (JSExpression [NS (JSIdentifier "x") (SpanPoint {span_filename = "", span_row = 1, span_column = 8})]) (SpanPoint {span_filename = "", span_row = 1, span_column = 8})) (NN (JSStatementBlock (NN (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}),NN (JSStatementBlock (NN (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 "switch(i){case 1:1;case 2:2}" -- EOF hjsmin-0.1.4.1/test/0000755000000000000000000000000012111226223012300 5ustar0000000000000000hjsmin-0.1.4.1/test/parsingonly/0000755000000000000000000000000012111226224014646 5ustar0000000000000000hjsmin-0.1.4.1/test/parsingonly/120_js.js0000755000000000000000000000532012111226223016204 0ustar0000000000000000/* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1/GPL 2.0/LGPL 2.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * The Original Code is the Narcissus JavaScript engine. * * The Initial Developer of the Original Code is * Brendan Eich . * Portions created by the Initial Developer are Copyright (C) 2004 * the Initial Developer. All Rights Reserved. * * Contributor(s): * * Alternatively, the contents of this file may be used under the terms of * either the GNU General Public License Version 2 or later (the "GPL"), or * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), * in which case the provisions of the GPL or the LGPL are applicable instead * of those above. If you wish to allow use of your version of this file only * under the terms of either the GPL or the LGPL, and not to allow others to * use your version of this file under the terms of the MPL, indicate your * decision by deleting the provisions above and replace them with the notice * and other provisions required by the GPL or the LGPL. If you do not delete * the provisions above, a recipient may use your version of this file under * the terms of any one of the MPL, the GPL or the LGPL. * * ***** END LICENSE BLOCK ***** */ /* * Narcissus - JS implemented in JS. * * Native objects and classes implemented metacircularly: * the global object (singleton) * eval * function objects, Function * * SpiderMonkey extensions used: * catch guards * const declarations * get and set functions in object initialisers * Object.prototype.__defineGetter__ * Object.prototype.__defineSetter__ * Object.prototype.__defineProperty__ * Object.prototype.__proto__ * filename and line number arguments to *Error constructors * callable regular expression objects * * SpiderMonkey extensions supported metacircularly: * catch guards * const declarations * get and set functions in object initialisers */ /* * Loads a file relative to the calling script's (our) source directory, and not * the directory that the executing shell is being run out of. */ function my_load(filename) { evaluate(snarf(filename), filename, 1); } my_load('jsdefs.js'); my_load('jsparse.js'); my_load('jsexec.js'); hjsmin-0.1.4.1/test/parsingonly/123_jsparse.js0000755000000000000000000007574112111226223017260 0ustar0000000000000000/* vim: set sw=4 ts=8 et tw=80: */ /* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1/GPL 2.0/LGPL 2.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * The Original Code is the Narcissus JavaScript engine. * * The Initial Developer of the Original Code is * Brendan Eich . * Portions created by the Initial Developer are Copyright (C) 2004 * the Initial Developer. All Rights Reserved. * * Contributor(s): * * Alternatively, the contents of this file may be used under the terms of * either the GNU General Public License Version 2 or later (the "GPL"), or * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), * in which case the provisions of the GPL or the LGPL are applicable instead * of those above. If you wish to allow use of your version of this file only * under the terms of either the GPL or the LGPL, and not to allow others to * use your version of this file under the terms of the MPL, indicate your * decision by deleting the provisions above and replace them with the notice * and other provisions required by the GPL or the LGPL. If you do not delete * the provisions above, a recipient may use your version of this file under * the terms of any one of the MPL, the GPL or the LGPL. * * ***** END LICENSE BLOCK ***** */ /* * Narcissus - JS implemented in JS. * * Lexical scanner and parser. */ // Build a regexp that recognizes operators and punctuators (except newline). var opRegExpSrc = "^"; for (i in opTypeNames) { if (i == '\n') continue; if (opRegExpSrc != "^") opRegExpSrc += "|^"; opRegExpSrc += i.replace(/[?|^&(){}\[\]+\-*\/\.]/g, "\\$&"); } var opRegExp = new RegExp(opRegExpSrc); // A regexp to match floating point literals (but not integer literals). var fpRegExp = /^\d+\.\d*(?:[eE][-+]?\d+)?|^\d+(?:\.\d*)?[eE][-+]?\d+|^\.\d+(?:[eE][-+]?\d+)?/; function Tokenizer(s, f, l) { this.cursor = 0; this.source = String(s); this.tokens = []; this.tokenIndex = 0; this.lookahead = 0; this.scanNewlines = false; this.scanOperand = true; this.filename = f || ""; this.lineno = l || 1; } Tokenizer.prototype = { get input() { return this.source.substring(this.cursor); }, get done() { return this.peek() == END; }, get token() { return this.tokens[this.tokenIndex]; }, match: function (tt) { return this.get() == tt || this.unget(); }, mustMatch: function (tt) { if (!this.match(tt)) throw this.newSyntaxError("Missing " + tokens[tt].toLowerCase()); return this.token; }, peek: function () { var tt; if (this.lookahead) { tt = this.tokens[(this.tokenIndex + this.lookahead) & 3].type; } else { tt = this.get(); this.unget(); } return tt; }, peekOnSameLine: function () { this.scanNewlines = true; var tt = this.peek(); this.scanNewlines = false; return tt; }, get: function () { var token; while (this.lookahead) { --this.lookahead; this.tokenIndex = (this.tokenIndex + 1) & 3; token = this.tokens[this.tokenIndex]; if (token.type != NEWLINE || this.scanNewlines) return token.type; } for (;;) { var input = this.input; var match = (this.scanNewlines ? /^[ \t]+/ : /^\s+/)(input); if (match) { var spaces = match[0]; this.cursor += spaces.length; var newlines = spaces.match(/\n/g); if (newlines) this.lineno += newlines.length; input = this.input; } if (!(match = /^\/(?:\*(?:.|\n)*?\*\/|\/.*)/(input))) break; var comment = match[0]; this.cursor += comment.length; newlines = comment.match(/\n/g); if (newlines) this.lineno += newlines.length } this.tokenIndex = (this.tokenIndex + 1) & 3; token = this.tokens[this.tokenIndex]; if (!token) this.tokens[this.tokenIndex] = token = {}; if (!input) return token.type = END; if ((match = fpRegExp(input))) { token.type = NUMBER; token.value = parseFloat(match[0]); } else if ((match = /^0[xX][\da-fA-F]+|^0[0-7]*|^\d+/(input))) { token.type = NUMBER; token.value = parseInt(match[0]); } else if ((match = /^\w+/(input))) { var id = match[0]; token.type = keywords[id] || IDENTIFIER; token.value = id; } else if ((match = /^"(?:\\.|[^"])*"|^'(?:[^']|\\.)*'/(input))) { //"){ token.type = STRING; token.value = eval(match[0]); } else if (this.scanOperand && (match = /^\/((?:\\.|[^\/])+)\/([gi]*)/(input))) { token.type = REGEXP; token.value = new RegExp(match[1], match[2]); } else if ((match = opRegExp(input))) { var op = match[0]; if (assignOps[op] && input[op.length] == '=') { token.type = ASSIGN; token.assignOp = GLOBAL[opTypeNames[op]]; match[0] += '='; } else { token.type = GLOBAL[opTypeNames[op]]; if (this.scanOperand && (token.type == PLUS || token.type == MINUS)) { token.type += UNARY_PLUS - PLUS; } token.assignOp = null; } token.value = op; } else { throw this.newSyntaxError("Illegal token"); } token.start = this.cursor; this.cursor += match[0].length; token.end = this.cursor; token.lineno = this.lineno; return token.type; }, unget: function () { if (++this.lookahead == 4) throw "PANIC: too much lookahead!"; this.tokenIndex = (this.tokenIndex - 1) & 3; }, newSyntaxError: function (m) { var e = new SyntaxError(m, this.filename, this.lineno); e.source = this.source; e.cursor = this.cursor; return e; } }; function CompilerContext(inFunction) { this.inFunction = inFunction; this.stmtStack = []; this.funDecls = []; this.varDecls = []; } var CCp = CompilerContext.prototype; CCp.bracketLevel = CCp.curlyLevel = CCp.parenLevel = CCp.hookLevel = 0; CCp.ecmaStrictMode = CCp.inForLoopInit = false; function Script(t, x) { var n = Statements(t, x); n.type = SCRIPT; n.funDecls = x.funDecls; n.varDecls = x.varDecls; return n; } // Node extends Array, which we extend slightly with a top-of-stack method. Array.prototype.__defineProperty__( 'top', function () { return this.length && this[this.length-1]; }, false, false, true ); function Node(t, type) { var token = t.token; if (token) { this.type = type || token.type; this.value = token.value; this.lineno = token.lineno; this.start = token.start; this.end = token.end; } else { this.type = type; this.lineno = t.lineno; } this.tokenizer = t; for (var i = 2; i < arguments.length; i++) this.push(arguments[i]); } var Np = Node.prototype = new Array; Np.constructor = Node; Np.toSource = Object.prototype.toSource; // Always use push to add operands to an expression, to update start and end. Np.push = function (kid) { if (kid.start < this.start) this.start = kid.start; if (this.end < kid.end) this.end = kid.end; return Array.prototype.push.call(this, kid); } Node.indentLevel = 0; function tokenstr(tt) { var t = tokens[tt]; return /^\W/.test(t) ? opTypeNames[t] : t.toUpperCase(); } Np.toString = function () { var a = []; for (var i in this) { if (this.hasOwnProperty(i) && i != 'type') a.push({id: i, value: this[i]}); } a.sort(function (a,b) { return (a.id < b.id) ? -1 : 1; }); const INDENTATION = " "; var n = ++Node.indentLevel; var s = "{\n" + INDENTATION.repeat(n) + "type: " + tokenstr(this.type); for (i = 0; i < a.length; i++) s += ",\n" + INDENTATION.repeat(n) + a[i].id + ": " + a[i].value; n = --Node.indentLevel; s += "\n" + INDENTATION.repeat(n) + "}"; return s; } Np.getSource = function () { return this.tokenizer.source.slice(this.start, this.end); }; Np.__defineGetter__('filename', function () { return this.tokenizer.filename; }); String.prototype.__defineProperty__( 'repeat', function (n) { var s = "", t = this + s; while (--n >= 0) s += t; return s; }, false, false, true ); // Statement stack and nested statement handler. function nest(t, x, node, func, end) { x.stmtStack.push(node); var n = func(t, x); x.stmtStack.pop(); end && t.mustMatch(end); return n; } function Statements(t, x) { var n = new Node(t, BLOCK); x.stmtStack.push(n); while (!t.done && t.peek() != RIGHT_CURLY) n.push(Statement(t, x)); x.stmtStack.pop(); return n; } function Block(t, x) { t.mustMatch(LEFT_CURLY); var n = Statements(t, x); t.mustMatch(RIGHT_CURLY); return n; } const DECLARED_FORM = 0, EXPRESSED_FORM = 1, STATEMENT_FORM = 2; function Statement(t, x) { var i, label, n, n2, ss, tt = t.get(); // Cases for statements ending in a right curly return early, avoiding the // common semicolon insertion magic after this switch. switch (tt) { case FUNCTION: return FunctionDefinition(t, x, true, (x.stmtStack.length > 1) ? STATEMENT_FORM : DECLARED_FORM); case LEFT_CURLY: n = Statements(t, x); t.mustMatch(RIGHT_CURLY); return n; case IF: n = new Node(t); n.condition = ParenExpression(t, x); x.stmtStack.push(n); n.thenPart = Statement(t, x); n.elsePart = t.match(ELSE) ? Statement(t, x) : null; x.stmtStack.pop(); return n; case SWITCH: n = new Node(t); t.mustMatch(LEFT_PAREN); n.discriminant = Expression(t, x); t.mustMatch(RIGHT_PAREN); n.cases = []; n.defaultIndex = -1; x.stmtStack.push(n); t.mustMatch(LEFT_CURLY); while ((tt = t.get()) != RIGHT_CURLY) { switch (tt) { case DEFAULT: if (n.defaultIndex >= 0) throw t.newSyntaxError("More than one switch default"); // FALL THROUGH case CASE: n2 = new Node(t); if (tt == DEFAULT) n.defaultIndex = n.cases.length; else n2.caseLabel = Expression(t, x, COLON); break; default: throw t.newSyntaxError("Invalid switch case"); } t.mustMatch(COLON); n2.statements = new Node(t, BLOCK); while ((tt=t.peek()) != CASE && tt != DEFAULT && tt != RIGHT_CURLY) n2.statements.push(Statement(t, x)); n.cases.push(n2); } x.stmtStack.pop(); return n; case FOR: n = new Node(t); n.isLoop = true; t.mustMatch(LEFT_PAREN); if ((tt = t.peek()) != SEMICOLON) { x.inForLoopInit = true; if (tt == VAR || tt == CONST) { t.get(); n2 = Variables(t, x); } else { n2 = Expression(t, x); } x.inForLoopInit = false; } if (n2 && t.match(IN)) { n.type = FOR_IN; if (n2.type == VAR) { if (n2.length != 1) { throw new SyntaxError("Invalid for..in left-hand side", t.filename, n2.lineno); } // NB: n2[0].type == IDENTIFIER and n2[0].value == n2[0].name. n.iterator = n2[0]; n.varDecl = n2; } else { n.iterator = n2; n.varDecl = null; } n.object = Expression(t, x); } else { n.setup = n2 || null; t.mustMatch(SEMICOLON); n.condition = (t.peek() == SEMICOLON) ? null : Expression(t, x); t.mustMatch(SEMICOLON); n.update = (t.peek() == RIGHT_PAREN) ? null : Expression(t, x); } t.mustMatch(RIGHT_PAREN); n.body = nest(t, x, n, Statement); return n; case WHILE: n = new Node(t); n.isLoop = true; n.condition = ParenExpression(t, x); n.body = nest(t, x, n, Statement); return n; case DO: n = new Node(t); n.isLoop = true; n.body = nest(t, x, n, Statement, WHILE); n.condition = ParenExpression(t, x); if (!x.ecmaStrictMode) { //