From d464f85f9da1e9f1a632b592e0eea69670883c08 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 25 Mar 2012 18:49:35 +0200 Subject: [PATCH] fsLabel and fsTooltip are SomeMessage --- yesod-form/Yesod/Form/Class.hs | 4 ++-- yesod-form/Yesod/Form/Fields.hs | 4 ++-- yesod-form/Yesod/Form/Functions.hs | 23 ++++++++++------------- yesod-form/Yesod/Form/MassInput.hs | 3 ++- yesod-form/Yesod/Form/Types.hs | 6 +++--- 5 files changed, 19 insertions(+), 21 deletions(-) diff --git a/yesod-form/Yesod/Form/Class.hs b/yesod-form/Yesod/Form/Class.hs index 9f34a1bd..629a93ca 100644 --- a/yesod-form/Yesod/Form/Class.hs +++ b/yesod-form/Yesod/Form/Class.hs @@ -22,8 +22,8 @@ class ToForm a where -} class ToField a master where - toField :: (RenderMessage master msg, RenderMessage master FormMessage) - => FieldSettings msg -> Maybe a -> AForm sub master a + toField :: RenderMessage master FormMessage + => FieldSettings master -> Maybe a -> AForm sub master a {- FIXME instance ToFormField String y where diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 609c7600..1254e371 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -463,7 +463,7 @@ selectFieldHelper outside onOpt inside opts' = Field Nothing -> Left $ SomeMessage $ MsgInvalidEntry x Just y -> Right $ Just y -fileAFormReq :: (RenderMessage master msg, RenderMessage master FormMessage) => FieldSettings msg -> AForm sub master FileInfo +fileAFormReq :: RenderMessage master FormMessage => FieldSettings master -> AForm sub master FileInfo fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do let (name, ints') = case fsName fs of @@ -493,7 +493,7 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do } return (res, (fv :), ints', Multipart) -fileAFormOpt :: (RenderMessage master msg, RenderMessage master FormMessage) => FieldSettings msg -> AForm sub master (Maybe FileInfo) +fileAFormOpt :: RenderMessage master FormMessage => FieldSettings master -> AForm sub master (Maybe FileInfo) fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do let (name, ints') = case fsName fs of diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index d44644d6..ec97dd8b 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -91,19 +91,17 @@ askFiles = do (x, _, _) <- ask return $ liftM snd x -mreq :: (RenderMessage master msg, RenderMessage master FormMessage) - => Field sub master a -> FieldSettings msg -> Maybe a +mreq :: RenderMessage master FormMessage + => Field sub master a -> FieldSettings master -> Maybe a -> 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) +mopt :: Field sub master a -> FieldSettings master -> Maybe (Maybe a) -> 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 - => Field sub master a - -> FieldSettings msg +mhelper :: Field sub master a + -> FieldSettings master -> Maybe a -> (master -> [Text] -> FormResult b) -- ^ on missing -> (a -> FormResult b) -- ^ on success @@ -140,14 +138,13 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do , fvRequired = isReq }) -areq :: (RenderMessage master msg, RenderMessage master FormMessage) - => Field sub master a -> FieldSettings msg -> Maybe a +areq :: RenderMessage master FormMessage + => Field sub master a -> FieldSettings master -> Maybe a -> AForm sub master a areq a b = formToAForm . fmap (second return) . mreq a b -aopt :: RenderMessage master msg - => Field sub master a - -> FieldSettings msg +aopt :: Field sub master a + -> FieldSettings master -> Maybe (Maybe a) -> AForm sub master (Maybe a) aopt a b = formToAForm . fmap (second return) . mopt a b @@ -347,7 +344,7 @@ customErrorMessage msg field = field { fieldParse = \ts -> fmap (either (const $ Left msg) Right) $ fieldParse field ts } -- | Generate a 'FieldSettings' from the given label. -fieldSettingsLabel :: msg -> FieldSettings msg +fieldSettingsLabel :: SomeMessage master -> FieldSettings master fieldSettingsLabel msg = FieldSettings msg Nothing Nothing Nothing [] -- | Generate an 'AForm' that gets its value from the given action. diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs index cbb64ad7..46f8cc97 100644 --- a/yesod-form/Yesod/Form/MassInput.hs +++ b/yesod-form/Yesod/Form/MassInput.hs @@ -24,6 +24,7 @@ import Data.Either (partitionEithers) import Data.Traversable (sequenceA) import qualified Data.Map as Map import Data.Maybe (listToMaybe) +import Yesod.Core (SomeMessage (SomeMessage)) down :: Int -> MForm sub master () down 0 = return () @@ -97,7 +98,7 @@ withDelete af = do Just ("yes":_) -> return $ Left [whamlet||] _ -> do (_, xml2) <- aFormToForm $ areq boolField FieldSettings - { fsLabel = MsgDelete + { fsLabel = SomeMessage MsgDelete , fsTooltip = Nothing , fsName = Just deleteName , fsId = Nothing diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs index eb003978..e18cb6c9 100644 --- a/yesod-form/Yesod/Form/Types.hs +++ b/yesod-form/Yesod/Form/Types.hs @@ -94,9 +94,9 @@ instance Monoid a => Monoid (AForm sub master a) where mempty = pure mempty mappend a b = mappend <$> a <*> b -data FieldSettings msg = FieldSettings - { fsLabel :: msg -- FIXME switch to SomeMessage? - , fsTooltip :: Maybe msg +data FieldSettings master = FieldSettings + { fsLabel :: SomeMessage master + , fsTooltip :: Maybe (SomeMessage master) , fsId :: Maybe Text , fsName :: Maybe Text , fsAttrs :: [(Text, Text)]