{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE CPP #-}

-- | Pretty-printing JavaScript.
module Language.ECMAScript3.PrettyPrint (Pretty (..)
                                        ,javaScript
                                        ,renderStatements
                                        ,renderExpression
                                        ,PP (..)
                                        ,unsafeInExprStmt
                                        ) where

import qualified Text.PrettyPrint.ANSI.Leijen as Pretty
import Text.PrettyPrint.ANSI.Leijen hiding (Pretty, parens)
import Language.ECMAScript3.Syntax
import Prelude hiding (maybe, id)
import qualified Prelude
import Data.Char
import Numeric

{-# DEPRECATED PP, javaScript, renderStatements, renderExpression "These interfaces are outdated and would be removed/hidden in version 1.0. Use the Pretty class instead." #-}

parens :: Doc -> Doc
parens :: Doc -> Doc
parens = Doc -> Doc
Pretty.parens (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
align

-- | A class of pretty-printable ECMAScript AST nodes. Will
-- pretty-print correct JavaScript given that the 'isValid' predicate
-- holds for the AST.
class Pretty a where
  -- | Pretty-print an ECMAScript AST node. Use 'render' or 'show' to
  -- convert 'Doc' to 'String'.
  prettyPrint :: a -> Doc

instance Pretty (JavaScript a) where
  prettyPrint :: JavaScript a -> Doc
prettyPrint (Script _ ss :: [Statement a]
ss) = [Statement a] -> Doc
forall a. Pretty a => a -> Doc
prettyPrint [Statement a]
ss

instance Pretty [Statement a] where
  prettyPrint :: [Statement a] -> Doc
prettyPrint = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Statement a] -> [Doc]) -> [Statement a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Statement a -> Doc) -> [Statement a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Statement a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint

instance Pretty (Expression a) where
  prettyPrint :: Expression a -> Doc
prettyPrint = Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True

-- | Print a list of items in parenthesis
parenList :: (a -> Doc) -> [a] -> Doc
parenList :: (a -> Doc) -> [a] -> Doc
parenList ppElem :: a -> Doc
ppElem = Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep (String -> Doc
text "(") (String -> Doc
text ")") Doc
comma ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
ppElem

isIf :: Statement a -> Bool
isIf :: Statement a -> Bool
isIf IfSingleStmt {} = Bool
True
isIf IfStmt {} = Bool
True
isIf _ = Bool
False

instance Pretty (Statement a) where
  prettyPrint :: Statement a -> Doc
prettyPrint s :: Statement a
s = case Statement a
s of
    BlockStmt _ ss :: [Statement a]
ss -> [Statement a] -> Doc
forall a. [Statement a] -> Doc
asBlock [Statement a]
ss
    EmptyStmt _ -> Doc
semi
    ExprStmt _ e :: Expression a
e | Expression a -> Bool
forall a. Expression a -> Bool
unsafeInExprStmt (Expression a
e) -> Doc -> Doc
parens (Int -> Doc -> Doc
nest 4 (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    ExprStmt _ e :: Expression a
e | Bool
otherwise            -> Int -> Doc -> Doc
nest 4 (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    IfSingleStmt _ test :: Expression a
test cons :: Statement a
cons -> String -> Doc
text "if" Doc -> Doc -> Doc
<+>
                                Doc -> Doc
parens (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
test) Doc -> Doc -> Doc
</>
                                Int -> Statement a -> Doc
forall a. Int -> Statement a -> Doc
indented 3 Statement a
cons
    IfStmt _ test :: Expression a
test cons :: Statement a
cons alt :: Statement a
alt -> String -> Doc
text "if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
test) Doc -> Doc -> Doc
</>
                              Int -> Statement a -> Doc
forall a. Int -> Statement a -> Doc
indented 3 Statement a
cons Doc -> Doc -> Doc
</> String -> Doc
text "else"
                              Doc -> Doc -> Doc
<+> if Statement a -> Bool
forall a. Statement a -> Bool
isIf Statement a
alt
                                  then Statement a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Statement a
alt
                                  else Int -> Statement a -> Doc
forall a. Int -> Statement a -> Doc
indented 3 Statement a
alt
    SwitchStmt _ e :: Expression a
e cases :: [CaseClause a]
cases ->
      String -> Doc
text "switch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> Doc -> Doc
ppBlock 2 ([Doc] -> Doc
vcat ((CaseClause a -> Doc) -> [CaseClause a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CaseClause a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint [CaseClause a]
cases))
    WhileStmt _ test :: Expression a
test body :: Statement a
body -> String -> Doc
text "while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
test) Doc -> Doc -> Doc
</>
                             Int -> Statement a -> Doc
forall a. Int -> Statement a -> Doc
indented 3 Statement a
body
    ReturnStmt _ Nothing -> String -> Doc
text "return" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    ReturnStmt _ (Just e :: Expression a
e) -> String -> Doc
text "return" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 4 (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    DoWhileStmt _ s :: Statement a
s e :: Expression a
e ->
      String -> Doc
text "do" Doc -> Doc -> Doc
</>
      (Int -> Statement a -> Doc
forall a. Int -> Statement a -> Doc
indented 3 Statement a
s Doc -> Doc -> Doc
</> String -> Doc
text "while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e)
       Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi)
    BreakStmt _ Nothing ->  String -> Doc
text "break" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    BreakStmt _ (Just label :: Id a
label) -> String -> Doc
text "break" Doc -> Doc -> Doc
<+> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
label Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    ContinueStmt _ Nothing -> String -> Doc
text "continue" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    ContinueStmt _ (Just label :: Id a
label) -> String -> Doc
text"continue" Doc -> Doc -> Doc
<+> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
label
                                   Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    LabelledStmt _ label :: Id a
label s :: Statement a
s -> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
label Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
</> Statement a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Statement a
s
    ForInStmt p :: a
p init :: ForInInit a
init e :: Expression a
e body :: Statement a
body ->
      String -> Doc
text "for" Doc -> Doc -> Doc
<+>
      Doc -> Doc
parens (ForInInit a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint ForInInit a
init Doc -> Doc -> Doc
<+> String -> Doc
text "in" Doc -> Doc -> Doc
<+> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e) Doc -> Doc -> Doc
</>
      Int -> Statement a -> Doc
forall a. Int -> Statement a -> Doc
indented 3 Statement a
body
    ForStmt _ init :: ForInit a
init incr :: Maybe (Expression a)
incr test :: Maybe (Expression a)
test body :: Statement a
body ->
      String -> Doc
text "for" Doc -> Doc -> Doc
<+>
      Doc -> Doc
parens (ForInit a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint ForInit a
init Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi Doc -> Doc -> Doc
<+> Maybe (Expression a) -> (Expression a -> Doc) -> Doc
forall a. Maybe a -> (a -> Doc) -> Doc
maybe Maybe (Expression a)
incr (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
              Doc
semi Doc -> Doc -> Doc
<+> Maybe (Expression a) -> (Expression a -> Doc) -> Doc
forall a. Maybe a -> (a -> Doc) -> Doc
maybe Maybe (Expression a)
test (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True)) Doc -> Doc -> Doc
</>
      Int -> Statement a -> Doc
forall a. Int -> Statement a -> Doc
indented 3 Statement a
body
    TryStmt _ stmt :: Statement a
stmt mcatch :: Maybe (CatchClause a)
mcatch mfinally :: Maybe (Statement a)
mfinally ->
      String -> Doc
text "try" Doc -> Doc -> Doc
</> Statement a -> Doc
forall a. Statement a -> Doc
inBlock Statement a
stmt Doc -> Doc -> Doc
</> Doc
ppCatch Doc -> Doc -> Doc
</> Doc
ppFinally
      where ppFinally :: Doc
ppFinally = case Maybe (Statement a)
mfinally of
              Nothing -> Doc
empty
              Just stmt :: Statement a
stmt -> String -> Doc
text "finally" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Statement a -> Doc
forall a. Statement a -> Doc
inBlock Statement a
stmt
            ppCatch :: Doc
ppCatch = case Maybe (CatchClause a)
mcatch of
              Nothing -> Doc
empty
              Just cc :: CatchClause a
cc -> CatchClause a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint CatchClause a
cc
    ThrowStmt _ e :: Expression a
e -> String -> Doc
text "throw" Doc -> Doc -> Doc
<+> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    WithStmt _ e :: Expression a
e s :: Statement a
s -> String -> Doc
text "with" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e)
                      Doc -> Doc -> Doc
</> Int -> Statement a -> Doc
forall a. Int -> Statement a -> Doc
indented 3 Statement a
s
    VarDeclStmt _ decls :: [VarDecl a]
decls ->
      String -> Doc
text "var" Doc -> Doc -> Doc
<+> [Doc] -> Doc
cat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((VarDecl a -> Doc) -> [VarDecl a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> VarDecl a -> Doc
forall a. Bool -> VarDecl a -> Doc
ppVarDecl Bool
True) [VarDecl a]
decls))
      Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    FunctionStmt _ name :: Id a
name args :: [Id a]
args body :: [Statement a]
body ->
      String -> Doc
text "function" Doc -> Doc -> Doc
<+> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
      (Id a -> Doc) -> [Id a] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
parenList Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint [Id a]
args Doc -> Doc -> Doc
<+>
      [Statement a] -> Doc
forall a. [Statement a] -> Doc
asBlock [Statement a]
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 :: Expression a -> Bool
unsafeInExprStmt = Integer -> Expression a -> Bool
forall t a. (Ord t, Num t) => t -> Expression a -> Bool
unsafeInExprStmt_ 15
  where unsafeInExprStmt_ :: t -> Expression a -> Bool
unsafeInExprStmt_ prec :: t
prec e :: Expression a
e =
          case Expression a
e of
            ObjectLit {} -> Bool
True
            DotRef _ obj :: Expression a
obj _ | t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 -> t -> Expression a -> Bool
unsafeInExprStmt_ 1 Expression a
obj
            BracketRef _ obj :: Expression a
obj _ | t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> t -> Expression a -> Bool
unsafeInExprStmt_ 1 Expression a
obj
            UnaryAssignExpr a :: a
a op :: UnaryAssignOp
op lv :: LValue a
lv | (UnaryAssignOp
op UnaryAssignOp -> [UnaryAssignOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnaryAssignOp
PostfixInc, UnaryAssignOp
PostfixDec])
                                      Bool -> Bool -> Bool
&& (t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> 3) -> t -> LValue a -> Bool
unsafeLv 2 LValue a
lv
            InfixExpr _ _ l :: Expression a
l _ | t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 5  -> t -> Expression a -> Bool
unsafeInExprStmt_ 5 Expression a
l
            CondExpr _ c :: Expression a
c _ _ | t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 12 -> t -> Expression a -> Bool
unsafeInExprStmt_ 12 Expression a
c
            AssignExpr _ _ lv :: LValue a
lv _ | t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 13 -> t -> LValue a -> Bool
unsafeLv 2 LValue a
lv
            ListExpr _ (e :: Expression a
e:_) | t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 14 -> t -> Expression a -> Bool
unsafeInExprStmt_ 14 Expression a
e
            CallExpr _ e :: Expression a
e _ | t
prec t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 2 -> t -> Expression a -> Bool
unsafeInExprStmt_ 2 Expression a
e
            FuncExpr {} -> Bool
True
            _ -> Bool
False
        unsafeLv :: t -> LValue a -> Bool
unsafeLv prec :: t
prec lv :: LValue a
lv = case LValue a
lv of
          LVar {} -> Bool
False
          LDot _ obj :: Expression a
obj _ -> t -> Expression a -> Bool
unsafeInExprStmt_ t
prec Expression a
obj
          LBracket _ obj :: Expression a
obj _ -> t -> Expression a -> Bool
unsafeInExprStmt_ t
prec Expression a
obj

instance Pretty (CatchClause a) where
  prettyPrint :: CatchClause a -> Doc
prettyPrint (CatchClause _ id :: Id a
id s :: Statement a
s) =
    String -> Doc
text "catch" Doc -> Doc -> Doc
<+> (Doc -> Doc
parens(Doc -> Doc) -> (Id a -> Doc) -> Id a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint) Id a
id Doc -> Doc -> Doc
<+> Statement a -> Doc
forall a. Statement a -> Doc
inBlock Statement a
s

instance Pretty (ForInit a) where
  prettyPrint :: ForInit a -> Doc
prettyPrint t :: ForInit a
t = case ForInit a
t of
    NoInit     -> Doc
empty
    VarInit vs :: [VarDecl a]
vs -> String -> Doc
text "var"
                  Doc -> Doc -> Doc
<+> [Doc] -> Doc
cat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (VarDecl a -> Doc) -> [VarDecl a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> VarDecl a -> Doc
forall a. Bool -> VarDecl a -> Doc
ppVarDecl Bool
False) [VarDecl a]
vs)
    ExprInit e :: Expression a
e -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
False Expression a
e

instance Pretty (ForInInit a) where
  prettyPrint :: ForInInit a -> Doc
prettyPrint t :: ForInInit a
t = case ForInInit a
t of
    ForInVar id :: Id a
id  -> String -> Doc
text "var" Doc -> Doc -> Doc
<+> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
id
    ForInLVal lv :: LValue a
lv -> LValue a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint LValue a
lv

instance Pretty (LValue a) where
  prettyPrint :: LValue a -> Doc
prettyPrint lv :: LValue a
lv = case LValue a
lv of
    LVar _ x :: String
x -> String -> Doc
printIdentifierName String
x
    LDot _ e :: Expression a
e x :: String
x -> Expression a -> (Expression a -> Doc) -> Doc
forall a. Expression a -> (Expression a -> Doc) -> Doc
ppObjInDotRef Expression a
e Expression a -> Doc
forall a. Expression a -> Doc
ppMemberExpression Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text "." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
printIdentifierName String
x
    LBracket _ e1 :: Expression a
e1 e2 :: Expression a
e2 -> Expression a -> Doc
forall a. Expression a -> Doc
ppMemberExpression Expression a
e1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
                        Doc -> Doc
brackets (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e2)

instance Pretty (VarDecl a) where
  prettyPrint :: VarDecl a -> Doc
prettyPrint = Bool -> VarDecl a -> Doc
forall a. Bool -> VarDecl a -> Doc
ppVarDecl Bool
True

instance Pretty (CaseClause a) where
  prettyPrint :: CaseClause a -> Doc
prettyPrint c :: CaseClause a
c = case CaseClause a
c of
    CaseClause _ e :: Expression a
e ss :: [Statement a]
ss ->
      String -> Doc
text "case" Doc -> Doc -> Doc
<+> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Statement a] -> Doc
suffix [Statement a]
ss
    CaseDefault _ ss :: [Statement a]
ss ->
      String -> Doc
text "default" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Statement a] -> Doc
suffix [Statement a]
ss
    where
      suffix :: [Statement a] -> Doc
      suffix :: [Statement a] -> Doc
suffix [] = Doc
colon
      suffix ss :: [Statement a]
ss = Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest 2 (Doc
linebreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Statement a] -> Doc
forall a. Pretty a => a -> Doc
prettyPrint [Statement a]
ss)

