haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Generalize yesod-form fields to take RenderMessage instead of Text.

Browse Source 
Fixes issue #240.
This commit is contained in:
Felipe Lessa 2012-01-26 16:35:50 -02:00
parent 8c35873291
commit baf10c118f
1 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
yesod-form/Yesod/Form/Fields.hs
View File

@ -45,6 +45,7 @@ module Yesod.Form.Fields
import Yesod.Form.Types import Yesod.Form.Types
import Yesod.Form.I18n.English import Yesod.Form.I18n.English
import Yesod.Handler (getMessageRender)
import Yesod.Widget import Yesod.Widget
import Yesod.Message (RenderMessage (renderMessage), SomeMessage (..)) import Yesod.Message (RenderMessage (renderMessage), SomeMessage (..))
import Text.Hamlet import Text.Hamlet
@ -303,7 +304,7 @@ urlField = Field
|] |]
} }
selectFieldList :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master a selectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master a
selectFieldList = selectField . optionsPairs selectFieldList = selectField . optionsPairs
selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
@ -312,7 +313,7 @@ selectField = selectFieldHelper
(\_theId _name isSel -> [WHAMLET|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt (\_theId _name isSel -> [WHAMLET|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
(\_theId _name theClass value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected :not (null theClass):class="#{T.intercalate " " theClass}">#{text}|]) -- inside (\_theId _name theClass value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected :not (null theClass):class="#{T.intercalate " " theClass}">#{text}|]) -- inside
multiSelectFieldList :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master [a] multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a]
multiSelectFieldList = multiSelectField . optionsPairs multiSelectFieldList = multiSelectField . optionsPairs
multiSelectField :: (Eq a, RenderMessage master FormMessage) multiSelectField :: (Eq a, RenderMessage master FormMessage)
@ -340,7 +341,7 @@ multiSelectField ioptlist =
optselected (Left _) _ = False optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
radioFieldList :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master a radioFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master a
radioFieldList = radioField . optionsPairs radioFieldList = radioField . optionsPairs
radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
@ -400,12 +401,15 @@ data Option a = Option
, optionExternalValue :: Text , optionExternalValue :: Text
} }
optionsPairs :: [(Text, a)] -> GHandler sub master (OptionList a) optionsPairs :: RenderMessage master msg => [(msg, a)] -> GHandler sub master (OptionList a)
optionsPairs = return . mkOptionList . zipWith (\external (display, internal) -> Option optionsPairs opts = do
{ optionDisplay = display mr <- getMessageRender
, optionInternalValue = internal let mkOption external (display, internal) =
, optionExternalValue = pack $ show external Option { optionDisplay = mr display
}) [1 :: Int ..] , optionInternalValue = internal
, optionExternalValue = pack $ show external
}
return $ mkOptionList (zipWith mkOption [1 :: Int ..] opts)
optionsEnum :: (Show a, Enum a, Bounded a) => GHandler sub master (OptionList a) optionsEnum :: (Show a, Enum a, Bounded a) => GHandler sub master (OptionList a)
optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound] optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
@ -413,12 +417,14 @@ optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
optionsPersist :: ( YesodPersist master, PersistEntity a optionsPersist :: ( YesodPersist master, PersistEntity a
, PersistQuery (YesodPersistBackend master) (GHandler sub master) , PersistQuery (YesodPersistBackend master) (GHandler sub master)
, PathPiece (Key (YesodPersistBackend master) a) , PathPiece (Key (YesodPersistBackend master) a)
, RenderMessage master msg
) )
=> [Filter a] -> [SelectOpt a] -> (a -> Text) -> GHandler sub master (OptionList (Entity (YesodPersistBackend master) a)) => [Filter a] -> [SelectOpt a] -> (a -> msg) -> GHandler sub master (OptionList (Entity (YesodPersistBackend master) a))
optionsPersist filts ords toDisplay = fmap mkOptionList $ do optionsPersist filts ords toDisplay = fmap mkOptionList $ do
mr <- getMessageRender
pairs <- runDB $ selectList filts ords pairs <- runDB $ selectList filts ords
return $ map (\(Entity key value) -> Option return $ map (\(Entity key value) -> Option
{ optionDisplay = toDisplay value { optionDisplay = mr (toDisplay value)
, optionInternalValue = Entity key value , optionInternalValue = Entity key value
, optionExternalValue = toPathPiece key , optionExternalValue = toPathPiece key
}) pairs }) pairs