如何从Yesod子网站重定向到主(调用方)网站，而不对子网站中的主路由进行硬编码

Question

我有一个简单的场景，在Yesod子网站中创建一个新的持久实体。发布并插入新实体后，子网站应重定向到调用方网站(主网站(。主站点本身可以是子网站。

如何从子网站重定向到调用方网站？

以下是我尝试的代码片段：

instance
( Yesod m
, RenderMessage m AppMessage
, RenderMessage m FormMessage
, YesodPersist m
, YesodPersistBackend m ~ SqlBackend
) => YesodSubDispatch CntrCrud m where
yesodSubDispatch = $(mkYesodSubDispatch resourcesCntrCrud)
postCntrNewR ::
( Yesod m
, RenderMessage m AppMessage
, RenderMessage m FormMessage
, YesodPersist m
, YesodPersistBackend m ~ SqlBackend
) => SubHandlerFor CntrCrud m Html
postCntrNewR = liftHandler $ do
((r,w),e) <- runFormPost $ cntrForm Nothing
case r of
FormSuccess x -> do
_ <- runDB $ insert x
redirect ???toMaster???
_ -> defaultLayout [whamlet|
<fieldset .border.p-2>
<legend>_{MsgNewCountry}
<form method=post enctype=#{e} novalidate .needs-validation>
^{w}
<button type=submit .btn.btn-primary>
_{MsgSave}
<a href=@{???toMaster???} .btn.btn-secondary role=button>
_{MsgCancel}
|]
cntrForm :: (Yesod m, RenderMessage m AppMessage, RenderMessage m FormMessage)
=> Maybe Cntr -> Html -> MForm (HandlerFor m) (FormResult Cntr, WidgetFor m ())
cntrForm mx extra = do
.....

其中???toMaster???是占位符。谢谢

我试着像下面的代码片段中那样使用getRouteToParent，但getRouteToParent返回到同一个子网站的路由(完整路径(：

postCntrNewR ::
( Yesod m
, RenderMessage m AppMessage
, RenderMessage m FormMessage
, YesodPersist m
, YesodPersistBackend m ~ SqlBackend
) => SubHandlerFor CntrCrud m Html
postCntrNewR = do
tp <- getRouteToParent
liftHandler $ do
((r,w),e) <- runFormPost $ cntrForm Nothing
case r of
FormSuccess x -> do
_ <- runDB $ insert x
redirect $ tp CntrNewR
_ -> defaultLayout [whamlet|
<fieldset .border.p-2>
<legend>_{MsgNewCountry}
<form method=post action=@{tp CntrNewR} enctype=#{e} novalidate .needs-validation>
^{w}
<button type=submit .btn.btn-primary>
_{MsgSave}
<a href=@{tp CntrNewR} .btn.btn-secondary role=button>
_{MsgCancel}
|]

上面，redirect $ tp CntrNewR和@{tp CntrNewR}重定向并链接到同一个子网站，在那里它们被称为"不到主站点"。(CntrNewR是在子站点中定义的路由(。因此，<form method=post action=@{tp CntrNewR}...工作正常，可以发布到同一个子网站，但它不是我所期望的重定向到主站点的。谢谢

Answer 1

一个解决方案是让主站点提供路由：

-- src/Dictionary/Cntr/Data.hs
...
data CntrCrud = CntrCrud
class (Yesod m, RenderMessage m FormMessage) => YesodCntr m where
toMaster :: m -> Route m
mkYesodSubData "CntrCrud" [parseRoutes|
/ CntrNewR GET POST
|]
...

-- src/Foundation.hs
...
instance YesodCntr App where
toMaster _ = CntrsR
...

-- src/Dictionary/Cntr/CntrSub.hs
...
instance
( YesodCntr m
, RenderMessage m AppMessage
, YesodPersist m
, YesodPersistBackend m ~ SqlBackend
) => YesodSubDispatch CntrCrud m where
yesodSubDispatch = $(mkYesodSubDispatch resourcesCntrCrud)
postCntrNewR ::
( YesodCntr m
, RenderMessage m AppMessage
, YesodPersist m
, YesodPersistBackend m ~ SqlBackend
) => SubHandlerFor CntrCrud m Html
postCntrNewR = do
tp <- getRouteToParent
master <- getYesod
liftHandler $ do
((r,w),e) <- runFormPost $ cntrForm Nothing
case r of
FormSuccess x ->  do
_ <- runDB $ insert x
redirect $ toMaster master
_ -> defaultLayout [whamlet|
<fieldset .border.p-2>
<legend>_{MsgNewCountry}
<form method=post action=@{tp CntrNewR} enctype=#{e} novalidate .needs-validation>
^{w}
<button type=submit .btn.btn-primary>
_{MsgSave}
<a href=@{toMaster master} .btn.btn-secondary role=button>
_{MsgCancel}
|]

getCntrNewR ::
( YesodCntr m
, RenderMessage m AppMessage
) => SubHandlerFor CntrCrud m Html
getCntrNewR = do  
tp <- getRouteToParent
master <- getYesod
liftHandler $ do
(w,e) <- generateFormPost $ cntrForm Nothing
defaultLayout [whamlet|
<fieldset .border.p-2>
<legend>_{MsgNewCountry}
<form method=post action=@{tp CntrNewR} enctype=#{e} novalidate .needs-validation>
^{w}
<button type=submit .btn.btn-primary>
_{MsgSave}
<a href=@{toMaster master} .btn.btn-secondary role=button>
_{MsgCancel}
|]

cntrForm :: (Yesod m, RenderMessage m AppMessage, RenderMessage m FormMessage)
=> Maybe Cntr -> Html -> MForm (HandlerFor m) (FormResult Cntr, WidgetFor m ())
cntrForm mx extra = do
...