instance Pretty InfixOp where
   prettyPrint :: InfixOp -> Doc
prettyPrint op :: InfixOp
op = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case InfixOp
op of
     OpMul -> "*"
     OpDiv -> "/"
     OpMod -> "%"
     OpAdd -> "+"
     OpSub -> "-"
     OpLShift -> "<<"
     OpSpRShift -> ">>"
     OpZfRShift -> ">>>"
     OpLT -> "<"
     OpLEq -> "<="
     OpGT -> ">"
     OpGEq -> ">="
     OpIn -> "in"
     OpInstanceof -> "instanceof"
     OpEq -> "=="
     OpNEq -> "!="
     OpStrictEq -> "==="
     OpStrictNEq -> "!=="
     OpBAnd -> "&"
     OpBXor -> "^"
     OpBOr -> "|"
     OpLAnd -> "&&"
     OpLOr -> "||"

instance Pretty AssignOp where
  prettyPrint :: AssignOp -> Doc
prettyPrint op :: AssignOp
op = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case AssignOp
op of
    OpAssign -> "="
    OpAssignAdd -> "+="
    OpAssignSub -> "-="
    OpAssignMul -> "*="
    OpAssignDiv -> "/="
    OpAssignMod -> "%="
    OpAssignLShift -> "<<="
    OpAssignSpRShift -> ">>="
    OpAssignZfRShift -> ">>>="
    OpAssignBAnd -> "&="
    OpAssignBXor -> "^="
    OpAssignBOr -> "|="

