Merge pull request #1003 from andrewthad/master

Make stripHandlerT and subHelper available for public use

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)

yesod-core/Yesod/Core/Dispatch.hs

@@ -30,6 +30,7 @@ module Yesod.Core.Dispatch
     , defaultMiddlewaresNoLogging
       -- * WAI subsites
     , WaiSubsite (..)
+    , subHelper
     ) where
 
 import Prelude hiding (exp)

yesod-core/Yesod/Core/Handler.hs

@@ -151,6 +151,7 @@ module Yesod.Core.Handler
       -- * Per-request caching
     , cached
     , cachedBy
+    , stripHandlerT
     ) where
 
 import           Data.Time                     (UTCTime, addUTCTime,
@@ -1238,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
+        }

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
-        }

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 <michael@snoyman.com>