{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE FlexibleInstances #-} -- | The basic typeclass for a Yesod application. module Yesod.Internal.Core ( -- * Type classes Yesod (..) , YesodDispatch (..) , RenderRoute (..) -- ** Breadcrumbs , YesodBreadcrumbs (..) , breadcrumbs -- * Utitlities , maybeAuthorized , widgetToPageContent -- * Defaults , defaultErrorHandler -- * Data types , AuthResult (..) -- * Sessions , SessionBackend (..) , defaultClientSessionBackend , clientSessionBackend , loadClientSession , clientSessionDateCacher -- * jsLoader , ScriptLoadPosition (..) , BottomOfHeadAsync -- * Misc , yesodVersion , yesodRender , resolveApproot , Approot (..) , FileUpload (..) , runFakeHandler ) where import Yesod.Content import Yesod.Handler hiding (lift, getExpires) import Yesod.Routes.Class import qualified Network.Wai as W import Yesod.Internal.Session import Yesod.Core.Internal.Request import Data.Text (Text) import qualified Paths_yesod_core import Data.Version (showVersion) import System.Log.FastLogger (Logger) import Yesod.Core.Types import Yesod.Core.Class import Yesod.Core.Run yesodVersion :: String yesodVersion = showVersion Paths_yesod_core.version -- | 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). class YesodBreadcrumbs y where -- | Returns the title and the parent resource, if available. If you return -- a 'Nothing', then this is considered a top-level page. breadcrumb :: Route y -> GHandler sub y (Text , Maybe (Route y)) -- | Gets the title of the current page and the hierarchy of parent pages, -- along with their respective titles. breadcrumbs :: YesodBreadcrumbs y => GHandler sub y (Text, [(Route y, Text)]) breadcrumbs = do x' <- getCurrentRoute tm <- getRouteToMaster let x = fmap tm x' case x of Nothing -> return ("Not found", []) Just y -> do (title, next) <- breadcrumb y z <- go [] next return (title, z) where go back Nothing = return back go back (Just this) = do (title, next) <- breadcrumb this go ((this, title) : back) next -- | 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 :: Yesod a => Route a -> Bool -- ^ is this a write request? -> GHandler s a (Maybe (Route a)) maybeAuthorized r isWrite = do x <- isAuthorized r isWrite return $ if x == Authorized then Just r else Nothing -- | This class is automatically instantiated when you use the template haskell -- mkYesod function. You should never need to deal with it directly. class YesodDispatch sub master where yesodDispatch :: Yesod master => Logger -> master -> sub -> (Route sub -> Route master) -> (Maybe (SessionBackend master) -> W.Application) -- ^ 404 handler -> (Route sub -> Maybe (SessionBackend master) -> W.Application) -- ^ 405 handler -> Text -- ^ request method -> [Text] -- ^ pieces -> Maybe (SessionBackend master) -> W.Application yesodRunner :: Yesod master => Logger -> GHandler sub master ChooseRep -> master -> sub -> Maybe (Route sub) -> (Route sub -> Route master) -> Maybe (SessionBackend master) -> W.Application yesodRunner logger handler master sub murl tomaster msb = defaultYesodRunner YesodRunnerEnv { yreLogger = logger , yreMaster = master , yreSub = sub , yreRoute = murl , yreToMaster = tomaster , yreSessionBackend = msb } handler instance YesodDispatch WaiSubsite master where yesodDispatch _logger _master (WaiSubsite app) _tomaster _404 _405 _method _pieces _session = app