fsLabel and fsTooltip are SomeMessage
This commit is contained in:
parent
46308c8d1f
commit
d464f85f9d
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user