From 7262c30c74ac0f17560f61f6fdc3051bbd343c82 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 6 Jun 2010 21:50:27 +0300 Subject: [PATCH] More sophisticated subsite support --- Yesod.hs | 4 ---- Yesod/Dispatch.hs | 42 ++++++++++++++++++++++++++++++++---------- Yesod/Form.hs | 4 ---- Yesod/Handler.hs | 8 ++------ Yesod/Request.hs | 4 ---- yesod.cabal | 2 +- 6 files changed, 35 insertions(+), 29 deletions(-) diff --git a/Yesod.hs b/Yesod.hs index 0bbf0572..95e68086 100644 --- a/Yesod.hs +++ b/Yesod.hs @@ -33,9 +33,5 @@ import Yesod.Handler hiding (runHandler) import Network.Wai (Application) import Yesod.Hamlet import Data.Convertible.Text (cs) -#if MIN_VERSION_transformers(0,2,0) import "transformers" Control.Monad.IO.Class (liftIO) -#else -import "transformers" Control.Monad.Trans (liftIO) -#endif import Web.Routes.Quasi (Routes) diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index 0056203a..800231f8 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -31,6 +31,7 @@ import Yesod.Internal import Web.Routes.Quasi import Language.Haskell.TH.Syntax +import Data.List (nub) import qualified Network.Wai as W import qualified Network.Wai.Enumerator as W @@ -46,7 +47,7 @@ import qualified Data.ByteString.Char8 as B import Web.Routes (encodePathInfo) import Control.Concurrent.MVar -import Control.Arrow ((***)) +import Control.Arrow ((***), first) import Data.Convertible.Text (cs) import Data.Time @@ -76,7 +77,7 @@ import Yesod.Content mkYesod :: String -- ^ name of the argument datatype -> [Resource] -> Q [Dec] -mkYesod name = fmap (\(x, y) -> x ++ y) . mkYesodGeneral name [] False +mkYesod name = fmap (\(x, y) -> x ++ y) . mkYesodGeneral name [] [] False -- | Generates URL datatype and site function for the given 'Resource's. This -- is used for creating subsites, *not* sites. See 'mkYesod' for the latter. @@ -84,11 +85,13 @@ mkYesod name = fmap (\(x, y) -> x ++ y) . mkYesodGeneral name [] False -- executable by itself, but instead provides functionality to -- be embedded in other sites. mkYesodSub :: String -- ^ name of the argument datatype - -> [Name] -- ^ a list of classes the master datatype must be an instance of + -> [(String, [Name])] -> [Resource] -> Q [Dec] mkYesodSub name clazzes = - fmap (\(x, y) -> x ++ y) . mkYesodGeneral name clazzes True + fmap (\(x, y) -> x ++ y) . mkYesodGeneral name' rest clazzes True + where + (name':rest) = words name -- | Sometimes, you will want to declare your routes in one file and define -- your handlers elsewhere. For example, this is the only way to break up a @@ -96,7 +99,7 @@ mkYesodSub name clazzes = -- 'mkYesodDispatch', do just that. mkYesodData :: String -> [Resource] -> Q [Dec] mkYesodData name res = do - (x, _) <- mkYesodGeneral name [] False res + (x, _) <- mkYesodGeneral name [] [] False res let rname = mkName $ "resources" ++ name eres <- liftResources res let y = [ SigD rname $ ListT `AppT` ConT ''Resource @@ -106,7 +109,7 @@ mkYesodData name res = do -- | See 'mkYesodData'. mkYesodDispatch :: String -> [Resource] -> Q [Dec] -mkYesodDispatch name = fmap snd . mkYesodGeneral name [] False +mkYesodDispatch name = fmap snd . mkYesodGeneral name [] [] False explodeHandler :: HasReps c => GHandler sub master c @@ -120,25 +123,44 @@ explodeHandler :: HasReps c -> YesodApp explodeHandler a b c d e f _ _ = runHandler a b (Just c) d e f -mkYesodGeneral :: String -> [Name] -> Bool -> [Resource] -> Q ([Dec], [Dec]) -mkYesodGeneral name clazzes isSub res = do +mkYesodGeneral :: String -- ^ argument name + -> [String] -- ^ parameters for site argument + -> [(String, [Name])] -- ^ classes + -> Bool -- ^ is subsite? + -> [Resource] + -> Q ([Dec], [Dec]) +mkYesodGeneral name args clazzes isSub res = do let name' = mkName name + args' = map mkName args + arg = foldl AppT (ConT $ name') $ map VarT args' let site = mkName $ "site" ++ name let gsbod = NormalB $ VarE site let yes' = FunD (mkName "getSite") [Clause [] gsbod []] let yes = InstanceD [] (ConT ''YesodSite `AppT` ConT name') [yes'] + let clazzes' = compact + $ map (\x -> (x, [])) ("master" : args) ++ + clazzes explode <- [|explodeHandler|] QuasiSiteDecs w x y z <- createQuasiSite QuasiSiteSettings { crRoutes = mkName $ name ++ "Routes" , crApplication = ConT ''YesodApp - , crArgument = ConT $ mkName name + , crArgument = arg , crExplode = explode , crResources = res , crSite = site - , crMaster = if isSub then Right clazzes else Left (ConT name') + , crMaster = if isSub + then Right clazzes' + else Left (ConT name') } return ([w, x], (if isSub then id else (:) yes) [y, z]) +compact :: [(String, [a])] -> [(String, [a])] +compact [] = [] +compact ((x, x'):rest) = + let ys = filter (\(y, _) -> y == x) rest + zs = filter (\(z, _) -> z /= x) rest + in (x, x' ++ concatMap snd ys) : compact zs + sessionName :: String sessionName = "_SESSION" diff --git a/Yesod/Form.hs b/Yesod/Form.hs index 9c3922b6..acacbb86 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -26,11 +26,7 @@ import Control.Applicative hiding (optional) import Data.Time (Day) import Data.Convertible.Text import Data.Maybe (fromMaybe) -#if MIN_VERSION_transformers(0,2,0) import "transformers" Control.Monad.IO.Class -#else -import "transformers" Control.Monad.Trans -#endif import Yesod.Internal import Control.Monad.Attempt diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index f4c8a0db..d79a99dd 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -76,13 +76,9 @@ import Control.Exception hiding (Handler, catch) import qualified Control.Exception as E import Control.Applicative -#if MIN_VERSION_transformers(0,2,0) import "transformers" Control.Monad.IO.Class -#else -import "transformers" Control.Monad.Trans -#endif -import qualified Control.Monad.CatchIO as C -import Control.Monad.CatchIO (catch) +import qualified "MonadCatchIO-transformers" Control.Monad.CatchIO as C +import "MonadCatchIO-transformers" Control.Monad.CatchIO (catch) import Control.Monad (liftM, ap) import System.IO diff --git a/Yesod/Request.hs b/Yesod/Request.hs index 5dcddc80..10c9ef10 100644 --- a/Yesod/Request.hs +++ b/Yesod/Request.hs @@ -42,11 +42,7 @@ module Yesod.Request import qualified Network.Wai as W import qualified Data.ByteString.Lazy as BL -#if MIN_VERSION_transformers(0,2,0) import "transformers" Control.Monad.IO.Class -#else -import "transformers" Control.Monad.Trans -#endif import Control.Monad (liftM) import Network.Wai.Parse import Control.Monad.Instances () -- I'm missing the instance Monad ((->) r diff --git a/yesod.cabal b/yesod.cabal index 493ae705..c164a0ec 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -41,7 +41,7 @@ library convertible-text >= 0.3.0 && < 0.4, template-haskell >= 2.4 && < 2.5, web-routes >= 0.22 && < 0.23, - web-routes-quasi >= 0.3 && < 0.4, + web-routes-quasi >= 0.4 && < 0.5, hamlet >= 0.3.0 && < 0.4, transformers >= 0.1 && < 0.3, clientsession >= 0.4.0 && < 0.5,