instance Pretty PrefixOp where
  prettyPrint :: PrefixOp -> Doc
prettyPrint op :: PrefixOp
op = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case PrefixOp
op of
    PrefixLNot -> "!"
    PrefixBNot -> "~"
    PrefixPlus -> "+"
    PrefixMinus -> "-"
    PrefixTypeof -> "typeof"
    PrefixVoid -> "void"
    PrefixDelete -> "delete"

instance Pretty (Prop a) where
  prettyPrint :: Prop a -> Doc
prettyPrint p :: Prop a
p = case Prop a
p of
    PropId _ id :: Id a
id -> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
id
    PropString _ str :: String
str -> Doc -> Doc
dquotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
jsEscape String
str
    PropNum _ n :: Integer
n -> String -> Doc
text (Integer -> String
forall a. Show a => a -> String
show Integer
n)

instance Pretty (Id a) where
  prettyPrint :: Id a -> Doc
prettyPrint (Id _ str :: String
str) = String -> Doc
printIdentifierName String
str

class PP a where
  pp :: a -> Doc

instance Pretty a => PP a where
  pp :: a -> Doc
pp = a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint

-- | DEPRECATED: Use 'prettyPrint' instead! Renders a JavaScript
-- program as a document, the show instance of 'Doc' will pretty-print
-- it automatically
javaScript :: JavaScript a -> Doc
javaScript :: JavaScript a -> Doc
javaScript = JavaScript a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint

