Offer split mkYesod
This commit is contained in:
parent
d20d76f677
commit
0d8c024c33
@ -5,6 +5,9 @@ module Yesod.Dispatch
|
|||||||
parseRoutes
|
parseRoutes
|
||||||
, mkYesod
|
, mkYesod
|
||||||
, mkYesodSub
|
, mkYesodSub
|
||||||
|
-- ** More fine-grained
|
||||||
|
, mkYesodData
|
||||||
|
, mkYesodDispatch
|
||||||
-- * Convert to WAI
|
-- * Convert to WAI
|
||||||
, toWaiApp
|
, toWaiApp
|
||||||
, basicHandler
|
, basicHandler
|
||||||
@ -54,7 +57,7 @@ import Web.ClientSession
|
|||||||
mkYesod :: String -- ^ name of the argument datatype
|
mkYesod :: String -- ^ name of the argument datatype
|
||||||
-> [Resource]
|
-> [Resource]
|
||||||
-> Q [Dec]
|
-> Q [Dec]
|
||||||
mkYesod name = 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
|
-- | Generates URL datatype and site function for the given 'Resource's. This
|
||||||
-- is used for creating subsites, *not* sites. See 'mkYesod' for the latter.
|
-- is used for creating subsites, *not* sites. See 'mkYesod' for the latter.
|
||||||
@ -65,7 +68,26 @@ mkYesodSub :: String -- ^ name of the argument datatype
|
|||||||
-> [Name] -- ^ a list of classes the master datatype must be an instance of
|
-> [Name] -- ^ a list of classes the master datatype must be an instance of
|
||||||
-> [Resource]
|
-> [Resource]
|
||||||
-> Q [Dec]
|
-> Q [Dec]
|
||||||
mkYesodSub name clazzes = mkYesodGeneral name clazzes True
|
mkYesodSub name clazzes =
|
||||||
|
fmap (\(x, y) -> x ++ y) . mkYesodGeneral name clazzes True
|
||||||
|
|
||||||
|
-- | 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
|
||||||
|
-- monolithic file into smaller parts. This function, paired with
|
||||||
|
-- 'mkYesodDispatch', do just that.
|
||||||
|
mkYesodData :: String -> [Resource] -> Q [Dec]
|
||||||
|
mkYesodData name res = do
|
||||||
|
(x, _) <- mkYesodGeneral name [] False res
|
||||||
|
let rname = mkName $ "resources" ++ name
|
||||||
|
eres <- liftResources res
|
||||||
|
let y = [ SigD rname $ ListT `AppT` ConT ''Resource
|
||||||
|
, FunD rname [Clause [] (NormalB eres) []]
|
||||||
|
]
|
||||||
|
return $ x ++ y
|
||||||
|
|
||||||
|
-- | See 'mkYesodData'.
|
||||||
|
mkYesodDispatch :: String -> [Resource] -> Q [Dec]
|
||||||
|
mkYesodDispatch name = fmap snd . mkYesodGeneral name [] False
|
||||||
|
|
||||||
explodeHandler :: HasReps c
|
explodeHandler :: HasReps c
|
||||||
=> GHandler sub master c
|
=> GHandler sub master c
|
||||||
@ -79,7 +101,7 @@ explodeHandler :: HasReps c
|
|||||||
-> YesodApp
|
-> YesodApp
|
||||||
explodeHandler a b c d e f _ _ = runHandler a b (Just c) d e f
|
explodeHandler a b c d e f _ _ = runHandler a b (Just c) d e f
|
||||||
|
|
||||||
mkYesodGeneral :: String -> [Name] -> Bool -> [Resource] -> Q [Dec]
|
mkYesodGeneral :: String -> [Name] -> Bool -> [Resource] -> Q ([Dec], [Dec])
|
||||||
mkYesodGeneral name clazzes isSub res = do
|
mkYesodGeneral name clazzes isSub res = do
|
||||||
let name' = mkName name
|
let name' = mkName name
|
||||||
let site = mkName $ "site" ++ name
|
let site = mkName $ "site" ++ name
|
||||||
@ -96,14 +118,14 @@ mkYesodGeneral name clazzes isSub res = do
|
|||||||
, crSite = site
|
, crSite = site
|
||||||
, crMaster = if isSub then Right clazzes else Left (ConT name')
|
, crMaster = if isSub then Right clazzes else Left (ConT name')
|
||||||
}
|
}
|
||||||
return $ (if isSub then id else (:) yes) [w, x, y, z]
|
return ([w, x], (if isSub then id else (:) yes) [y, z])
|
||||||
|
|
||||||
sessionName :: String
|
sessionName :: String
|
||||||
sessionName = "_SESSION"
|
sessionName = "_SESSION"
|
||||||
|
|
||||||
-- | Convert the given argument into a WAI application, executable with any WAI
|
-- | Convert the given argument into a WAI application, executable with any WAI
|
||||||
-- handler. You can use 'basicHandler' if you wish.
|
-- handler. You can use 'basicHandler' if you wish.
|
||||||
toWaiApp :: Yesod y => y -> IO W.Application
|
toWaiApp :: (Yesod y, YesodSite y) => y -> IO W.Application
|
||||||
toWaiApp a =
|
toWaiApp a =
|
||||||
return $ gzip
|
return $ gzip
|
||||||
$ jsonp
|
$ jsonp
|
||||||
@ -116,7 +138,7 @@ parseSession bs = case reads $ cs bs of
|
|||||||
[] -> []
|
[] -> []
|
||||||
((x, _):_) -> x
|
((x, _):_) -> x
|
||||||
|
|
||||||
toWaiApp' :: Yesod y
|
toWaiApp' :: (Yesod y, YesodSite y)
|
||||||
=> y
|
=> y
|
||||||
-> [B.ByteString]
|
-> [B.ByteString]
|
||||||
-> W.Request
|
-> W.Request
|
||||||
|
|||||||
@ -31,7 +31,7 @@ class YesodSite y where
|
|||||||
|
|
||||||
-- | Define settings for a Yesod applications. The only required setting is
|
-- | Define settings for a Yesod applications. The only required setting is
|
||||||
-- 'approot'; other than that, there are intelligent defaults.
|
-- 'approot'; other than that, there are intelligent defaults.
|
||||||
class YesodSite a => Yesod a where
|
class Yesod a where
|
||||||
-- | An absolute URL to the root of the application. Do not include
|
-- | An absolute URL to the root of the application. Do not include
|
||||||
-- trailing slash.
|
-- trailing slash.
|
||||||
--
|
--
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user