Added a few incomplete functions to Form

This commit is contained in:
Michael Snoyman 2010-06-30 23:17:00 +03:00
parent 1a375e8fb4
commit 53f7837cff
2 changed files with 27 additions and 20 deletions

View File

@ -30,6 +30,10 @@ module Yesod.Form
, deriveFormable , deriveFormable
, share2 , share2
-- * Pre-built formlets -- * Pre-built formlets
, optionalField
, requiredField
, notEmptyField
, boolField
) where ) where
import Text.Hamlet import Text.Hamlet
@ -39,8 +43,6 @@ import Control.Applicative hiding (optional)
import Data.Time (Day) import Data.Time (Day)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import "transformers" Control.Monad.IO.Class import "transformers" Control.Monad.IO.Class
import Yesod.Internal
import Control.Monad.Attempt
import Control.Monad ((<=<), liftM, join) import Control.Monad ((<=<), liftM, join)
import Data.Monoid (mempty, mappend) import Data.Monoid (mempty, mappend)
import Control.Monad.Trans.State import Control.Monad.Trans.State
@ -48,14 +50,11 @@ import Control.Arrow (first)
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
import Database.Persist.Base (PersistField, EntityDef (..)) import Database.Persist.Base (PersistField, EntityDef (..))
import Data.Char (isAlphaNum, toUpper, isUpper) import Data.Char (isAlphaNum, toUpper, isUpper)
import Data.Maybe (fromMaybe, isJust) import Data.Maybe (isJust)
import Web.Routes.Quasi (SinglePiece) import Web.Routes.Quasi (SinglePiece)
import Data.Int (Int64) import Data.Int (Int64)
import qualified Data.ByteString.Lazy.UTF8 import qualified Data.ByteString.Lazy.UTF8
noParamNameError :: String
noParamNameError = "No param name (miscalling of Yesod.Form library)"
data FormResult a = FormMissing data FormResult a = FormMissing
| FormFailure [String] | FormFailure [String]
| FormSuccess a | FormSuccess a
@ -120,8 +119,8 @@ helper (FormMissing, _) = invalidArgs ["No input found"]
runFormGet :: Form sub y a runFormGet :: Form sub y a
-> GHandler sub y (FormResult a, Hamlet (Routes y)) -> GHandler sub y (FormResult a, Hamlet (Routes y))
runFormGet f = do runFormGet f = do
gets <- reqGetParams `fmap` getRequest gs <- reqGetParams `fmap` getRequest
runFormGeneric gets f runFormGeneric gs f
type Incr = StateT Int type Incr = StateT Int
@ -180,6 +179,26 @@ sealFormlet :: ([String] -> Hamlet (Routes y) -> Hamlet (Routes y))
-> Formlet sub y a -> Formlet sub y a -> Formlet sub y a -> Formlet sub y a
sealFormlet wrapper formlet initVal = sealForm wrapper $ formlet initVal sealFormlet wrapper formlet initVal = sealForm wrapper $ formlet initVal
-------- Prebuilt
optionalField :: String -> Form sub master (Maybe String)
optionalField n = Form $ \env ->
return (FormSuccess $ lookup n env, mempty) -- FIXME
requiredField :: String -> Form sub master String
requiredField n = Form $ \env ->
return (maybe FormMissing FormSuccess $ lookup n env, mempty) -- FIXME
notEmptyField :: String -> Form sub master String
notEmptyField n = Form $ \env -> return
(case lookup n env of
Nothing -> FormMissing
Just "" -> FormFailure [n ++ ": You must provide a non-empty string"]
Just x -> FormSuccess x, mempty) -- FIXME
boolField :: String -> Form sub master Bool
boolField n = Form $ \env -> return
(FormSuccess $ isJust $ lookup n env, mempty) -- FIXME
class Formable a where class Formable a where
formable :: Formlet sub master a formable :: Formlet sub master a

View File

@ -179,18 +179,6 @@ $maybe message msg
%input!type=submit!value=Login %input!type=submit!value=Login
|] |]
-- FIXME next two functions should show up in Yesod.Form properly
requiredField :: String -> Form sub master String
requiredField n = Form $ \env ->
return (maybe FormMissing FormSuccess $ lookup n env, mempty)
notEmptyField :: String -> Form sub master String
notEmptyField n = Form $ \env -> return
(case lookup n env of
Nothing -> FormMissing
Just "" -> FormFailure [n ++ ": You must provide a non-empty string"]
Just x -> FormSuccess x, mempty)
getOpenIdForward :: GHandler Auth master () getOpenIdForward :: GHandler Auth master ()
getOpenIdForward = do getOpenIdForward = do
testOpenId testOpenId