diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index f0b58419..0fa8e489 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -47,31 +47,53 @@ module Yesod.Core , yesodRender , runFakeHandler -- * Re-exports - , module Yesod.Content - , module Yesod.Dispatch - , module Yesod.Handler - , module Yesod.Widget + , module Yesod.Core.Content + , module Yesod.Core.Dispatch + , module Yesod.Core.Handler + , module Yesod.Core.Widget , module Yesod.Core.Json - , module Yesod.Core.Trans.Class + , module Yesod.Core.Class.MonadLift , module Text.Shakespeare.I18N , module Yesod.Core.Internal.Util ) where -import Yesod.Internal.Core -import Yesod.Content -import Yesod.Dispatch -import Yesod.Handler -import Yesod.Widget +import Yesod.Core.Content +import Yesod.Core.Dispatch +import Yesod.Core.Handler +import Yesod.Core.Widget import Yesod.Core.Json import Yesod.Core.Types -import Yesod.Core.Trans.Class +import Yesod.Core.Class.MonadLift import Text.Shakespeare.I18N import Yesod.Core.Internal.Util (formatW3 , formatRFC1123 , formatRFC822) import Control.Monad.Logger +import Yesod.Core.Internal.Session +import Yesod.Core.Class.Yesod +import Yesod.Core.Class.Dispatch +import Yesod.Core.Class.Breadcrumbs +import Yesod.Core.Internal.Run (yesodRender, runFakeHandler) +import qualified Paths_yesod_core +import Data.Version (showVersion) +import Yesod.Routes.Class (RenderRoute (..)) -- | Return an 'Unauthorized' value, with the given i18n message. unauthorizedI :: RenderMessage master msg => msg -> GHandler sub master AuthResult unauthorizedI msg =do mr <- getMessageRender return $ Unauthorized $ mr msg + +yesodVersion :: String +yesodVersion = showVersion Paths_yesod_core.version + +-- | 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 diff --git a/yesod-core/Yesod/Core/Class/Breadcrumbs.hs b/yesod-core/Yesod/Core/Class/Breadcrumbs.hs new file mode 100644 index 00000000..246cf101 --- /dev/null +++ b/yesod-core/Yesod/Core/Class/Breadcrumbs.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} +module Yesod.Core.Class.Breadcrumbs where + +import Yesod.Core.Handler +import Yesod.Routes.Class +import Data.Text (Text) + +-- | 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 + 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 diff --git a/yesod-core/Yesod/Core/Class/Dispatch.hs b/yesod-core/Yesod/Core/Class/Dispatch.hs new file mode 100644 index 00000000..bb91b84e --- /dev/null +++ b/yesod-core/Yesod/Core/Class/Dispatch.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +module Yesod.Core.Class.Dispatch where + +import Yesod.Core.Content +import Yesod.Core.Handler + +import Yesod.Routes.Class + +import qualified Network.Wai as W +import Yesod.Core.Internal.Session +import Data.Text (Text) +import System.Log.FastLogger (Logger) +import Yesod.Core.Types +import Yesod.Core.Class.Yesod +import Yesod.Core.Internal.Run + +-- | 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 TypedContent + -> 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 diff --git a/yesod-core/Yesod/Core/Handler/Class.hs b/yesod-core/Yesod/Core/Class/Handler.hs similarity index 96% rename from yesod-core/Yesod/Core/Handler/Class.hs rename to yesod-core/Yesod/Core/Class/Handler.hs index 6d35112d..da406f51 100644 --- a/yesod-core/Yesod/Core/Handler/Class.hs +++ b/yesod-core/Yesod/Core/Class/Handler.hs @@ -2,10 +2,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} -module Yesod.Core.Handler.Class where +module Yesod.Core.Class.Handler where import Yesod.Core.Types -import Yesod.Core.Trans.Class (lift) +import Yesod.Core.Class.MonadLift (lift) import Control.Monad.Trans.Class (MonadTrans) import Data.IORef.Lifted (atomicModifyIORef) import Control.Exception.Lifted (throwIO) diff --git a/yesod-core/Yesod/Core/Trans/Class.hs b/yesod-core/Yesod/Core/Class/MonadLift.hs similarity index 90% rename from yesod-core/Yesod/Core/Trans/Class.hs rename to yesod-core/Yesod/Core/Class/MonadLift.hs index a4d362b5..62e8cb6d 100644 --- a/yesod-core/Yesod/Core/Trans/Class.hs +++ b/yesod-core/Yesod/Core/Class/MonadLift.hs @@ -1,7 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} -module Yesod.Core.Trans.Class (MonadLift (..)) where +module Yesod.Core.Class.MonadLift (MonadLift (..)) where import Control.Monad.Trans.Class diff --git a/yesod-core/Yesod/Core/Class.hs b/yesod-core/Yesod/Core/Class/Yesod.hs similarity index 98% rename from yesod-core/Yesod/Core/Class.hs rename to yesod-core/Yesod/Core/Class/Yesod.hs index 665477a6..23b97c30 100644 --- a/yesod-core/Yesod/Core/Class.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -2,11 +2,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} -module Yesod.Core.Class where +module Yesod.Core.Class.Yesod where import Control.Monad.Logger (logErrorS) -import Yesod.Content -import Yesod.Handler hiding (getExpires) +import Yesod.Core.Content +import Yesod.Core.Handler hiding (getExpires) import Yesod.Routes.Class @@ -53,9 +53,9 @@ import qualified Web.ClientSession as CS import Web.Cookie (parseCookies) import Web.Cookie (SetCookie (..)) import Yesod.Core.Types -import Yesod.Internal.Session -import Yesod.Widget -import Yesod.Core.Trans.Class (lift) +import Yesod.Core.Internal.Session +import Yesod.Core.Widget +import Yesod.Core.Class.MonadLift (lift) -- | Define settings for a Yesod applications. All methods have intelligent -- defaults, and therefore no implementation is required. diff --git a/yesod-core/Yesod/Content.hs b/yesod-core/Yesod/Core/Content.hs similarity index 99% rename from yesod-core/Yesod/Content.hs rename to yesod-core/Yesod/Core/Content.hs index 2c3ea2b7..fcc72f71 100644 --- a/yesod-core/Yesod/Content.hs +++ b/yesod-core/Yesod/Core/Content.hs @@ -5,7 +5,7 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -module Yesod.Content +module Yesod.Core.Content ( -- * Content Content (..) , emptyContent diff --git a/yesod-core/Yesod/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs similarity index 97% rename from yesod-core/Yesod/Dispatch.hs rename to yesod-core/Yesod/Core/Dispatch.hs index b9f8cad3..53a0fb25 100644 --- a/yesod-core/Yesod/Dispatch.hs +++ b/yesod-core/Yesod/Core/Dispatch.hs @@ -1,10 +1,9 @@ {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Yesod.Dispatch +module Yesod.Core.Dispatch ( -- * Quasi-quoted routing parseRoutes , parseRoutesNoCheck @@ -31,8 +30,7 @@ module Yesod.Dispatch import Control.Applicative ((<$>), (<*>)) import Prelude hiding (exp) -import Yesod.Internal.Core -import Yesod.Handler +import Yesod.Core.Handler import Web.PathPieces import Language.Haskell.TH @@ -52,10 +50,13 @@ import qualified Data.ByteString as S import qualified Blaze.ByteString.Builder import Network.HTTP.Types (status301) import Yesod.Routes.TH -import Yesod.Content (toTypedContent) +import Yesod.Core.Content (toTypedContent) import Yesod.Routes.Parse import System.Log.FastLogger (Logger) import Yesod.Core.Types +import Yesod.Core.Class.Yesod +import Yesod.Core.Class.Dispatch +import Yesod.Core.Internal.Run -- | Generates URL datatype and site function for the given 'Resource's. This -- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter. diff --git a/yesod-core/Yesod/Handler.hs b/yesod-core/Yesod/Core/Handler.hs similarity index 99% rename from yesod-core/Yesod/Handler.hs rename to yesod-core/Yesod/Core/Handler.hs index 6e07dea0..84549fa5 100644 --- a/yesod-core/Yesod/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -19,7 +19,7 @@ -- Define Handler stuff. -- --------------------------------------------------------- -module Yesod.Handler +module Yesod.Core.Handler ( -- * Handler monad GHandler -- ** Read information from handler @@ -158,7 +158,7 @@ import Data.Text (Text) import qualified Network.Wai.Parse as NWP import Text.Shakespeare.I18N (RenderMessage (..)) import Web.Cookie (SetCookie (..)) -import Yesod.Content (ToTypedContent (..), simpleContentType, HasContentType (..), ToContent (..)) +import Yesod.Core.Content (ToTypedContent (..), simpleContentType, HasContentType (..), ToContent (..)) import Yesod.Core.Internal.Util (formatRFC1123) import Text.Blaze.Html (preEscapedToMarkup, toHtml) @@ -167,7 +167,7 @@ import Data.Dynamic (fromDynamic, toDyn) import qualified Data.IORef as I import Data.Maybe (listToMaybe) import Data.Typeable (Typeable, typeOf) -import Yesod.Core.Handler.Class +import Yesod.Core.Class.Handler import Yesod.Core.Types import Yesod.Routes.Class (Route) diff --git a/yesod-core/Yesod/Core/Internal.hs b/yesod-core/Yesod/Core/Internal.hs new file mode 100644 index 00000000..e60e4d6e --- /dev/null +++ b/yesod-core/Yesod/Core/Internal.hs @@ -0,0 +1,7 @@ +-- | Exposed mostly for testing. These functions provide an unstable API and +-- should not be relied upon. +module Yesod.Core.Internal + ( module X + ) where + +import Yesod.Core.Internal.Request as X (randomString, parseWaiRequest) diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs new file mode 100644 index 00000000..d8c2bb3b --- /dev/null +++ b/yesod-core/Yesod/Core/Internal/Response.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +module Yesod.Core.Internal.Response where + +import Blaze.ByteString.Builder (toByteString) +import Data.ByteString (ByteString) +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 +import Data.CaseInsensitive (CI) +import qualified Data.CaseInsensitive as CI +import Network.Wai +import Prelude hiding (catch) +import Web.Cookie (renderSetCookie) +import Yesod.Core.Content +import Yesod.Core.Types + +yarToResponse :: YesodResponse -> [(CI ByteString, ByteString)] -> Response +yarToResponse (YRWai a) _ = a +yarToResponse (YRPlain s hs _ c _) extraHeaders = + go c + where + finalHeaders = extraHeaders ++ map headerToPair hs + finalHeaders' len = ("Content-Length", S8.pack $ show len) + : finalHeaders + + go (ContentBuilder b mlen) = + ResponseBuilder s hs' b + where + hs' = maybe finalHeaders finalHeaders' mlen + go (ContentFile fp p) = ResponseFile s finalHeaders fp p + go (ContentSource body) = ResponseSource s finalHeaders body + go (ContentDontEvaluate c') = go c' + +-- | Convert Header to a key/value pair. +headerToPair :: Header + -> (CI ByteString, ByteString) +headerToPair (AddCookie sc) = + ("Set-Cookie", toByteString $ renderSetCookie $ sc) +headerToPair (DeleteCookie key path) = + ( "Set-Cookie" + , S.concat + [ key + , "=; path=" + , path + , "; expires=Thu, 01-Jan-1970 00:00:00 GMT" + ] + ) +headerToPair (Header key value) = (CI.mk key, value) diff --git a/yesod-core/Yesod/Core/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs similarity index 91% rename from yesod-core/Yesod/Core/Run.hs rename to yesod-core/Yesod/Core/Internal/Run.hs index 7518fed7..5beab696 100644 --- a/yesod-core/Yesod/Core/Run.hs +++ b/yesod-core/Yesod/Core/Internal/Run.hs @@ -3,8 +3,9 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -module Yesod.Core.Run where +module Yesod.Core.Internal.Run where +import Yesod.Core.Internal.Response import Blaze.ByteString.Builder (fromLazyByteString, toByteString, toLazyByteString) import Control.Applicative ((<$>)) @@ -16,12 +17,9 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (LogLevel (LevelError), LogSource, liftLoc) import Control.Monad.Trans.Resource (runResourceT) -import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L -import Data.CaseInsensitive (CI) -import qualified Data.CaseInsensitive as CI import qualified Data.IORef as I import qualified Data.Map as Map import Data.Maybe (isJust) @@ -39,47 +37,13 @@ import Prelude hiding (catch) import System.Log.FastLogger (Logger) import System.Log.FastLogger (LogStr, toLogStr) import System.Random (newStdGen) -import Web.Cookie (renderSetCookie) -import Yesod.Content -import Yesod.Core.Class +import Yesod.Core.Content +import Yesod.Core.Class.Yesod import Yesod.Core.Types import Yesod.Core.Internal.Request (parseWaiRequest, tokenKey, tooLargeResponse) import Yesod.Routes.Class (Route, renderRoute) -yarToResponse :: YesodResponse -> [(CI ByteString, ByteString)] -> Response -yarToResponse (YRWai a) _ = a -yarToResponse (YRPlain s hs _ c _) extraHeaders = - go c - where - finalHeaders = extraHeaders ++ map headerToPair hs - finalHeaders' len = ("Content-Length", S8.pack $ show len) - : finalHeaders - - go (ContentBuilder b mlen) = - ResponseBuilder s hs' b - where - hs' = maybe finalHeaders finalHeaders' mlen - go (ContentFile fp p) = ResponseFile s finalHeaders fp p - go (ContentSource body) = ResponseSource s finalHeaders body - go (ContentDontEvaluate c') = go c' - --- | Convert Header to a key/value pair. -headerToPair :: Header - -> (CI ByteString, ByteString) -headerToPair (AddCookie sc) = - ("Set-Cookie", toByteString $ renderSetCookie $ sc) -headerToPair (DeleteCookie key path) = - ( "Set-Cookie" - , S.concat - [ key - , "=; path=" - , path - , "; expires=Thu, 01-Jan-1970 00:00:00 GMT" - ] - ) -headerToPair (Header key value) = (CI.mk key, value) - localNoCurrent :: GHandler s m a -> GHandler s m a localNoCurrent = local (\hd -> hd { handlerEnv = (handlerEnv hd) { rheRoute = Nothing }}) diff --git a/yesod-core/Yesod/Internal/Session.hs b/yesod-core/Yesod/Core/Internal/Session.hs similarity index 98% rename from yesod-core/Yesod/Internal/Session.hs rename to yesod-core/Yesod/Core/Internal/Session.hs index ff9f93cc..dd9ebc61 100644 --- a/yesod-core/Yesod/Internal/Session.hs +++ b/yesod-core/Yesod/Core/Internal/Session.hs @@ -1,4 +1,4 @@ -module Yesod.Internal.Session +module Yesod.Core.Internal.Session ( encodeClientSession , decodeClientSession , clientSessionDateCacher diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs index 15572638..405860ef 100644 --- a/yesod-core/Yesod/Core/Json.hs +++ b/yesod-core/Yesod/Core/Json.hs @@ -19,11 +19,11 @@ module Yesod.Core.Json , acceptsJson ) where -import Yesod.Handler (GHandler, waiRequest, invalidArgs, redirect, selectRep, provideRep) -import Yesod.Core.Trans.Class (lift) -import Yesod.Content (TypedContent) -import Yesod.Internal.Core (defaultLayout, Yesod) -import Yesod.Widget (GWidget) +import Yesod.Core.Handler (GHandler, waiRequest, invalidArgs, redirect, selectRep, provideRep) +import Yesod.Core.Class.MonadLift (lift) +import Yesod.Core.Content (TypedContent) +import Yesod.Core.Class.Yesod (defaultLayout, Yesod) +import Yesod.Core.Widget (GWidget) import Yesod.Routes.Class import Control.Applicative ((<$>)) import Control.Monad (join) diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs index 669fa141..50d99d9d 100644 --- a/yesod-core/Yesod/Core/Types.hs +++ b/yesod-core/Yesod/Core/Types.hs @@ -51,7 +51,7 @@ import Text.Hamlet (HtmlUrl) import Text.Julius (JavascriptUrl) import Web.Cookie (SetCookie) import Yesod.Core.Internal.Util (getTime, putTime) -import Yesod.Core.Trans.Class (MonadLift (..)) +import Yesod.Core.Class.MonadLift (MonadLift (..)) import Yesod.Routes.Class (RenderRoute (..)) -- Sessions diff --git a/yesod-core/Yesod/Widget.hs b/yesod-core/Yesod/Core/Widget.hs similarity index 98% rename from yesod-core/Yesod/Widget.hs rename to yesod-core/Yesod/Core/Widget.hs index c0099e49..39142c2f 100644 --- a/yesod-core/Yesod/Widget.hs +++ b/yesod-core/Yesod/Core/Widget.hs @@ -8,7 +8,7 @@ {-# LANGUAGE CPP #-} -- | Widgets combine HTML with JS and CSS dependencies with a unique identifier -- generator, allowing you to create truly modular HTML components. -module Yesod.Widget +module Yesod.Core.Widget ( -- * Datatype GWidget , PageContent (..) @@ -51,8 +51,8 @@ import Text.Hamlet import Text.Cassius import Text.Julius import Yesod.Routes.Class -import Yesod.Handler (getMessageRender, getUrlRenderParams) -import Yesod.Core.Trans.Class (lift) +import Yesod.Core.Handler (getMessageRender, getUrlRenderParams) +import Yesod.Core.Class.MonadLift (lift) import Text.Shakespeare.I18N (RenderMessage) import Control.Monad (liftM) import Data.Text (Text) diff --git a/yesod-core/Yesod/Internal/Core.hs b/yesod-core/Yesod/Internal/Core.hs deleted file mode 100644 index e7e5d753..00000000 --- a/yesod-core/Yesod/Internal/Core.hs +++ /dev/null @@ -1,134 +0,0 @@ -{-# 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 (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 - 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 TypedContent - -> 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 diff --git a/yesod-core/test/YesodCoreTest/InternalRequest.hs b/yesod-core/test/YesodCoreTest/InternalRequest.hs index 90834485..9d6e13ec 100644 --- a/yesod-core/test/YesodCoreTest/InternalRequest.hs +++ b/yesod-core/test/YesodCoreTest/InternalRequest.hs @@ -6,7 +6,7 @@ import System.Random (StdGen, mkStdGen) import Network.Wai as W import Network.Wai.Test -import Yesod.Core.Internal.Request (randomString, parseWaiRequest) +import Yesod.Core.Internal (randomString, parseWaiRequest) import Test.Hspec import Data.Monoid (mempty) import Data.Map (singleton) diff --git a/yesod-core/test/YesodCoreTest/Redirect.hs b/yesod-core/test/YesodCoreTest/Redirect.hs index 63d28759..da6f9725 100644 --- a/yesod-core/test/YesodCoreTest/Redirect.hs +++ b/yesod-core/test/YesodCoreTest/Redirect.hs @@ -2,7 +2,7 @@ module YesodCoreTest.Redirect (specs, Widget) where import YesodCoreTest.YesodTest -import Yesod.Handler (redirectWith) +import Yesod.Core.Handler (redirectWith) import qualified Network.HTTP.Types as H data Y = Y diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index a0398fcf..0a2011f4 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -88,20 +88,23 @@ library , blaze-html >= 0.5 , blaze-markup >= 0.5.1 - exposed-modules: Yesod.Content - Yesod.Core + exposed-modules: Yesod.Core + Yesod.Core.Content + Yesod.Core.Dispatch + Yesod.Core.Handler Yesod.Core.Json - Yesod.Core.Handler.Class - Yesod.Dispatch - Yesod.Handler - Yesod.Widget + Yesod.Core.Widget + Yesod.Core.Internal + other-modules: Yesod.Core.Internal.Session Yesod.Core.Internal.Request - other-modules: Yesod.Internal.Core - Yesod.Internal.Session + Yesod.Core.Class.Handler Yesod.Core.Internal.Util - Yesod.Core.Trans.Class - Yesod.Core.Run - Yesod.Core.Class + Yesod.Core.Internal.Response + Yesod.Core.Class.MonadLift + Yesod.Core.Internal.Run + Yesod.Core.Class.Yesod + Yesod.Core.Class.Dispatch + Yesod.Core.Class.Breadcrumbs Yesod.Core.Types Paths_yesod_core ghc-options: -Wall