-- | DEPRECATED: Use 'prettyPrint' instead! Renders a list of
-- statements as a 'String'
renderStatements :: [Statement a] -> String
renderStatements :: [Statement a] -> String
renderStatements = Doc -> String
forall a. Show a => a -> String
show (Doc -> String)
-> ([Statement a] -> Doc) -> [Statement a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Statement a] -> Doc
forall a. Pretty a => a -> Doc
prettyPrint

-- | DEPRECATED: Use 'prettyPrint' instead! Renders a list of
-- statements as a 'String'
renderExpression :: Expression a -> String
renderExpression :: Expression a -> String
renderExpression = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (Expression a -> Doc) -> Expression a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint

indented :: Int -> Statement a -> Doc
indented :: Int -> Statement a -> Doc
indented _     stmt :: Statement a
stmt@BlockStmt {} = Statement a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Statement a
stmt
indented width :: Int
width stmt :: Statement a
stmt              = Int -> Doc -> Doc
indent Int
width (Statement a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Statement a
stmt)

-- Displays the statement in { ... }, unless it is a block itself.
inBlock:: Statement a -> Doc
inBlock :: Statement a -> Doc
inBlock s :: Statement a
s@(BlockStmt _ _) = Statement a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Statement a
s
inBlock s :: Statement a
s                 = [Statement a] -> Doc
forall a. [Statement a] -> Doc
asBlock [Statement a
s]

asBlock :: [Statement a] -> Doc
asBlock :: [Statement a] -> Doc
asBlock [] = Doc
lbrace Doc -> Doc -> Doc
<$$> Doc
rbrace
asBlock ss :: [Statement a]
ss = Int -> Doc -> Doc
ppBlock 3 ([Statement a] -> Doc
forall a. Pretty a => a -> Doc
prettyPrint [Statement a]
ss)

ppBlock :: Int -> Doc -> Doc
ppBlock :: Int -> Doc -> Doc
ppBlock width :: Int
width doc :: Doc
doc = Doc
lbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
width (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
doc) Doc -> Doc -> Doc
<$$> Doc
rbrace

ppVarDecl :: Bool -> VarDecl a -> Doc
ppVarDecl :: Bool -> VarDecl a -> Doc
ppVarDecl hasIn :: Bool
hasIn vd :: VarDecl a
vd = case VarDecl a
vd of
  VarDecl _ id :: Id a
id Nothing  -> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
id
  VarDecl _ id :: Id a
id (Just e :: Expression a
e) ->
      Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
id Doc -> Doc -> Doc
<+> Doc
equals
      Doc -> Doc -> Doc
</> Doc -> Doc
maybeAlign (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppAssignmentExpression Bool
hasIn Expression a
e)
      where
          maybeAlign :: Doc -> Doc
maybeAlign =
              case Expression a
e of
              FuncExpr {} -> Doc -> Doc
