Switch Routes back to type family.
There appears to be a bug in GHC, but I'm not certain. Look at the output from compiling the previous commit; some kind of interaction with a DataInstD and deriving instances.
This commit is contained in:
parent
5568530a5d
commit
3ed97f4cfc
@ -141,7 +141,9 @@ mkYesodGeneral name args clazzes isSub res = do
|
||||
$ map (\x -> (x, [])) ("master" : args) ++ clazzes
|
||||
th <- mapM (thResourceFromResource arg) res -- FIXME now we cannot have multi-nested subsites
|
||||
w' <- createRoutes th
|
||||
let w = DataInstD [] ''Routes [arg] w' [''Show, ''Read, ''Eq]
|
||||
let routesName = mkName $ name ++ "Routes"
|
||||
let w = DataD [] routesName [] w' [''Show, ''Read, ''Eq]
|
||||
let x = TySynInstD ''Routes [arg] $ ConT routesName
|
||||
|
||||
parse' <- createParse th
|
||||
parse'' <- newName "parse"
|
||||
@ -166,7 +168,7 @@ mkYesodGeneral name args clazzes isSub res = do
|
||||
let y = InstanceD ctx ytyp
|
||||
[ FunD (mkName yfunc) [Clause [] (NormalB site') []]
|
||||
]
|
||||
return ([w], [y])
|
||||
return ([w, x], [y])
|
||||
|
||||
isStatic :: Piece -> Bool
|
||||
isStatic StaticPiece{} = True
|
||||
@ -248,7 +250,7 @@ toWaiApp' y segments env = do
|
||||
eurl = parsePathSegments site pathSegments
|
||||
render u = fromMaybe
|
||||
(fullRender (approot y) (formatPathSegments site) u)
|
||||
(urlRenderOverride u)
|
||||
(urlRenderOverride y u)
|
||||
rr <- parseWaiRequest env session'
|
||||
let h = do
|
||||
onRequest
|
||||
|
||||
@ -96,7 +96,7 @@ import Numeric (showIntAtBase)
|
||||
import Data.Char (ord, chr)
|
||||
|
||||
-- | The type-safe URLs associated with a site argument.
|
||||
data family Routes a
|
||||
type family Routes a
|
||||
|
||||
data HandlerData sub master = HandlerData
|
||||
{ handlerRequest :: Request
|
||||
|
||||
@ -22,7 +22,7 @@
|
||||
module Yesod.Helpers.Auth
|
||||
( -- * Subsite
|
||||
Auth (..)
|
||||
, Routes (..)
|
||||
, AuthRoutes (..)
|
||||
-- * Settings
|
||||
, YesodAuth (..)
|
||||
, Creds (..)
|
||||
@ -154,7 +154,7 @@ mkYesodSub "Auth" [("master", [''YesodAuth])] [$parseRoutes|
|
||||
/facebook/start StartFacebookR GET
|
||||
|
||||
/register EmailRegisterR GET POST
|
||||
/verify/#EmailId/#String EmailVerifyR GET
|
||||
/verify/#Integer/#String EmailVerifyR GET
|
||||
/login EmailLoginR GET POST
|
||||
/set-password EmailPasswordR GET POST
|
||||
|]
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
module Yesod.Helpers.Crud
|
||||
( Item (..)
|
||||
, Crud (..)
|
||||
, Routes (..)
|
||||
, CrudRoutes (..)
|
||||
, defaultCrud
|
||||
) where
|
||||
|
||||
|
||||
@ -27,7 +27,7 @@
|
||||
module Yesod.Helpers.Static
|
||||
( -- * Subsite
|
||||
Static (..)
|
||||
, Routes (..)
|
||||
, StaticRoutes (..)
|
||||
-- * Lookup files in filesystem
|
||||
, fileLookupDir
|
||||
, staticFiles
|
||||
|
||||
@ -93,8 +93,8 @@ class Yesod a where
|
||||
-- | Override the rendering function for a particular URL. One use case for
|
||||
-- this is to offload static hosting to a different domain name to avoid
|
||||
-- sending cookies.
|
||||
urlRenderOverride :: Routes a -> Maybe String
|
||||
urlRenderOverride _ = Nothing
|
||||
urlRenderOverride :: a -> Routes a -> Maybe String
|
||||
urlRenderOverride _ _ = Nothing
|
||||
|
||||
-- | Determine if a request is authorized or not.
|
||||
--
|
||||
|
||||
Loading…
Reference in New Issue
Block a user