WaiSubsite

yesod-core/Yesod/Dispatch.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 module Yesod.Dispatch
     ( -- * Quasi-quoted routing
       parseRoutes
@@ -21,6 +24,8 @@ module Yesod.Dispatch
       -- * Convert to WAI
     , toWaiApp
     , toWaiAppPlain
+      -- * WAI subsites
+    , WaiSubsite (..)
     ) where
 
 import Data.Functor   ((<$>))
@@ -187,3 +192,14 @@ sendRedirect y segments' env =
             then dest
             else (dest `mappend`
                  Blaze.ByteString.Builder.fromByteString (W.rawQueryString env))
+
+-- | Wrap up a normal WAI application as a Yesod subsite.
+newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
+
+instance RenderRoute WaiSubsite where
+    data Route WaiSubsite = WaiSubsiteRoute [Text] [(Text, Text)]
+        deriving (Show, Eq, Read, Ord)
+    renderRoute (WaiSubsiteRoute ps qs) = (ps, qs)
+
+instance YesodDispatch WaiSubsite master where
+    yesodDispatch _master (WaiSubsite app) _tomaster _404 _405 _method _pieces _session = app

yesod-core/test/YesodCoreTest.hs

@@ -9,6 +9,7 @@ import YesodCoreTest.NoOverloadedStrings
 import YesodCoreTest.InternalRequest
 import YesodCoreTest.ErrorHandling
 import YesodCoreTest.Cache
+import qualified YesodCoreTest.WaiSubsite as WaiSubsite
 import qualified YesodCoreTest.Redirect as Redirect
 import qualified YesodCoreTest.JsLoader as JsLoader
 
@@ -25,6 +26,7 @@ specs =
     , internalRequestTest
     , errorHandlingTest
     , cacheTest
+    , WaiSubsite.specs
     , Redirect.specs
     , JsLoader.specs
     ]

yesod-core/yesod-core.cabal

@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.0.0.20120316
+version:         1.0.0.20120320
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>