packages feed

js-good-parts (empty) → 0.0.1

raw patch · 5 files changed

+907/−0 lines, 5 filesdep +basedep +wl-pprintsetup-changed

Dependencies added: base, wl-pprint

Files

+ LICENSE view
@@ -0,0 +1,31 @@+See the AUTHORS file for a list of copyright holders.++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 the copyright holders 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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ js-good-parts.cabal view
@@ -0,0 +1,29 @@+Name:                js-good-parts+Version:             0.0.1+Cabal-Version:       >= 1.6+Synopsis:            Javascript: The Good Parts -- AST & Pretty Printer+Category:            Language, Javascript+Description:+  An AST for the "the good parts" of Javascript (as defined by Douglas Crockford) +  and a pretty printer for that AST. Designed to be the target of a code generator.+  Does not include a parser.++Author:              Sean Seefried+Maintainer:          sean.seefried@gmail.com+Homepage:            http://github.com/sseefried/js-good-parts.git+Copyright:           (c) by Sean Seefried+License:             BSD3 +License-File:        LICENSE+Stability:           experimental+build-type:          Simple+Source-Repository head+    type:         git+    location:     git://github.com/sseefried/js-tgp.git++Library+  hs-Source-Dirs:      src+  Build-Depends:       base >=4 && < 5,+                       wl-pprint >= 1.1++  Exposed-Modules:    Language.JavaScript.AST+                      Language.JavaScript.Pretty
+ src/Language/JavaScript/AST.hs view
@@ -0,0 +1,473 @@+{-# OPTIONS_GHC -Wall #-}+--+-- Module: Language.Javascript.AST+-- Author: Sean Seefried+--+-- © 2012+--+-- In Chapter 2 of "JavaScript: The Good Parts", Douglas Crockford presents a+-- concrete grammar for "the good parts" of JavaScript.+--+-- This module provides an abstract grammar for those good parts. We will abbreviate this+-- language to JS:TGP+--+-- Crockford presents the grammar as a series of railroad diagrams.+-- The correspondence between the concrete grammar and the abstract grammar+-- in this module is NOT one-to-one. However, the following property does hold: the+-- pretty printing of an abstract syntax tree will be parseable by the concrete grammar. i.e.+-- For each valid program produced by the concrete grammar there is a corresponding+-- abstract syntax tree that when pretty printed will produce that program (modulo whitespace).+--+-- The abstract grammar:+--   * removes unnecessary characters such as parentheses (normal, curly and square)+--   * represents JavaScript's string, name and number literals directly in Haskell as+--     'String', 'String' and 'Double' respectively.+--+-- Conventions for concrete syntax:+--  -  Non-terminals appear in angle brackets e.g. <JSName>+--  -  ? means zero or one. e.g. <JSExpression>?+--  -  * means zero or more e.g. <JSStatement>*+--  -  + means one  or more e.g. <JSStatement>++--  -  \( \) are meta-brackets used to enclose a concrete-syntax expression so that ?,* or ++--     can be applied. e.g. \(= <JSExpression>\)*+--     This means zero or more repetitions of: = <JsExpression>+--+-- The data structure ensures no incorrect JS:TGP programs+-- -------------------------------------------------------+-- This library was designed so that it would be impossible, save for name, string literals+-- to construct an incorrect JS:TGP program.+--+-- To this end some of the data structures may look like they contain redundancy.+-- For instance, consider the 'JSESDelete' constructor which is defined+--+-- JSESDelete JSExpression JSInvocation+--+-- Why not just define it as 'JSESDelete JSExpression' since type 'JSExpression'+-- has a constructor defined as 'JSExpressionInvocation JSExpression JSInvocation'?+-- The reason is that this would allow incorrect programs. A 'JSExpression' is+-- not necessarily an invocation.+--+-- However, even though none of the programs are incorrect there are still some things+-- it cannot check for. Although labels can appear before any statement, they should+-- only be used on statements that interact with a switch, while, do, or for statement.+-- This cannot be checked except by a second pass over the AST. This library does not+-- provide this functionality.+--+-- A note on precedence of JavaScript operators+-- --------------------------------------------+-- Interestingly, the precedence of JavaScript operators is+-- not defined in the ECMAScript standard. The precedence used in this library comes from+-- the Mozilla Developer's Network pages.+-- (https://developer.mozilla.org/en/JavaScript/Reference/Operators/Operator_Precedence)+--+-- I have not used the precise precedence numbers from that page since in this module+-- a lower precedence means the operator binds more tightly (as opposed to the page where+-- a higher precedence does the same). Also, we have need for less precedence values so they+-- have been normalised to what we are using in JS:TGP+--+-- You will also note that we don't even consider the associativity/precedence of+-- "=", "+=", "-=" etc. In JS:TGP the notion of expression statements is quite different+-- to that of expressions. It simply isn't legal to write an expression statement like+--+--  (a += 2) -= 3+--    OR+--  a = (b = c) = (c = d)+--+-- although it is perfectly legal to write+--+--  a = b = c = d += 2+--+-- which if we add brackets to disambiguate is really+--+-- a = (b = (c = (d += 2)))+--+--+-- Interesting aspects of "the good parts"+-- ---------------------------------------+--+-- A JS:TGP program is a collection of statements. You'll note that there is no+-- statement to declare a function in JS:TGP. However you can assign a function literal+-- to a variable.+--+-- e.g. var fun = function(x) { return x + 1;}+--+-- What about recursive functions then? There is the option to give the function a name which is+-- local to the literal.+--+-- e.g. var factorial = function f(n) {+--                        if ( n > 0 ) {+--                          return n * f(n - 1);+--                        } else {+--                          return 1;+--                        }+--                      }+--+-- 'f' is local. It will not be in scope outside of the function body.+--+module Language.JavaScript.AST (+  -- JSString, JSName can't be create except with constructors+  JSString, JSName, +  unJSString, unJSName,+  jsString, jsName,+   +  -- Data types+  JSNumber(..),+  JSVarStatement(..), JSVarDecl(..), JSStatement(..),+  JSDisruptiveStatement(..), JSIfStatement(..), JSSwitchStatement(..),+  JSCaseAndDisruptive(..), JSCaseClause(..), JSForStatement(..),+  JSDoStatement(..), JSWhileStatement(..), JSTryStatement(..),+  JSThrowStatement(..), JSReturnStatement(..), JSBreakStatement(..),+  JSExpressionStatement(..), JSLValue(..), JSRValue(..), JSExpression(..),+  JSPrefixOperator(..), JSInfixOperator(..), JSInvocation(..), JSRefinement(..),+  JSLiteral(..), JSObjectLiteral(..), JSObjectField(..), JSArrayLiteral(..),+  JSFunctionLiteral(..), JSFunctionBody(..), JSProgram(..)+) where++import Language.JavaScript.NonEmptyList+++data JSName = JSName { unJSName :: String }++--+-- The only way you can create a JSName+--+jsName :: String -> Either String JSName+jsName = Right . JSName -- FIXME: Return Left on error.++data JSString = JSString { unJSString :: String }++--+-- The only way you can create a Javascript string.+-- This function needs to correctly encode all special characters.+-- See p9 of "JavaScript: The Good Parts"+--+jsString :: String -> Either String JSString +jsString = Right . JSString -- FIXME: Return Left on error+++newtype JSNumber = JSNumber Double -- 64 bit floating point number++--+-- Concrete syntax: var <VarDecl> [, <VarDecl>]* ;+--+-- e.g. var x = 1, y;+--+data JSVarStatement = JSVarStatement (NonEmptyList JSVarDecl)++--+-- | Concrete syntax:+--   1. <JSName> \(= <JSExpression>\)?+--+-- e.g.+-- 1. x+-- 2. x = 2 + y+--+data JSVarDecl = JSVarDecl JSName (Maybe JSExpression) -- optional initialization++--+-- | The many different kinds of statements+--+data JSStatement+  = JSStatementExpression   JSExpressionStatement -- ^ syntax: <JSExpressionStatement>;+  | JSStatementDisruptive  JSDisruptiveStatement -- ^ syntax: <JSDisruptiveStatement>+  | JSStatementTry         JSTryStatement        -- ^ syntax: <JSTryStatement>+  | JSStatementIf          JSIfStatement         -- ^ syntax: <JSIfStatement>+  -- | syntax: \(<JSName> : \) <JSSwitchStatement>+  | JSStatementSwitch      (Maybe JSName) JSSwitchStatement+  -- | syntax: \(<JSName> : \) <JSWhileStatement>+  | JSStatementWhile       (Maybe JSName) JSWhileStatement+  -- | syntax: \(<JSName> : \) <JSForStatement>+  | JSStatementFor         (Maybe JSName) JSForStatement+  -- | syntax: \(<JSName> : \) <JSDoStatement>+  | JSStatementDo          (Maybe JSName) JSDoStatement++--+-- | Disruptive statements+--+data JSDisruptiveStatement+  = JSDSBreak   JSBreakStatement  -- syntax: <JSBreakStatement>+  | JSDSReturn  JSReturnStatement -- syntax: <JSReturnStatement>+  | JSDSThrow   JSThrowStatement  -- syntax: <JSThrowStatement>++--+-- | Concrete syntax:+--   if ( <JSExpression> ) { <JSStatement>* }                         -- for 'Nothing'+--     OR+--   if ( <JSExpression> ) { <JSStatement>* } else { <JSStatement>* } -- for 'Just . Left'+--     OR+--   if ( <JSExpression> ) { <JSStatement>* } else <JSIfStatement>    -- for 'Just . Right'+--+--   e.g.+--   if (x > 3) { y = 2; }+--     OR+--   if (x < 2) { y = 1; } else { y = 3; z = 2; }+--     OR+--   if (x > 0) { y = 20; } else if ( x > 10) { y = 30; } else { y = 10; }+--+data JSIfStatement = JSIfStatement JSExpression [JSStatement] (Maybe (Either [JSStatement] JSIfStatement))++--+-- | Concrete syntax:+--   switch ( <Expression> ) { <JSCaseClause> }+--     OR+--   switch ( <Expression> ) { <JSCaseAndDisruptive>++--                             default : <JSStatement>* }+--   e.g.+--   1. switch ( x ) {+--        case 1:+--          y = 2;+--      }+--   2. switch ( x ) {+--        case 1:+--          y = 2;+--          break;+--        case 2:+--           y = 3;+--           break;+--        default:+--           y = 4;+--      }+--+data JSSwitchStatement+  = JSSwitchStatementSingleCase JSExpression JSCaseClause+  | JSSwitchStatement           JSExpression+                                (NonEmptyList JSCaseAndDisruptive) -- non-default case clauses+                                [JSStatement]                 -- default clause statements++--+-- | A case clause followed by a disruptive statement+--+--   Concrete syntax:+--     <JSCaseClause> <JSDisruptiveStatement>+--   e.g.+--   1. case 2:+--        y = 2;+--        break;+--+data JSCaseAndDisruptive = JSCaseAndDisruptive JSCaseClause JSDisruptiveStatement++--+-- | Concrete syntax:+--   case <JSExpression> : <JSStatement>*+--+--   e.g.+--   1. case 2:   // zero statements following the case expression is valid.+--   2. case 2:+--        y = 1;+--+data JSCaseClause = JSCaseClause JSExpression [JSStatement]++--+-- | Two style of for-statements -- C-style and In-style.+--+--   Concrete syntax:+--+--   1. for (<JSExpressionStatement>? ; <JSExpression>? ; <JSExpressionStatement>? ) {+--        <JSStatement>*+--      }+--   2. for ( <JSName> in <JSExpression> ) {+--        <JSStatement>*+--      }+--+--   e.g.+--   1. for ( ; ; ) { }+--   2. for ( ; x < 10 ;) { x += 1; }+--   3. for (i = 0; i < 10; i += 1) {+--         x += i;+--      }+--   4. for ( i in indices ) { a[i] = 66; }+--+data JSForStatement = JSForStatementCStyle+                        (Maybe JSExpressionStatement) -- initialization+                        (Maybe JSExpression)          -- condition+                        (Maybe JSExpressionStatement) -- increment+                        [JSStatement]                 -- body+                    | JSForStatementInStyle+                        JSName+                        JSExpression+                        [JSStatement]++--+-- | Concrete syntax:+--     do { <JSStatement>* } while ( <JSExpression> );+--+data JSDoStatement = JSDoStatement [JSStatement] JSExpression++--+-- | Concrete syntax:+--     while ( <JSExpression>) { <JSStatement>* }+--+data JSWhileStatement = JSWhileStatement JSExpression [JSStatement]++--+-- | Concrete syntax:+--     try { <JSStatement>* } catch ( <JSName> ) { <JSStatement>* }+--+data JSTryStatement = JSTryStatement [JSStatement] JSName [JSStatement]++--+-- | Concrete syntax:+--     throw <JSExpression>;+--+data JSThrowStatement = JSThrowStatement JSExpression++--+-- | Concrete syntax:+--     return <JSExpression>?;+--   e.g.+--   1. return;+--   2. return 2 + x;+--+data JSReturnStatement = JSReturnStatement (Maybe JSExpression)++--+-- | Concrete syntax:+--     break <JSName>?;+--   e.g.+--   1. break;+--   2. break some_label;+--+data JSBreakStatement = JSBreakStatement (Maybe JSName)++--+-- | Concrete syntax:+--+--++data JSExpressionStatement+  = JSESApply (NonEmptyList JSLValue) JSRValue+  | JSESDelete JSExpression JSRefinement++--+-- | Concrete syntax:+--     <JSName> \(<JSInvocation>* <JSRefinement>\)*+--   e.g.+--   1. x+--   2. x.field_1+--   3. fun().field_1+--   4. fun(1)(2)+--   5. fun(1)(2).field_1+--   5. x.fun_field_1(x+2).fun_field_2(y+3).field_3+--+data JSLValue = JSLValue JSName [([JSInvocation], JSRefinement)]++--+-- | Concrete syntax:+--   1. =  <JSExpression>+--   2. += <JSExpression>+--   3. -= <JSExpression>+--   4. <JSInvocation>++--+--   e.g.+--   1. = 2+--   2. += 3+--   3. -= (4 + y)+--   4a. ()+--   4b. (1)+--   4c. (x,y,z)+--+data JSRValue+  = JSRVAssign    JSExpression+  | JSRVAddAssign JSExpression+  | JSRVSubAssign JSExpression+  | JSRVInvoke    (NonEmptyList JSInvocation)++data JSExpression = JSExpressionLiteral    JSLiteral+                  | JSExpressionName       JSName+                  | JSExpressionPrefix     JSPrefixOperator JSExpression+                  | JSExpressionInfix      JSInfixOperator  JSExpression JSExpression+                  | JSExpressionTernary    JSExpression     JSExpression JSExpression+                  | JSExpressionInvocation JSExpression     JSInvocation+                  | JSExpressionRefinement JSExpression     JSRefinement+                  | JSExpressionNew        JSExpression     JSInvocation+                  | JSExpressionDelete     JSExpression     JSRefinement++data JSPrefixOperator+  = JSTypeOf   -- syntax: typeof+  | JSToNumber -- syntax: ++  | JSNegate   -- syntax: -+  | JSNot      -- syntax: !++data JSInfixOperator+  = JSMul  -- syntax: *+  | JSDiv  -- syntax: /+  | JSMod  -- syntax: %+  | JSAdd  -- syntax: ++  | JSSub  -- syntax: -+  | JSGTE  -- syntax: >=+  | JSLTE  -- syntax: <=+  | JSGT   -- syntax: >+  | JSLT   -- syntax: <+  | JSEq   -- syntax: ===+  | JSNotEq-- syntax: !==+  | JSOr   -- syntax: ||+  | JSAnd  -- syntax: &&++--+-- | Concrete syntax:+--     <JSExpression>*+--   e.g.+--   1. ()+--   2. (1)+--   3. (x,z,y)+--+data JSInvocation = JSInvocation [JSExpression]++--   e.g.+--   1. .field_1+--   2. [i+1]+--+data JSRefinement+  -- | syntax: .<JSName>+  --   e.g. .field_1+  = JSProperty  JSName+  -- | syntax: [<JSExpression>]+  --   e.g. [x+3]+  | JSSubscript JSExpression++data JSLiteral+  = JSLiteralNumber   JSNumber+  | JSLiteralString   JSString+  | JSLiteralObject   JSObjectLiteral+  | JSLiteralArray    JSArrayLiteral+  | JSLiteralFunction JSFunctionLiteral+--  | JSLiteralRegexp   JSRegexpLiteral -- TODO: Add regexps++--+-- | Concrete syntax:+--   1. {}                                          // no  fields+--   2. {<JSObjectField> \(, <JSObjectField> \)*}   // one or more fields+--+data JSObjectLiteral = JSObjectLiteral [JSObjectField]++--+-- | Concrete syntax:+--   1. <JSName>: <JSExpression>      // for Left+--   2. <JSString>: <JSExpression>     // for Right+--+--   e.g.+--   1. x: y + 3+--   2. "value": 3 - z+--+data JSObjectField  = JSObjectField (Either JSName JSString) JSExpression++--+-- | Concrete syntax:+--   1. []                             // empty array+--   2. [<JSExpression> \(, <JSExpression>*\) ]+--+data JSArrayLiteral = JSArrayLiteral [JSExpression]++--+-- | Concrete syntax:+--   function <JSName>? <JSFunctionBody>+--+data JSFunctionLiteral = JSFunctionLiteral (Maybe JSName) [JSName] JSFunctionBody++--+-- | Concrete syntax:+--   { <JSVarStatement>+ <JSStatement>+ }+--+data JSFunctionBody = JSFunctionBody [JSVarStatement] [JSStatement]++data JSProgram = JSProgram [JSVarStatement] [JSStatement]
+ src/Language/JavaScript/Pretty.hs view
@@ -0,0 +1,372 @@+module Language.JavaScript.Pretty where++-- System libraries+import Text.PrettyPrint.Leijen+import Text.PrettyPrint.Leijen.PrettyPrec++-- friends+import Language.JavaScript.AST+import Language.JavaScript.NonEmptyList++-- FIXME: This will be a little tricky to get right.+instance Pretty JSString where+  pretty s = char '"' <> text (unJSString s) <> char '"' -- enclosed in double quotes++instance Pretty JSName where+  pretty = text . unJSName++sepWith :: Pretty a => Doc -> [a] -> Doc+sepWith s = encloseSep empty empty s . map pretty++endWith :: Pretty a => Doc -> [a] -> Doc+endWith s xs = sepWith s xs <> s++sepWith' :: Pretty a => Doc -> NonEmptyList a -> Doc+sepWith' s = encloseSep empty empty s . map pretty . toList++endWith' :: Pretty a => Doc -> NonEmptyList a -> Doc+endWith' s xs = sepWith' s xs <> s++prettyBlock :: Pretty a => [a] -> Doc+prettyBlock stmts = lbrace <$> indent 2 (endWith (semi <$> empty) stmts) <$> rbrace++------------------------------------------------------------------------+--+-- Associativity+--++data Associativity = LeftToRight | RightToLeft deriving Eq+type Fixity = (Associativity, Int)++assoc :: Associativity -> Int -> Fixity+assoc ass n = (ass, n)++leftToRight, rightToLeft :: Int -> Fixity++leftToRight = assoc LeftToRight+rightToLeft = assoc RightToLeft+++prettyInfixOpApp :: (PrettyPrec a, PrettyPrec b) => Int ->  OpInfo -> a -> b -> Doc+prettyInfixOpApp prec (OpInfo opPrec assoc name) a b =+  docParen (prec > opPrec) $ bump LeftToRight a <+> text name <+> bump RightToLeft b+  where+    bump assoc' d = prettyPrec opPrec' d+      where opPrec' = if assoc == assoc' then opPrec else opPrec + 1++-- LAST: Check that bump works in 'prettyInfixOpApp' and do the right thing for prefix ops.+--+prettyPrefixOpApp :: PrettyPrec a => Int -> OpInfo -> a -> Doc+prettyPrefixOpApp prec (OpInfo opPrec assoc name) a =+  text name <> docParen (prec > opPrec) (prettyPrec prec a)+++docParen :: Bool -> Doc -> Doc+docParen True  = parens+docParen False = id++data OpInfo = OpInfo Int           -- recedence+                     Associativity -- associativity+                     String        -- name+--+-- FIXME: What about the associativity of +=, -=, etc. It's not defined in your+-- grammar. How will you handle it? Is it even defined in JS:TGP? Answer this question+-- and then write a note about it.+--++--+-- Lower precedence means the operatorbinds more tightly+--+infixOpInfo :: JSInfixOperator -> OpInfo+infixOpInfo op = case op of+  JSMul   -> go 6 "*"+  JSDiv   -> go 6 "/"+  JSMod   -> go 6 "%"+  JSAdd   -> go 5 "+"+  JSSub   -> go 5 "-"+  JSGTE   -> go 4 ">="+  JSLTE   -> go 4 "<="+  JSGT    -> go 4 ">"+  JSLT    -> go 4 "<"+  JSEq    -> go 3 "==="+  JSNotEq -> go 3 "!=="+  JSOr    -> go 1 "||"+  JSAnd   -> go 2 "&&"+ where go i s = OpInfo i LeftToRight s++prefixOpInfo :: JSPrefixOperator -> OpInfo+prefixOpInfo op = case op of+  JSTypeOf   -> go 7 "typeof"+  JSToNumber -> go 7 "+"+  JSNegate   -> go 7 "-"+  JSNot      -> go 7 "!"+  where go i s = OpInfo i RightToLeft s++-----------------------------------------------------------------------++instance Pretty JSNumber where+  pretty (JSNumber n) = pretty n -- FIXME: Make sure this always produce valid Javascript numbers.++instance PrettyPrec JSNumber -- default++instance Pretty JSVarStatement where+  pretty (JSVarStatement varDecls) = sepWith' (text ", ") varDecls++instance PrettyPrec JSVarStatement -- default++instance Pretty JSVarDecl where+  pretty (JSVarDecl nm Nothing)    = pretty nm+  pretty (JSVarDecl nm (Just exp)) = pretty nm <+> text "=" <+> pretty exp++instance PrettyPrec JSVarDecl -- default++instance Pretty JSStatement where+  pretty stmt = case stmt of+    (JSStatementExpression  es)  -> pretty es <> semi+    (JSStatementDisruptive  ds)  -> pretty ds+    (JSStatementTry         ts)  -> pretty ts+    (JSStatementIf          is)  -> pretty is+    (JSStatementSwitch mbLbl ss) -> pp mbLbl ss+    (JSStatementWhile  mbLbl ws) -> pp mbLbl ws+    (JSStatementFor    mbLbl fs) -> pp mbLbl fs+    (JSStatementDo     mbLbl ds) -> pp mbLbl ds+    where+      pp :: Pretty a => Maybe JSName -> a -> Doc+      pp (Just label) doc = pretty label <> colon <+> pretty doc+      pp Nothing      doc = pretty doc++instance PrettyPrec JSStatement-- default++instance Pretty JSDisruptiveStatement where+  pretty stmt = case stmt of+    JSDSBreak  bs -> pretty bs+    JSDSReturn rs -> pretty rs+    JSDSThrow  ts -> pretty ts++instance PrettyPrec JSDisruptiveStatement -- default++instance Pretty JSIfStatement where+  pretty (JSIfStatement cond thenStmts blockOrIf) =+    text "if" <+> parens (pretty cond) <+> prettyBlock thenStmts <+> ppRest+    where+      ppRest = case blockOrIf of+        Nothing               -> empty+        Just (Left elseStmts) -> text "else" <+> prettyBlock elseStmts+        Just (Right ifStmt)   -> pretty ifStmt++instance PrettyPrec JSIfStatement -- default++instance Pretty JSSwitchStatement where+  pretty (JSSwitchStatementSingleCase cond caseClause) =+    text "switch" <+> parens (pretty cond) <+> lbrace <$> pretty caseClause <$> rbrace+  pretty (JSSwitchStatement cond cds stmts) =+    text "switch" <+> parens (pretty cond) <+> lbrace <$>+      indent 2 (vcat (toList . fmap pretty $ cds) <$>+               (text "default:" <$>+                  indent 2 (endWith semi stmts))) <$>+    rbrace++instance PrettyPrec JSSwitchStatement -- default++instance Pretty JSCaseAndDisruptive where+  pretty (JSCaseAndDisruptive caseClause disruptive) =+    pretty caseClause <$> pretty disruptive++instance PrettyPrec JSCaseAndDisruptive -- default++instance Pretty JSCaseClause where+  pretty (JSCaseClause exp stmts) =+    text "case" <+> pretty exp <> colon <+> endWith semi stmts++instance PrettyPrec JSCaseClause -- default++instance Pretty JSForStatement where+  pretty (JSForStatementCStyle init cond incr stmts) =+    text "for" <+> parens (pretty init <> semi <+> pretty cond <> semi <+>+                           pretty incr) <+> prettyBlock stmts++instance PrettyPrec JSForStatement -- default++instance Pretty JSDoStatement where+  pretty (JSDoStatement stmts cond) =+    text "do" <+> prettyBlock stmts <+> text "while" <+>+      parens (pretty cond) <> semi++instance PrettyPrec JSDoStatement -- default++instance Pretty JSWhileStatement where+  pretty (JSWhileStatement cond stmts) =+    text "while" <+> parens (pretty cond) <+> prettyBlock stmts++instance PrettyPrec JSWhileStatement -- default++instance Pretty JSTryStatement where+  pretty (JSTryStatement tryStmts varName catchStmts) =+    text "try" <+> prettyBlock tryStmts <+> parens (pretty varName) <+> prettyBlock catchStmts++instance PrettyPrec JSTryStatement -- default++instance Pretty JSThrowStatement where+  pretty (JSThrowStatement exp) =+    text "throw" <+> pretty exp <> semi++instance PrettyPrec JSThrowStatement -- default++instance Pretty JSReturnStatement where+  pretty (JSReturnStatement mbExp) = case mbExp of+    Nothing  -> text "return;"+    Just exp -> text "return" <+> pretty exp <> semi++instance PrettyPrec JSReturnStatement -- default++instance Pretty JSBreakStatement      where+  pretty (JSBreakStatement mbExp) = case mbExp of+    Nothing  -> text "break;"+    Just exp -> text "break" <+> pretty exp <> semi++instance PrettyPrec JSBreakStatement -- default++instance Pretty JSExpressionStatement where+  pretty (JSESApply lvalues rvalue) =+    sepWith' (space <> text "=" <> space) lvalues <+> pretty rvalue+  pretty (JSESDelete exp refine) =+    text "delete" <+> pretty exp <> pretty refine++instance PrettyPrec JSExpressionStatement -- default++instance Pretty JSLValue              where+  pretty (JSLValue name invsAndRefines) = pretty name <> (hcat . map ppIR $ invsAndRefines)+    where+      ppIR (invs, refine) = (hcat . map pretty $ invs) <> pretty refine++instance PrettyPrec JSLValue -- default++instance Pretty JSRValue              where+  pretty rvalue = case rvalue of+    JSRVAssign e    -> text "="  <+> pretty e+    JSRVAddAssign e -> text "+=" <+> pretty e+    JSRVSubAssign e -> text "-=" <+> pretty e+    JSRVInvoke invs -> hcat . toList . fmap pretty $ invs++instance PrettyPrec JSRValue -- default++instance Pretty JSExpression          where+  pretty = prettyPrec 0++instance PrettyPrec JSExpression where+  prettyPrec i exp = case exp of+    JSExpressionLiteral literal      -> pretty literal+    JSExpressionName name            -> pretty name+    JSExpressionPrefix prefixOp e    -> pretty prefixOp <> pretty e+    JSExpressionInfix infixOp e e'   -> prettyInfixOpApp i (infixOpInfo infixOp) e e'+    JSExpressionTernary cond thn els ->+      pretty cond <+> char '?' <+> pretty thn <+> colon <+> pretty els+    JSExpressionInvocation e i       -> pretty e <> pretty i+    JSExpressionRefinement e r       -> pretty e <> pretty r+    JSExpressionNew e i              -> text "new" <+> pretty e <> pretty i+    JSExpressionDelete e r           -> text "new" <+> pretty e <> pretty r++instance Pretty JSPrefixOperator      where+  pretty op = case op of+    JSTypeOf   -> text "typeof" <+> empty+    JSToNumber -> char '+'+    JSNegate   -> char '-'+    JSNot      -> char '!'++instance PrettyPrec JSPrefixOperator --default++instance Pretty JSInfixOperator where+  pretty = prettyPrec 0++instance PrettyPrec JSInfixOperator where+  prettyPrec = error "we never print an operator by itself"++instance Pretty JSInvocation          where+  pretty = error "undefined"++instance PrettyPrec JSInvocation -- default++instance Pretty JSRefinement          where+  pretty (JSProperty name) = char '.' <> pretty name+  pretty (JSSubscript e)   = char '[' <> pretty e <> char ']'++instance PrettyPrec JSRefinement -- default++instance Pretty JSLiteral             where+  pretty lit = case lit of+    JSLiteralNumber n   -> pretty n+    JSLiteralString s   -> pretty s+    JSLiteralObject o   -> pretty o+    JSLiteralArray  a   -> pretty a+    JSLiteralFunction f -> pretty f++instance PrettyPrec JSLiteral -- default++instance Pretty JSObjectLiteral       where+  pretty (JSObjectLiteral fields) = lbrace <> sepWith (comma <$> empty) fields <> rbrace++instance PrettyPrec JSObjectLiteral -- default++instance Pretty JSObjectField         where+  pretty (JSObjectField eitherNameString e) = ppEitherNameString <> colon <+> pretty e+    where ppEitherNameString = case eitherNameString of+                 Left name -> pretty name+                 Right s   -> pretty s++instance PrettyPrec JSObjectField -- default++instance Pretty JSArrayLiteral        where+  pretty (JSArrayLiteral es) = sepWith (comma <+> empty) es++instance PrettyPrec JSArrayLiteral -- default++instance Pretty JSFunctionLiteral     where+  pretty (JSFunctionLiteral mbName params body) =+    text "function" `join` (parens . hcat . map pretty $ params) <+> pretty body+      where join = case mbName of+                     Just name -> (\a b -> a <+> pretty name <> b)+                     Nothing   -> (<>)++instance PrettyPrec JSFunctionLiteral -- default++instance Pretty JSFunctionBody        where+  pretty (JSFunctionBody varStmts stmts) =+    lbrace <$>+    indent 2 (sepWith (semi <$> empty) (map pretty varStmts ++ map pretty stmts)) <$>+    rbrace++instance PrettyPrec JSFunctionBody -- default++instance Pretty JSProgram where+  pretty (JSProgram varStmts stmts) = vcat (map pretty varStmts ++ map pretty stmts)++------------------------+++test1 = add (n 1) (add (n 2) (add (add (n 3) (n 4)) (n 5)))++test2  = add (n 1) (mul (n 2) (n 3))+test2' = ((n 1) `add` (n 2)) `mul` (n 3)++test3 :: JSExpressionStatement+test3 = case jsName "x" of+  Right nm ->+    case jsName "y" of+      Right nm' -> JSESApply ((JSLValue nm' []) <:> singleton (JSLValue nm []))+                     (JSRVAssign test2')+++test4 :: JSStatement+test4 = JSStatementExpression test3++-- test4a = JSStatement++test5 :: JSProgram+test5 = JSProgram [] [test4, test4]++test6 :: JSFunctionLiteral+test6 = JSFunctionLiteral Nothing [] (JSFunctionBody [] [test4])++add e e' = JSExpressionInfix JSAdd e e'+mul e e' = JSExpressionInfix JSMul e e'+n x = JSExpressionLiteral (JSLiteralNumber (JSNumber x))