{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE TemplateHaskell #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE UndecidableInstances #-}-- | Widgets combine HTML with JS and CSS dependencies with a unique identifier-- generator, allowing you to create truly modular HTML components.moduleYesod.Widget(-- * DatatypeGWidget,GGWidget(..),PageContent(..)-- * Special Hamlet quasiquoter/TH for Widgets,whamlet,whamletFile,ihamletToRepHtml-- * Convert to Widget,ToWidget(..),ToWidgetHead(..),ToWidgetBody(..)-- * Creating-- ** Head of page,setTitle,setTitleI,addHamletHead,addHtmlHead-- ** Body,addHamlet,addHtml,addWidget,addSubWidget-- ** CSS,addCassius,addCassiusMedia,addLucius,addLuciusMedia,addStylesheet,addStylesheetAttrs,addStylesheetRemote,addStylesheetRemoteAttrs,addStylesheetEither-- ** Javascript,addJulius,addJuliusBody,addCoffee,addCoffeeBody,addScript,addScriptAttrs,addScriptRemote,addScriptRemoteAttrs,addScriptEither-- * Utilities,extractBody)whereimportData.MonoidimportControl.Monad.Trans.RWSimportqualifiedText.Blaze.Html5asHimportText.HamletimportText.CassiusimportText.JuliusimportText.CoffeeimportYesod.Handler(Route,GHandler,GGHandler,YesodSubRoute(..),toMasterHandlerMaybe,getYesod,getMessageRender,getUrlRenderParams)importYesod.Message(RenderMessage)importYesod.Content(RepHtml(..),toContent)importControl.Applicative(Applicative)importControl.Monad.IO.Class(MonadIO(liftIO))importControl.Monad.Trans.Class(MonadTrans(lift))importYesod.InternalimportControl.Monad(liftM)importData.Text(Text)importqualifiedData.MapasMapimportLanguage.Haskell.TH.Quote(QuasiQuoter)importLanguage.Haskell.TH.Syntax(Q,Exp(InfixE,VarE,LamE),Pat(VarP),newName)importControl.Monad.IO.Control(MonadControlIO)importqualifiedText.HamletasNPimportData.Text.Lazy.Builder(fromLazyText)importText.Blaze(toHtml,preEscapedLazyText)-- | A generic widget, allowing specification of both the subsite and master-- site datatypes. This is basically a large 'WriterT' stack keeping track of-- dependencies along with a 'StateT' to track unique identifiers.newtypeGGWidgetmmonada=GWidget{unGWidget::GWInnermmonada}deriving(Functor,Applicative,Monad,MonadIO,MonadControlIO)instanceMonadTrans(GGWidgetm)wherelift=GWidget.lifttypeGWidgetsm=GGWidgetm(GHandlersm)typeGWInnermaster=RWST()(GWData(Routemaster))Intinstance(Monadmonad,a~())=>Monoid(GGWidgetmastermonada)wheremempty=return()mappendxy=x>>yaddSubWidget::(YesodSubRoutesubmaster)=>sub->GWidgetsubmastera->GWidgetsub'masteraaddSubWidgetsub(GWidgetw)=domaster<-liftgetYesodletsr=fromSubRoutesubmasters<-GWidgetget(a,s',w')<-lift$toMasterHandlerMaybesr(constsub)Nothing$runRWSTw()sGWidget$puts'GWidget$tellw'returnaclassToWidgetsubmasterawheretoWidget::a->GWidgetsubmaster()-- FIXME At some point in the future, deprecate all the-- addHamlet/Cassius/Lucius/Julius stuff. For the most part, toWidget* will be-- sufficient. For somethings, like addLuciusMedia, create addCssUrlMedia.typeRYmaster=Routemaster->[(Text,Text)]->Textinstancerender~RYmaster=>ToWidgetsubmaster(render->Html)wheretoWidget=addHamletinstancerender~RYmaster=>ToWidgetsubmaster(render->Css)wheretoWidget=addCassiusinstancerender~RYmaster=>ToWidgetsubmaster(render->Javascript)wheretoWidget=addJuliusinstanceToWidgetsubmaster(GWidgetsubmaster())wheretoWidget=idinstanceToWidgetsubmasterHtmlwheretoWidget=addHtmlinstancerender~RYmaster=>ToWidgetsubmaster(render->Coffeescript)wheretoWidget=addCoffeeclassToWidgetBodysubmasterawheretoWidgetBody::a->GWidgetsubmaster()instancerender~RYmaster=>ToWidgetBodysubmaster(render->Html)wheretoWidgetBody=addHamletinstancerender~RYmaster=>ToWidgetBodysubmaster(render->Javascript)wheretoWidgetBody=addJuliusBodyinstanceToWidgetBodysubmasterHtmlwheretoWidgetBody=addHtmlinstancerender~RYmaster=>ToWidgetBodysubmaster(render->Coffeescript)wheretoWidgetBody=addCoffeeBodyclassToWidgetHeadsubmasterawheretoWidgetHead::a->GWidgetsubmaster()instancerender~RYmaster=>ToWidgetHeadsubmaster(render->Html)wheretoWidgetHead=addHamletHeadinstancerender~RYmaster=>ToWidgetHeadsubmaster(render->Css)wheretoWidgetHead=addCassiusinstancerender~RYmaster=>ToWidgetHeadsubmaster(render->Javascript)wheretoWidgetHead=addJuliusinstanceToWidgetHeadsubmasterHtmlwheretoWidgetHead=addHtmlHeadinstancerender~RYmaster=>ToWidgetHeadsubmaster(render->Coffeescript)wheretoWidgetHead=addCoffee-- | Set the page title. Calling 'setTitle' multiple times overrides previously-- set values.setTitle::Monadm=>Html->GGWidgetmasterm()setTitlex=GWidget$tell$GWDatamempty(Last$Just$Titlex)memptymemptymemptymemptymempty-- | Set the page title. Calling 'setTitle' multiple times overrides previously-- set values.setTitleI::(RenderMessagemastermsg,Monadm)=>msg->GGWidgetmaster(GGHandlersubmasterm)()setTitleImsg=domr<-liftgetMessageRendersetTitle$toHtml$mrmsg-- | Add a 'Hamlet' to the head tag.addHamletHead::Monadm=>HtmlUrl(Routemaster)->GGWidgetmasterm()addHamletHead=GWidget.tell.GWDatamemptymemptymemptymemptymemptymempty.Head-- | Add a 'Html' to the head tag.addHtmlHead::Monadm=>Html->GGWidgetmasterm()addHtmlHead=addHamletHead.const-- | Add a 'Hamlet' to the body tag.addHamlet::Monadm=>HtmlUrl(Routemaster)->GGWidgetmasterm()addHamletx=GWidget$tell$GWData(Bodyx)memptymemptymemptymemptymemptymempty-- | Add a 'Html' to the body tag.addHtml::Monadm=>Html->GGWidgetmasterm()addHtml=addHamlet.const-- | Add another widget. This is defined as 'id', by can help with types, and-- makes widget blocks look more consistent.addWidget::Monadmo=>GGWidgetmmo()->GGWidgetmmo()addWidget=id-- | Add some raw CSS to the style tag. Applies to all media types.addCassius::Monadm=>CssUrl(Routemaster)->GGWidgetmasterm()addCassiusx=GWidget$tell$GWDatamemptymemptymemptymempty(Map.singletonNothingx)memptymempty-- | Identical to 'addCassius'.addLucius::Monadm=>CssUrl(Routemaster)->GGWidgetmasterm()addLucius=addCassius-- | Add some raw CSS to the style tag, for a specific media type.addCassiusMedia::Monadm=>Text->CssUrl(Routemaster)->GGWidgetmasterm()addCassiusMediamx=GWidget$tell$GWDatamemptymemptymemptymempty(Map.singleton(Justm)x)memptymempty-- | Identical to 'addCassiusMedia'.addLuciusMedia::Monadm=>Text->CssUrl(Routemaster)->GGWidgetmasterm()addLuciusMedia=addCassiusMedia-- | Link to the specified local stylesheet.addStylesheet::Monadm=>Routemaster->GGWidgetmasterm()addStylesheet=flipaddStylesheetAttrs[]-- | Link to the specified local stylesheet.addStylesheetAttrs::Monadm=>Routemaster->[(Text,Text)]->GGWidgetmasterm()addStylesheetAttrsxy=GWidget$tell$GWDatamemptymemptymempty(toUnique$Stylesheet(Localx)y)memptymemptymempty-- | Link to the specified remote stylesheet.addStylesheetRemote::Monadm=>Text->GGWidgetmasterm()addStylesheetRemote=flipaddStylesheetRemoteAttrs[]-- | Link to the specified remote stylesheet.addStylesheetRemoteAttrs::Monadm=>Text->[(Text,Text)]->GGWidgetmasterm()addStylesheetRemoteAttrsxy=GWidget$tell$GWDatamemptymemptymempty(toUnique$Stylesheet(Remotex)y)memptymemptymemptyaddStylesheetEither::Monadm=>Either(Routemaster)Text->GGWidgetmasterm()addStylesheetEither=eitheraddStylesheetaddStylesheetRemoteaddScriptEither::Monadm=>Either(Routemaster)Text->GGWidgetmasterm()addScriptEither=eitheraddScriptaddScriptRemote-- | Link to the specified local script.addScript::Monadm=>Routemaster->GGWidgetmasterm()addScript=flipaddScriptAttrs[]-- | Link to the specified local script.addScriptAttrs::Monadm=>Routemaster->[(Text,Text)]->GGWidgetmasterm()addScriptAttrsxy=GWidget$tell$GWDatamemptymempty(toUnique$Script(Localx)y)memptymemptymemptymempty-- | Link to the specified remote script.addScriptRemote::Monadm=>Text->GGWidgetmasterm()addScriptRemote=flipaddScriptRemoteAttrs[]-- | Link to the specified remote script.addScriptRemoteAttrs::Monadm=>Text->[(Text,Text)]->GGWidgetmasterm()addScriptRemoteAttrsxy=GWidget$tell$GWDatamemptymempty(toUnique$Script(Remotex)y)memptymemptymemptymempty-- | Include raw Javascript in the page's script tag.addJulius::Monadm=>JavascriptUrl(Routemaster)->GGWidgetmasterm()addJuliusx=GWidget$tell$GWDatamemptymemptymemptymemptymempty(Justx)mempty-- | Add a new script tag to the body with the contents of this 'Julius'-- template.addJuliusBody::Monadm=>JavascriptUrl(Routemaster)->GGWidgetmasterm()addJuliusBodyj=addHamlet$\r->H.script$preEscapedLazyText$renderJavascriptUrlrj-- | Add Coffesscript to the page's script tag. Requires the coffeescript-- executable to be present at runtime.addCoffee::MonadIOm=>CoffeeUrl(Routemaster)->GGWidgetmaster(GGHandlersubmasterm)()addCoffeec=dorender<-liftgetUrlRenderParamst<-liftIO$renderCoffeerendercaddJulius$const$Javascript$fromLazyTextt-- | Add a new script tag to the body with the contents of this Coffesscript-- template. Requires the coffeescript executable to be present at runtime.addCoffeeBody::MonadIOm=>CoffeeUrl(Routemaster)->GGWidgetmaster(GGHandlersubmasterm)()addCoffeeBodyc=dorender<-liftgetUrlRenderParamst<-liftIO$renderCoffeerendercaddJuliusBody$const$Javascript$fromLazyTextt-- | Pull out the HTML tag contents and return it. Useful for performing some-- manipulations. It can be easier to use this sometimes than 'wrapWidget'.extractBody::Monadmo=>GGWidgetmmo()->GGWidgetmmo(HtmlUrl(Routem))extractBody(GWidgetw)=GWidget$mapRWST(liftMgo)wwherego((),s,GWData(Bodyh)bcdefg)=(h,s,GWData(Bodymempty)bcdefg)-- | Content for a web page. By providing this datatype, we can easily create-- generic site templates, which would have the type signature:---- > PageContent url -> HtmlUrl urldataPageContenturl=PageContent{pageTitle::Html,pageHead::HtmlUrlurl,pageBody::HtmlUrlurl}whamlet::QuasiQuoterwhamlet=NP.hamletWithSettingsrulesNP.defaultHamletSettingswhamletFile::FilePath->QExpwhamletFile=NP.hamletFileWithSettingsrulesNP.defaultHamletSettingsrules::QNP.HamletRulesrules=doah<-[|addHtml|]lethelperqgf=dox<-newName"urender"e<-f$VarExlete'=LamE[VarPx]eg<-qgbind<-[|(>>=)|]return$InfixE(Justg)bind(Juste')leturf=doletenv=NP.Env(Just$helper[|liftgetUrlRenderParams|])(Just$helper[|liftM(toHtml.)$liftgetMessageRender|])fenvreturn$NP.HamletRulesahur$\_b->returnb-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.ihamletToRepHtml::(Monadmo,RenderMessagemastermessage)=>HtmlUrlI18nmessage(Routemaster)->GGHandlersubmastermoRepHtmlihamletToRepHtmlih=dourender<-getUrlRenderParamsmrender<-getMessageRenderreturn$RepHtml$toContent$ih(toHtml.mrender)urender