Multiple Button Forms in Yesod

As I am a big fan of type-safe programming in Haskell, I want to run my blog on a Haskell Software as well. I decided to use Yesod to write a dynamic web site and here it is. However, at the beginning of the development, I was relatively new to both, web development and Yesod, so I had a few obstacles to overcome.

This blog post is about a relatively easy task, for which I could not find working examples: writing forms with multiple buttons. Michael Snoyman, a creator of Yesod, recommends a similar technique in this stack overflow question. I started with a simple page to add a new entry.

{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} import Control.Applicative import Data.Text (Text) import Yesod data App = App mkYesod "App" [parseRoutes| / HomeR GET POST |] instance Yesod App instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage data Entry = Entry { entryTitle :: Text , entryContent :: Textarea } deriving Show entryForm :: Html -> MForm Handler (FormResult Entry, Widget) entryForm = renderDivs $ Entry <$> areq textField "Title" Nothing <*> areq textareaField "Content" Nothing getHomeR :: Handler Html getHomeR = do (widget, enctype) <- generateFormPost entryForm defaultLayout $ do setTitle "Add Blog Entry" [whamlet| <div .container> <h1>Add Blog Entry <form method=post enctype=#{enctype}> ^{widget} <button type=submit>Save |] postHomeR :: Handler Html postHomeR = do ((res, widget), enctype) <- runFormPost entryForm case res of FormSuccess entry -> defaultLayout $ do setTitle "Entry saved" [whamlet| <div .container> <h1>Entry Saved |] _ -> do defaultLayout $ do setTitle "Failed Form" [whamlet| <div .container> <h1>Error |] main :: IO () main = warpEnv App

The program defines the form and two handlers. One handler is for GET requests and the other is for POST requests on the root path of the server. Yesod encourages the programmer to use the same path for the form action as for the form itself. This is achieved by omitting the action attribute of the <form> -tag.

On a GET request, the server shows a simple page using the form created by entryForm . Furthermore, it adds a submit button with the text “Save”. On a POST request, the form results are evaluated with runFormPost . If the form has been filled correctly, the “Entry Saved” page is returned. If it has not, the user sees an error page.

For now, our form has only one button, but adding a second button is simple: The Hamlet code is modified to contain a second preview button. Additionally, to distinguish a click on the submit button from a click on the preview button, the button gets the name “preview” and the value “yes”. This adds the attribute preview=yes to the content of the POST request when the user clicks on this button.

getHomeR :: Handler Html getHomeR = do (widget, enctype) <- generateFormPost entryForm defaultLayout $ do setTitle "Add Blog Entry" [whamlet| <div .container> <h1>Add Blog Entry <form method=post enctype=#{enctype}> ^{widget} <button type=submit name=preview value=yes>Preview <button type=submit>Save |]

Now, we have to evaluate the Information of the additional field to determine if we have to display a preview or if we have to save the blog entry. Therefore, we run an additional boolField with the name “preview” corresponding the name of the preview button.

postHomeR :: Handler Html postHomeR = do ((res, widget), enctype) <- runFormPost entryForm isPreview <- runInputPost $ iopt boolField "preview" case res of FormSuccess entry -> case isPreview of Just True -> defaultLayout $ do setTitle "Preview Entry" [whamlet| <div .container> <h1>#{entryTitle entry} <article>#{entryContent entry} |] _ -> do defaultLayout $ do setTitle "Entry saved" [whamlet| <div .container> <h1>Entry Saved |] _ -> do defaultLayout $ do setTitle "Failed Form" [whamlet| <div .container> <h1>Error |]

If the post request sets the value of preview to yes , on , or true , the action returns Just True . If it sets preview to no , off , or false , it returns Just False . If the field preview is not set at all, the action returns Nothing . In our case, as we only set the field “preview” when the user clicked the preview button, we can show the preview if isPreview equals Just True . Otherwise, we can expect that the user wants to save the entry. This code example shows only two buttons, but we can add even more buttons in the same way. I hope this blog post helps the one or other Yesod newbie. If you find any mistakes, please inform me in a comment or e-mail.

Edit

Let's say we want to add a third button to the form to publish the entry. Using the above technique, it would require to add another boolField to the PUSH handler. On reddit, Michael Snoyman indicated that there is a function lookupPostParam to lookup arbitrary post parameters. To adapt my form, I decided to add a field action , which indicates which button has been pushed. Furthermore, we now require the action parameter.