Added a few incomplete functions to Form
This commit is contained in:
parent
1a375e8fb4
commit
53f7837cff
@ -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
|
||||||
|
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user