Happstack handling

I'm parsing a form in happstack but I don't know of a more concise way to gather the form variables on the server. Does anyone know if there are any tricks to reduce the amount of code needed here?

 formHandler = do
    method POST
    delA1       <- look "address-01-delivery"
    delA2       <- look "address-02-delivery"
    delSuburb   <- look "suburb-delivery"
    delPostcode <- look "postcode-delivery"
    delState    <- look "state-delivery"
    delCountry  <- look "country-delivery"

    bilA1       <- look "address-01-billing"
    bilA2       <- look "address-02-billing"
    bilSuburb   <- look "suburb-billing"
    bilPostcode <- look "postcode-billing"
    bilState    <- look "state-billing"
    bilCountry  <- look "country-billing"

Solution

Preface: This is clearly not going to reduce the amount of code that you posted above, but in the long run it may make things more maintainable as it provides a consistent way to perform validation and allows you to deal with strongly typed objects rather than large numbers of text values.

If you are going to do any amount of form processing, I would recommend using a forms library. I've personally used digestive-functors and have found it enjoyable to work with. As well, it comes with a Happstack backend which makes the Happstack integration very straight-forward.

This may be more than you care to invest in, but here is a sample of what your form code might look like using digestive functors. I didn't try compiling any of this, so it may or may not work, but hopefully it provides the general idea.

{-# LANGUAGE OverloadedStrings #-}

module Forms where

import Control.Applicative ((<$>), (<*>))
import Data.Text (Text)
import qualified Data.Text as T
import Happstack.Server
import Text.Digestive


data AddressState 
  = Alabama
  | Alaska
  | Arkansas
  -- ...
  deriving (Enum, Eq, Read)

data Country
  = Canada
  | Mexico
  | UnitedStates
  -- ...
  deriving (Enum, Eq, Read)

data Address = Address
  { street1  :: Text
  , street2  :: Maybe Text
  , suburb   :: Maybe Text
  , postcode :: Int
  , state    :: AddressState
  , country  :: Country
  }

data ShippingForm = ShippingForm
  { deliveryAddress :: Address
  , billingAddress  :: Address
  }

addressForm :: (Monad m) => Form Text m Address
addressForm = Address
  <$> "street1"  .: nonEmptyText (text Nothing)
  <*> "street2"  .: optionalText Nothing
  <*> "suburb"   .: optionalText Nothing
  <*> "postcode" .: stringRead "Please enter a valid postcode" Nothing
  <*> "state"    .: choice mkChoices Nothing
  <*> "country"  .: choice mkChoices Nothing
  where
    nonEmptyText = check "Cannot be empty" (not . T.null)
    mkChoices = [(x, T.pack (show x)) | x <- [minBound .. maxBound]]

shippingForm :: (Monad m) => Form Text m ShippingForm
shippingForm = ShippingForm
  <$> "delivery" .: addressForm
  <*> "billing"  .: addressForm

formHandler :: ServerPart Response
formHandler = do
  method POST
  decodeBody $ defaultBodyPolicy "/tmp" 4096 4096 4096
  res <- runForm "shipping" shippingForm
  case res of
    (view, Nothing) -> do
      -- setup your view
      ok $ toResponse () -- <-- replace this with your view code
    (_, Just formData) -> do
      -- here, formData is a fully valid `ShippingForm`
      let delStreet1 = (street1 . deliveryAddress) formData
      -- do whatever you need to with this data (ie: persist it to a database, etc)
      ok $ toResponse ()

For some good reading on digestive functors, you could check out the following links:

digestive functors tutorial

ocharles' blog post