fsLabel and fsTooltip are SomeMessage

This commit is contained in:
Michael Snoyman 2012-03-25 18:49:35 +02:00
parent 46308c8d1f
commit d464f85f9d
5 changed files with 19 additions and 21 deletions

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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|<input type=hidden name=#{deleteName} value=yes>|]
_ -> do
(_, xml2) <- aFormToForm $ areq boolField FieldSettings
{ fsLabel = MsgDelete
{ fsLabel = SomeMessage MsgDelete
, fsTooltip = Nothing
, fsName = Just deleteName
, fsId = Nothing

View File

@ -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)]