Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Dynamic form generation with yesod

Tags:

haskell

yesod

How do I dynamically generate forms with a varying number of input fields?

The closest I managed is:

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

but this has the result type Text and not [Text] as intended, owning to the coincidence that Text is an instance of Monoid, e.g. it fails with Int.

I have a working alternate attempt, which combines several forms, but somehow it only works for this toy example, while the real attempt fails strangely. Anyhow, I don't think this is the correct approach:

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|]
like image 600
Steffen Avatar asked Aug 29 '12 14:08

Steffen


1 Answers

Duh, it is actually easy using monadic forms (see code below).

My major headache is the extra text fields to make sure that the handler which receives the answer may also infer the corresponding question. Maybe I can hide those text fields, make them uneditable, or find another way around that (but I don't know much about Html yet).

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)

There are also still some ugly things that I have no clue about, like always wrapping the result always in an outermost FormSuccess constructor, but I guess that really depends on each use-case (e.g. a single FormFailure or FormMissing should probably make the whole form fail/missing as well, but maybe in some case this is not wanted.)

All the zipping and unzipping can probably be done more neatly, but I guess in my case I just create a combined field textintField. I think I know how to do it, but it would be neat if there were a function to combine fields.

like image 119
Steffen Avatar answered Oct 31 '22 14:10

Steffen