{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE TypeSynonymInstances #-}moduleSnap.Snaplet.HeistNoClass(Heist,heistInit,heistInit',clearHeistCache,addTemplates,addTemplatesAt,modifyHeistTS,modifyHeistTS',withHeistTS,withHeistTS',addSplices,addSplices',render,renderAs,heistServe,heistServeSingle,heistLocal,withSplices,renderWithSplices,heistLocal',withSplices',renderWithSplices',SnapletHeist,SnapletSplice,runSnapletSplice,liftHeist,liftWith,liftHandler,liftAppHandler,bindSnapletSplices)whereimportPreludehiding((.),id)importControl.ArrowimportControl.ApplicativeimportControl.CategoryimportControl.Monad.CatchIO(MonadCatchIO)importControl.Monad.ReaderimportControl.Monad.StateimportData.ByteString(ByteString)importqualifiedData.ByteString.Char8asBimportqualifiedData.ByteString.UTF8asUimportData.MaybeimportData.MonoidimportData.Lens.LazyimportData.Text(Text)importqualifiedData.TextasTimportSystem.FilePath.PosiximportText.Templating.HeistimportText.Templating.Heist.Splices.CacheimportSnap.SnapletimportSnap.CoreimportSnap.Util.FileServe-------------------------------------------------------------------------------- | The state for the Heist snaplet. To use the Heist snaplet in your app-- include this in your application state and use 'heistInit' to initialize-- it. The type parameter b will typically be the base state type for your-- application.--dataHeistb=Heist{_heistTS::HeistState(Handlerbb),_heistCTS::CacheTagState}------------------------------------------------------------------------------changeTS::(HeistState(Handleraa)->HeistState(Handleraa))->Heista->HeistachangeTSf(Heisttscts)=Heist(fts)cts-------------------------------------------------------------------------------- | Clears data stored by the cache tag. The cache tag automatically reloads-- its data when the specified TTL expires, but sometimes you may want to-- trigger a manual reload. This function lets you do that.--clearHeistCache::Heistb->IO()clearHeistCache=clearCacheTagState._heistCTS------------------------------- SnapletSplice functions --------------------------------------------------------------------------------------------------------------- | This instance is here because we don't want the heist package to depend-- on anything from snap packages.--instanceMonadSnapm=>MonadSnap(HeistTm)whereliftSnap=lift.liftSnap-------------------------------------------------------------------------------- | Monad for working with Heist's API from within a snaplet.--newtypeSnapletHeistbva=SnapletHeist(ReaderT(Lens(Snapletb)(Snapletv))(HeistT(Handlerbb))a)deriving(Monad,Functor,Applicative,Alternative,MonadIO,MonadPlus,MonadReader(Lens(Snapletb)(Snapletv)),MonadCatchIO,MonadSnap)-------------------------------------------------------------------------------- | Type alias for convenience.--typeSnapletSplicebv=SnapletHeistbvTemplate-------------------------------------------------------------------------------- | Runs the SnapletSplice.--runSnapletSplice::(Lens(Snapletb)(Snapletv))->SnapletHeistbva->HeistT(Handlerbb)arunSnapletSplicel(SnapletHeistm)=runReaderTml------------------------------------------------------------------------------withSS::(Lens(Snapletb)(Snapletv)->Lens(Snapletb)(Snapletv'))->SnapletHeistbv'a->SnapletHeistbvawithSSf(SnapletHeistm)=SnapletHeist$withReaderTfm-------------------------------------------------------------------------------- | Lifts a HeistT action into SnapletHeist. Use this with all the functions-- from the Heist API.--liftHeist::HeistT(Handlerbb)a->SnapletHeistbvaliftHeist=SnapletHeist.lift-------------------------------------------------------------------------------- | Common idiom for the combination of liftHandler and withTop.--liftWith::(Lens(Snapletb)(Snapletv'))->Handlerbv'a->SnapletHeistbvaliftWithl=liftHeist.lift.withTop'l-------------------------------------------------------------------------------- | Lifts a Handler into SnapletHeist.--liftHandler::Handlerbva->SnapletHeistbvaliftHandlerm=dol<-askliftWithlm-------------------------------------------------------------------------------- | Lifts a (Handler b b) into SnapletHeist.--liftAppHandler::Handlerbba->SnapletHeistbvaliftAppHandler=liftHeist.lift------------------------------------------------------------------------------instanceMonadStatev(SnapletHeistbv)whereget=dol<-askb<-liftAppHandlergetSnapletStatereturn$getL(snapletValue.l)bputs=dol<-askb<-liftAppHandlergetSnapletStateliftAppHandler$putSnapletState$setL(snapletValue.l)sb-------------------------------------------------------------------------------- | MonadSnaplet instance gives us access to the snaplet infrastructure.--instanceMonadSnapletSnapletHeistwheregetLens=askwith'l=withSS(l.)withTop'l=withSS(constid).with'lgetOpaqueConfig=dol<-askb<-liftAppHandlergetSnapletStatereturn$getL(snapletConfig.l)b-------------------------------------------------------------------------------- | SnapletSplices version of bindSplices.--bindSnapletSplices::(Lens(Snapletb)(Snapletv))->[(Text,SnapletSplicebv)]->HeistState(Handlerbb)->HeistState(Handlerbb)bindSnapletSpliceslsplices=bindSplices$map(second$runSnapletSplicel)splices----------------------------- Initializer functions ------------------------------------------------------------------------------------------------------------- | The 'Initializer' for 'Heist'. This function is a convenience wrapper-- around `heistInit'` that uses the default `mempty` HeistState and sets up-- routes for all the templates.--heistInit::FilePath-- ^ Path to templates->SnapletInitb(Heistb)heistInittemplateDir=domakeSnaplet"heist"""Nothing$dohs<-heistInitWorkertemplateDirdefaultHeistStateaddRoutes[("",heistServe)]returnhs-------------------------------------------------------------------------------- | A lower level 'Initializer' for 'Heist'. This initializer requires you-- to specify the initial HeistState. It also does not add any routes for-- templates, allowing you complete control over which templates get routed.--heistInit'::FilePath-- ^ Path to templates->HeistState(Handlerbb)-- ^ Initial HeistState->SnapletInitb(Heistb)heistInit'templateDirinitialHeistState=makeSnaplet"heist"""Nothing$heistInitWorkertemplateDirinitialHeistState-------------------------------------------------------------------------------- | Internal worker function used by variantsof heistInit. This is necessary-- because of the divide between SnapletInit and Initializer.--heistInitWorker::FilePath->HeistState(Handlerbb)->Initializerbv(Heistb)heistInitWorkertemplateDirinitialHeistState=do(cacheFunc,cts)<-liftIOmkCacheTagletorigTs=cacheFuncinitialHeistStatesnapletPath<-getSnapletFilePathlettDir=snapletPath</>templateDirts<-liftIO$loadTemplatestDirorigTs>>=eithererrorreturnprintInfo$T.pack$unwords["...loaded",(show$length$templateNamests),"templates from",tDir]return$Heisttscts-------------------------------------------------------------------------------- | Adds templates to the Heist HeistState. Other snaplets should use-- this function to add their own templates. The templates are automatically-- read from the templates directory in the current snaplet's filesystem root.addTemplates::ByteString-- ^ The url prefix for the template routes->Initializerb(Heistb)()addTemplatesurlPrefix=dosnapletPath<-getSnapletFilePathaddTemplatesAturlPrefix(snapletPath</>"templates")-------------------------------------------------------------------------------- | Adds templates to the Heist HeistState, and lets you specify where-- they are found in the filesystem. Note that the path to the template-- directory is an absolute path. This allows you more flexibility in where-- your templates are located, but means that you have to explicitly call-- getSnapletFilePath if you want your snaplet to use templates within its-- normal directory structure.addTemplatesAt::ByteString-- ^ URL prefix for template routes->FilePath-- ^ Path to templates->Initializerb(Heistb)()addTemplatesAturlPrefixtemplateDir=dots<-liftIO$loadTemplatestemplateDirmempty>>=eithererrorreturnrootUrl<-getSnapletRootURLletfullPrefix=U.toStringrootUrl</>U.toStringurlPrefixprintInfo$T.pack$unwords["...adding",(show$length$templateNamests),"templates from",templateDir,"with route prefix",fullPrefix++"/"]addPostInitHook$return.changeTS(`mappend`addTemplatePathPrefix(U.fromStringfullPrefix)ts)------------------------------------------------------------------------------modifyHeistTS'::(Lens(Snapletb)(Snaplet(Heistb)))->(HeistState(Handlerbb)->HeistState(Handlerbb))->Initializerbv()modifyHeistTS'heistf=do_lens<-getLenswithTop'heist$addPostInitHook$return.changeTSf------------------------------------------------------------------------------modifyHeistTS::(Lensb(Snaplet(Heistb)))->(HeistState(Handlerbb)->HeistState(Handlerbb))->Initializerbv()modifyHeistTSheistf=modifyHeistTS'(subSnapletheist)f------------------------------------------------------------------------------withHeistTS'::(Lens(Snapletb)(Snaplet(Heistb)))->(HeistState(Handlerbb)->a)->HandlerbvawithHeistTS'heistf=withTop'heist$gets(f._heistTS)------------------------------------------------------------------------------withHeistTS::(Lensb(Snaplet(Heistb)))->(HeistState(Handlerbb)->a)->HandlerbvawithHeistTSheistf=withHeistTS'(subSnapletheist)f------------------------------------------------------------------------------addSplices'::(Lens(Snapletb)(Snaplet(Heistb)))->[(Text,SnapletSplicebv)]->Initializerbv()addSplices'heistsplices=do_lens<-getLenswithTop'heist$addPostInitHook$return.changeTS(bindSnapletSplices_lenssplices)------------------------------------------------------------------------------addSplices::(Lensb(Snaplet(Heistb)))->[(Text,SnapletSplicebv)]->Initializerbv()addSplicesheistsplices=addSplices'(subSnapletheist)splices------------------------- Handler functions --------------------------------------------------------------------------------------------------------- | Internal helper function for rendering.renderHelper::MaybeMIMEType->ByteString->Handlerb(Heistb)()renderHelperct=do(Heistts_)<-getwithTop'id$renderTemplatetst>>=maybepassservewhereserve(b,mime)=domodifyResponse$setContentType$fromMaybemimecwriteBuilderb------------------------------------------------------------------------------render::ByteString-- ^ Name of the template->Handlerb(Heistb)()rendert=renderHelperNothingt------------------------------------------------------------------------------renderAs::ByteString-- ^ Content type->ByteString-- ^ Name of the template->Handlerb(Heistb)()renderAsctt=renderHelper(Justct)t------------------------------------------------------------------------------heistServe::Handlerb(Heistb)()heistServe=ifTop(render"index")<|>(render.B.pack=<<getSafePath)------------------------------------------------------------------------------heistServeSingle::ByteString->Handlerb(Heistb)()heistServeSinglet=rendert<|>error("Template "++showt++" not found.")------------------------------------------------------------------------------heistLocal'::(Lens(Snapletb)(Snaplet(Heistb)))->(HeistState(Handlerbb)->HeistState(Handlerbb))->Handlerbva->HandlerbvaheistLocal'heistfm=dohs<-withTop'heistgetwithTop'heist$modify$changeTSfres<-mwithTop'heist$puthsreturnres------------------------------------------------------------------------------heistLocal::(Lensb(Snaplet(Heistb)))->(HeistState(Handlerbb)->HeistState(Handlerbb))->Handlerbva->HandlerbvaheistLocalheistfm=heistLocal'(subSnapletheist)fm------------------------------------------------------------------------------withSplices'::(Lens(Snapletb)(Snaplet(Heistb)))->[(Text,SnapletSplicebv)]->Handlerbva->HandlerbvawithSplices'heistsplicesm=do_lens<-getLensheistLocal'heist(bindSnapletSplices_lenssplices)m------------------------------------------------------------------------------withSplices::(Lensb(Snaplet(Heistb)))->[(Text,SnapletSplicebv)]->Handlerbva->HandlerbvawithSplicesheistsplicesm=withSplices'(subSnapletheist)splicesm------------------------------------------------------------------------------renderWithSplices'::(Lens(Snapletb)(Snaplet(Heistb)))->ByteString->[(Text,SnapletSplicebv)]->Handlerbv()renderWithSplices'heisttsplices=withSplices'heistsplices$withTop'heist$rendert------------------------------------------------------------------------------renderWithSplices::(Lensb(Snaplet(Heistb)))->ByteString->[(Text,SnapletSplicebv)]->Handlerbv()renderWithSplicesheisttsplices=renderWithSplices'(subSnapletheist)tsplices