From 746a3fe5d223c14a19c791b2b08aa91690ae4304 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 17 Jan 2012 10:15:08 -0200 Subject: [PATCH] Generalize formToAForm (fixes issue #213). --- yesod-form/Yesod/Form/Functions.hs | 11 ++++++----- yesod-form/Yesod/Form/MassInput.hs | 4 ++-- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index a358a717..fb4deaa7 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -39,6 +39,7 @@ module Yesod.Form.Functions import Yesod.Form.Types import Data.Text (Text, pack) +import Control.Arrow (second) import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST) import Control.Monad.Trans.Class (lift) import Control.Monad (liftM, join) @@ -74,10 +75,10 @@ newFormIdent = do incrInts (IntSingle i) = IntSingle $ i + 1 incrInts (IntCons i is) = (i + 1) `IntCons` is -formToAForm :: MForm sub master (FormResult a, FieldView sub master) -> AForm sub master a +formToAForm :: MForm sub master (FormResult a, [FieldView sub master]) -> AForm sub master a formToAForm form = AForm $ \(master, langs) env ints -> do - ((a, xml), ints', enc) <- runRWST form (env, master, langs) ints - return (a, (:) xml, ints', enc) + ((a, xmls), ints', enc) <- runRWST form (env, master, langs) ints + return (a, (++) xmls, ints', enc) aFormToForm :: AForm sub master a -> MForm sub master (FormResult a, [FieldView sub master] -> [FieldView sub master]) aFormToForm (AForm aform) = do @@ -150,14 +151,14 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do areq :: (RenderMessage master msg, RenderMessage master FormMessage) => Field sub master a -> FieldSettings msg -> Maybe a -> AForm sub master a -areq a b = formToAForm . mreq a b +areq a b = formToAForm . fmap (second return) . mreq a b aopt :: RenderMessage master msg => Field sub master a -> FieldSettings msg -> Maybe (Maybe a) -> AForm sub master (Maybe a) -aopt a b = formToAForm . mopt a b +aopt a b = formToAForm . fmap (second return) . mopt a b runFormGeneric :: MForm sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype) runFormGeneric form master langs env = evalRWST form (env, master, langs) (IntSingle 1) diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs index 661cc0b8..fad38186 100644 --- a/yesod-form/Yesod/Form/MassInput.hs +++ b/yesod-form/Yesod/Form/MassInput.hs @@ -78,7 +78,7 @@ inputList label fixXml single mdef = formToAForm $ do let count = length vals (res, xmls, views) <- liftM fixme $ mapM (withDelete . single) vals up 1 - return (res, FieldView + return (res, [FieldView { fvLabel = label , fvTooltip = Nothing , fvId = theId @@ -93,7 +93,7 @@ inputList label fixXml single mdef = formToAForm $ do |] , fvErrors = Nothing , fvRequired = False - }) + }]) withDelete :: (xml ~ GWidget sub master (), RenderMessage master FormMessage) => AForm sub master a