language-ecmascript 0.15.2 → 0.15.3
raw patch · 8 files changed
+260/−133 lines, 8 filesdep +wl-pprintdep −prettydep ~HUnitdep ~QuickCheckdep ~containers
Dependencies added: wl-pprint
Dependencies removed: pretty
Dependency ranges changed: HUnit, QuickCheck, containers, directory, filepath, mtl, parsec, template-haskell
Files
- CHANGELOG +7/−0
- language-ecmascript.cabal +17/−16
- src/Language/ECMAScript3/Lexer.hs +70/−17
- src/Language/ECMAScript3/Parser.hs +35/−55
- src/Language/ECMAScript3/PrettyPrint.hs +77/−38
- test/Test/Pretty.hs +47/−4
- test/Test/Unit.hs +3/−2
- test/TestMain.hs +4/−1
CHANGELOG view
@@ -1,5 +1,12 @@ Version change log. +=0.15.3=+Ported the pretty printer to use 'wl-pprint' instead of+'pretty'. Pretty-printed code is now more compact and resembles common+formatting conventions. Fixed bugs where the pretty-printer produced+unparseable source representations for expression statements starting with+'{' or "function". Disabled the QuickCheck pretty-printer test.+ =0.15.2= Fixed an error in the .cabal file that prevented some of the test modules to be packaged.
language-ecmascript.cabal view
@@ -1,5 +1,5 @@ Name: language-ecmascript-Version: 0.15.2+Version: 0.15.3 Cabal-Version: >= 1.10 Copyright: (c) 2007-2012 Brown University, (c) 2008-2010 Claudiu Saftoiu, (c) 2012-2013 Stevens Institute of Technology@@ -29,21 +29,21 @@ Source-repository this type: git location: git://github.com/jswebtools/language-ecmascript.git- tag: 0.15.2+ tag: 0.15.3 Library Hs-Source-Dirs: src Build-Depends: base >= 4 && < 5,- mtl >= 1.1.0.1,- parsec < 3.2.0,- pretty >= 0.1,- containers >= 0.1,+ mtl >= 1 && < 3,+ parsec > 3 && < 3.2.0,+ wl-pprint == 1.*,+ containers == 0.*, uniplate >= 1.6 && <1.7, data-default-class >= 0.0.1 && < 0.1,- QuickCheck >= 2.5,- template-haskell,+ QuickCheck >= 2.5 && < 2.7,+ template-haskell >= 2.8 && < 2.9, Diff == 0.3.* ghc-options: -fwarn-incomplete-patterns@@ -76,18 +76,19 @@ Test.Pretty Build-Depends: base >= 4 && < 5,- mtl >= 1.1.0.1,- parsec < 3.2.0,- pretty >= 0.1,- containers >= 0.1 && < 0.6,- directory,- filepath,- HUnit,- QuickCheck >= 2.5 && < 2.6,+ mtl >= 1 && < 3,+ parsec >= 3 && < 3.2.0,+ wl-pprint == 1.*,+ containers == 0.*,+ directory >= 1.2 && < 1.3,+ filepath >= 1.3 && < 1.4,+ HUnit >= 1.2 && < 1.3,+ QuickCheck >= 2.5 && < 2.7, data-default-class >= 0.0.1 && < 0.1, test-framework >= 0.8 && < 0.9, test-framework-hunit >= 0.3.0 && < 0.4, test-framework-quickcheck2 >= 0.3.0.1 && < 0.4,+ uniplate >= 1.6 && <1.7, Diff == 0.3.*, language-ecmascript Default-Extensions: DeriveDataTypeable, ScopedTypeVariables, DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts
src/Language/ECMAScript3/Lexer.hs view
@@ -3,10 +3,14 @@ -- JavaScript tokens. module Language.ECMAScript3.Lexer(lexeme,identifier,reserved,operator,reservedOp,charLiteral,- stringLiteral,natural,integer,float,naturalOrFloat,- decimal,hexadecimal,octal,symbol,whiteSpace,parens,+ stringLiteral,+-- natural,integer,float,naturalOrFloat,+-- decimal,+-- hexadecimal,octal,+ symbol,whiteSpace,parens, braces,brackets,squares,semi,comma,colon,dot,- identifierStart) where+ identifierStart+ ,hexIntLit,decIntLit, decDigits, decDigitsOpt, exponentPart, decLit) where import Prelude hiding (lex) import Text.Parsec@@ -14,6 +18,8 @@ import Language.ECMAScript3.Parser.State import Language.ECMAScript3.Parser.Type import Control.Monad.Identity+import Control.Applicative ((<$>), (<*>))+import Data.Maybe (isNothing) identifierStart :: Stream s Identity Char => Parser s Char identifierStart = letter <|> oneOf "$_"@@ -56,20 +62,20 @@ charLiteral = T.charLiteral lex stringLiteral :: Stream s Identity Char => Parser s String stringLiteral = T.stringLiteral lex-natural :: Stream s Identity Char => Parser s Integer-natural = T.natural lex -integer :: Stream s Identity Char => Parser s Integer-integer = T.integer lex -float :: Stream s Identity Char => Parser s Double-float = T.float lex-naturalOrFloat :: Stream s Identity Char => Parser s (Either Integer Double)-naturalOrFloat = T.naturalOrFloat lex-decimal :: Stream s Identity Char => Parser s Integer-decimal = T.decimal lex -hexadecimal :: Stream s Identity Char => Parser s Integer-hexadecimal = T.hexadecimal lex -octal :: Stream s Identity Char => Parser s Integer-octal = T.octal lex+-- natural :: Stream s Identity Char => Parser s Integer+-- natural = T.natural lex +-- integer :: Stream s Identity Char => Parser s Integer+-- integer = T.integer lex +-- float :: Stream s Identity Char => Parser s Double+-- float = T.float lex+-- naturalOrFloat :: Stream s Identity Char => Parser s (Either Integer Double)+-- naturalOrFloat = T.naturalOrFloat lex+-- decimal :: Stream s Identity Char => Parser s Integer+-- decimal = T.decimal lex +-- hexadecimal :: Stream s Identity Char => Parser s Integer+-- hexadecimal = T.hexadecimal lex +-- octal :: Stream s Identity Char => Parser s Integer+-- octal = T.octal lex symbol :: Stream s Identity Char => String -> Parser s String symbol = T.symbol lex whiteSpace :: Stream s Identity Char => Parser s ()@@ -92,3 +98,50 @@ brackets = T.brackets lex lexeme :: Stream s Identity Char => Parser s a -> Parser s a lexeme = T.lexeme lex++-- 7.8.3+decIntLit :: Stream s Identity Char => Parser s String+decIntLit = digit >>= \d -> case d of+ '0' -> return [d]+ _ -> (d:) <$> decDigitsOpt++decDigitsOpt :: Stream s Identity Char => Parser s String+decDigitsOpt = many digit++decDigits :: Stream s Identity Char => Parser s String+decDigits = many1 digit++hexIntLit :: Stream s Identity Char => Parser s String+hexIntLit = do try (char '0' >> oneOf "xX")+ many1 hexDigit++exponentPart :: Stream s Identity Char => Parser s String+exponentPart = do ei <- oneOf "eE"+ sgn<- option "" $ oneOf "+-" >>= \x -> return [x]+ si <- decDigits+ return (ei:(sgn++si))++-- data Sign = Plus | Minus++-- signedInteger :: Stream s Identity Char => Parser s (Sign, String)+-- signedInteger = do sgn <- option Plus (char '+' >> return Plus)+-- <|>(char '+' >> return Minus)+-- s <- decDigits+-- return (sgn, s)++-- | returns (s, True) if the number is an integer, an (s, False)+-- otherwise+decLit :: Stream s Identity Char => Parser s (String, Bool)+decLit = + choice [do whole <- decIntLit+ mfrac <- optionMaybe ((:) <$> char '.' <*> decDigitsOpt)+ mexp <- optionMaybe exponentPart+ let isint = isNothing mfrac && isNothing mexp+ return (whole ++ marr mfrac ++ marr mexp, isint)+ ,do frac <- (:) <$> (char '.') <*> decDigits+ exp <- option "" exponentPart+ return ('0':frac++exp, True) + ]++marr (Just ar) = ar+marr Nothing = []
src/Language/ECMAScript3/Parser.hs view
@@ -36,11 +36,12 @@ import Text.Parsec.Expr import Control.Monad(liftM,liftM2) import Control.Monad.Trans (MonadIO,liftIO)-import Numeric(readDec,readOct,readHex)+import Numeric(readDec,readOct,readHex, readFloat) import Data.Char import Control.Monad.Identity import Data.Maybe (isJust, isNothing, fromMaybe) import Control.Monad.Error.Class+import Control.Applicative ((<$>), (<*>)) {-# DEPRECATED ParsedStatement, ParsedExpression, StatementParser, ExpressionParser@@ -219,7 +220,7 @@ parseExpressionStmt:: Stream s Identity Char => StatementParser s parseExpressionStmt = do pos <- getPosition- expr <- parseListExpr -- TODO: spec 12.4?+ expr <- parseExpression -- TODO: spec 12.4? optional semi return $ ExprStmt pos expr @@ -250,7 +251,7 @@ semi test <- optionMaybe parseExpression semi- iter <- optionMaybe parseListExpr+ iter <- optionMaybe parseExpression reservedOp ")" <?> "closing paren" stmt <- parseStatement return $ ForStmt pos init test iter stmt@@ -302,7 +303,7 @@ parseVarDecl = do pos <- getPosition id <- identifier- init <- (reservedOp "=" >> liftM Just parseExpression) <|> return Nothing+ init <- (reservedOp "=" >> liftM Just assignExpr) <|> return Nothing return (VarDecl pos id init) parseVarDeclStmt:: Stream s Identity Char => StatementParser s@@ -381,7 +382,7 @@ parseVarRef = liftM2 VarRef getPosition identifier parseArrayLit:: Stream s Identity Char => ExpressionParser s-parseArrayLit = liftM2 ArrayLit getPosition (squares (parseExpression `sepEndBy` comma))+parseArrayLit = liftM2 ArrayLit getPosition (squares (assignExpr `sepEndBy` comma)) parseFuncExpr :: Stream s Identity Char => ExpressionParser s parseFuncExpr = do@@ -486,65 +487,44 @@ -- much shorter. name <- liftM (\(StringLit p s) -> PropString p s) parseStringLit <|> liftM2 PropId getPosition identifier- <|> liftM2 PropNum getPosition decimal+ <|> liftM2 PropNum getPosition (parseNumber >>= toInt) colon val <- assignExpr return (name,val)+ toInt eid = case eid of+ Left i -> return $ fromIntegral i+ Right d-> unexpected "Floating point number in property name"+ -- ^ Note, the spec actually allows floats in property names.+ -- This is left for legacy reasons and will be fixed in 1.0 in do pos <- getPosition props <- braces (parseProp `sepEndBy` comma) <?> "object literal" return $ ObjectLit pos props --{{{ Parsing numbers. From pg. 17-18 of ECMA-262.-hexLit :: Stream s Identity Char => Parser s (Bool, Double)-hexLit = do- try (char '0' >> oneOf "xX")- digits <- many1 (oneOf "0123456789abcdefABCDEF")- [(hex,"")] <- return $ Numeric.readHex digits- return (True, hex)---- | Creates a decimal value from a whole, fractional and exponent part.-mkDecimal :: Integer -> Integer -> Integer -> Integer -> Double-mkDecimal whole frac fracLen exp = - ((fromInteger whole) + ((fromInteger frac) * (10 ^^ (-fracLen)))) * (10 ^^ exp)--exponentPart :: Stream s Identity Char => Parser s Integer-exponentPart = do- oneOf "eE"- (char '+' >> decimal) <|> (char '-' >> negate `fmap` decimal) <|> decimal+hex :: Stream s Identity Char => Parser s (Either Int Double)+hex = do s <- hexIntLit+ Left <$> wrapReadS Numeric.readHex s ---wrap a parser's result in a Just:-jparser :: Stream s Identity Char => Parser s a -> Parser s (Maybe a)-jparser = liftM Just+decimal :: Stream s Identity Char => Parser s (Either Int Double)+decimal = do (s, i) <- decLit+ if i then Left <$> wrapReadS readDec s+ else Right <$> wrapReadS readFloat s -decLit :: Stream s Identity Char => Parser s (Bool, Double)-decLit = - (do whole <- decimal- mfrac <- option Nothing (jparser (char '.' >> decimal))- mexp <- option Nothing (jparser exponentPart)- if isNothing mfrac && isNothing mexp- then return (True, fromIntegral whole)- else let frac = fromIntegral (fromMaybe 0 mfrac)- in return (False, mkDecimal (fromIntegral whole) frac - (intLen frac)- (fromIntegral (fromMaybe 0 mexp))))- <|>- (do frac <- char '.' >> decimal- exp <- option 0 exponentPart- let ifrac = fromIntegral frac- return (False, mkDecimal 0 ifrac (intLen frac) (fromIntegral exp)))+wrapReadS :: ReadS a -> String -> Parser s a+wrapReadS r s = case r s of+ [(a, "")] -> return a+ _ -> fail "Bad parse: could not convert a string to a Haskell value" -intLen i | i `div` 10 < 1 = 1-intLen i | otherwise = 1 + intLen (i `div` 10)+parseNumber:: Stream s Identity Char => Parser s (Either Int Double) +parseNumber = hex <|> decimal parseNumLit:: Stream s Identity Char => ExpressionParser s-parseNumLit = do- pos <- getPosition- (isint, num) <- lexeme $ hexLit <|> decLit- notFollowedBy identifierStart <?> "whitespace"- if isint- then return $ IntLit pos (round num) - else return $ NumLit pos num-+parseNumLit = do pos <- getPosition+ eid <- lexeme $ parseNumber+ notFollowedBy identifierStart <?> "whitespace"+ return $ case eid of+ Left i -> IntLit pos i+ Right d-> NumLit pos d ------------------------------------------------------------------------------ -- Position Helper@@ -559,7 +539,7 @@ dotRef e = (reservedOp "." >> withPos cstr identifier) <?> "property.ref" where cstr pos = DotRef pos e -funcApp e = parens (withPos cstr (parseExpression `sepBy` comma)) +funcApp e = parens (withPos cstr (assignExpr `sepBy` comma)) <?>"(function application)" where cstr pos = CallExpr pos e @@ -591,7 +571,7 @@ (do pos <- getPosition reserved "new" constructor <- parseSimpleExprForNew Nothing -- right-associativity- arguments <- try (parens (parseExpression `sepBy` comma)) <|> return []+ arguments <- try (parens (assignExpr `sepBy` comma)) <|> return [] return (NewExpr pos constructor arguments)) <|> parseSimpleExpr' @@ -757,11 +737,11 @@ assign <|> return lhs parseExpression:: Stream s Identity Char => ExpressionParser s-parseExpression = assignExpr+parseExpression = parseListExpr -- | A parser that parses ECMAScript expressions expression :: Stream s Identity Char => Parser s (Expression SourcePos)-expression = assignExpr+expression = parseExpression parseListExpr :: Stream s Identity Char => ExpressionParser s parseListExpr = assignExpr `sepBy1` comma >>= \exprs ->
src/Language/ECMAScript3/PrettyPrint.hs view
@@ -6,9 +6,10 @@ ,renderStatements ,renderExpression ,PP (..)+ ,unsafeInExprStmt ) where -import Text.PrettyPrint.HughesPJ+import Text.PrettyPrint.Leijen hiding (Pretty) import Language.ECMAScript3.Syntax import Prelude hiding (maybe, id) @@ -33,43 +34,42 @@ prettyPrint s = case s of BlockStmt _ ss -> asBlock ss EmptyStmt _ -> semi- ExprStmt _ e@(CallExpr _ (FuncExpr {}) _ ) -> - parens (ppExpression True e) <> semi- ExprStmt _ e -> ppExpression True e <> semi+ ExprStmt _ e | unsafeInExprStmt (e) -> parens (ppExpression True e) <> semi+ ExprStmt _ e | otherwise -> ppExpression True e <> semi IfSingleStmt _ test cons -> text "if" <+> - parens (ppExpression True test) $$ - prettyPrint cons- IfStmt _ test cons alt -> text "if" <+> parens (ppExpression True test) $$- prettyPrint cons $$ text "else"- <+> prettyPrint alt+ parens (ppExpression True test) </> + (nest 3 $ prettyPrint cons)+ IfStmt _ test cons alt -> text "if" <+> parens (ppExpression True test) </>+ (nest 3 $ prettyPrint cons) </> text "else"+ <+> (nest 3 $ prettyPrint alt) SwitchStmt _ e cases ->- text "switch" <+> parens (ppExpression True e) $$ - braces (nest 2 (vcat (map prettyPrint cases)))- WhileStmt _ test body -> text "while" <+> parens (ppExpression True test)- $$ prettyPrint body+ text "switch" <+> parens (ppExpression True e) <$>+ braces (nest 3 (vcat (map prettyPrint cases)))+ WhileStmt _ test body -> text "while" <+> parens (ppExpression True test) </>+ prettyPrint body ReturnStmt _ Nothing -> text "return" <> semi ReturnStmt _ (Just e) -> text "return" <+> ppExpression True e <> semi DoWhileStmt _ s e -> - text "do" $$ - (prettyPrint s <+> text "while" <+> parens (ppExpression True e)+ text "do" </> + (prettyPrint s </> text "while" <+> parens (ppExpression True e) <> semi) BreakStmt _ Nothing -> text "break" <> semi BreakStmt _ (Just label) -> text "break" <+> prettyPrint label <> semi ContinueStmt _ Nothing -> text "continue" <> semi ContinueStmt _ (Just label) -> text"continue" <+> prettyPrint label <> semi- LabelledStmt _ label s -> prettyPrint label <> colon $$ prettyPrint s+ LabelledStmt _ label s -> prettyPrint label <> colon </> prettyPrint s ForInStmt p init e body -> text "for" <+> - parens (prettyPrint init <+> text "in" <+> ppExpression True e) $+$ + parens (prettyPrint init <+> text "in" <+> ppExpression True e) </> prettyPrint body ForStmt _ init incr test body -> text "for" <+> parens (prettyPrint init <> semi <+> maybe incr (ppExpression True) <> - semi <+> maybe test (ppExpression True)) $$ + semi <+> maybe test (ppExpression True)) </> prettyPrint body TryStmt _ stmt mcatch mfinally ->- text "try" $$ inBlock stmt $$ ppCatch $$ ppFinally + text "try" </> inBlock stmt </> ppCatch </> ppFinally where ppFinally = case mfinally of Nothing -> empty Just stmt -> text "finally" <> inBlock stmt@@ -78,15 +78,41 @@ Just cc -> prettyPrint cc ThrowStmt _ e -> text "throw" <+> ppExpression True e <> semi WithStmt _ e s -> text "with" <+> parens (ppExpression True e)- $$ prettyPrint s+ </> prettyPrint s VarDeclStmt _ decls -> text "var" <+> cat (punctuate comma (map (ppVarDecl True) decls)) <> semi FunctionStmt _ name args body -> text "function" <+> prettyPrint name <> - parens (cat $ punctuate comma (map prettyPrint args)) $$ + parens (cat $ punctuate comma (map prettyPrint args)) <+> asBlock body +-- | A predicate to tell if the expression --when pretty-printed--+-- will begin with "function" or '{' and be thus unsafe to use in an+-- expression statement without wrapping it in '()'.+unsafeInExprStmt :: Expression a -> Bool+-- property: forall e. unsafeInExprStmt(e) <==> prettyPrint(e) begins+-- with "function" or '{'+unsafeInExprStmt = unsafeInExprStmt_ 15+ where unsafeInExprStmt_ prec e =+ case e of+ ObjectLit {} -> True+ DotRef _ obj _ | prec >= 1 -> unsafeInExprStmt_ 1 obj+ BracketRef _ obj _ | prec > 0 -> unsafeInExprStmt_ 1 obj+ UnaryAssignExpr a op lv | (op `elem` [PostfixInc, PostfixDec])+ && (prec > 3) -> unsafeLv 2 lv+ InfixExpr _ _ l _ | prec >= 5 -> unsafeInExprStmt_ 5 l+ CondExpr _ c _ _ | prec >= 12 -> unsafeInExprStmt_ 12 c+ AssignExpr _ _ lv _ | prec >= 13 -> unsafeLv 2 lv+ ListExpr _ (e:_) | prec >= 14 -> unsafeInExprStmt_ 14 e+ CallExpr _ e _ | prec >= 2 -> unsafeInExprStmt_ 2 e+ FuncExpr {} -> True+ _ -> False+ unsafeLv prec lv = case lv of+ LVar {} -> False+ LDot _ obj _ -> unsafeInExprStmt_ prec obj+ LBracket _ obj _ -> unsafeInExprStmt_ prec obj+ instance Pretty (CatchClause a) where prettyPrint (CatchClause _ id s) = text "catch" <+> (parens.prettyPrint) id <+> inBlock s@@ -116,8 +142,8 @@ instance Pretty (CaseClause a) where prettyPrint c = case c of CaseClause _ e ss -> - text "case" $+$ ppExpression True e <+> colon $$ nest 2 (prettyPrint ss)- CaseDefault _ ss -> text "default:" $$ nest 2 (prettyPrint ss)+ text "case" <+> ppExpression True e <> colon </> nest 2 (prettyPrint ss)+ CaseDefault _ ss -> text "default:" </> nest 2 (prettyPrint ss) instance Pretty InfixOp where prettyPrint op = text $ case op of@@ -173,7 +199,7 @@ instance Pretty (Prop a) where prettyPrint p = case p of PropId _ id -> prettyPrint id- PropString _ str -> doubleQuotes (text (jsEscape str))+ PropString _ str -> dquotes $ text $ jsEscape str PropNum _ n -> text (show n) instance Pretty (Id a) where@@ -194,12 +220,12 @@ -- | DEPRECATED: Use 'prettyPrint' instead! Renders a list of -- statements as a 'String' renderStatements :: [Statement a] -> String-renderStatements = render . prettyPrint+renderStatements = show . prettyPrint -- | DEPRECATED: Use 'prettyPrint' instead! Renders a list of -- statements as a 'String' renderExpression :: Expression a -> String-renderExpression = render . prettyPrint+renderExpression = show . prettyPrint -- Displays the statement in { ... }, unless it is a block itself. inBlock:: Statement a -> Doc@@ -207,8 +233,12 @@ inBlock s = asBlock [s] asBlock :: [Statement a] -> Doc-asBlock ss = lbrace $+$ nest 2 (prettyPrint ss) $$ rbrace+asBlock [] = lbrace <$$> rbrace+asBlock ss = lbrace <> line <> (indentBlock $ prettyPrint ss) <$$> rbrace +indentBlock :: Doc -> Doc+indentBlock = indent 3+ ppVarDecl :: Bool -> VarDecl a -> Doc ppVarDecl hasIn vd = case vd of VarDecl _ id Nothing -> prettyPrint id@@ -256,25 +286,23 @@ NullLit _ -> text "null" BoolLit _ True -> text "true" BoolLit _ False -> text "false"- NumLit _ n -> text (show n)- IntLit _ n -> text (show n)- StringLit _ str -> doubleQuotes (text (jsEscape str))+ NumLit _ n -> double n+ IntLit _ n -> int n+ StringLit _ str -> dquotes $ text $ jsEscape str RegexpLit _ reg g ci -> text "/" <> (text (regexpEscape reg)) <> text "/" <> (if g then text "g" else empty) <> (if ci then text "i" else empty)- ArrayLit _ es -> - brackets $ cat $ punctuate comma (map (ppAssignmentExpression True) es)- ObjectLit _ xs -> - braces (hsep (punctuate comma (map pp' xs))) where- pp' (n,v) = prettyPrint n <> colon <+> ppAssignmentExpression True v+ ArrayLit _ es -> list $ map (ppAssignmentExpression True) es+ ObjectLit _ xs -> encloseSep lbrace rbrace comma $ map ppField xs+ where ppField (f,v)= prettyPrint f <> colon <+> ppAssignmentExpression True v _ -> parens $ ppExpression True e -- 11.2 ppMemberExpression :: Expression a -> Doc ppMemberExpression e = case e of FuncExpr _ name params body -> - text "function" <+> maybe name prettyPrint <+>- parens (cat $ punctuate comma (map prettyPrint params)) $$ + text "function" <+> maybe name (\n -> prettyPrint n <> space) <>+ parens (cat $ punctuate comma (map prettyPrint params)) <+> asBlock body DotRef _ obj id -> ppObjInDotRef obj ppMemberExpression <> text "." <> prettyPrint id BracketRef _ obj key -> @@ -312,11 +340,21 @@ -- 11.4 ppUnaryExpression :: Expression a -> Doc ppUnaryExpression e = case e of- PrefixExpr _ op e' -> prettyPrint op <+> ppUnaryExpression e'+ PrefixExpr _ op e' -> prettyPrint op <> prefixSpace op <> ppUnaryExpression e' UnaryAssignExpr _ PrefixInc e' -> text "++" <> prettyPrint e' UnaryAssignExpr _ PrefixDec e' -> text "--" <> prettyPrint e' _ -> ppPostfixExpression e +prefixSpace :: PrefixOp -> Doc+prefixSpace op = case op of+ PrefixLNot -> empty+ PrefixBNot -> empty+ PrefixPlus -> empty+ PrefixMinus -> empty+ PrefixTypeof -> space+ PrefixVoid -> space+ PrefixDelete -> space+ -- 11.5 ppMultiplicativeExpression :: Expression a -> Doc ppMultiplicativeExpression e = case e of@@ -421,3 +459,4 @@ maybe :: Maybe a -> (a -> Doc) -> Doc maybe Nothing _ = empty maybe (Just a) f = f a+
test/Test/Pretty.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Pretty where import Test.Framework@@ -10,9 +12,16 @@ --import System.Exit import Language.ECMAScript3.SourceDiff import Test.QuickCheck+import Data.List+import Data.Generics.Uniplate.Data+import Control.Applicative+import Data.Default.Class+import Data.Data (Data) tests_pretty :: Test-tests_pretty = testProperty "Parse is the inverse of pretty" prettyParseEquivalence+tests_pretty = testGroup "Pretty-printer tests"+ [testProperty "Parse is the inverse of pretty" prettyParseEquivalence+ ,testProperty "Expressions not safe to print in an Expression Statement" unsafeExprStmtProp] -- main :: IO () -- main = @@ -30,14 +39,48 @@ prettyParseEquivalence :: JavaScript () -> Property prettyParseEquivalence orig =- let pp = show $ prettyPrint orig+ let aor = adaptAST orig+ pp = show $ prettyPrint aor in case parseFromString pp of Left e -> let err = "Can't parse pretty-printed code. The error was: " ++ (show e) ++ "\nThe pretty-printed code in question:\n" ++ pp in whenFail (putStrLn err) False Right parsed ->- let eq = (removeAnnotations parsed) == orig+ let eq = (removeAnnotations parsed) == aor msg ="The parse of the pretty-printed AST didn't match the original\n"- ++"Diff:\n" ++ jsDiff orig (reannotate (const ()) parsed)+ ++"Diff:\n" ++ jsDiff aor (reannotate (const ()) parsed) in whenFail (putStrLn msg) eq++unsafeExprStmtProp :: Expression () -> Bool+unsafeExprStmtProp e =+ let se = show $ prettyPrint e+ actuallyUnsafe = "{" `isPrefixOf` se || "function" `isPrefixOf` se+ oracleUnsafe = unsafeInExprStmt e+ in actuallyUnsafe == oracleUnsafe++-- | Adapt the AST to account for (non-critical) discrepancies between+-- the parser and the pretty-printer.+adaptAST :: JavaScript () -> JavaScript ()+adaptAST = adaptTryBlock . flattenListExpr++adaptTryBlock :: JavaScript () -> JavaScript ()+adaptTryBlock = transformBi adaptTryBlock_+ where adaptTryBlock_ s = case s of+ TryStmt a tb mc mf -> TryStmt a (blockerize tb) (blockerizeCC <$> mc)+ (blockerize <$> mf)+ _ -> s+ blockerize s = case s of+ BlockStmt _ _ -> s+ _ -> BlockStmt () [s]+ blockerizeCC (CatchClause a id s) = CatchClause a id (blockerize s)++flattenListExpr :: JavaScript () -> JavaScript ()+flattenListExpr = transformBi flattenListExpr_+ where flattenListExpr_ :: Expression () -> Expression ()+ flattenListExpr_ e = case e of+ ListExpr a es -> ListExpr a (concatMap gatherExprs es)+ _ -> e+ gatherExprs e = case e of+ ListExpr a es -> es+ _ -> [e]
test/Test/Unit.hs view
@@ -12,6 +12,7 @@ import Language.ECMAScript3.Syntax.Annotations import Language.ECMAScript3.SourceDiff import Control.Monad+import Data.Default.Class tests_unit :: Test@@ -32,7 +33,8 @@ parsePrettyTest filename = readFile filename >>= \src -> case parseFromString src of- Left err -> assertFailure $ "Can't parse a test-case: " ++ filename+ Left err -> assertFailure $ "Can't parse a test-case: " ++ filename +++ "\nThe error was " ++ (show err) Right js -> let str = show $ prettyPrint js in case parseFromString str of Left err ->@@ -46,4 +48,3 @@ let msg = "The parse of the pretty-printed AST didn't match the original\n" ++ "Diff:\n" ++ jsDiff js js' assertFailure msg-
test/TestMain.hs view
@@ -9,4 +9,7 @@ -- entry point for the test-suite main = defaultMain tests -tests = [tests_diff, tests_pretty, tests_unit]+tests = [tests_diff+ ,tests_unit+ --,tests_pretty -- disabled the pretty tests until version 1.0+ ]