forall a. a -> a
Prelude.id
              _ -> Doc -> Doc
align

-- | Pretty prints a string assuming it's used as an identifier. Note
-- that per Spec 7.6 unicode escape sequences representing illegal
-- identifier characters are not allowed as well, so we do not
-- unicode-escape illegal characters in identifiers anymore.
printIdentifierName :: String -> Doc
printIdentifierName :: String -> Doc
printIdentifierName = String -> Doc
text

-- Based on:
--   http://developer.mozilla.org/en/docs/Core_JavaScript_1.5_Guide:Literals
jsEscape:: String -> String
jsEscape :: String -> String
jsEscape "" = ""
jsEscape (ch :: Char
ch:chs :: String
chs) = Char -> String
sel Char
ch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
jsEscape String
chs where
    sel :: Char -> String
sel '\b' = "\\b"
    sel '\f' = "\\f"
    sel '\n' = "\\n"
    sel '\r' = "\\r"
    sel '\t' = "\\t"
    sel '\v' = "\\v"
    sel '\'' = "\\'"
    sel '\"' = "\\\""
    sel '\\' = "\\\\"
    sel x :: Char
x    = [Char
x]
    -- We don't have to do anything about \X, \x and \u escape sequences.

-- | Escapes a regular expression so that it can be parsed correctly afterwards
regexpEscape :: String -> String
regexpEscape :: String -> String
regexpEscape = Bool -> String -> String
regexpEscapeChar Bool
True
  where regexpEscapeChar :: Bool -- ^ First char?
                         -> String -> String
        regexpEscapeChar :: Bool -> String -> String
regexpEscapeChar first :: Bool
first s :: String
s =
          case (String
s, Bool
first) of
            ("", True) -> "(?:)"
            ("", False)-> ""
            -- see spec 7.8.5, RegularExpressionFirstChar
            ("\\", _) -> "\\\\"
            ('\\':c :: Char
c:rest :: String
rest, _) -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:(Bool -> String -> String
regexpEscapeChar Bool
False String
rest)
            ('/':rest :: String
rest, _) -> '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'/'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> String -> String
regexpEscapeChar Bool
False String
rest
            ('*':rest :: String
rest, True) -> ('\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'*'Char -> String -> String
forall a. a -> [a] -> [a]
:Bool -> String -> String
regexpEscapeChar Bool
False String
rest)
            (c :: Char
c:rest :: String
rest, _)   -> Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Bool -> String -> String
regexpEscapeChar Bool
False String
rest

-- 11.1
ppPrimaryExpression :: Expression a -> Doc
ppPrimaryExpression :: Expression a -> Doc
ppPrimaryExpression e :: Expression a
e = case Expression a
e of
  ThisRef _ -> String -> Doc
text "this"
  VarRef _ id :: Id a
id -> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
id
  NullLit _ -> String -> Doc
text "null"
  BoolLit _ True -> String -> Doc
text "true"
  BoolLit _ False -> String -> Doc
text "false"
  NumLit  _ n :: Double
n -> Double -> Doc
double Double
n
  IntLit _ n :: Int
n ->  Int -> Doc
int Int
n
  StringLit _ str :: String
str -> Doc -> Doc
dquotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
jsEscape String
str
  RegexpLit _ reg :: String
reg g :: Bool
g ci :: Bool
ci -> String -> Doc
text "/" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (String -> Doc
text (String -> String
regexpEscape String
reg)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text "/" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
                          (if Bool
g then String -> Doc
text "g" else Doc
empty) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
                          (if Bool
ci then String -> Doc
text "i" else Doc
empty)
  ArrayLit _ es :: [Expression a]
es -> [Doc] -> Doc
list ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Expression a -> Doc) -> [Expression a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppAssignmentExpression Bool
True) [Expression a]
es
  ObjectLit _ xs :: [(Prop a, Expression a)]
xs -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Doc
lbrace Doc
rbrace Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Prop a, Expression a) -> Doc)
-> [(Prop a, Expression a)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Prop a, Expression a) -> Doc
forall a a. Pretty a => (a, Expression a) -> Doc
ppField [(Prop a, Expression a)]
xs
    where ppField :: (a, Expression a) -> Doc
ppField (f :: a
f,v :: Expression a
v)= a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint a
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppAssignmentExpression Bool
True Expression a
v
  _ -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
e

-- 11.2
ppMemberExpression :: Expression a -> Doc
ppMemberExpression :: Expression a -> Doc
ppMemberExpression e :: Expression a
e = case Expression a
e of
  FuncExpr _ name :: Maybe (Id a)
name params :: [Id a]
params body :: [Statement a]
body ->
    String -> Doc
text "function" Doc -> Doc -> Doc
<+> Maybe (Id a) -> (Id a -> Doc) -> Doc
forall a. Maybe a -> (a -> Doc) -> Doc
maybe Maybe (Id a)
name (\n :: Id a
n -> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    (Id a -> Doc) -> [Id a] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
parenList Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint [Id a]
params Doc -> Doc -> Doc
<+>
    [Statement a] -> Doc
forall a. [Statement a] -> Doc
asBlock [Statement a]
body
  DotRef _ obj :: Expression a
obj id :: Id a
id -> Expression a -> (Expression a -> Doc) -> Doc
forall a. Expression a -> (Expression a -> Doc) -> Doc
ppObjInDotRef Expression a
obj Expression a -> Doc
forall a. Expression a -> Doc
ppMemberExpression Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text "." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
id
  BracketRef _ obj :: Expression a
obj key :: Expression a
key ->
    Expression a -> Doc
forall a. Expression a -> Doc
ppMemberExpression Expression a
obj Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
key)
  NewExpr _ ctor :: Expression a
