TH defines Widget and Handler type synonyms

This commit is contained in:
Michael Snoyman 2011-08-22 19:30:55 +03:00
parent d859e5c3f9
commit bab00d13fa
4 changed files with 19 additions and 20 deletions

View File

@ -47,6 +47,7 @@ instance RenderMessage Y Msg where
renderMessage a (_:xs) y = renderMessage a xs y renderMessage a (_:xs) y = renderMessage a xs y
renderMessage a [] y = renderMessage a ["en"] y renderMessage a [] y = renderMessage a ["en"] y
getTowidgetR :: Handler RepHtml
getTowidgetR = defaultLayout $ do getTowidgetR = defaultLayout $ do
toWidget [julius|foo|] toWidget [julius|foo|]
toWidgetHead [julius|foo|] toWidgetHead [julius|foo|]
@ -55,7 +56,7 @@ getTowidgetR = defaultLayout $ do
toWidget [lucius|foo{bar:baz}|] toWidget [lucius|foo{bar:baz}|]
toWidgetHead [lucius|foo{bar:baz}|] toWidgetHead [lucius|foo{bar:baz}|]
toWidget [hamlet|<foo>|] toWidget [hamlet|<foo>|] :: Widget
toWidgetHead [hamlet|<foo>|] toWidgetHead [hamlet|<foo>|]
toWidgetBody [hamlet|<foo>|] toWidgetBody [hamlet|<foo>|]

View File

@ -27,6 +27,7 @@ import Prelude hiding (exp)
import Yesod.Internal.Core import Yesod.Internal.Core
import Yesod.Handler import Yesod.Handler
import Yesod.Internal.Dispatch import Yesod.Internal.Dispatch
import Yesod.Widget (GWidget)
import Web.PathPieces (SinglePiece (..), MultiPiece (..)) import Web.PathPieces (SinglePiece (..), MultiPiece (..))
import Yesod.Internal.RouteParsing (THResource, Pieces (..), createRoutes, createRender, Resource (..), parseRoutes, parseRoutesFile) import Yesod.Internal.RouteParsing (THResource, Pieces (..), createRoutes, createRender, Resource (..), parseRoutes, parseRoutesFile)
@ -103,8 +104,7 @@ mkYesodGeneral :: String -- ^ foundation name
-> [Resource] -> [Resource]
-> Q ([Dec], [Dec]) -> Q ([Dec], [Dec])
mkYesodGeneral name args clazzes isSub res = do mkYesodGeneral name args clazzes isSub res = do
let name' = mkName name let args' = map mkName args
args' = map mkName args
arg = foldl AppT (ConT name') $ map VarT args' arg = foldl AppT (ConT name') $ map VarT args'
th' <- mapM thResourceFromResource res th' <- mapM thResourceFromResource res
let th = map fst th' let th = map fst th'
@ -134,7 +134,21 @@ mkYesodGeneral name args clazzes isSub res = do
then ConT ''YesodDispatch `AppT` arg `AppT` VarT master then ConT ''YesodDispatch `AppT` arg `AppT` VarT master
else ConT ''YesodDispatch `AppT` arg `AppT` arg else ConT ''YesodDispatch `AppT` arg `AppT` arg
let y = InstanceD ctx ytyp [FunD (mkName "yesodDispatch") [yd]] let y = InstanceD ctx ytyp [FunD (mkName "yesodDispatch") [yd]]
return ([w, x, x'], [y]) return ([w, x, x'] ++ masterTypSyns, [y])
where
name' = mkName name
masterTypSyns
| isSub = []
| otherwise =
[ TySynD
(mkName "Handler")
[]
(ConT ''GHandler `AppT` ConT name' `AppT` ConT name')
, TySynD
(mkName "Widget")
[]
(ConT ''GWidget `AppT` ConT name' `AppT` ConT name' `AppT` TupleT 0)
]
thResourceFromResource :: Resource -> Q (THResource, Maybe String) thResourceFromResource :: Resource -> Q (THResource, Maybe String)
thResourceFromResource (Resource n ps atts) thResourceFromResource (Resource n ps atts)

View File

@ -50,14 +50,6 @@ data ~sitearg~ = ~sitearg~
, connPool :: Settings.ConnectionPool -- ^ Database connection pool. , connPool :: Settings.ConnectionPool -- ^ Database connection pool.
} }
-- | A useful synonym; most of the handler functions in your application
-- will need to be of this type.
type Handler = GHandler ~sitearg~ ~sitearg~
-- | A useful synonym; most of the widgets functions in your application
-- will need to be of this type.
type Widget = GWidget ~sitearg~ ~sitearg~
-- This is where we define all of the routes in our application. For a full -- This is where we define all of the routes in our application. For a full
-- explanation of the syntax, please see: -- explanation of the syntax, please see:
-- http://www.yesodweb.com/book/handler -- http://www.yesodweb.com/book/handler

View File

@ -37,14 +37,6 @@ data ~sitearg~ = ~sitearg~
, getStatic :: Static -- ^ Settings for static file serving. , getStatic :: Static -- ^ Settings for static file serving.
} }
-- | A useful synonym; most of the handler functions in your application
-- will need to be of this type.
type Handler = GHandler ~sitearg~ ~sitearg~
-- | A useful synonym; most of the widgets functions in your application
-- will need to be of this type.
type Widget = GWidget ~sitearg~ ~sitearg~
-- This is where we define all of the routes in our application. For a full -- This is where we define all of the routes in our application. For a full
-- explanation of the syntax, please see: -- explanation of the syntax, please see:
-- http://docs.yesodweb.com/book/web-routes-quasi/ -- http://docs.yesodweb.com/book/web-routes-quasi/