diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs
index 516ba22a..9a901108 100644
--- a/yesod-form/Yesod/Form/Functions.hs
+++ b/yesod-form/Yesod/Form/Functions.hs
@@ -20,6 +20,9 @@ module Yesod.Form.Functions
, runFormPost
, runFormPostNoNonce
, runFormGet
+ -- * Generate a blank form
+ , generateFormPost
+ , generateFormGet
-- * Rendering
, FormRender
, renderTable
@@ -39,14 +42,14 @@ import Control.Monad (liftM, join)
import Text.Blaze (Html, toHtml)
import Yesod.Handler (GHandler, GGHandler, getRequest, runRequestBody, newIdent, getYesod)
import Yesod.Core (RenderMessage, liftIOHandler)
-import Yesod.Widget (GWidget, GGWidget, whamlet)
+import Yesod.Widget (GWidget, whamlet)
import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams, languages)
import Network.Wai (requestMethod)
import Text.Hamlet (html)
import Data.Monoid (mempty)
import Data.Maybe (listToMaybe, fromMaybe)
import Yesod.Message (RenderMessage (..))
-import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.IO.Class (MonadIO)
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ >= 700
@@ -169,13 +172,20 @@ runFormPost :: RenderMessage master FormMessage
=> (Html -> Form sub master (FormResult a, xml))
-> GHandler sub master ((FormResult a, xml), Enctype)
runFormPost form = do
+ env <- postEnv
+ postHelper form env
+
+postHelper :: RenderMessage master FormMessage
+ => (Html -> Form sub master (FormResult a, xml))
+ -> Maybe (Env, FileEnv)
+ -> GHandler sub master ((FormResult a, xml), Enctype)
+postHelper form env = do
req <- getRequest
let nonceKey = "_nonce"
let nonce =
case reqNonce req of
Nothing -> mempty
Just n -> [HTML||]
- env <- postEnv
m <- getYesod
langs <- languages
((res, xml), enctype) <- runFormGeneric (form nonce) m langs env
@@ -187,6 +197,17 @@ runFormPost form = do
_ -> res
return ((res', xml), enctype)
+-- | Similar to 'runFormPost', except it always ignore the currently available
+-- environment. This is necessary in cases like a wizard UI, where a single
+-- page will both receive and incoming form and produce a new, blank form. For
+-- general usage, you can stick with @runFormPost@.
+generateFormPost
+ :: RenderMessage master FormMessage
+ => (Html -> Form sub master (FormResult a, xml))
+ -> GHandler sub master ((FormResult a, xml), Enctype)
+generateFormPost form = postHelper form Nothing
+
+postEnv :: GHandler sub master (Maybe (Env, FileEnv))
postEnv = do
req <- getRequest
if requestMethod (reqWaiRequest req) == "GET"
@@ -205,13 +226,22 @@ runFormPostNoNonce form = do
runFormGet :: (Html -> Form sub master a) -> GHandler sub master (a, Enctype)
runFormGet form = do
- let key = "_hasdata"
- let fragment = [HTML||]
gets <- liftM reqGetParams getRequest
let env =
- case lookup key gets of
+ case lookup getKey gets of
Nothing -> Nothing
Just _ -> Just (Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) gets, Map.empty)
+ getHelper form env
+
+generateFormGet :: (Html -> Form sub master a) -> GHandler sub master (a, Enctype)
+generateFormGet form = getHelper form Nothing
+
+getKey :: Text
+getKey = "_hasdata"
+
+getHelper :: (Html -> Form sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype)
+getHelper form env = do
+ let fragment = [HTML||]
langs <- languages
m <- getYesod
runFormGeneric (form fragment) m langs env