无法在 Yesod 子站点小部件中使用类型安全路由

Question

我正在为毕业实习在 Yesod 之上构建一个 CMS。目前我们正在使用一个子站点 (Core) 来表示管理区域，这个 Core 应该可以在项目之间重用，因此它与主站点分离并拥有自己的存储库。应该可以包含其他子站点以集成到Core。那些其他子网站都应该能够使用相同的（管理员）布局。

我们使用的存储库是：
CMS 核心：https://github.com/lambdacms/lambdacms-core/tree/extensions
CMS 媒体扩展：https://github.com/lambdacms/lambdacms-media
Demo Yesod 大师：https://github.com/lambdacms/ponycms/tree/media

请注意，有 url 链接到特定分支，这些是我当前正在使用的分支。

最初我使用函数lambdaCoreLayout（在Foundation.hs 中找到）为Core 本身内的所有处理程序提供正确的布局。但我无法在其他子站点中使用此功能。相反，重写了已经工作的内容，我添加了函数tryoutLayout（在同一个文件中找到），它适用于所有子站点，并且与defaultLayoutSub（Yesod 附带）非常相似。但是，它不允许我在任何处理程序中使用 getRouteToParent 向小部件添加类型安全的路由。

以sn-p为例：

getAdminHomeR :: CoreHandler Html
getAdminHomeR = do
  tp <- getRouteToParent
  tryoutLayout [whamlet|@{tp AdminHomeR}|]

这给了我以下错误：

Could not deduce (master ~ Core)
from the context (LambdaCmsAdmin master)
  bound by the type signature for
             getAdminHomeR :: LambdaCmsAdmin master =>
                              HandlerT Core (HandlerT master IO) Html
  at LambdaCms/Core/Handler/Home.hs:17:18-33
  ‘master’ is a rigid type variable bound by
           the type signature for
             getAdminHomeR :: LambdaCmsAdmin master =>
                              HandlerT Core (HandlerT master IO) Html
           at <no location info>
Expected type: WidgetT
                 Core
                 IO
                 (yesod-core-1.4.2:Yesod.Routes.Class.Route master
                  -> [(Text, Text)] -> Text)
  Actual type: WidgetT
                 Core
                 IO
                 (yesod-core-1.4.2:Yesod.Routes.Class.Route
                    (HandlerSite (WidgetT Core IO))
                  -> [(Text, Text)] -> Text)
Relevant bindings include
  tp :: yesod-core-1.4.2:Yesod.Routes.Class.Route Core
        -> yesod-core-1.4.2:Yesod.Routes.Class.Route master
    (bound at LambdaCms/Core/Handler/Home.hs:20:3)
  getAdminHomeR :: HandlerT Core (HandlerT master IO) Html
    (bound at LambdaCms/Core/Handler/Home.hs:19:1)
In the first argument of ‘(>>=)’, namely ‘getUrlRenderParams’
In the first argument of ‘tryoutLayout’, namely
  ‘((getUrlRenderParams
     >>=
       (\ urender_agTZ
          -> (asWidgetT . toWidget)
               (toHtml (\ u_agU0 -> urender_agTZ u_agU0 [] (tp AdminHomeR))))))’

如果我纠正了这个错误，则表明getRouteToParent 试图返回一个函数，该函数试图生成Route Core 而不是Route master。我尝试了不同的地方来放置tp <- getRouteToParent，但我无法让它工作。

我自己对 Haskell 和 Yesod 的了解是有限的，我一直无法找到正确方向的解决方案或指针。是否有我遗漏的东西，或者有其他方法可以解决这个问题？

Answer 1

您希望您的 tryoutLayout 函数采用 WidgetT master IO () 类型的值，而不是 WidgetT Core IO ()，以允许您嵌入主站点路由。