From ae79c4db391cc3c9b7a51f83485e7857f4640f30 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 28 Dec 2011 00:07:06 +0200
Subject: [PATCH] yesod-form fixes

---
 yesod-auth/yesod-auth.cabal        |  2 +-
 yesod-form/Yesod/Form/Fields.hs    | 23 ++++++++++++-----------
 yesod-form/Yesod/Form/Functions.hs |  6 +++---
 yesod-form/Yesod/Form/Input.hs     |  4 ++--
 yesod-form/Yesod/Form/Jquery.hs    |  2 +-
 yesod-form/Yesod/Form/MassInput.hs |  4 ++--
 yesod-form/Yesod/Form/Types.hs     | 10 +++++-----
 yesod-form/yesod-form.cabal        |  2 +-
 yesod-persistent/Yesod/Persist.hs  | 11 ++++++-----
 9 files changed, 33 insertions(+), 31 deletions(-)

diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index c43e5256..f898fdda 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -21,7 +21,7 @@ library
         cpp-options:     -DGHC7
     else
         build-depends:   base                >= 4        && < 4.3
-    build-depends:   authenticate            >= 0.10.4    && < 0.11
+    build-depends:   authenticate            >= 0.11      && < 0.12
                    , bytestring              >= 0.9.1.4   && < 0.10
                    , yesod-core              >= 0.10      && < 0.11
                    , wai                     >= 1.0       && < 1.1
diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs
index ad94b825..556476f1 100644
--- a/yesod-form/Yesod/Form/Fields.hs
+++ b/yesod-form/Yesod/Form/Fields.hs
@@ -75,8 +75,8 @@ import qualified Data.Map as Map
 import Yesod.Handler (newIdent, liftIOHandler)
 import Yesod.Request (FileInfo)
 
-import Yesod.Core (toSinglePiece, GGHandler, SinglePiece)
-import Yesod.Persist (selectList, runDB, Filter, SelectOpt, YesodPersistBackend, Key, YesodPersist, PersistEntity, PersistBackend)
+import Yesod.Core (toPathPiece, GHandler, GHandlerT, PathPiece)
+import Yesod.Persist (selectList, runDB, Filter, SelectOpt, YesodPersistBackend, Key, YesodPersist, PersistEntity, PersistQuery)
 import Control.Arrow ((&&&))
 
 #if __GLASGOW_HASKELL__ >= 700
@@ -305,7 +305,7 @@ urlField = Field
 selectField :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master a
 selectField = selectField' . optionsPairs
 
