{-# LANGUAGE TemplateHaskell #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# LANGUAGE EmptyDataDecls #-}{-# OPTIONS_GHC -fno-warn-missing-fields #-}moduleText.Hamlet(-- * Plain HTMLHtml,shamlet,shamletFile,xshamlet,xshamletFile-- * Hamlet,HtmlUrl,hamlet,hamletFile,xhamlet,xhamletFile-- * I18N Hamlet,HtmlUrlI18n,ihamlet,ihamletFile-- * Internal, for making more,HamletSettings,hamletWithSettings,hamletFileWithSettings,defaultHamletSettings,xhtmlHamletSettings,Env(..),HamletRules(..))whereimportText.Shakespeare.BaseimportText.Hamlet.ParseimportLanguage.Haskell.TH.SyntaximportLanguage.Haskell.TH.QuoteimportData.Char(isUpper,isDigit)importData.Maybe(fromMaybe)importData.Text(Text,pack)importqualifiedData.Text.LazyasTLimportText.Blaze(Html,preEscapedText,toHtml)importqualifiedData.FoldableasFimportControl.Monad(mplus)typeRenderurl=url->[(Text,Text)]->TexttypeTranslatemsg=msg->Html-- | A function generating an 'Html' given a URL-rendering function.typeHtmlUrlurl=Renderurl->Html-- | A function generating an 'Html' given a message translator and a URL rendering function.typeHtmlUrlI18nmsgurl=Translatemsg->Renderurl->HtmldocsToExp::Env->HamletRules->Scope->[Doc]->QExpdocsToExpenvhrscopedocs=doexps<-mapM(docToExpenvhrscope)docscaseexpsof[]->[|return()|][x]->returnx_->return$DoE$mapNoBindSexpsunIdent::Ident->StringunIdent(Idents)=sdocToExp::Env->HamletRules->Scope->Doc->QExpdocToExpenvhrscope(DocForalllistidentsinside)=doletlist'=derefToExpscopelistnames<-mapM(newName.unIdent)identsletpairs=zipidents(mapVarEnames)letscope'=pairs++scopemh<-[|F.mapM_|]inside'<-docsToExpenvhrscope'insideletlam=flipLamEinside'$casenamesof[x]->[VarPx]_->[TupP$mapVarPnames]return$mh`AppE`lam`AppE`list'docToExpenvhrscope(DocWith[]inside)=doinside'<-docsToExpenvhrscopeinsidereturn$inside'docToExpenvhrscope(DocWith((deref,idents):dis)inside)=doletderef'=derefToExpscopederefnames<-mapM(newName.unIdent)identsletpairs=zipidents(mapVarEnames)letscope'=pairs++scopeinside'<-docToExpenvhrscope'(DocWithdisinside)letlam=flipLamEinside'$casenamesof[x]->[VarPx]_->[TupP$mapVarPnames]return$lam`AppE`deref'docToExpenvhrscope(DocMaybevalidentsinsidemno)=doletval'=derefToExpscopevalnames<-mapM(newName.unIdent)identsletpairs=zipidents(mapVarEnames)letscope'=pairs++scopeinside'<-docsToExpenvhrscope'insideletinside''=flipLamEinside'$casenamesof[x]->[VarPx]_->[TupP$mapVarPnames]ninside'<-casemnoofNothing->[|Nothing|]Justno->dono'<-docsToExpenvhrscopenoj<-[|Just|]return$j`AppE`no'mh<-[|maybeH|]return$mh`AppE`val'`AppE`inside''`AppE`ninside'docToExpenvhrscope(DocCondcondsfinal)=doconds'<-mapMgocondsfinal'<-casefinalofNothing->[|Nothing|]Justf->dof'<-docsToExpenvhrscopefj<-[|Just|]return$j`AppE`f'ch<-[|condH|]return$ch`AppE`ListEconds'`AppE`final'wherego::(Deref,[Doc])->QExpgo(d,docs)=doletd'=derefToExpscopeddocs'<-docsToExpenvhrscopedocsreturn$TupE[d',docs']docToExpenvhrv(DocContentc)=contentToExpenvhrvccontentToExp::Env->HamletRules->Scope->Content->QExpcontentToExp_hr_(ContentRaws)=doos<-[|preEscapedText.pack|]lets'=LitE$StringLsreturn$hrFromHtmlhr`AppE`(os`AppE`s')contentToExp_hrscope(ContentVard)=dostr<-[|toHtml|]return$hrFromHtmlhr`AppE`(str`AppE`derefToExpscoped)contentToExpenvhrscope(ContentUrlhasParamsd)=caseurlRenderenvofNothing->error"URL interpolation used, but no URL renderer provided"Justwrender->wrender$\render->doletrender'=returnrenderou<-ifhasParamsthen[|\(u,p)->$(render')up|]else[|\u->$(render')u[]|]letd'=derefToExpscopedpet<-[|toHtml|]return$hrFromHtmlhr`AppE`(pet`AppE`(ou`AppE`d'))contentToExpenvhrscope(ContentEmbedd)=hrEmbedhrenv$derefToExpscopedcontentToExpenvhrscope(ContentMsgd)=casemsgRenderenvofNothing->error"Message interpolation used, but no message renderer provided"Justwrender->wrender$\render->return$hrFromHtmlhr`AppE`(render`AppE`derefToExpscoped)shamlet::QuasiQuotershamlet=hamletWithSettingshtmlRulesdefaultHamletSettingsxshamlet::QuasiQuoterxshamlet=hamletWithSettingshtmlRulesxhtmlHamletSettingshtmlRules::QHamletRuleshtmlRules=doi<-[|id|]return$HamletRulesi($(EnvNothingNothing))(\_b->returnb)hamlet::QuasiQuoterhamlet=hamletWithSettingshamletRulesdefaultHamletSettingsxhamlet::QuasiQuoterxhamlet=hamletWithSettingshamletRulesxhtmlHamletSettingshamletRules::QHamletRuleshamletRules=doi<-[|id|]leturf=dor<-newName"_render"letenv=Env{urlRender=Just($(VarEr)),msgRender=Nothing}h<-fenvreturn$LamE[VarPr]hreturn$HamletRulesiuremwhereem(Env(Justurender)Nothing)e=urender$\ur'->return(e`AppE`ur')em__=error"bad Env"ihamlet::QuasiQuoterihamlet=hamletWithSettingsihamletRulesdefaultHamletSettingsihamletRules::QHamletRulesihamletRules=doi<-[|id|]leturf=dou<-newName"_urender"m<-newName"_mrender"letenv=Env{urlRender=Just($(VarEu)),msgRender=Just($(VarEm))}h<-fenvreturn$LamE[VarPm,VarPu]hreturn$HamletRulesiuremwhereem(Env(Justurender)(Justmrender))e=urender$\ur'->mrender$\mr->return(e`AppE`mr`AppE`ur')em__=error"bad Env"hamletWithSettings::QHamletRules->HamletSettings->QuasiQuoterhamletWithSettingshrset=QuasiQuoter{quoteExp=hamletFromStringhrset}dataHamletRules=HamletRules{hrFromHtml::Exp,hrWithEnv::(Env->QExp)->QExp,hrEmbed::Env->Exp->QExp}dataEnv=Env{urlRender::Maybe((Exp->QExp)->QExp),msgRender::Maybe((Exp->QExp)->QExp)}hamletFromString::QHamletRules->HamletSettings->String->QExphamletFromStringqhrsets=dohr<-qhrcaseparseDocsetsofErrors'->errors'Okd->hrWithEnvhr$\env->docsToExpenvhr[]dhamletFileWithSettings::QHamletRules->HamletSettings->FilePath->QExphamletFileWithSettingsqhrsetfp=docontents<-fmapTL.unpack$qRunIO$readUtf8FilefphamletFromStringqhrsetcontentshamletFile::FilePath->QExphamletFile=hamletFileWithSettingshamletRulesdefaultHamletSettingsxhamletFile::FilePath->QExpxhamletFile=hamletFileWithSettingshamletRulesxhtmlHamletSettingsshamletFile::FilePath->QExpshamletFile=hamletFileWithSettingshtmlRulesdefaultHamletSettingsxshamletFile::FilePath->QExpxshamletFile=hamletFileWithSettingshtmlRulesxhtmlHamletSettingsihamletFile::FilePath->QExpihamletFile=hamletFileWithSettingsihamletRulesdefaultHamletSettingsvarName::Scope->String->ExpvarName_""=error"Illegal empty varName"varNamescopev@(_:_)=fromMaybe(strToExpv)$lookup(Identv)scopestrToExp::String->ExpstrToExps@(c:_)|allisDigits=LitE$IntegerL$reads|isUpperc=ConE$mkNames|otherwise=VarE$mkNamesstrToExp""=error"strToExp on empty string"-- | Checks for truth in the left value in each pair in the first argument. If-- a true exists, then the corresponding right action is performed. Only the-- first is performed. In there are no true values, then the second argument is-- performed, if supplied.condH::Monadm=>[(Bool,m())]->Maybe(m())->m()condHbmsmm=fromMaybe(return())$lookupTruebms`mplus`mm-- | Runs the second argument with the value in the first, if available.-- Otherwise, runs the third argument, if available.maybeH::Monadm=>Maybev->(v->m())->Maybe(m())->m()maybeHmvfmm=fromMaybe(return())$fmapfmv`mplus`mm