Expanded yesod-test testsuite

yesod-test/test/main.hs

@@ -1,15 +1,18 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 import Test.HUnit hiding (Test)
 import Test.Hspec
 
 import Yesod.Core
+import Yesod.Form
 import Yesod.Test
 import Yesod.Test.CssQuery
 import Yesod.Test.TransversingCSS
 import Text.XML
 import Data.Text (Text)
 import Data.Monoid ((<>))
+import Control.Applicative
 
 import Data.ByteString.Lazy.Char8 ()
 import qualified Data.Map as Map
@@ -64,11 +67,6 @@ main = hspec $ do
                         ]
                     ]
              in parseHtml_ html @?= doc
-    let app = liteApp $ dispatchTo $ do
-            mfoo <- lookupGetParam "foo"
-            case mfoo of
-                Nothing -> return "Hello world!"
-                Just foo -> return $ "foo=" <> foo
     describe "basic usage" $ yesodSpec app $ do
         ydescribe "tests1" $ do
             yit "tests1a" $ do
@@ -86,4 +84,50 @@ main = hspec $ do
                 get (LiteAppRoute [], [("foo", "bar")])
                 statusIs 200
                 bodyEquals "foo=bar"
-            yit "tests2b" $ return ()
+            yit "post params" $ do
+                post ("/post" :: Text)
+                statusIs 500
+
+                request $ do
+                    setMethod "POST"
+                    setUrl $ LiteAppRoute ["post"]
+                    addPostParam "foo" "foobarbaz"
+                statusIs 200
+                bodyEquals "foobarbaz"
+            yit "labels" $ do
+                get ("/form" :: Text)
+                statusIs 200
+
+                request $ do
+                    setMethod "POST"
+                    setUrl ("/form" :: Text)
+                    byLabel "Some Label" "12345"
+                    fileByLabel "Some File" "test/main.hs" "text/plain"
+                    addNonce
+                statusIs 200
+                bodyEquals "12345"
+
+instance RenderMessage LiteApp FormMessage where
+    renderMessage _ _ = defaultFormMessage
+
+app :: LiteApp
+app = liteApp $ do
+    dispatchTo $ do
+        mfoo <- lookupGetParam "foo"
+        case mfoo of
+            Nothing -> return "Hello world!"
+            Just foo -> return $ "foo=" <> foo
+    onStatic "post" $ dispatchTo $ do
+        mfoo <- lookupPostParam "foo"
+        case mfoo of
+            Nothing -> error "No foo"
+            Just foo -> return foo
+    onStatic "form" $ dispatchTo $ do
+        ((mfoo, widget), _) <- runFormPost
+                        $ renderDivs
+                        $ (,)
+                      <$> areq textField "Some Label" Nothing
+                      <*> areq fileField "Some File" Nothing
+        case mfoo of
+            FormSuccess (foo, _) -> return $ toHtml foo
+            _ -> defaultLayout widget

yesod-test/yesod-test.cabal

@@ -58,6 +58,7 @@ test-suite test
                           , containers
                           , html-conduit
                           , yesod-core
+                          , yesod-form
                           , text
 
 source-repository head