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 [] y = renderMessage a ["en"] y
getTowidgetR :: Handler RepHtml
getTowidgetR = defaultLayout $ do
toWidget [julius|foo|]
toWidgetHead [julius|foo|]
@ -55,7 +56,7 @@ getTowidgetR = defaultLayout $ do
toWidget [lucius|foo{bar:baz}|]
toWidgetHead [lucius|foo{bar:baz}|]
toWidget [hamlet|<foo>|]
toWidget [hamlet|<foo>|] :: Widget
toWidgetHead [hamlet|<foo>|]
toWidgetBody [hamlet|<foo>|]

View File

@ -27,6 +27,7 @@ import Prelude hiding (exp)
import Yesod.Internal.Core
import Yesod.Handler
import Yesod.Internal.Dispatch
import Yesod.Widget (GWidget)
import Web.PathPieces (SinglePiece (..), MultiPiece (..))
import Yesod.Internal.RouteParsing (THResource, Pieces (..), createRoutes, createRender, Resource (..), parseRoutes, parseRoutesFile)
@ -103,8 +104,7 @@ mkYesodGeneral :: String -- ^ foundation name
-> [Resource]
-> Q ([Dec], [Dec])
mkYesodGeneral name args clazzes isSub res = do
let name' = mkName name
args' = map mkName args
let args' = map mkName args
arg = foldl AppT (ConT name') $ map VarT args'
th' <- mapM thResourceFromResource res
let th = map fst th'
@ -134,7 +134,21 @@ mkYesodGeneral name args clazzes isSub res = do
then ConT ''YesodDispatch `AppT` arg `AppT` VarT master
else ConT ''YesodDispatch `AppT` arg `AppT` arg
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 n ps atts)

View File

@ -50,14 +50,6 @@ data ~sitearg~ = ~sitearg~
, 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
-- explanation of the syntax, please see:
-- http://www.yesodweb.com/book/handler

View File

@ -37,14 +37,6 @@ data ~sitearg~ = ~sitearg~
, 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
-- explanation of the syntax, please see:
-- http://docs.yesodweb.com/book/web-routes-quasi/