-selectField' :: (Eq a, RenderMessage master FormMessage) => GGHandler sub master IO (OptionList a) -> Field sub master a
+selectField' :: (Eq a, RenderMessage master FormMessage) => GHandlerT sub master IO (OptionList a) -> Field sub master a
 selectField' = selectFieldHelper
     (\theId name inside -> [WHAMLET|<select ##{theId} name=#{name}>^{inside}|]) -- outside
     (\_theId _name isSel -> [WHAMLET|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
@@ -319,7 +319,7 @@ multiSelectField = multiSelectFieldHelper
 radioField :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master a
 radioField = radioField' . optionsPairs
 
-radioField' :: (Eq a, RenderMessage master FormMessage) => GGHandler sub master IO (OptionList a) -> Field sub master a
+radioField' :: (Eq a, RenderMessage master FormMessage) => GHandlerT sub master IO (OptionList a) -> Field sub master a
 radioField' = selectFieldHelper
     (\theId _name inside -> [WHAMLET|<div ##{theId}>^{inside}|])
     (\theId name isSel -> [WHAMLET|
@@ -399,26 +399,27 @@ data Option a = Option
     , optionExternalValue :: Text
     }
 
-optionsPairs :: [(Text, a)] -> GGHandler sub master IO (OptionList a)
+optionsPairs :: [(Text, a)] -> GHandlerT sub master IO (OptionList a)
 optionsPairs = return . mkOptionList . zipWith (\external (display, internal) -> Option
     { optionDisplay = display
     , optionInternalValue = internal
     , optionExternalValue = pack $ show external
     }) [1 :: Int ..]
 
-optionsEnum :: (Show a, Enum a, Bounded a) => GGHandler sub master IO (OptionList a)
+optionsEnum :: (Show a, Enum a, Bounded a) => GHandlerT sub master IO (OptionList a)
 optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
 
-optionsPersist :: ( YesodPersist master, PersistEntity a, PersistBackend (YesodPersistBackend master) (GGHandler sub master IO)
-                  , SinglePiece (Key (YesodPersistBackend master) a)
+optionsPersist :: ( YesodPersist master, PersistEntity a
+                  , PersistQuery (YesodPersistBackend master) (GHandler sub master)
+                  , PathPiece (Key (YesodPersistBackend master) a)
                   )
-               => [Filter a] -> [SelectOpt a] -> (a -> Text) -> GGHandler sub master IO (OptionList (Key (YesodPersistBackend master) a, a))
+               => [Filter a] -> [SelectOpt a] -> (a -> Text) -> GHandler sub master (OptionList (Key (YesodPersistBackend master) a, a))
 optionsPersist filts ords toDisplay = fmap mkOptionList $ do
     pairs <- runDB $ selectList filts ords
     return $ map (\(key, value) -> Option
         { optionDisplay = toDisplay value
         , optionInternalValue = (key, value)
-        , optionExternalValue = toSinglePiece key
+        , optionExternalValue = toPathPiece key
         }) pairs
 
 selectFieldHelper
@@ -426,7 +427,7 @@ selectFieldHelper
         => (Text -> Text -> GWidget sub master () -> GWidget sub master ())
         -> (Text -> Text -> Bool -> GWidget sub master ())
         -> (Text -> Text -> Text -> Bool -> Text -> GWidget sub master ())
-        -> GGHandler sub master IO (OptionList a) -> Field sub master a
+        -> GHandlerT sub master IO (OptionList a) -> Field sub master a
 selectFieldHelper outside onOpt inside opts' = Field
     { fieldParse = \x -> do
         opts <- opts'
diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs
index 84e96dc8..b148c5a4 100644
--- a/yesod-form/Yesod/Form/Functions.hs
+++ b/yesod-form/Yesod/Form/Functions.hs
@@ -40,7 +40,7 @@ import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad (liftM, join)
 import Text.Blaze (Html, toHtml)
-import Yesod.Handler (GHandler, GGHandler, getRequest, runRequestBody, newIdent, getYesod)
+import Yesod.Handler (GHandler, GHandlerT, getRequest, runRequestBody, newIdent, getYesod)
 import Yesod.Core (RenderMessage, liftIOHandler, SomeMessage (..))
 import Yesod.Widget (GWidget, whamlet)
 import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams, languages, FileInfo (..))
@@ -157,7 +157,7 @@ aopt :: RenderMessage master msg
      -> AForm sub master (Maybe a)
 aopt a b = formToAForm . mopt a b
 
-runFormGeneric :: MonadIO m => MForm sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GGHandler sub master m (a, Enctype)
+runFormGeneric :: MonadIO m => MForm sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GHandlerT sub master m (a, Enctype)
 runFormGeneric form master langs env = liftIOHandler $ evalRWST form (env, master, langs) (IntSingle 1)
 
 -- | This function is used to both initially render a form and to later extract
@@ -299,7 +299,7 @@ checkBool :: RenderMessage master msg
 checkBool b s = check $ \x -> if b x then Right x else Left s
 
 checkM :: RenderMessage master msg
-       => (a -> GGHandler sub master IO (Either msg a))
+       => (a -> GHandlerT sub master IO (Either msg a))
        -> Field sub master a
        -> Field sub master a
 checkM f field = field
diff --git a/yesod-form/Yesod/Form/Input.hs b/yesod-form/Yesod/Form/Input.hs
index 34abd57a..62fcfcdb 100644
--- a/yesod-form/Yesod/Form/Input.hs
+++ b/yesod-form/Yesod/Form/Input.hs
@@ -11,7 +11,7 @@ module Yesod.Form.Input
 import Yesod.Form.Types
 import Data.Text (Text)
 import Control.Applicative (Applicative (..))
-import Yesod.Handler (GHandler, GGHandler, invalidArgs, runRequestBody, getRequest, getYesod, liftIOHandler)
+import Yesod.Handler (GHandler, GHandlerT, invalidArgs, runRequestBody, getRequest, getYesod, liftIOHandler)
 import Yesod.Request (reqGetParams, languages)
 import Control.Monad (liftM)
 import Yesod.Message (RenderMessage (..), SomeMessage (..))
@@ -19,7 +19,7 @@ import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
 
 type DText = [Text] -> [Text]
-newtype FormInput sub master a = FormInput { unFormInput :: master -> [Text] -> Env -> GGHandler sub master IO (Either DText a) }
+newtype FormInput sub master a = FormInput { unFormInput :: master -> [Text] -> Env -> GHandlerT sub master IO (Either DText a) }
 instance Functor (FormInput sub master) where
     fmap a (FormInput f) = FormInput $ \c d e -> fmap (either Left (Right . a)) $ f c d e
 instance Applicative (FormInput sub master) where
diff --git a/yesod-form/Yesod/Form/Jquery.hs b/yesod-form/Yesod/Form/Jquery.hs
index fa6f6e5d..9411c9eb 100644
--- a/yesod-form/Yesod/Form/Jquery.hs
+++ b/yesod-form/Yesod/Form/Jquery.hs
@@ -171,7 +171,7 @@ $(function(){$("##{theId}").autocomplete({source:"@{src}",minLength:2})});
 |]
     }
 
-addScript' :: Monad m => (t -> Either (Route master) Text) -> GGWidget master (GGHandler sub t m) ()
+addScript' :: (master -> Either (Route master) Text) -> GWidget sub master ()
 addScript' f = do
     y <- lift getYesod
     addScriptEither $ f y
diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs
index a07fd7fe..ec796715 100644
--- a/yesod-form/Yesod/Form/MassInput.hs
+++ b/yesod-form/Yesod/Form/MassInput.hs
@@ -14,7 +14,7 @@ import Yesod.Form.Functions
 import Yesod.Form.Fields (boolField)
 import Yesod.Widget (GWidget, whamlet)
 import Yesod.Message (RenderMessage)
-import Yesod.Handler (newIdent, GGHandler)
+import Yesod.Handler (newIdent, GHandler)
 import Text.Blaze (Html)
 import Control.Monad.Trans.Class (lift)
 import Data.Text (pack)
@@ -53,7 +53,7 @@ up i = do
         IntCons _ is' -> put is' >> newFormIdent >> return ()
     up $ i - 1
 
-inputList :: (m ~ GGHandler sub master IO, xml ~ GWidget sub master (), RenderMessage master FormMessage)
+inputList :: (m ~ GHandler sub master, xml ~ GWidget sub master (), RenderMessage master FormMessage)
           => Html
           -> ([[FieldView sub master]] -> xml)
           -> (Maybe a -> AForm sub master a)
diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs
index ddd1cd48..4cefea68 100644
--- a/yesod-form/Yesod/Form/Types.hs
+++ b/yesod-form/Yesod/Form/Types.hs
@@ -27,7 +27,7 @@ import Text.Blaze (Html, ToHtml (toHtml))
 import Control.Applicative ((<$>), Applicative (..))
 import Control.Monad (liftM)
 import Data.String (IsString (..))
-import Yesod.Core (GGHandler, GWidget, SomeMessage)
+import Yesod.Core (GHandlerT, GWidget, SomeMessage)
 import qualified Data.Map as Map
 
 -- | A form can produce three different results: there was no data available,
@@ -75,12 +75,12 @@ type Env = Map.Map Text [Text]
 type FileEnv = Map.Map Text FileInfo
 
 type Lang = Text
-type Form sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GGHandler sub master IO) a
+type Form sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GHandlerT sub master IO) a
 {-# DEPRECATED Form "Use MForm instead" #-}
-type MForm sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GGHandler sub master IO) a
+type MForm sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GHandlerT sub master IO) a
 
 newtype AForm sub master a = AForm
-    { unAForm :: (master, [Text]) -> Maybe (Env, FileEnv) -> Ints -> GGHandler sub master IO (FormResult a, [FieldView sub master] -> [FieldView sub master], Ints, Enctype)
+    { unAForm :: (master, [Text]) -> Maybe (Env, FileEnv) -> Ints -> GHandlerT sub master IO (FormResult a, [FieldView sub master] -> [FieldView sub master], Ints, Enctype)
     }
 instance Functor (AForm sub master) where
     fmap f (AForm a) =
@@ -117,7 +117,7 @@ data FieldView sub master = FieldView
     }
 
 data Field sub master a = Field
-    { fieldParse :: [Text] -> GGHandler sub master IO (Either (SomeMessage master) (Maybe a))
+    { fieldParse :: [Text] -> GHandlerT sub master IO (Either (SomeMessage master) (Maybe a))
     -- | ID, name, (invalid text OR legimiate result), required?
     , fieldView :: Text
                 -> Text
diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal
index f9036550..5e5d73da 100644
--- a/yesod-form/yesod-form.cabal
+++ b/yesod-form/yesod-form.cabal
@@ -20,7 +20,7 @@ library
                    , hamlet                >= 0.10     && < 0.11
                    , shakespeare-css       >= 0.10     && < 0.11
                    , shakespeare-js        >= 0.10     && < 0.11
-                   , persistent            >= 0.6      && < 0.7
+                   , persistent            >= 0.7      && < 0.8
                    , template-haskell
                    , transformers          >= 0.2.2    && < 0.3
                    , data-default          >= 0.3      && < 0.4
diff --git a/yesod-persistent/Yesod/Persist.hs b/yesod-persistent/Yesod/Persist.hs
index f6a2c107..d8535f08 100644
--- a/yesod-persistent/Yesod/Persist.hs
+++ b/yesod-persistent/Yesod/Persist.hs
@@ -6,25 +6,26 @@ module Yesod.Persist
     , get404
     , getBy404
     , module Database.Persist
+    , module Database.Persist.Query
     , module Database.Persist.TH
     ) where
 
 import Database.Persist
+import Database.Persist.Query
 import Database.Persist.TH
 import Control.Monad.Trans.Class (MonadTrans (..))
-import Control.Monad.IO.Class (MonadIO)
 import Control.Failure (Failure)
 
 import Yesod.Handler
 
-type YesodDB sub master = YesodPersistBackend master (GGHandler sub master IO)
+type YesodDB sub master = YesodPersistBackend master (GHandler sub master)
 
 class YesodPersist master where
     type YesodPersistBackend master :: (* -> *) -> * -> *
-    runDB :: MonadIO monad => YesodDB sub master a -> GGHandler sub master monad a
+    runDB :: YesodDB sub master a -> GHandler sub master a
 
 -- | Get the given entity by ID, or return a 404 not found if it doesn't exist.
-get404 :: (PersistBackend t m, PersistEntity val, Monad (t m),
+get404 :: (PersistStore t m, PersistEntity val, Monad (t m),
            Failure ErrorResponse m, MonadTrans t)
        => Key t val -> t m val
 get404 key = do
@@ -35,7 +36,7 @@ get404 key = do
 
 -- | Get the given entity by unique key, or return a 404 not found if it doesn't
 --   exist.
-getBy404 :: (PersistBackend t m, PersistEntity val, Monad (t m),
+getBy404 :: (PersistUnique t m, PersistEntity val, Monad (t m),
              Failure ErrorResponse m, MonadTrans t)
          => Unique val t -> t m (Key t val, val)
 getBy404 key = do