{-# LANGUAGE ScopedTypeVariables #-}moduleText.Press.TagswhereimportText.JSON.TypesimportData.Map(fromList,insert)importData.Maybe(catMaybes)importqualifiedText.Parsec.PrimasParsec.PrimimportText.Parsec.Combinator(manyTill,choice)importControl.Monad.Trans(lift,liftIO)importControl.Monad(forM_)importText.Press.ParserimportControl.Monad.Trans(lift,liftIO)importText.Press.ParserimportText.Press.RenderimportText.Press.TypesextendsTagnamerest=doexprs<-runParseTagExpressionsrestinclude<-caseexprsof(ExprStrs:xs)->returnsotherwise->fail"expecting a string"letrest'=Just.strip$includeParsec.Prim.modifyState$\(parser,tmpl)->(parser,tmpl{tmplExtends=rest'})return$NothingblockTagnamerest=doexprs<-runParseTagExpressionsrestblockName<-caseexprsof(ExprVarvar:xs)->returnvarotherwise->Parsec.Prim.unexpected(showotherwise)nodes<-fmapcatMaybes$manyTillpNode(tagNamed"endblock")Parsec.Prim.modifyState$\(parser,tmpl)->(parser,tmpl{tmplBlocks=insertblockNamenodes(tmplBlockstmpl)})return$Just$Tag"block"$TagFunc$showBlockblockName-- This is mapping of all of the default tag types. defaultTagTypes=(fromList[("extends",TagTypeextendsTag),("block",TagTypeblockTag),("if",TagTypeifTag),("for",TagTypeforTag),("comment",TagTypecommentTag)])-- Comment TagcommentTagnamerest=domanyTillpNode(tagNamed"endcomment")returnNothing-- If tagifTagnamerest=doexpr<-parseIfExprrestscan[]exprwherescanifse=do(maybeNodes,tokenPos)<-manyTill'pNode(tagNamedOneOf["else","endif","elif"])letnodes=catMaybesmaybeNodeslettoken=fsttokenPosletifs'=ifs++[(e,nodes)]casetokenof(PTag"endif"rest)->doreturn$Just$Tag"if"$TagFunc$showIfElseifs'[](PTag"elif"rest)->doe'<-parseIfExprrestscanifs'e'(PTag"else"rest)->donodes<-fmapcatMaybes$manyTillpNode(tagNamed"endif")return$Just$Tag"if"$TagFunc$showIfElseifs'nodesotherwise->Parsec.Prim.unexpected"unexpected tag"parseIfExprs=doexprs<-runParseTagExpressionsscaseexprsof[]->Parsec.Prim.unexpected"empty if"(x:[])->returnx(x:xs)->Parsec.Prim.unexpected$show.head$xs-- Version of manyTill that returns the terminating tokenmanyTill'p1p2=scanwherescan=(Parsec.Prim.tryp2')Parsec.Prim.<|>p1'p1'=dox<-p1(xs,y)<-scanreturn(x:xs,y)p2'=doy<-p2return([],y)-- Evaluate an expression to a boolean suitable for an If claseexprToBool::Expr->RenderTBoolexprToBoolexpr=docaseexprofExprStrs->return$lengths>0ExprNumnum->return$num>0ExprVarvar->domaybeVal<-lookupVarMvarcasemaybeValofNothing->returnFalseJustval->return$coerceJSToBoolvalshowIfElse::[(Expr,[Node])]->[Node]->RenderT_showIfElse[]right=mapM_renderrightshowIfElse((expr,left):xs)right=dosucc<-exprToBoolexprifsuccthenmapM_renderleftelseshowIfElsexsrightforTagnamerest=do(target,sourceExpr)<-parseForrest(maybeNodes,(token,pos))<-manyTill'pNode(tagNamedOneOf["endfor","else"])letforNodes=catMaybesmaybeNodescasetokenofPTag"else"_->doelseNodes<-fmapcatMaybes$manyTillpNode(tagNamed"endfor")return$Just$Tag"for"$TagFunc$showFortargetsourceExprforNodeselseNodesPTag"endfor"_->doreturn$Just$Tag"for"$TagFunc$showFortargetsourceExprforNodes[]whereparseFors=doexprs<-runParseTagExpressionssiflengthexprs==3thendotarget<-caseheadexprsofExprVarx->returnxotherwise->fail"unexpected for target"casehead$tailexprsofExprVar"in"->return()otherwise->fail"expecting 'in'"return$(target,head$tail$tailexprs)elseParsec.Prim.unexpected"number of arguments"showFor::String->Expr->[Node]->[Node]->RenderT_showFortargetsourceExprforNodeselseNodes=dosourceValues<-fmaptoList$toJSsourceExprrunForsourceValueswhererunFor[]=mapM_renderelseNodesrunForvals=forM_vals$\x->dopushValues[(target,x)]mapM_renderforNodespopValuestoList(Just(JSArrayvals))=valstoListotherwise=[]toJS(ExprVarx)=lookupVarMxtoJSotherwise=returnNothingpushValueskvpairs=dost<-getRenderStatesetRenderState$st{renderStateValues=values':renderStateValuesst}wherevalues'=JSObject$toJSObjectkvpairspopValues=dost<-getRenderStatesetRenderState$st{renderStateValues=tail$renderStateValuesst}