moduleLanguage.JavaScript.Pretty(-- | This module just defines and exports 'Pretty' and 'PrettyPrec' instancesPretty(..))where-- System librariesimportText.PrettyPrint.LeijenimportText.PrettyPrint.Leijen.PrettyPrec-- friendsimportLanguage.JavaScript.ASTimportLanguage.JavaScript.NonEmptyList-- FIXME: This will be a little tricky to get right.instancePrettyJSStringwhereprettys=char'"'<>text(unJSStrings)<>char'"'-- enclosed in double quotesinstancePrettyJSNamewherepretty=text.unJSNamesepWith::Prettya=>Doc->[a]->DocsepWiths=encloseSepemptyemptys.mapprettyendWith::Prettya=>Doc->[a]->DocendWithsxs=sepWithsxs<>ssepWith'::Prettya=>Doc->NonEmptyLista->DocsepWith's=encloseSepemptyemptys.mappretty.toListendWith'::Prettya=>Doc->NonEmptyLista->DocendWith'sxs=sepWith'sxs<>sprettyBlock::Prettya=>[a]->DocprettyBlockstmts=lbrace<$>indent2(endWith(semi<$>empty)stmts)<$>rbrace---------------------------------------------------------------------------- Associativity--dataAssociativity=LeftToRight|RightToLeftderivingEqtypeFixity=(Associativity,Int)assoc::Associativity->Int->Fixityassocassn=(ass,n)leftToRight,rightToLeft::Int->FixityleftToRight=assocLeftToRightrightToLeft=assocRightToLeftprettyInfixOpApp::(PrettyPreca,PrettyPrecb)=>Int->OpInfo->a->b->DocprettyInfixOpAppprec(OpInfoopPrecassocname)ab=docParen(prec>opPrec)$bumpLeftToRighta<+>textname<+>bumpRightToLeftbwherebumpassoc'd=prettyPrecopPrec'dwhereopPrec'=ifassoc==assoc'thenopPrecelseopPrec+1-- LAST: Check that bump works in 'prettyInfixOpApp' and do the right thing for prefix ops.--prettyPrefixOpApp::PrettyPreca=>Int->OpInfo->a->DocprettyPrefixOpAppprec(OpInfoopPrecassocname)a=textname<>docParen(prec>opPrec)(prettyPrecpreca)docParen::Bool->Doc->DocdocParenTrue=parensdocParenFalse=iddataOpInfo=OpInfoInt-- recedenceAssociativity-- associativityString-- 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->OpInfoinfixOpInfoop=caseopofJSMul->go6"*"JSDiv->go6"/"JSMod->go6"%"JSAdd->go5"+"JSSub->go5"-"JSGTE->go4">="JSLTE->go4"<="JSGT->go4">"JSLT->go4"<"JSEq->go3"==="JSNotEq->go3"!=="JSOr->go1"||"JSAnd->go2"&&"wheregois=OpInfoiLeftToRights-----------------------------------------------------------------------instancePrettyJSNumberwherepretty(JSNumbern)=prettyn-- FIXME: Make sure this always produce valid Javascript numbers.instancePrettyPrecJSNumber-- defaultinstancePrettyJSVarStatementwherepretty(JSVarStatementvarDecls)=sepWith'(comma<+>empty)varDeclsinstancePrettyPrecJSVarStatement-- defaultinstancePrettyJSVarDeclwherepretty(JSVarDeclnmNothing)=prettynmpretty(JSVarDeclnm(Justexp))=prettynm<+>text"="<+>prettyexpinstancePrettyPrecJSVarDecl-- defaultinstancePrettyJSStatementwhereprettystmt=casestmtof(JSStatementExpressiones)->prettyes<>semi(JSStatementDisruptiveds)->prettyds(JSStatementTryts)->prettyts(JSStatementIfis)->prettyis(JSStatementSwitchmbLblss)->ppmbLblss(JSStatementWhilembLblws)->ppmbLblws(JSStatementFormbLblfs)->ppmbLblfs(JSStatementDombLblds)->ppmbLbldswherepp::Prettya=>MaybeJSName->a->Docpp(Justlabel)doc=prettylabel<>colon<+>prettydocppNothingdoc=prettydocinstancePrettyPrecJSStatement-- defaultinstancePrettyJSDisruptiveStatementwhereprettystmt=casestmtofJSDSBreakbs->prettybsJSDSReturnrs->prettyrsJSDSThrowts->prettytsinstancePrettyPrecJSDisruptiveStatement-- defaultinstancePrettyJSIfStatementwherepretty(JSIfStatementcondthenStmtsblockOrIf)=text"if"<+>parens(prettycond)<+>prettyBlockthenStmts<+>ppRestwhereppRest=caseblockOrIfofNothing->emptyJust(LeftelseStmts)->text"else"<+>prettyBlockelseStmtsJust(RightifStmt)->prettyifStmtinstancePrettyPrecJSIfStatement-- defaultinstancePrettyJSSwitchStatementwherepretty(JSSwitchStatementSingleCasecondcaseClause)=text"switch"<+>parens(prettycond)<+>lbrace<$>prettycaseClause<$>rbracepretty(JSSwitchStatementcondcdsstmts)=text"switch"<+>parens(prettycond)<+>lbrace<$>indent2(vcat(toList.fmappretty$cds)<$>(text"default:"<$>indent2(endWithsemistmts)))<$>rbraceinstancePrettyPrecJSSwitchStatement-- defaultinstancePrettyJSCaseAndDisruptivewherepretty(JSCaseAndDisruptivecaseClausedisruptive)=prettycaseClause<$>prettydisruptiveinstancePrettyPrecJSCaseAndDisruptive-- defaultinstancePrettyJSCaseClausewherepretty(JSCaseClauseexpstmts)=text"case"<+>prettyexp<>colon<+>endWithsemistmtsinstancePrettyPrecJSCaseClause-- defaultinstancePrettyJSForStatementwherepretty(JSForStatementCStyleinitcondincrstmts)=text"for"<+>parens(prettyinit<>semi<+>prettycond<>semi<+>prettyincr)<+>prettyBlockstmtsinstancePrettyPrecJSForStatement-- defaultinstancePrettyJSDoStatementwherepretty(JSDoStatementstmtscond)=text"do"<+>prettyBlockstmts<+>text"while"<+>parens(prettycond)<>semiinstancePrettyPrecJSDoStatement-- defaultinstancePrettyJSWhileStatementwherepretty(JSWhileStatementcondstmts)=text"while"<+>parens(prettycond)<+>prettyBlockstmtsinstancePrettyPrecJSWhileStatement-- defaultinstancePrettyJSTryStatementwherepretty(JSTryStatementtryStmtsvarNamecatchStmts)=text"try"<+>prettyBlocktryStmts<+>parens(prettyvarName)<+>prettyBlockcatchStmtsinstancePrettyPrecJSTryStatement-- defaultinstancePrettyJSThrowStatementwherepretty(JSThrowStatementexp)=text"throw"<+>prettyexp<>semiinstancePrettyPrecJSThrowStatement-- defaultinstancePrettyJSReturnStatementwherepretty(JSReturnStatementmbExp)=casembExpofNothing->text"return;"Justexp->text"return"<+>prettyexp<>semiinstancePrettyPrecJSReturnStatement-- defaultinstancePrettyJSBreakStatementwherepretty(JSBreakStatementmbExp)=casembExpofNothing->text"break;"Justexp->text"break"<+>prettyexp<>semiinstancePrettyPrecJSBreakStatement-- defaultinstancePrettyJSExpressionStatementwherepretty(JSESApplylvaluesrvalue)=sepWith'(space<>text"="<>space)lvalues<+>prettyrvaluepretty(JSESDeleteexprefine)=text"delete"<+>prettyexp<>prettyrefineinstancePrettyPrecJSExpressionStatement-- defaultinstancePrettyJSLValuewherepretty(JSLValuenameinvsAndRefines)=prettyname<>(hcat.mapppIR$invsAndRefines)whereppIR(invs,refine)=(hcat.mappretty$invs)<>prettyrefineinstancePrettyPrecJSLValue-- defaultinstancePrettyJSRValuewhereprettyrvalue=caservalueofJSRVAssigne->text"="<+>prettyeJSRVAddAssigne->text"+="<+>prettyeJSRVSubAssigne->text"-="<+>prettyeJSRVInvokeinvs->hcat.toList.fmappretty$invsinstancePrettyPrecJSRValue-- defaultinstancePrettyJSExpressionwherepretty=prettyPrec0instancePrettyPrecJSExpressionwhereprettyPreciexp=caseexpofJSExpressionLiteralliteral->prettyliteralJSExpressionNamename->prettynameJSExpressionPrefixprefixOpe->prettyprefixOp<>prettyeJSExpressionInfixinfixOpee'->prettyInfixOpAppi(infixOpInfoinfixOp)ee'JSExpressionTernarycondthnels->prettycond<+>char'?'<+>prettythn<+>colon<+>prettyelsJSExpressionInvocationei->prettye<>prettyiJSExpressionRefinementer->prettye<>prettyrJSExpressionNewei->text"new"<+>prettye<>prettyiJSExpressionDeleteer->text"new"<+>prettye<>prettyrinstancePrettyJSPrefixOperatorwhereprettyop=caseopofJSTypeOf->text"typeof"<+>emptyJSToNumber->char'+'JSNegate->char'-'JSNot->char'!'instancePrettyPrecJSPrefixOperator--defaultinstancePrettyJSInfixOperatorwherepretty=prettyPrec0instancePrettyPrecJSInfixOperatorwhereprettyPrec=error"we never print an operator by itself"instancePrettyJSInvocationwherepretty(JSInvocationes)=lparen<>sepWith(comma<+>empty)es<>rpareninstancePrettyPrecJSInvocation-- defaultinstancePrettyJSRefinementwherepretty(JSPropertyname)=char'.'<>prettynamepretty(JSSubscripte)=char'['<>prettye<>char']'instancePrettyPrecJSRefinement-- defaultinstancePrettyJSLiteralwhereprettylit=caselitofJSLiteralNumbern->prettynJSLiteralStrings->prettysJSLiteralObjecto->prettyoJSLiteralArraya->prettyaJSLiteralFunctionf->prettyfinstancePrettyPrecJSLiteral-- defaultinstancePrettyJSObjectLiteralwherepretty(JSObjectLiteralfields)=lbrace<>sepWith(comma<$>empty)fields<>rbraceinstancePrettyPrecJSObjectLiteral-- defaultinstancePrettyJSObjectFieldwherepretty(JSObjectFieldeitherNameStringe)=ppEitherNameString<>colon<+>prettyewhereppEitherNameString=caseeitherNameStringofLeftname->prettynameRights->prettysinstancePrettyPrecJSObjectField-- defaultinstancePrettyJSArrayLiteralwherepretty(JSArrayLiterales)=lbracket<>sepWith(comma<+>empty)es<>rbracketinstancePrettyPrecJSArrayLiteral-- defaultinstancePrettyJSFunctionLiteralwherepretty(JSFunctionLiteralmbNameparamsbody)=text"function"`join`(parens.hcat.mappretty$params)<+>prettybodywherejoin=casembNameofJustname->(\ab->a<+>prettyname<>b)Nothing->(<>)instancePrettyPrecJSFunctionLiteral-- defaultinstancePrettyJSFunctionBodywherepretty(JSFunctionBodyvarStmtsstmts)=lbrace<$>indent2(sepWith(semi<$>empty)(mapprettyvarStmts++mapprettystmts))<$>rbraceinstancePrettyPrecJSFunctionBody-- defaultinstancePrettyJSProgramwherepretty(JSProgramvarStmtsstmts)=vcat(mapprettyvarStmts++mapprettystmts)------------------------test1=add(n1)(add(n2)(add(add(n3)(n4))(n5)))test2=add(n1)(mul(n2)(n3))test2'=((n1)`add`(n2))`mul`(n3)test3::JSExpressionStatementtest3=casejsName"x"ofRightnm->casejsName"y"ofRightnm'->JSESApply((JSLValuenm'[])<:>singleton(JSLValuenm[]))(JSRVAssigntest2')test4::JSStatementtest4=JSStatementExpressiontest3-- test4a = JSStatementtest5::JSProgramtest5=JSProgram[][test4,test4]test6::JSFunctionLiteraltest6=JSFunctionLiteralNothing[](JSFunctionBody[][test4])addee'=JSExpressionInfixJSAddee'mulee'=JSExpressionInfixJSMulee'nx=JSExpressionLiteral(JSLiteralNumber(JSNumberx))