Merge branch 'master' of https://github.com/andrewthad/yesod

yesod-form/Yesod/Form/Fields.hs

@@ -42,6 +42,7 @@ module Yesod.Form.Fields
     , OptionList (..)
     , mkOptionList
     , optionsPersist
+    , optionsPersistKey
     , optionsPairs
     , optionsEnum
     ) where
@@ -86,6 +87,8 @@ import Control.Applicative ((<$>), (<|>))
 
 import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly)
 
+import Yesod.Persist.Core
+
 defaultFormMessage :: FormMessage -> Text
 defaultFormMessage = englishFormMessage
 
@@ -513,6 +516,27 @@ optionsPersist filts ords toDisplay = fmap mkOptionList $ do
         , optionExternalValue = toPathPiece key
         }) pairs
 
+optionsPersistKey
+  :: (YesodPersist site
+     , PersistEntity a
+     , PersistQuery (YesodPersistBackend site (HandlerT site IO))
+     , PathPiece (Key a)
+     , RenderMessage site msg
+     , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site))
+  => [Filter a]
+  -> [SelectOpt a]
+  -> (a -> msg)
+  -> HandlerT site IO (OptionList (Key a))
+
+optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do
+    mr <- getMessageRender
+    pairs <- runDB $ selectList filts ords
+    return $ Import.map (\(Entity key value) -> Option
+        { optionDisplay = mr (toDisplay value)
+        , optionInternalValue = key
+        , optionExternalValue = toPathPiece key
+        }) pairs
+
 selectFieldHelper
         :: (Eq a, RenderMessage site FormMessage)
         => (Text -> Text -> [(Text, Text)] -> WidgetT site IO () -> WidgetT site IO ())