39 lines
1.3 KiB
Haskell
39 lines
1.3 KiB
Haskell
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
module Yesod.Resource
|
|
( parseRoutes
|
|
, mkYesod
|
|
, mkYesodSub
|
|
) where
|
|
|
|
import Web.Routes.Quasi (parseRoutes, createRoutes, Resource (..))
|
|
import Yesod.Handler
|
|
import Language.Haskell.TH.Syntax
|
|
import Yesod.Yesod
|
|
|
|
mkYesod :: String -> [Resource] -> Q [Dec]
|
|
mkYesod name res = do
|
|
let name' = mkName name
|
|
let tySyn = TySynInstD ''Routes [ConT $ name'] (ConT $ mkName $ name ++ "Routes")
|
|
let gsbod = NormalB $ VarE $ mkName $ "site" ++ name ++ "Routes"
|
|
let yes' = FunD (mkName "getSite") [Clause [] gsbod []]
|
|
let yes = InstanceD [] (ConT ''YesodSite `AppT` ConT name') [yes']
|
|
decs <- createRoutes (name ++ "Routes")
|
|
(ConT ''YesodApp)
|
|
name'
|
|
"runHandler'"
|
|
res
|
|
return $ tySyn : yes : decs
|
|
|
|
mkYesodSub :: String -> [Resource] -> Q [Dec]
|
|
mkYesodSub name res = do
|
|
let name' = mkName name
|
|
let tySyn = TySynInstD ''Routes [ConT $ name'] (ConT $ mkName $ name ++ "Routes")
|
|
let yas = ConT ''YesodApp `AppT` VarT (mkName "master")
|
|
decs <- createRoutes (name ++ "Routes")
|
|
yas
|
|
name'
|
|
"runHandlerSub"
|
|
res
|
|
return $ tySyn : decs
|