Using newIdent properly for IDs

This commit is contained in:
Michael Snoyman 2011-05-09 18:43:05 +03:00
parent 000da953d6
commit c593ded7e5
2 changed files with 13 additions and 9 deletions

View File

@ -31,7 +31,7 @@ import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad (liftM, join) import Control.Monad (liftM, join)
import Text.Blaze (Html, toHtml) import Text.Blaze (Html, toHtml)
import Yesod.Handler (GHandler, GGHandler, getRequest, runRequestBody) import Yesod.Handler (GHandler, GGHandler, getRequest, runRequestBody, newIdent)
import Yesod.Widget (GGWidget, whamlet) import Yesod.Widget (GGWidget, whamlet)
import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams) import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams)
import Network.Wai (requestMethod) import Network.Wai (requestMethod)
@ -78,10 +78,12 @@ askParams = liftM (liftM fst) ask
askFiles :: Monad m => Form m (Maybe FileEnv) askFiles :: Monad m => Form m (Maybe FileEnv)
askFiles = liftM (liftM snd) ask askFiles = liftM (liftM snd) ask
mreq :: Monad m => Field xml a -> FieldSettings -> Maybe a -> Form m (FormResult a, FieldView xml) mreq :: Monad m => Field xml a -> FieldSettings -> Maybe a
-> Form (GGHandler sub master m) (FormResult a, FieldView xml)
mreq field fs mdef = mhelper field fs mdef (FormFailure ["Value is required"]) FormSuccess True -- TRANS mreq field fs mdef = mhelper field fs mdef (FormFailure ["Value is required"]) FormSuccess True -- TRANS
mopt :: Monad m => Field xml a -> FieldSettings -> Maybe (Maybe a) -> Form m (FormResult (Maybe a), FieldView xml) mopt :: Monad m => Field xml a -> FieldSettings -> Maybe (Maybe a)
-> Form (GGHandler sub master m) (FormResult (Maybe a), FieldView xml)
mopt field fs mdef = mhelper field fs (join mdef) (FormSuccess Nothing) (FormSuccess . Just) False mopt field fs mdef = mhelper field fs (join mdef) (FormSuccess Nothing) (FormSuccess . Just) False
mhelper :: Monad m mhelper :: Monad m
@ -91,11 +93,11 @@ mhelper :: Monad m
-> FormResult b -- ^ on missing -> FormResult b -- ^ on missing
-> (a -> FormResult b) -- ^ on success -> (a -> FormResult b) -- ^ on success
-> Bool -- ^ is it required? -> Bool -- ^ is it required?
-> Form m (FormResult b, FieldView xml) -> Form (GGHandler sub master m) (FormResult b, FieldView xml)
mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
mp <- askParams mp <- askParams
name <- maybe newFormIdent return fsName name <- maybe newFormIdent return fsName
theId <- maybe newFormIdent return fsId -- FIXME use widget ident for this theId <- lift $ maybe (liftM pack newIdent) return fsId
let (res, val) = let (res, val) =
case mp of case mp of
Nothing -> (FormMissing, maybe "" fieldRender mdef) Nothing -> (FormMissing, maybe "" fieldRender mdef)
@ -115,10 +117,12 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
, fvRequired = isReq , fvRequired = isReq
}) })
areq :: Monad m => Field xml a -> FieldSettings -> Maybe a -> AForm ([FieldView xml] -> [FieldView xml]) m a areq :: Monad m => Field xml a -> FieldSettings -> Maybe a
-> AForm ([FieldView xml] -> [FieldView xml]) (GGHandler sub master m) a
areq a b = formToAForm . mreq a b areq a b = formToAForm . mreq a b
aopt :: Monad m => Field xml a -> FieldSettings -> Maybe (Maybe a) -> AForm ([FieldView xml] -> [FieldView xml]) m (Maybe a) aopt :: Monad m => Field xml a -> FieldSettings -> Maybe (Maybe a)
-> AForm ([FieldView xml] -> [FieldView xml]) (GGHandler sub master m) (Maybe a)
aopt a b = formToAForm . mopt a b aopt a b = formToAForm . mopt a b
runFormGeneric :: Monad m => Form m a -> Maybe (Env, FileEnv) -> m (a, Enctype) runFormGeneric :: Monad m => Form m a -> Maybe (Env, FileEnv) -> m (a, Enctype)

View File

@ -13,9 +13,9 @@ homepage: http://www.yesodweb.com/
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.8 && < 0.9 , yesod-core >= 0.8.1 && < 0.9
, time >= 1.1.4 && < 1.3 , time >= 1.1.4 && < 1.3
, hamlet >= 0.8 && < 0.9 , hamlet >= 0.8.1 && < 0.9
, persistent >= 0.5 && < 0.6 , persistent >= 0.5 && < 0.6
, yesod-persistent >= 0.1 && < 0.2 , yesod-persistent >= 0.1 && < 0.2
, template-haskell , template-haskell