Rewritten the pretty-printer using wl-pprint + fixed bugs in pretty-p…

…rinting of expression statements

CHANGELOG

@@ -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".
+
 =0.15.2=
 Fixed an error in the .cabal file that prevented some of the test modules
 to be packaged.

language-ecmascript.cabal

@@ -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
@@ -38,7 +38,7 @@ Library
     base >= 4 && < 5,
     mtl >= 1.1.0.1,
     parsec < 3.2.0,
-    pretty >= 0.1,
+    wl-pprint == 1.*,
     containers >= 0.1,
     uniplate >= 1.6 && <1.7,
     data-default-class >= 0.0.1 && < 0.1,
@@ -78,7 +78,7 @@ Test-Suite test
     base >= 4 && < 5,
     mtl >= 1.1.0.1,
     parsec < 3.2.0,
-    pretty >= 0.1,
+    wl-pprint == 1.*,
     containers >= 0.1 && < 0.6,
     directory,
     filepath,

src/Language/ECMAScript3/PrettyPrint.hs

@@ -6,9 +6,10 @@ module Language.ECMAScript3.PrettyPrint (Pretty (..)
                                         ,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 @@ instance Pretty (Statement a) where
   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 @@ instance Pretty (Statement a) where
               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 (VarDecl a) where
 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 PrefixOp where
 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,20 +220,24 @@ javaScript = prettyPrint
 -- | 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
 inBlock s@(BlockStmt _ _) = prettyPrint s
 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
@@ -256,25 +286,23 @@ ppPrimaryExpression e = case e of
   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,7 +340,7 @@ ppPostfixExpression e = case e of
 -- 11.4
 ppUnaryExpression :: Expression a -> Doc
 ppUnaryExpression e = case e of
-  PrefixExpr _ op e' -> prettyPrint op <+> ppUnaryExpression e'
+  PrefixExpr _ op e' -> prettyPrint op <> ppUnaryExpression e'
   UnaryAssignExpr _ PrefixInc e' -> text "++" <> prettyPrint e'
   UnaryAssignExpr _ PrefixDec e' -> text "--" <> prettyPrint e'
   _ -> ppPostfixExpression e
@@ -421,3 +449,4 @@ ppExpression hasIn e = case e of
 maybe :: Maybe a -> (a -> Doc) -> Doc
 maybe Nothing  _ = empty
 maybe (Just a) f = f a
+

test/Test/Pretty.hs

@@ -10,9 +10,12 @@ import Language.ECMAScript3.Syntax.Annotations
 --import System.Exit
 import Language.ECMAScript3.SourceDiff
 import Test.QuickCheck
+import Data.List
 
 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 = 
@@ -41,3 +44,10 @@ prettyParseEquivalence orig =
           msg ="The parse of the pretty-printed AST didn't match the original\n"
                ++"Diff:\n" ++ jsDiff orig (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