使用 yesod 生成动态表单

Question

如何动态生成具有不同数量输入字段的表单？

我管理的最接近的是：

listEditForm :: [String] -> Html -> MForm App App (FormResult Text, Widget)
listEditForm xs = renderDivs $ mconcat [ areq textField (String.fromString x) Nothing | x <- xs]

但这具有Text而不是[Text]的结果类型，因为巧合Text是Monoid的一个实例，例如它以Int 失败。

我有一个可行的替代尝试，它结合了几种形式，但不知何故，它只适用于这个玩具示例，而真正的尝试却奇怪地失败了。无论如何，我认为这不是正确的方法：

data MapPair = MapPair { mpKey :: T.Text, mpValue :: Maybe T.Text }

editForm mmp = renderTable $ MapPair
  <$> areq textField "Key"   (mpKey  <$> mmp)
  <*> aopt textField "Value" (mpValue <$> mmp)

pair2mp (v,k) = MapPair { mpKey = v, mpValue = Just k }

getEditR = do
  sess <- getSession
  let sesslist = Map.toList $ Map.map (decodeUtf8With lenientDecode) sess  
  forms <- forM sesslist (\a -> generateFormPost $ editForm $ Just $ pair2mp a)

  defaultLayout [whamlet|
    <h1>Edit Value Pairs
    $forall (widget,enctype) <- forms
      <form method=post action=@{EditR} enctype=#{enctype}>
        ^{widget}
        <input type=submit>
  |]

  postEditR = do
    sess <- getSession
    let sesslist = Map.toList $ Map.map (decodeUtf8With lenientDecode) sess
    forM_ sesslist (\a -> do
        ((res,_),_) <- runFormPost $ editForm $ Just $ pair2mp a
        case res of
          (FormSuccess (MapPair {mpKey=mk, mpValue=(Just mv)})) -> setSession mk mv
          _ -> return ()
      )
    defaultLayout [whamlet|ok|]

Answer 1

呃，使用单子形式实际上很容易（见下面的代码）。

我最头疼的是额外的文本字段，以确保收到答案的处理程序也可以推断出相应的问题。也许我可以隐藏这些文本字段，使它们不可编辑，或者找到另一种解决方法（但我对 Html 知之甚少）。

listEditMForm :: [(String,Int)] -> Html -> MForm App App (FormResult [(FormResult Int, FormResult Text)], Widget)
listEditMForm xs extra = do
    ifields <- forM xs (\(s,i) -> mreq intField  (String.fromString s) (Just i))
    tfields <- forM xs (\(s,i) -> mreq textField (String.fromString s) (Just $ pack s))
    let (iresults,iviews) = unzip ifields
    let (tresults,tviews) = unzip tfields
    let results = zip iresults tresults
    let views   = zip iviews tviews
    let widget = [whamlet|
        #{extra}
        <h1>Multi Field Form
        $forall (iv,tv) <- views
          Field #
          #{fvLabel iv}: #
          ^{fvInput tv} #
          ^{fvInput iv}
          <div>
      |]
    return ((FormSuccess results), widget)

还有一些我不知道的丑陋的事情，比如总是将结果包装在最外面的 FormSuccess 构造函数中，但我想这真的取决于每个用例（例如，单个 FormFailure 或 FormMissing 应该可能也会使整个表单失败/丢失，但在某些情况下可能不需要这样做。）

所有的压缩和解压缩可能都可以更整齐地完成，但我想在我的例子中我只是创建了一个组合字段textintField。我想我知道该怎么做，但是如果有一个组合字段的功能会很整洁。

Answer 2

动态字段数的棘手之处在于，在处理程序中解析表单时需要知道行数/字段数。

假设我们有一个如下所示的常规形式：

type Form m a b =
    (MonadHandler m, m ~ HandlerFor App) =>
    Maybe a ->
    Html ->
    MForm m (FormResult b, Widget)

nameAndAgeForm :: Form m (Text, Int) (Text, Int)
nameAndAgeForm mPair extra = do
    let nameSettings =
            FieldSettings
                { fsLabel = "name"
                , fsTooltip = Nothing
                , fsId = Nothing
                , fsName = Nothing
                , fsAttrs = []
                }
    (nameResult, nameField) <- mreq textField nameSettings (fst <$> mPair)

    let ageSettings =
            FieldSettings
                { fsLabel = "age"
                , fsTooltip = Nothing
                , fsId = Nothing
                , fsName = Nothing
                , fsAttrs = []
                }

    (ageResult, ageField) <- mreq intField ageSettings (snd <$> mPair)

    let result = (,) <$> nameResult <*> ageResult
    let widget = [whamlet|age: ^{fvInput nameField}, age: ^{fvInput ageField}^{extra}|]

    pure (result, widget)

注意重要的是fsName = Nothing 在所有字段中，否则当我们尝试在列表中重复表单时它们会相互冲突。

我们可以将其转换为具有以下签名 Form m a b -> Form m [a] [b] 的函数的对列表形式。

如果我们使用一个技巧来解决解析时必须知道字段数的问题，我们可以编写这样一个函数。我们可以将行数作为要解析的第一个字段发送。

listifyForm :: Form m a b -> Form m [a] [b]
listifyForm form items csrf = do
    let countSettings =
            FieldSettings
                { fsLabel = "rowCount"
                , fsTooltip = Nothing
                , fsId = Nothing
                , fsName = Just "listifiedFormRowCount"
                , fsAttrs = []
                }

    (rowCountResult, rowCountField) <- mreq hiddenField countSettings (length <$> items)

    case (rowCountResult, items) of
        (FormSuccess rowCount, _) -> constructForms rowCountField $ replicate rowCount Nothing
        (FormMissing, Just items') -> constructForms rowCountField $ Just <$> items'
        (FormFailure err, _) -> pure (FormFailure err, [whamlet|Something went wrong with the form. Do all the fields have unique ID's?|])
        (FormMissing, _) -> pure (FormMissing, [whamlet|Something went wrong with the form|])
  where
    constructForms rowCountField mItems =
        fmap ([whamlet|^{csrf}^{fvInput rowCountField}|] <>) . bimap sequenceA mconcat . unzip
            <$> traverse (flip form mempty) mItems

现在我们可以将nameAndAgeForm 转换为nameAndAgeListForm：

nameAndAgeListForm :: Form m [(Text, Int)] [(Text, Int)]
nameAndAgeListForm = listifyForm nameAndAgeForm

然后可以在显示表单的处理程序中这样调用：

((_, namesAndAgesWidget), _) <- runFormPost $ nameAndAgeListForm $ Just [("Alice", 12), ("Bob", 34)]

在处理输入的处理程序中就像这样：

((result, _), _) <- runFormPost $ nameAndAgeListForm Nothing