ctor args :: [Expression a]
args ->
    String -> Doc
text "new" Doc -> Doc -> Doc
<+> Expression a -> Doc
forall a. Expression a -> Doc
ppMemberExpression Expression a
ctor Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Expression a] -> Doc
forall a. [Expression a] -> Doc
ppArguments [Expression a]
args
  _ -> Expression a -> Doc
forall a. Expression a -> Doc
ppPrimaryExpression Expression a
e

ppCallExpression :: Expression a -> Doc
ppCallExpression :: Expression a -> Doc
ppCallExpression e :: Expression a
e = case Expression a
e of
  CallExpr _ f :: Expression a
f args :: [Expression a]
args -> Expression a -> Doc
forall a. Expression a -> Doc
ppCallExpression Expression a
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Expression a] -> Doc
forall a. [Expression a] -> Doc
ppArguments [Expression a]
args
  DotRef _ obj :: Expression a
obj id :: Id a
id -> Expression a -> (Expression a -> Doc) -> Doc
forall a. Expression a -> (Expression a -> Doc) -> Doc
ppObjInDotRef Expression a
obj Expression a -> Doc
forall a. Expression a -> Doc
ppCallExpression Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text "." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Id a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint Id a
id
  BracketRef _ obj :: Expression a
obj key :: Expression a
key -> Expression a -> Doc
forall a. Expression a -> Doc
ppCallExpression Expression a
obj
                          Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
True Expression a
key)
  _ -> Expression a -> Doc
forall a. Expression a -> Doc
ppMemberExpression Expression a
e

ppObjInDotRef :: Expression a -> (Expression a -> Doc) -> Doc
ppObjInDotRef :: Expression a -> (Expression a -> Doc) -> Doc
ppObjInDotRef i :: Expression a
i@(IntLit _ _) _ = Doc -> Doc
parens (Expression a -> Doc
forall a. Expression a -> Doc
ppPrimaryExpression Expression a
i)
ppObjInDotRef e :: Expression a
e p :: Expression a -> Doc
p              = Expression a -> Doc
p Expression a
e

ppArguments :: [Expression a] -> Doc
ppArguments :: [Expression a] -> Doc
ppArguments = (Expression a -> Doc) -> [Expression a] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
parenList (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppAssignmentExpression Bool
True)

ppLHSExpression :: Expression a -> Doc
ppLHSExpression :: Expression a -> Doc
ppLHSExpression = Expression a -> Doc
forall a. Expression a -> Doc
ppCallExpression

-- 11.3
ppPostfixExpression :: Expression a -> Doc
ppPostfixExpression :: Expression a -> Doc
ppPostfixExpression e :: Expression a
e = case Expression a
e of
  UnaryAssignExpr _ PostfixInc e' :: LValue a
e' -> LValue a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint LValue a
e' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text "++"
  UnaryAssignExpr _ PostfixDec e' :: LValue a
e' -> LValue a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint LValue a
e' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text "--"
  _ -> Expression a -> Doc
forall a. Expression a -> Doc
ppLHSExpression Expression a
e

-- 11.4
ppUnaryExpression :: Expression a -> Doc
ppUnaryExpression :: Expression a -> Doc
ppUnaryExpression e :: Expression a
e = case Expression a
e of
  PrefixExpr _ op :: PrefixOp
op e' :: Expression a
e' -> PrefixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint PrefixOp
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PrefixOp -> Doc
prefixSpace PrefixOp
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression a -> Doc
forall a. Expression a -> Doc
ppUnaryExpression Expression a
e'
  UnaryAssignExpr _ PrefixInc e' :: LValue a
e' -> String -> Doc
text "++" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> LValue a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint LValue a
e'
  UnaryAssignExpr _ PrefixDec e' :: LValue a
e' -> String -> Doc
text "--" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> LValue a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint LValue a
e'
  _ -> Expression a -> Doc
forall a. Expression a -> Doc
ppPostfixExpression Expression a
e

prefixSpace :: PrefixOp -> Doc
prefixSpace :: PrefixOp -> Doc
prefixSpace op :: PrefixOp
op = case PrefixOp
op of
  PrefixLNot   -> Doc
empty
  PrefixBNot   -> Doc
empty
  PrefixPlus   -> Doc
empty
  PrefixMinus  -> Doc
empty
  PrefixTypeof -> Doc
space
  PrefixVoid   -> Doc
space
  PrefixDelete -> Doc
space

-- 11.5
ppMultiplicativeExpression :: Expression a -> Doc
ppMultiplicativeExpression :: Expression a -> Doc
ppMultiplicativeExpression e :: Expression a
e = case Expression a
e of
  InfixExpr _ op :: InfixOp
op e1 :: Expression a
e1 e2 :: Expression a
e2 | InfixOp
op InfixOp -> [InfixOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [InfixOp
OpMul, InfixOp
OpDiv, InfixOp
OpMod] ->
    Expression a -> Doc
forall a. Expression a -> Doc
ppMultiplicativeExpression Expression a
e1 Doc -> Doc -> Doc
</> InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op Doc -> Doc -> Doc
</> Expression a -> Doc
forall a. Expression a -> Doc
ppUnaryExpression Expression a
e2
  _ -> Expression a -> Doc
forall a. Expression a -> Doc
ppUnaryExpression Expression a
e

-- 11.6
ppAdditiveExpression :: Expression a -> Doc
ppAdditiveExpression :: Expression a -> Doc
ppAdditiveExpression e :: Expression a
e = case Expression a
e of
  InfixExpr _ op :: InfixOp
op e1 :: Expression a
e1 e2 :: Expression a
e2 | InfixOp
op InfixOp -> [InfixOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [InfixOp
OpAdd, InfixOp
OpSub] ->
    Expression a -> Doc
forall a. Expression a -> Doc
ppAdditiveExpression Expression a
e1 Doc -> Doc -> Doc
</> InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op
    Doc -> Doc -> Doc
</> Expression a -> Doc
forall a. Expression a -> Doc
ppMultiplicativeExpression Expression a
e2
  _ -> Expression a -> Doc
forall a. Expression a -> Doc
ppMultiplicativeExpression Expression a
e

-- 11.7
ppShiftExpression :: Expression a -> Doc
ppShiftExpression :: Expression a -> Doc
ppShiftExpression e :: Expression a
e = case Expression a
e of
  InfixExpr _ op :: InfixOp
op e1 :: Expression a
e1 e2 :: Expression a
e2 | InfixOp
op InfixOp -> [InfixOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [InfixOp
OpLShift, InfixOp
OpSpRShift, InfixOp
OpZfRShift] ->
    Expression a -> Doc
forall a. Expression a -> Doc
ppShiftExpression Expression a
e1 Doc -> Doc -> Doc
</> InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op Doc -> Doc -> Doc
</> Expression a -> Doc
forall a. Expression a -> Doc
ppAdditiveExpression Expression a
e2
  _ -> Expression a -> Doc
forall a. Expression a -> Doc
ppAdditiveExpression Expression a
e

-- 11.8.
-- | @ppRelationalExpression True@ is RelationalExpression,
-- @ppRelationalExpression False@ is RelationalExpressionNoIn
ppRelationalExpression :: Bool -> Expression a -> Doc
ppRelationalExpression :: Bool -> Expression a -> Doc
ppRelationalExpression hasIn :: Bool
hasIn e :: Expression a
e =
  let opsNoIn :: [InfixOp]
opsNoIn = [InfixOp
OpLT, InfixOp
OpGT, InfixOp
OpLEq, InfixOp
OpGEq, InfixOp
OpInstanceof]
      ops :: [InfixOp]
ops     = if Bool
hasIn then InfixOp
OpInInfixOp -> [InfixOp] -> [InfixOp]
forall a. a -> [a] -> [a]
:[InfixOp]
opsNoIn else [InfixOp]
opsNoIn
  in case Expression a
e of
    InfixExpr _ op :: InfixOp
op e1 :: Expression a
e1 e2 :: Expression a
e2 | InfixOp
op InfixOp -> [InfixOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [InfixOp]
ops ->
      Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppRelationalExpression Bool
hasIn Expression a
e1 Doc -> Doc -> Doc
</> InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op
      Doc -> Doc -> Doc
</> Expression a -> Doc
forall a. Expression a -> Doc
ppShiftExpression Expression a
e2
    _ -> Expression a -> Doc
forall a. Expression a -> Doc
ppShiftExpression Expression a
e

-- 11.9
ppEqualityExpression :: Bool -> Expression a -> Doc
ppEqualityExpression :: Bool -> Expression a -> Doc
ppEqualityExpression hasIn :: Bool
hasIn e :: Expression a
e = case Expression a
e of
  InfixExpr _ op :: InfixOp
op e1 :: Expression a
e1 e2 :: Expression a
e2 | InfixOp
op InfixOp -> [InfixOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [InfixOp
OpEq, InfixOp
OpNEq, InfixOp
OpStrictEq, InfixOp
OpStrictNEq] ->
    Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppEqualityExpression Bool
hasIn Expression a
e1 Doc -> Doc -> Doc
</> InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op Doc -> Doc -> Doc
</>
    Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppRelationalExpression Bool
hasIn Expression a
e2
  _ -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppRelationalExpression Bool
hasIn Expression a
e

-- 11.10
ppBitwiseANDExpression :: Bool -> Expression a -> Doc
ppBitwiseANDExpression :: Bool -> Expression a -> Doc
ppBitwiseANDExpression hasIn :: Bool
hasIn e :: Expression a
e = case Expression a
e of
  InfixExpr _ op :: InfixOp
op@InfixOp
OpBAnd e1 :: Expression a
e1 e2 :: Expression a
e2 -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppBitwiseANDExpression Bool
hasIn Expression a
e1 Doc -> Doc -> Doc
</>
                                 InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op Doc -> Doc -> Doc
</>
                                 Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppEqualityExpression Bool
hasIn Expression a
e2
  _ -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppEqualityExpression Bool
hasIn Expression a
e

ppBitwiseXORExpression :: Bool -> Expression a -> Doc
ppBitwiseXORExpression :: Bool -> Expression a -> Doc
ppBitwiseXORExpression hasIn :: Bool
hasIn e :: Expression a
e = case Expression a
e of
  InfixExpr _ op :: InfixOp
op@InfixOp
OpBXor e1 :: Expression a
e1 e2 :: Expression a
e2 -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppBitwiseXORExpression Bool
hasIn Expression a
e1 Doc -> Doc -> Doc
</>
                                 InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op Doc -> Doc -> Doc
</>
                                 Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppBitwiseANDExpression Bool
hasIn Expression a
e2
  _ -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppBitwiseANDExpression Bool
hasIn Expression a
e

ppBitwiseORExpression :: Bool -> Expression a -> Doc
ppBitwiseORExpression :: Bool -> Expression a -> Doc
ppBitwiseORExpression hasIn :: Bool
hasIn e :: Expression a
e = case Expression a
e of
  InfixExpr _ op :: InfixOp
op@InfixOp
OpBOr e1 :: Expression a
e1 e2 :: Expression a
e2 -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppBitwiseORExpression Bool
hasIn Expression a
e1 Doc -> Doc -> Doc
</>
                                InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op Doc -> Doc -> Doc
</>
                                Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppBitwiseXORExpression Bool
hasIn Expression a
e2
  _ -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppBitwiseXORExpression Bool
hasIn Expression a
e

-- 11.11
ppLogicalANDExpression :: Bool -> Expression a -> Doc
ppLogicalANDExpression :: Bool -> Expression a -> Doc
ppLogicalANDExpression hasIn :: Bool
hasIn e :: Expression a
e = case Expression a
e of
  InfixExpr _ op :: InfixOp
op@InfixOp
OpLAnd e1 :: Expression a
e1 e2 :: Expression a
e2 -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppLogicalANDExpression Bool
hasIn Expression a
e1 Doc -> Doc -> Doc
</>
                                 InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op Doc -> Doc -> Doc
</>
                                 Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppBitwiseORExpression Bool
hasIn Expression a
e2
  _ -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppBitwiseORExpression Bool
hasIn Expression a
e

ppLogicalORExpression :: Bool -> Expression a -> Doc
ppLogicalORExpression :: Bool -> Expression a -> Doc
ppLogicalORExpression hasIn :: Bool
hasIn e :: Expression a
e = case Expression a
e of
  InfixExpr _ op :: InfixOp
op@InfixOp
OpLOr e1 :: Expression a
e1 e2 :: Expression a
e2 -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppLogicalORExpression Bool
hasIn Expression a
e1 Doc -> Doc -> Doc
</>
                                InfixOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint InfixOp
op Doc -> Doc -> Doc
</>
                                Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppLogicalANDExpression Bool
hasIn Expression a
e2
  _ -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppLogicalANDExpression Bool
hasIn Expression a
e

-- 11.12
ppConditionalExpression :: Bool -> Expression a -> Doc
ppConditionalExpression :: Bool -> Expression a -> Doc
ppConditionalExpression hasIn :: Bool
hasIn e :: Expression a
e = case Expression a
e of
  CondExpr _ c :: Expression a
c et :: Expression a
et ee :: Expression a
ee -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppLogicalORExpression Bool
hasIn Expression a
c Doc -> Doc -> Doc
</> String -> Doc
text "?" Doc -> Doc -> Doc
<+>
                        Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppAssignmentExpression Bool
hasIn Expression a
et Doc -> Doc -> Doc
</> Doc
colon Doc -> Doc -> Doc
<+>
                        Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppAssignmentExpression Bool
hasIn Expression a
ee
  _ -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppLogicalORExpression Bool
hasIn Expression a
e

-- 11.13
ppAssignmentExpression :: Bool -> Expression a -> Doc
ppAssignmentExpression :: Bool -> Expression a -> Doc
ppAssignmentExpression hasIn :: Bool
hasIn e :: Expression a
e = case Expression a
e of
  AssignExpr _ op :: AssignOp
op l :: LValue a
l r :: Expression a
r -> LValue a -> Doc
forall a. Pretty a => a -> Doc
prettyPrint LValue a
l Doc -> Doc -> Doc
</> AssignOp -> Doc
forall a. Pretty a => a -> Doc
prettyPrint AssignOp
op Doc -> Doc -> Doc
</>
                         Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppAssignmentExpression Bool
hasIn Expression a
r
  _ -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppConditionalExpression Bool
hasIn Expression a
e

-- 11.14
ppExpression :: Bool -> Expression a -> Doc
ppExpression :: Bool -> Expression a -> Doc
ppExpression hasIn :: Bool
hasIn e :: Expression a
e = case Expression a
e of
  ListExpr _ es :: [Expression a]
es -> (Expression a -> Doc) -> [Expression a] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
parenList (Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppExpression Bool
hasIn) [Expression a]
es
  _ -> Bool -> Expression a -> Doc
forall a. Bool -> Expression a -> Doc
ppAssignmentExpression Bool
hasIn Expression a
e

maybe :: Maybe a -> (a -> Doc) -> Doc
maybe :: Maybe a -> (a -> Doc) -> Doc
maybe Nothing  _ = Doc
empty
maybe (Just a :: a
a) f :: a -> Doc
f = a -> Doc
f a
a