Moved code around some more
This commit is contained in:
parent
4d6c114b12
commit
9873b4d8f3
@ -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
|
||||
|
||||
31
yesod-core/Yesod/Core/Class/Breadcrumbs.hs
Normal file
31
yesod-core/Yesod/Core/Class/Breadcrumbs.hs
Normal file
@ -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
|
||||
53
yesod-core/Yesod/Core/Class/Dispatch.hs
Normal file
53
yesod-core/Yesod/Core/Class/Dispatch.hs
Normal file
@ -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
|
||||
@ -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)
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
@ -5,7 +5,7 @@
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Yesod.Content
|
||||
module Yesod.Core.Content
|
||||
( -- * Content
|
||||
Content (..)
|
||||
, emptyContent
|
||||
@ -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.
|
||||
@ -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)
|
||||
|
||||
7
yesod-core/Yesod/Core/Internal.hs
Normal file
7
yesod-core/Yesod/Core/Internal.hs
Normal file
@ -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)
|
||||
51
yesod-core/Yesod/Core/Internal/Response.hs
Normal file
51
yesod-core/Yesod/Core/Internal/Response.hs
Normal file
@ -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)
|
||||
@ -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 }})
|
||||
@ -1,4 +1,4 @@
|
||||
module Yesod.Internal.Session
|
||||
module Yesod.Core.Internal.Session
|
||||
( encodeClientSession
|
||||
, decodeClientSession
|
||||
, clientSessionDateCacher
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
@ -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
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user