Formlets.hs

module Happstack.Server.Dialogues.Formlets where

import Happstack.Server.Dialogues

import Text.XHtml.Strict
import Text.XHtml.Strict.Formlets hiding (hidden)
import Control.Applicative.Error (Failing (..))

import Happstack.Server.SimpleHTTP hiding (method)

import Control.Monad.Identity

showForm :: Monad m => XHtmlForm Identity a -> Dlg m (Maybe a)
showForm f = showPage render parse
    where render uri = let (_, Identity html, _) = runFormState [] f
                       in  return $ toResponse $
                              form ! [method "POST", action uri] << (html
                                  +++ submit "submit" "submit"
                                  )
          parse    = withDataFn lookPairs $ \env -> do
                        let (Identity x, _, _) = runFormState (map (fmap Left) env) f
                        case x of Success a -> return (Just a)
                                  Failure _ -> return Nothing