{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE PackageImports #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE TypeFamilies #-}-- | Widgets combine HTML with JS and CSS dependencies with a unique identifier-- generator, allowing you to create truly modular HTML components.moduleYesod.Widget(-- * DatatypeGWidget(..),liftHandler-- * Creating-- ** Head of page,setTitle,addHamletHead,addHtmlHead-- ** Body,addHamlet,addHtml,addWidget,addSubWidget-- ** CSS,addCassius,addStylesheet,addStylesheetRemote,addStylesheetEither-- ** Javascript,addJulius,addScript,addScriptRemote,addScriptEither-- * Utilities,extractBody,newIdent)whereimportData.MonoidimportControl.Monad.Trans.WriterimportControl.Monad.Trans.StateimportText.HamletimportText.CassiusimportText.JuliusimportYesod.Handler(Route,GHandler,HandlerData,YesodSubRoute(..),toMasterHandlerMaybe,getYesod)importControl.Applicative(Applicative)importControl.Monad.IO.Class(MonadIO)importControl.Monad.Trans.Class(lift)importYesod.InternalimportControl.Monad.Invert(MonadInvertIO(..))importControl.Monad(liftM)importqualifiedData.MapasMap-- | 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.newtypeGWidgetsma=GWidget{unGWidget::GWInnersma}deriving(Functor,Applicative,Monad,MonadIO)typeGWInnersubmaster=WriterT(Body(Routemaster))(WriterT(LastTitle)(WriterT(UniqueList(Script(Routemaster)))(WriterT(UniqueList(Stylesheet(Routemaster)))(WriterT(Maybe(Cassius(Routemaster)))(WriterT(Maybe(Julius(Routemaster)))(WriterT(Head(Routemaster))(StateTInt(GHandlersubmaster))))))))instanceMonoid(GWidgetsubmaster())wheremempty=return()mappendxy=x>>yinstanceMonadInvertIO(GWidgetsm)wherenewtypeInvertedIO(GWidgetsm)a=InvGWidgetIO{runInvGWidgetIO::InvertedIO(GWInnersm)a}typeInvertedArg(GWidgetsm)=(Int,(HandlerDatasm,(Map.MapStringString,())))invertIO=liftM(fmapInvGWidgetIO).invertIO.unGWidgetrevertIOf=GWidget$revertIO$liftMrunInvGWidgetIO.finstanceHamletValue(GWidgetsm())wherenewtypeHamletMonad(GWidgetsm())a=GWidget'{runGWidget'::GWidgetsma}typeHamletUrl(GWidgetsm())=RoutemtoHamletValue=runGWidget'htmlToHamletMonad=GWidget'.addHtmlurlToHamletMonadurlparams=GWidget'$addHamlet$\r->preEscapedString(rurlparams)fromHamletValue=GWidget'instanceMonad(HamletMonad(GWidgetsm()))wherereturn=GWidget'.returnx>>=y=GWidget'$runGWidget'x>>=runGWidget'.y-- | Lift an action in the 'GHandler' monad into an action in the 'GWidget'-- monad.liftHandler::GHandlersubmastera->GWidgetsubmasteraliftHandler=GWidget.lift.lift.lift.lift.lift.lift.lift.liftaddSubWidget::(YesodSubRoutesubmaster)=>sub->GWidgetsubmastera->GWidgetsub'masteraaddSubWidgetsubw=domaster<-liftHandlergetYesodletsr=fromSubRoutesubmasteri<-GWidget$lift$lift$lift$lift$lift$lift$liftgetw'<-liftHandler$toMasterHandlerMaybesr(constsub)Nothing$fliprunStateTi$runWriterT$runWriterT$runWriterT$runWriterT$runWriterT$runWriterT$runWriterT$unGWidgetwlet((((((((a,body),title),scripts),stylesheets),style),jscript),h),i')=w'GWidget$dotellbodylift$telltitlelift$lift$tellscriptslift$lift$lift$tellstylesheetslift$lift$lift$lift$tellstylelift$lift$lift$lift$lift$telljscriptlift$lift$lift$lift$lift$lift$tellhlift$lift$lift$lift$lift$lift$lift$puti'returna-- | Set the page title. Calling 'setTitle' multiple times overrides previously-- set values.setTitle::Html->GWidgetsubmaster()setTitle=GWidget.lift.tell.Last.Just.Title-- | Add a 'Hamlet' to the head tag.addHamletHead::Hamlet(Routemaster)->GWidgetsubmaster()addHamletHead=GWidget.lift.lift.lift.lift.lift.lift.tell.Head-- | Add a 'Html' to the head tag.addHtmlHead::Html->GWidgetsubmaster()addHtmlHead=GWidget.lift.lift.lift.lift.lift.lift.tell.Head.const-- | Add a 'Hamlet' to the body tag.addHamlet::Hamlet(Routemaster)->GWidgetsubmaster()addHamlet=GWidget.tell.Body-- | Add a 'Html' to the body tag.addHtml::Html->GWidgetsubmaster()addHtml=GWidget.tell.Body.const-- | Add another widget. This is defined as 'id', by can help with types, and-- makes widget blocks look more consistent.addWidget::GWidgetsm()->GWidgetsm()addWidget=id-- | Get a unique identifier.newIdent::GWidgetsubmasterStringnewIdent=GWidget$lift$lift$lift$lift$lift$lift$lift$doi<-getleti'=i+1puti'return$"w"++showi'-- | Add some raw CSS to the style tag.addCassius::Cassius(Routemaster)->GWidgetsubmaster()addCassius=GWidget.lift.lift.lift.lift.tell.Just-- | Link to the specified local stylesheet.addStylesheet::Routemaster->GWidgetsubmaster()addStylesheet=GWidget.lift.lift.lift.tell.toUnique.Stylesheet.Local-- | Link to the specified remote stylesheet.addStylesheetRemote::String->GWidgetsubmaster()addStylesheetRemote=GWidget.lift.lift.lift.tell.toUnique.Stylesheet.RemoteaddStylesheetEither::Either(Routemaster)String->GWidgetsubmaster()addStylesheetEither=eitheraddStylesheetaddStylesheetRemoteaddScriptEither::Either(Routemaster)String->GWidgetsubmaster()addScriptEither=eitheraddScriptaddScriptRemote-- | Link to the specified local script.addScript::Routemaster->GWidgetsubmaster()addScript=GWidget.lift.lift.tell.toUnique.Script.Local-- | Link to the specified remote script.addScriptRemote::String->GWidgetsubmaster()addScriptRemote=GWidget.lift.lift.tell.toUnique.Script.Remote-- | Include raw Javascript in the page's script tag.addJulius::Julius(Routemaster)->GWidgetsubmaster()addJulius=GWidget.lift.lift.lift.lift.lift.tell.Just-- | 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::GWidgetsm()->GWidgetsm(Hamlet(Routem))extractBody(GWidgetw)=GWidget$mapWriterT(fmapgo)wwherego((),Bodyh)=(h,Bodymempty)