From 6816039b21025ae576d67a4bf62e1d2f05aae04c Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Sat, 26 Nov 2011 10:31:12 -0600 Subject: [PATCH] Form -> MForm --- yesod-form/Yesod/Form/Functions.hs | 36 +++++++++++++++--------------- yesod-form/Yesod/Form/MassInput.hs | 6 ++--- 2 files changed, 21 insertions(+), 21 deletions(-) diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index f762b621..84e96dc8 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -4,7 +4,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} module Yesod.Form.Functions - ( -- * Running in Form monad + ( -- * Running in MForm monad newFormIdent , askParams , askFiles @@ -62,7 +62,7 @@ import qualified Data.ByteString.Lazy as L #endif -- | Get a unique identifier. -newFormIdent :: Form sub master Text +newFormIdent :: MForm sub master Text newFormIdent = do i <- get let i' = incrInts i @@ -72,12 +72,12 @@ newFormIdent = do incrInts (IntSingle i) = IntSingle $ i + 1 incrInts (IntCons i is) = (i + 1) `IntCons` is -formToAForm :: Form 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) -aFormToForm :: AForm sub master a -> Form sub master (FormResult a, [FieldView sub master] -> [FieldView sub master]) +aFormToForm :: AForm sub master a -> MForm sub master (FormResult a, [FieldView sub master] -> [FieldView sub master]) aFormToForm (AForm aform) = do ints <- get (env, master, langs) <- ask @@ -86,24 +86,24 @@ aFormToForm (AForm aform) = do tell enc return (a, xml) -askParams :: Form sub master (Maybe Env) +askParams :: MForm sub master (Maybe Env) askParams = do (x, _, _) <- ask return $ liftM fst x -askFiles :: Form sub master (Maybe FileEnv) +askFiles :: MForm sub master (Maybe FileEnv) askFiles = do (x, _, _) <- ask return $ liftM snd x mreq :: (RenderMessage master msg, RenderMessage master FormMessage) => Field sub master a -> FieldSettings msg -> Maybe a - -> Form sub master (FormResult a, FieldView sub master) + -> MForm sub master (FormResult a, FieldView sub master) mreq field fs mdef = mhelper field fs mdef (\m l -> FormFailure [renderMessage m l MsgValueRequired]) FormSuccess True mopt :: RenderMessage master msg => Field sub master a -> FieldSettings msg -> Maybe (Maybe a) - -> Form sub master (FormResult (Maybe a), FieldView sub master) + -> MForm sub master (FormResult (Maybe a), FieldView sub master) mopt field fs mdef = mhelper field fs (join mdef) (const $ const $ FormSuccess Nothing) (FormSuccess . Just) False mhelper :: RenderMessage master msg @@ -113,7 +113,7 @@ mhelper :: RenderMessage master msg -> (master -> [Text] -> FormResult b) -- ^ on missing -> (a -> FormResult b) -- ^ on success -> Bool -- ^ is it required? - -> Form sub master (FormResult b, FieldView sub master) + -> MForm sub master (FormResult b, FieldView sub master) mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do mp <- askParams @@ -157,7 +157,7 @@ aopt :: RenderMessage master msg -> AForm sub master (Maybe a) aopt a b = formToAForm . mopt a b -runFormGeneric :: MonadIO m => Form sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GGHandler sub master m (a, Enctype) +runFormGeneric :: MonadIO m => MForm sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GGHandler sub master m (a, Enctype) runFormGeneric form master langs env = liftIOHandler $ evalRWST form (env, master, langs) (IntSingle 1) -- | This function is used to both initially render a form and to later extract @@ -170,14 +170,14 @@ runFormGeneric form master langs env = liftIOHandler $ evalRWST form (env, maste -- the form submit to a POST page. In such a case, both the GET and POST -- handlers should use 'runFormPost'. runFormPost :: RenderMessage master FormMessage - => (Html -> Form sub master (FormResult a, xml)) + => (Html -> MForm sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype) runFormPost form = do env <- postEnv postHelper form env postHelper :: RenderMessage master FormMessage - => (Html -> Form sub master (FormResult a, xml)) + => (Html -> MForm sub master (FormResult a, xml)) -> Maybe (Env, FileEnv) -> GHandler sub master ((FormResult a, xml), Enctype) postHelper form env = do @@ -204,7 +204,7 @@ postHelper form env = do -- general usage, you can stick with @runFormPost@. generateFormPost :: RenderMessage master FormMessage - => (Html -> Form sub master (FormResult a, xml)) + => (Html -> MForm sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype) generateFormPost form = postHelper form Nothing @@ -220,14 +220,14 @@ postEnv = do where notEmpty = not . L.null . fileContent -runFormPostNoNonce :: (Html -> Form sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype) +runFormPostNoNonce :: (Html -> MForm sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype) runFormPostNoNonce form = do langs <- languages m <- getYesod env <- postEnv runFormGeneric (form mempty) m langs env -runFormGet :: (Html -> Form sub master a) -> GHandler sub master (a, Enctype) +runFormGet :: (Html -> MForm sub master a) -> GHandler sub master (a, Enctype) runFormGet form = do gets <- liftM reqGetParams getRequest let env = @@ -236,13 +236,13 @@ runFormGet form = do Just _ -> Just (Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) gets, Map.empty) getHelper form env -generateFormGet :: (Html -> Form sub master a) -> GHandler sub master (a, Enctype) +generateFormGet :: (Html -> MForm sub master a) -> GHandler sub master (a, Enctype) generateFormGet form = getHelper form Nothing getKey :: Text getKey = "_hasdata" -getHelper :: (Html -> Form sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype) +getHelper :: (Html -> MForm sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype) getHelper form env = do let fragment = [HTML||] langs <- languages @@ -252,7 +252,7 @@ getHelper form env = do type FormRender sub master a = AForm sub master a -> Html - -> Form sub master (FormResult a, GWidget sub master ()) + -> MForm sub master (FormResult a, GWidget sub master ()) renderTable, renderDivs :: FormRender sub master a renderTable aform fragment = do diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs index 3a3eae40..a07fd7fe 100644 --- a/yesod-form/Yesod/Form/MassInput.hs +++ b/yesod-form/Yesod/Form/MassInput.hs @@ -35,7 +35,7 @@ import Data.Maybe (listToMaybe) #define WHAMLET $whamlet #endif -down :: Int -> Form sub master () +down :: Int -> MForm sub master () down 0 = return () down i | i < 0 = error "called down with a negative number" down i = do @@ -43,7 +43,7 @@ down i = do put $ IntCons 0 is down $ i - 1 -up :: Int -> Form sub master () +up :: Int -> MForm sub master () up 0 = return () up i | i < 0 = error "called down with a negative number" up i = do @@ -98,7 +98,7 @@ inputList label fixXml single mdef = formToAForm $ do withDelete :: (xml ~ GWidget sub master (), RenderMessage master FormMessage) => AForm sub master a - -> Form sub master (Either xml (FormResult a, [FieldView sub master])) + -> MForm sub master (Either xml (FormResult a, [FieldView sub master])) withDelete af = do down 1 deleteName <- newFormIdent