Question

我是Yesod的新手，想要创建一个自定义字段，我需要在其中进行查询。

我的模型如下：

Article
    artname     Text
    title       Text
    body        Text
    parent      ArticleId Maybe

    UniqueArt   artname

    deriving    Typeable

我想创建一个＆＃34;父字段＆＃34;其中用户输入artname而不是数字ID，但它将是存储在数据库中的真实ID。

我无法使用checkMMap，因为反转功能在IO之外工作。

根据我对字段处理的理解，fieldParse获取用户输入的值并尝试将其转换为ArticleId，而fieldView使用ArticleId并显示更人性化的版本。

到目前为止我所得到的是：

parentField :: Field sub ArticleId
parentField = Field
    { fieldParse = \rawVals _ -> do
            let (name:[]) = rawVals
            marticle <- runDB $ getBy (UniqueArt name)
            case marticle of
                Nothing      -> return $ (Left . SomeMessage) ("Article name invalid." :: Text)
                Just article -> return $ (Right . Just) (entityKey article)

    , fieldView = \idAttr nameAttr attrs eResult isReq ->
            case eResult of
                Right key -> do
                    marticle <- runDB $ get key
                    let name = case marticle of
                                   Just article -> Right (articleArtname article)
                                   Nothing      -> Left ("Article key invalid." :: Text)

                    (fieldView textField) idAttr nameAttr attrs name isReq

                Left _ -> (fieldView textField) idAttr nameAttr attrs eResult isReq
    }

GHC不喜欢marticle <- runDB $ get key行并给出以下错误：

Handler/Article.hs:50:21:
    Couldn't match type ‘HandlerT site1 IO’
                  with ‘WidgetT (HandlerSite sub) IO’
    Expected type: HandlerT site1 IO (Maybe Article)
                   -> (Maybe Article -> HandlerT site1 IO ())
                   -> WidgetT (HandlerSite sub) IO ()
      Actual type: HandlerT site1 IO (Maybe Article)
                   -> (Maybe Article -> HandlerT site1 IO ()) -> HandlerT site1 IO ()
    Relevant bindings include
      parentField :: Field sub ArticleId
        (bound at Handler/Article.hs:39:1)
    In a stmt of a 'do' block: marticle <- runDB $ get key
    In the expression:
      do { marticle <- runDB $ get key;
           let name = ...;
           (fieldView textField) idAttr nameAttr attrs name isReq }
    In a case alternative:
        Right key
          -> do { marticle <- runDB $ get key;
                  let name = ...;
                  (fieldView textField) idAttr nameAttr attrs name isReq }

有什么想法吗？它是lift我忘记了吗？

Answer 1

为了能够在fieldParse和fieldView内进行查询，我需要进行一些调整：

必须完全指定parentField签名。由于YesodPersist来电，因此需要设置YesodPersistBackend和runDB约束。
fieldView内的查询需要转换为Widget，因为它在输出Widget的函数内部工作。这就是使用handlerToWidget函数的原因。
原始代码基于textField字段，但这会产生其他限制。因此我定义了自己的whamlet。
fieldEnctype失踪。

以下是更新后的源代码：

parentField :: YesodPersist site
            => YesodPersistBackend site ~ SqlBackend
            => RenderMessage (HandlerSite (HandlerT site IO)) FormMessage
            => Field (HandlerT site IO) ArticleId
parentField = Field
    { fieldParse = \rawVals _ -> do
            let (name:[]) = rawVals
            articleM <- runDB $ getBy (UniqueArt name)
            return $ case articleM of
                Nothing      -> (Left . SomeMessage) ("Article name invalid." :: Text)
                Just article -> (Right . Just) (entityKey article)

    , fieldView = \ident name attrs resultE isReq ->
            case resultE of
                Right key -> do
                    articleM <- handlerToWidget . runDB $ get key
                    let value = case articleM of
                                   Just article -> Right (articleArtname article)
                                   Nothing      -> Left ("Article key invalid." :: Text)

                    parentHtml ident name attrs value isReq

                Left err -> parentHtml ident name attrs (Left err) isReq
    , fieldEnctype = UrlEncoded
    }
    where parentHtml ident name attrs val isReq =
            [whamlet|$newline never
                <input id="#{ident}"
                       name="#{name}"
                       *{attrs}
                       type="text"
                       :isReq:required
                       value="#{either id id val}">
            |]

如何创建查询数据库的自定义字段？

1 个答案: