module Yesod.Crud.Internal where -- import ClassyPrelude.Yesod -- import Yesod.Core -- import Yesod.Core.Types -- import qualified Network.Wai as W -- -- subHelper :: Monad m -- => HandlerT child (HandlerT parent m) TypedContent -- -> YesodSubRunnerEnv child parent (HandlerT parent m) -- -> Maybe (Route child) -- -> W.Application -- subHelper handlert YesodSubRunnerEnv {..} route = -- ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) -- where -- base = stripHandlerT (fmap toTypedContent handlert) ysreGetSub ysreToParentRoute route -- -- 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 -- }