{-# LANGUAGE TemplateHaskell #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# LANGUAGE EmptyDataDecls #-}{-# OPTIONS_GHC -fno-warn-missing-fields #-}moduleText.Hamlet(-- * Plain HTMLHtml,html,htmlFile,xhtml,xhtmlFile-- * Hamlet,Hamlet,hamlet,hamletFile,xhamlet,xhamletFile-- * I18N Hamlet,IHamlet,ihamlet,ihamletFile-- * Internal, for making more,hamletWithSettings,hamletFileWithSettings,defaultHamletSettings,xhtmlHamletSettings,Env(..),HamletRules(..))whereimportText.ShakespeareimportText.Hamlet.ParseimportLanguage.Haskell.TH.SyntaximportLanguage.Haskell.TH.QuoteimportData.Char(isUpper,isDigit)importData.Monoid(Monoid(..))importData.Maybe(fromMaybe)importData.Text(Text,pack)importqualifiedData.Text.LazyasTLimportqualifiedData.Text.Lazy.IOasTIOimportqualifiedSystem.IOasSIOimportText.Blaze(Html,preEscapedText,toHtml)importqualifiedData.FoldableasFimportControl.Applicative((<$>))importControl.Monad(ap)typeRenderurl=url->[(Text,Text)]->TexttypeTranslatemsg=msg->Html-- | A function generating an 'Html' given a URL-rendering function.typeHamleturl=Renderurl->Html-- | A function generating an 'Html' given a message translator and a URL rendering function.typeIHamletmsgurl=Translatemsg->Renderurl->HtmldocsToExp::Env->HamletRules->Scope->[Doc]->QExpdocsToExpenvhrscopedocs=doexps<-mapM(docToExpenvhrscope)docscaseexpsof[]->[|return()|][x]->returnx_->return$DoE$mapNoBindSexpsdocToExp::Env->HamletRules->Scope->Doc->QExpdocToExpenvhrscope(DocForalllistident@(Identname)inside)=doletlist'=derefToExpscopelistname'<-newNamenameletscope'=(ident,VarEname'):scopemh<-[|F.mapM_|]inside'<-docsToExpenvhrscope'insideletlam=LamE[VarPname']inside'return$mh`AppE`lam`AppE`list'docToExpenvhrscope(DocWith[]inside)=doinside'<-docsToExpenvhrscopeinsidereturn$inside'docToExpenvhrscope(DocWith((deref,ident@(Identname)):dis)inside)=doletderef'=derefToExpscopederefname'<-newNamenameletscope'=(ident,VarEname'):scopeinside'<-docToExpenvhrscope'(DocWithdisinside)letlam=LamE[VarPname']inside'return$lam`AppE`deref'docToExpenvhrscope(DocMaybevalident@(Identname)insidemno)=doletval'=derefToExpscopevalname'<-newNamenameletscope'=(ident,VarEname'):scopeinside'<-docsToExpenvhrscope'insideletinside''=LamE[VarPname']inside'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)html::QuasiQuoterhtml=hamletWithSettingshtmlRulesdefaultHamletSettingsxhtml::QuasiQuoterxhtml=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]hletem(Env(Justurender)Nothing)e=urender$\ur->return(e`AppE`ur)return$HamletRulesiuremihamlet::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]hletem(Env(Justurender)(Justmrender))e=urender$\ur->mrender$\mr->return(e`AppE`mr`AppE`ur)return$HamletRulesiuremhamletWithSettings::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=hamletFileWithSettingshamletRulesxhtmlHamletSettingshtmlFile::FilePath->QExphtmlFile=hamletFileWithSettingshtmlRulesdefaultHamletSettingsxhtmlFile::FilePath->QExpxhtmlFile=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()condH[]Nothing=return()condH[](Justx)=xcondH((True,y):_)_=ycondH((False,_):rest)z=condHrestz-- | 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()maybeHNothing_Nothing=return()maybeHNothing_(Justx)=xmaybeH(Justv)f_=fv