{-# LANGUAGE QuasiQuotes #-}{-# LANGUAGE RankNTypes #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE CPP #-}-- | The basic typeclass for a Yesod application.moduleYesod.Yesod(-- * Type classesYesod(..),YesodSite(..),YesodSubSite(..)-- ** Persistence,YesodPersist(..),moduleDatabase.Persist,get404-- ** Breadcrumbs,YesodBreadcrumbs(..),breadcrumbs-- * Utitlities,maybeAuthorized,widgetToPageContent,defaultLayoutJson,redirectToPost-- * Defaults,defaultErrorHandler-- * Data types,AuthResult(..)#if TEST,testSuite#endif)where#if TESTimportYesod.Contenthiding(testSuite)importYesod.Jsonhiding(testSuite)importYesod.Handlerhiding(testSuite)importqualifiedData.ByteString.UTF8asBSU#elseimportYesod.ContentimportYesod.JsonimportYesod.Handler#endifimportYesod.WidgetimportYesod.RequestimportYesod.HamletimportqualifiedNetwork.WaiasWimportYesod.InternalimportWeb.ClientSession(getKey,defaultKeyFile)importqualifiedWeb.ClientSessionasCSimportDatabase.PersistimportControl.Monad.Trans.Class(MonadTrans(..))importControl.Failure(Failure)importqualifiedData.ByteStringasSimportqualifiedNetwork.Wai.Middleware.CleanPathimportqualifiedData.ByteString.LazyasLimportData.MonoidimportControl.Monad.Trans.WriterimportControl.Monad.Trans.Statehiding(get)importText.HamletimportText.CassiusimportText.JuliusimportWeb.Routes#if TESTimportTest.Framework(testGroup,Test)importTest.Framework.Providers.HUnitimportTest.Framework.Providers.QuickCheck2(testProperty)importTest.HUnithiding(Test)#endif-- | This class is automatically instantiated when you use the template haskell-- mkYesod function. You should never need to deal with it directly.classEq(Routey)=>YesodSiteywheregetSite::Site(Routey)(Method->Maybe(GHandleryyChooseRep))typeMethod=String-- | Same as 'YesodSite', but for subsites. Once again, users should not need-- to deal with it directly, as the mkYesodSub creates instances appropriately.classEq(Routes)=>YesodSubSitesywheregetSubSite::Site(Routes)(Method->Maybe(GHandlersyChooseRep))-- | Define settings for a Yesod applications. The only required setting is-- 'approot'; other than that, there are intelligent defaults.classEq(Routea)=>Yesodawhere-- | An absolute URL to the root of the application. Do not include-- trailing slash.---- If you want to be lazy, you can supply an empty string under the-- following conditions:---- * Your application is served from the root of the domain.---- * You do not use any features that require absolute URLs, such as Atom-- feeds and XML sitemaps.approot::a->String-- | The encryption key to be used for encrypting client sessions.encryptKey::a->IOCS.KeyencryptKey_=getKeydefaultKeyFile-- | Number of minutes before a client session times out. Defaults to-- 120 (2 hours).clientSessionDuration::a->IntclientSessionDuration=const120-- | Output error response pages.errorHandler::ErrorResponse->GHandlersubaChooseReperrorHandler=defaultErrorHandler-- | Applies some form of layout to the contents of a page.defaultLayout::GWidgetsuba()->GHandlersubaRepHtmldefaultLayoutw=dop<-widgetToPageContentwmmsg<-getMessagehamletToRepHtml[$hamlet|!!!%html%head%title$pageTitle.p$^pageHead.p^%body$maybemmsgmsg%p.message$msg$^pageBody.p^|]-- | Gets called at the beginning of each request. Useful for logging.onRequest::GHandlersuba()onRequest=return()-- | Override the rendering function for a particular URL. One use case for-- this is to offload static hosting to a different domain name to avoid-- sending cookies.urlRenderOverride::a->Routea->MaybeStringurlRenderOverride__=Nothing-- | Determine if a request is authorized or not.---- Return 'Nothing' is the request is authorized, 'Just' a message if-- unauthorized. If authentication is required, you should use a redirect;-- the Auth helper provides this functionality automatically.isAuthorized::Routea->Bool-- ^ is this a write request?->GHandlersaAuthResultisAuthorized__=returnAuthorized-- | Determines whether the current request is a write request. By default,-- this assumes you are following RESTful principles, and determines this-- from request method. In particular, all except the following request-- methods are considered write: GET HEAD OPTIONS TRACE.---- This function is used to determine if a request is authorized; see-- 'isAuthorized'.isWriteRequest::Routea->GHandlersaBoolisWriteRequest_=dowai<-waiRequestreturn$not$W.requestMethodwai`elem`["GET","HEAD","OPTIONS","TRACE"]-- | The default route for authentication.---- Used in particular by 'isAuthorized', but library users can do whatever-- they want with it.authRoute::a->Maybe(Routea)authRoute_=Nothing-- | A function used to split a raw PATH_INFO value into path pieces. It-- returns a 'Left' value when you should redirect to the given path, and a-- 'Right' value on successful parse.---- By default, it splits paths on slashes, and ensures the following are true:---- * No double slashes---- * If the last path segment has a period, there is no trailing slash.---- * Otherwise, ensures there /is/ a trailing slash.splitPath::a->S.ByteString->EitherS.ByteString[String]splitPath_=Network.Wai.Middleware.CleanPath.splitPath-- | Join the pieces of a path together into an absolute URL. This should-- be the inverse of 'splitPath'.joinPath::a->String->[String]->[(String,String)]->StringjoinPath_arpiecesqs=ar++'/':encodePathInfo(fixSegspieces)qswherefixSegs[]=[]fixSegs[x]|any(=='.')x=[x]|otherwise=[x,""]-- append trailing slashfixSegs(x:xs)=x:fixSegsxs-- | This function is used to store some static content to be served as an-- external file. The most common case of this is stashing CSS and-- JavaScript content in an external file; the "Yesod.Widget" module uses-- this feature.---- The return value is 'Nothing' if no storing was performed; this is the-- default implementation. A 'Just' 'Left' gives the absolute URL of the-- file, whereas a 'Just' 'Right' gives the type-safe URL. The former is-- necessary when you are serving the content outside the context of a-- Yesod application, such as via memcached.addStaticContent::String-- ^ filename extension->String-- ^ mime-type->L.ByteString-- ^ content->GHandlersuba(Maybe(EitherString(Routea,[(String,String)])))addStaticContent___=returnNothing-- | Whether or not to tie a session to a specific IP address. Defaults to-- 'True'.sessionIpAddress::a->BoolsessionIpAddress_=TruedataAuthResult=Authorized|AuthenticationRequired|UnauthorizedStringderiving(Eq,Show,Read)-- | A type-safe, concise method of creating breadcrumbs for pages. For each-- resource, you declare the title of the page and the parent resource (if-- present).classYesodBreadcrumbsywhere-- | Returns the title and the parent resource, if available. If you return-- a 'Nothing', then this is considered a top-level page.breadcrumb::Routey->GHandlersuby(String,Maybe(Routey))-- | Gets the title of the current page and the hierarchy of parent pages,-- along with their respective titles.breadcrumbs::YesodBreadcrumbsy=>GHandlersuby(String,[(Routey,String)])breadcrumbs=dox'<-getCurrentRoutetm<-getRouteToMasterletx=fmaptmx'casexofNothing->return("Not found",[])Justy->do(title,next)<-breadcrumbyz<-go[]nextreturn(title,z)wheregobackNothing=returnbackgoback(Justthis)=do(title,next)<-breadcrumbthisgo((this,title):back)next-- | Provide both an HTML and JSON representation for a piece of data, using-- the default layout for the HTML output ('defaultLayout').defaultLayoutJson::Yesodmaster=>GWidgetsubmaster()->Json->GHandlersubmasterRepHtmlJsondefaultLayoutJsonwjson=doRepHtmlhtml'<-defaultLayoutwjson'<-jsonToContentjsonreturn$RepHtmlJsonhtml'json'applyLayout'::Yesodmaster=>Html-- ^ title->Hamlet(Routemaster)-- ^ body->GHandlersubmasterChooseRepapplyLayout'titlebody=fmapchooseRep$defaultLayout$dosetTitletitleaddHamletbody-- | The default error handler for 'errorHandler'.defaultErrorHandler::Yesody=>ErrorResponse->GHandlersubyChooseRepdefaultErrorHandlerNotFound=dor<-waiRequestletpath'=bsToChars$pathInforapplyLayout'"Not Found"$[$hamlet|%h1NotFound%p$path'$|]wherepathInfo=W.pathInfodefaultErrorHandler(PermissionDeniedmsg)=applyLayout'"Permission Denied"$[$hamlet|%h1Permissiondenied%p$msg$|]defaultErrorHandler(InvalidArgsia)=applyLayout'"Invalid Arguments"$[$hamlet|%h1InvalidArguments%ul$foralliamsg%li$msg$|]defaultErrorHandler(InternalErrore)=applyLayout'"Internal Server Error"$[$hamlet|%h1InternalServerError%p$e$|]defaultErrorHandler(BadMethodm)=applyLayout'"Bad Method"$[$hamlet|%h1MethodNotSupported%pMethod"$m$"notsupported|]classYesodPersistywheretypeYesodDBy::(*->*)->*->*runDB::YesodDBy(GHandlersuby)a->GHandlersubya-- Get the given entity by ID, or return a 404 not found if it doesn't exist.get404::(PersistBackend(tm),PersistEntityval,Monad(tm),FailureErrorResponsem,MonadTranst)=>Keyval->tmvalget404key=domres<-getkeycasemresofNothing->liftnotFoundJustres->returnres-- | Return the same URL if the user is authorized to see it.---- Built on top of 'isAuthorized'. This is useful for building page that only-- contain links to pages the user is allowed to see.maybeAuthorized::Yesoda=>Routea->Bool-- ^ is this a write request?->GHandlersa(Maybe(Routea))maybeAuthorizedrisWrite=dox<-isAuthorizedrisWritereturn$ifx==AuthorizedthenJustrelseNothing-- | Convert a widget to a 'PageContent'.widgetToPageContent::(Eq(Routemaster),Yesodmaster)=>GWidgetsubmaster()->GHandlersubmaster(PageContent(Routemaster))widgetToPageContent(GWidgetw)=dow'<-flipevalStateT0$runWriterT$runWriterT$runWriterT$runWriterT$runWriterT$runWriterT$runWriterTwlet((((((((),Bodybody),LastmTitle),scripts'),stylesheets'),style),jscript),Headhead')=w'lettitle=maybememptyunTitlemTitleletscripts=map(locationToHamlet.unScript)$runUniqueListscripts'letstylesheets=map(locationToHamlet.unStylesheet)$runUniqueListstylesheets'letcssToHtml(Cssb)=Htmlbcelper::Cassiusurl->Hamleturlcelper=fmapcssToHtmljsToHtml(Javascriptb)=Htmlbjelper::Juliusurl->Hamleturljelper=fmapjsToHtmlrender<-getUrlRenderParamsletrenderLocx=casexofNothing->NothingJust(Lefts)->JustsJust(Right(u,p))->Just$renderupcssLoc<-casestyleofNothing->returnNothingJusts->dox<-addStaticContent"css""text/css; charset=utf-8"$renderCassiusrendersreturn$renderLocxjsLoc<-casejscriptofNothing->returnNothingJusts->dox<-addStaticContent"js""text/javascript; charset=utf-8"$renderJuliusrendersreturn$renderLocxlethead''=[$hamlet|$forallscriptss%script!src=^s^$forallstylesheetss%link!rel=stylesheet!href=^s^$maybestyles$maybecssLocs%link!rel=stylesheet!href=$s$$nothing%style^celper.s^$maybejscriptj$maybejsLocs%script!src=$s$$nothing%script^jelper.j^^head'^|]return$PageContenttitlehead''body#if TESTtestSuite::TesttestSuite=testGroup"Yesod.Yesod"[testProperty"join/split path"propJoinSplitPath,testCase"utf8 split path"caseUtf8SplitPath,testCase"utf8 join path"caseUtf8JoinPath]dataTmpYesod=TmpYesoddataTmpRoute=TmpRoutederivingEqtypeinstanceRouteTmpYesod=TmpRouteinstanceYesodTmpYesodwhereapproot_=""propJoinSplitPath::[String]->BoolpropJoinSplitPathss=splitPathTmpYesod(BSU.fromString$joinPathTmpYesod""ss'[])==Rightss'wheress'=filter(not.null)sscaseUtf8SplitPath::AssertioncaseUtf8SplitPath=doRight["שלום"]@=?splitPathTmpYesod(BSU.fromString"/שלום/")Right["page","Fooé"]@=?splitPathTmpYesod(BSU.fromString"/page/Fooé/")Right["\156"]@=?splitPathTmpYesod(BSU.fromString"/\156/")Right["ð"]@=?splitPathTmpYesod(BSU.fromString"/%C3%B0/")caseUtf8JoinPath::AssertioncaseUtf8JoinPath=do"/%D7%A9%D7%9C%D7%95%D7%9D/"@=?joinPathTmpYesod""["שלום"][]#endif-- | Redirect to a POST resource.---- This is not technically a redirect; instead, it returns an HTML page with a-- POST form, and some Javascript to automatically submit the form. This can be-- useful when you need to post a plain link somewhere that needs to cause-- changes on the server.redirectToPost::Routemaster->GHandlersubmasteraredirectToPostdest=hamletToRepHtml[$hamlet|!!!%html%head%titleRedirecting...%body!onload="document.getElementById('form').submit()"%form#form!method=post!action=@dest@%noscript%pJavascripthasbeendisabled;pleaseclickonthebuttonbelowtoberedirected.%input!type=submit!value=Continue|]>>=sendResponse