Removed some subsite stuff

yesod-core/Yesod/Core.hs

@@ -11,6 +11,7 @@ module Yesod.Core
       -- * Types
     , Approot (..)
     , FileUpload (..)
+    , ErrorResponse (..)
       -- * Utitlities
     , maybeAuthorized
     , widgetToPageContent

yesod-core/Yesod/Core/Class.hs

@@ -287,8 +287,7 @@ $doctype 5
     yesodMiddleware handler = do
         setHeader "Vary" "Accept, Accept-Language"
         route <- getCurrentRoute
-        toMaster <- getRouteToMaster
-        case fmap toMaster route of
+        case route of
             Nothing -> handler
             Just url -> do
                 isWrite <- isWriteRequest url

yesod-core/Yesod/Handler.hs

@@ -25,16 +25,15 @@
 --
 ---------------------------------------------------------
 module Yesod.Handler
-    ( -- * Type families
-      YesodSubRoute (..)
-      -- * Handler monad
-    , GHandler
+    ( -- * Handler monad
+      GHandler
       -- ** Read information from handler
     , getYesod
     , getYesodSub
     , getUrlRender
     , getUrlRenderParams
     , getCurrentRoute
+    , getCurrentRouteSub
     , getRouteToMaster
     , getRequest
     , waiRequest
@@ -122,11 +121,6 @@ module Yesod.Handler
     , getMessageRender
       -- * Per-request caching
     , cached
-      -- * Internal Yesod
-    , YesodApp
-    , runSubsiteGetter
-    , HandlerData
-    , ErrorResponse (..)
     ) where
 
 import           Data.Time                     (UTCTime, addUTCTime,
@@ -136,7 +130,7 @@ import           Yesod.Core.Internal.Request   (langKey, mkFileInfoFile,
 
 import           Control.Applicative           ((<$>))
 
-import           Control.Monad                 (liftM)
+import           Control.Monad                 (ap, liftM)
 
 import           Control.Monad.IO.Class        (MonadIO, liftIO)
 import           Control.Monad.Trans.Resource  (MonadResource, liftResourceT)
@@ -176,9 +170,6 @@ import           Yesod.Core.Handler.Class
 import           Yesod.Core.Types
 import           Yesod.Routes.Class            (Route)
 
-class YesodSubRoute s y where
-    fromSubRoute :: s -> y -> Route s -> Route y
-
 get :: HandlerState m => m GHState
 get = getGHState
 
@@ -194,18 +185,6 @@ tell hs = modify $ \g -> g { ghsHeaders = ghsHeaders g `mappend` hs }
 hcError :: HandlerError m => ErrorResponse -> m a
 hcError = handlerError . HCError
 
-class SubsiteGetter g m s | g -> s where
-  runSubsiteGetter :: g -> m s
-
-instance (master ~ master'
-         ) => SubsiteGetter (master -> sub) (GHandler anySub master') sub where
-  runSubsiteGetter getter = getter <$> getYesod
-
-instance (anySub ~ anySub'
-         ,master ~ master'
-         ) => SubsiteGetter (GHandler anySub master sub) (GHandler anySub' master') sub where
-  runSubsiteGetter = id
-
 getRequest :: HandlerReader m => m YesodRequest
 getRequest = askYesodRequest
 
@@ -273,8 +252,12 @@ getUrlRenderParams = rheRender `liftM` askHandlerEnv
 
 -- | Get the route requested by the user. If this is a 404 response- where the
 -- user requested an invalid route- this function will return 'Nothing'.
-getCurrentRoute :: HandlerReader m => m (Maybe (Route (HandlerSub m)))
-getCurrentRoute = rheRoute `liftM` askHandlerEnv
+getCurrentRoute :: HandlerReader m => m (Maybe (Route (HandlerMaster m)))
+getCurrentRoute = fmap `liftM` getRouteToMaster `ap` getCurrentRouteSub
+
+-- | Same as 'getCurrentRoute', but for the subsite.
+getCurrentRouteSub :: HandlerReader m => m (Maybe (Route (HandlerSub m)))
+getCurrentRouteSub = rheRoute `liftM` askHandlerEnv
 
 -- | Get the function to promote a route for a subsite to a route for the
 -- master site.
@@ -401,9 +384,8 @@ setUltDestCurrent = do
     case route of
         Nothing -> return ()
         Just r -> do
-            tm <- getRouteToMaster
             gets' <- reqGetParams `liftM` askYesodRequest
-            setUltDest (tm r, gets')
+            setUltDest (r, gets')
 
 -- | Sets the ultimate destination to the referer request header, if present.
 --

yesod-core/Yesod/Internal/Core.hs

@@ -71,9 +71,7 @@ class YesodBreadcrumbs y where
 -- along with their respective titles.
 breadcrumbs :: YesodBreadcrumbs y => GHandler sub y (Text, [(Route y, Text)])
 breadcrumbs = do
-    x' <- getCurrentRoute
-    tm <- getRouteToMaster
-    let x = fmap tm x'
+    x <- getCurrentRoute
     case x of
         Nothing -> return ("Not found", [])
         Just y -> do

yesod-core/Yesod/Widget.hs

@@ -51,10 +51,7 @@ import Text.Hamlet
 import Text.Cassius
 import Text.Julius
 import Yesod.Routes.Class
-import Yesod.Handler
-    ( YesodSubRoute(..), getYesod
-    , getMessageRender, getUrlRenderParams
-    )
+import Yesod.Handler (getMessageRender, getUrlRenderParams)
 import Yesod.Core.Trans.Class (lift)
 import Text.Shakespeare.I18N (RenderMessage)
 import Yesod.Content (toContent)
@@ -74,13 +71,17 @@ import Yesod.Core.Types
 preEscapedLazyText :: TL.Text -> Html
 preEscapedLazyText = preEscapedToMarkup
 
-addSubWidget :: (YesodSubRoute sub master) => sub -> GWidget sub master a -> GWidget sub' master a
-addSubWidget sub (GWidget w) = do
-    master <- lift getYesod
-    let sr = fromSubRoute sub master
-    (a, w') <- lift $ error "FIXME Yesod.Widget.toMasterHandlerMaybe" sr (const sub) Nothing w
-    tell w'
-    return a
+addSubWidget :: (Route sub -> Route master) -> sub -> GWidget sub master a -> GWidget sub' master a
+addSubWidget toMaster sub (GWidget (GHandler f)) =
+    GWidget $ GHandler $ f . modHD
+  where
+    modHD hd = hd
+        { handlerEnv = (handlerEnv hd)
+            { rheRoute = Nothing
+            , rheSub = sub
+            , rheToMaster = toMaster
+            }
+        }
 
 class ToWidget sub master a where
     toWidget :: a -> GWidget sub master ()

yesod-core/test/YesodCoreTest/Media.hs

@@ -15,9 +15,8 @@ mkYesodDispatch "Y" resourcesY
 
 instance Yesod Y where
     addStaticContent _ _ content = do
-        tm <- getRouteToMaster
         route <- getCurrentRoute
-        case fmap tm route of
+        case route of
             Just StaticR -> return $ Just $ Left $
                         if content == "foo2{bar:baz}"
                             then "screen.css"