diff --git a/yesod-core/Yesod/Core/Class/Dispatch.hs b/yesod-core/Yesod/Core/Class/Dispatch.hs index fe014ac2..cf998477 100644 --- a/yesod-core/Yesod/Core/Class/Dispatch.hs +++ b/yesod-core/Yesod/Core/Class/Dispatch.hs @@ -11,9 +11,9 @@ import Yesod.Routes.Class import qualified Network.Wai as W import Yesod.Core.Types import Yesod.Core.Content +import Yesod.Core.Handler (stripHandlerT) import Yesod.Core.Class.Yesod import Yesod.Core.Class.Handler -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. @@ -31,7 +31,8 @@ instance YesodSubDispatch WaiSubsite master where WaiSubsite app = ysreGetSub $ yreSite $ ysreParentEnv -- | A helper function for creating YesodSubDispatch instances, used by the --- internal generated code. +-- internal generated code. This function has been exported since 1.4.11. +-- It promotes a subsite handler to a wai application. subHelper :: Monad m -- NOTE: This is incredibly similar in type signature to yesodRunner, should probably be pointed out/explained. => HandlerT child (HandlerT parent m) TypedContent -> YesodSubRunnerEnv child parent (HandlerT parent m) diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs index b0c32d17..072181d3 100644 --- a/yesod-core/Yesod/Core/Dispatch.hs +++ b/yesod-core/Yesod/Core/Dispatch.hs @@ -30,7 +30,7 @@ module Yesod.Core.Dispatch , defaultMiddlewaresNoLogging -- * WAI subsites , WaiSubsite (..) - , subHelper + , module YCCD ) where import Prelude hiding (exp) @@ -70,7 +70,7 @@ import Control.Monad (when) import qualified Paths_yesod_core import Data.Version (showVersion) import qualified System.Random.MWC as MWC -import Yesod.Core.Class.Dispatch (subHelper) +import Yesod.Core.Class.Dispatch as YCCD (subHelper) -- | Convert the given argument into a WAI application, executable with any WAI -- handler. This function will provide no middlewares; if you want commonly diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index 88d27620..8116864b 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -218,7 +218,6 @@ import Data.Conduit (Source, transPipe, Flush (Flush), yield, Producer ) import qualified Yesod.Core.TypeCache as Cache import qualified Data.Word8 as W8 -import Yesod.Core.Internal.Run (stripHandlerT) get :: MonadHandler m => m GHState get = liftHandlerT $ HandlerT $ I.readIORef . handlerState @@ -1240,3 +1239,22 @@ sendChunkLazyText = sendChunk -- Since 1.2.0 sendChunkHtml :: Monad m => Html -> Producer m (Flush Builder) sendChunkHtml = sendChunk + +-- | Converts a child handler to a parent handler +-- +-- Exported since 1.4.11 +stripHandlerT :: HandlerT child (HandlerT parent m) a + -> (parent -> child) + -> (Route child -> Route parent) + -> Maybe (Route child) + -> HandlerT parent m a +stripHandlerT (HandlerT f) getSub toMaster newRoute = HandlerT $ \hd -> do + let env = handlerEnv hd + ($ hd) $ unHandlerT $ f hd + { handlerEnv = env + { rheSite = getSub $ rheSite env + , rheRoute = newRoute + , rheRender = \url params -> rheRender env (toMaster url) params + } + , handlerToParent = toMaster + } diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs index 651c11ca..6725fa3b 100644 --- a/yesod-core/Yesod/Core/Internal/Run.hs +++ b/yesod-core/Yesod/Core/Internal/Run.hs @@ -320,19 +320,3 @@ resolveApproot master req = ApprootStatic t -> t ApprootMaster f -> f master ApprootRequest f -> f master req - -stripHandlerT :: HandlerT child (HandlerT parent m) a - -> (parent -> child) - -> (Route child -> Route parent) - -> Maybe (Route child) - -> HandlerT parent m a -stripHandlerT (HandlerT f) getSub toMaster newRoute = HandlerT $ \hd -> do - let env = handlerEnv hd - ($ hd) $ unHandlerT $ f hd - { handlerEnv = env - { rheSite = getSub $ rheSite env - , rheRoute = newRoute - , rheRender = \url params -> rheRender env (toMaster url) params - } - , handlerToParent = toMaster - } diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index ed564de2..c9dd541a 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.10 +version: 1.4.11 license: MIT license-file: LICENSE author: Michael Snoyman