From db096471caaed2d99abba5a0a34d310d3d66fc24 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 16 Jan 2014 08:23:50 +0200
Subject: [PATCH] persistent2

---
 yesod-auth/Yesod/Auth.hs                | 63 +++++++++++++++++++++++++
 yesod-auth/Yesod/Auth/HashDB.hs         | 49 +++++++++++++++++++
 yesod-auth/yesod-auth.cabal             |  4 +-
 yesod-form/Yesod/Form/Fields.hs         | 24 ++++++++++
 yesod-form/yesod-form.cabal             |  2 +-
 yesod-persistent/Yesod/Persist/Core.hs  | 39 ++++++++++++++-
 yesod-persistent/yesod-persistent.cabal |  4 +-
 7 files changed, 178 insertions(+), 7 deletions(-)

diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index 0fb6dedc..239f9a69 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/yesod-auth/Yesod/Auth.hs
@@ -156,6 +156,18 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     -- Since 1.2.0
     maybeAuthId :: HandlerT master IO (Maybe (AuthId master))
 
+#if MIN_VERSION_persistent(2, 0, 0)
+    default maybeAuthId
+        :: ( YesodAuth master
+           , PersistEntityBackend val ~ YesodPersistBackend master
+           , Key val ~ AuthId master
+           , PersistStore (PersistEntityBackend val)
+           , PersistEntity val
+           , YesodPersist master
+           , Typeable val
+           )
+        => HandlerT master IO (Maybe (AuthId master))
+#else
     default maybeAuthId
         :: ( YesodAuth master
            , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val
@@ -167,6 +179,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
            , Typeable val
            )
         => HandlerT master IO (Maybe (AuthId master))
+#endif
     maybeAuthId = defaultMaybeAuthId
 
     -- | Called on login error for HTTP requests. By default, calls
@@ -191,6 +204,18 @@ credsKey = "_ID"
 -- 'maybeAuthIdRaw' for more information.
 --
 -- Since 1.1.2
+#if MIN_VERSION_persistent(2, 0, 0)
+defaultMaybeAuthId
+          :: ( YesodAuth master
+             , b ~ YesodPersistBackend master
+             , b ~ PersistEntityBackend val
+             , Key val ~ AuthId master
+             , PersistStore b
+             , PersistEntity val
+             , YesodPersist master
+             , Typeable val
+             ) => HandlerT master IO (Maybe (AuthId master))
+#else
 defaultMaybeAuthId
           :: ( YesodAuth master
              , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val
@@ -201,6 +226,7 @@ defaultMaybeAuthId
              , YesodPersist master
              , Typeable val
              ) => HandlerT master IO (Maybe (AuthId master))
+#endif
 defaultMaybeAuthId = do
     ms <- lookupSession credsKey
     case ms of
@@ -210,6 +236,17 @@ defaultMaybeAuthId = do
                 Nothing -> return Nothing
                 Just aid -> fmap (fmap entityKey) $ cachedAuth aid
 
+#if MIN_VERSION_persistent(2, 0, 0)
+cachedAuth :: ( YesodAuth master
+             , b ~ YesodPersistBackend master
+             , b ~ PersistEntityBackend val
+             , Key val ~ AuthId master
+             , PersistStore b
+             , PersistEntity val
+             , YesodPersist master
+             , Typeable val
+             ) => AuthId master -> HandlerT master IO (Maybe (Entity val))
+#else
 cachedAuth :: ( YesodAuth master
              , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val
              , b ~ YesodPersistBackend master
@@ -219,6 +256,7 @@ cachedAuth :: ( YesodAuth master
              , YesodPersist master
              , Typeable val
              ) => AuthId master -> HandlerT master IO (Maybe (Entity val))
+#endif
 cachedAuth aid = runMaybeT $ do
     a <- MaybeT $ fmap unCachedMaybeAuth
                 $ cached
@@ -363,6 +401,17 @@ handlePluginR plugin pieces = do
 -- assumes that you are using a Persistent database.
 --
 -- Since 1.1.0
+#if MIN_VERSION_persistent(2, 0, 0)
+maybeAuth :: ( YesodAuth master
+             , b ~ YesodPersistBackend master
+             , b ~ PersistEntityBackend val
+             , Key val ~ AuthId master
+             , PersistStore b
+             , PersistEntity val
+             , YesodPersist master
+             , Typeable val
+             ) => HandlerT master IO (Maybe (Entity val))
+#else
 maybeAuth :: ( YesodAuth master
              , PersistMonadBackend (b (HandlerT master IO)) ~ PersistEntityBackend val
              , b ~ YesodPersistBackend master
@@ -372,6 +421,7 @@ maybeAuth :: ( YesodAuth master
              , YesodPersist master
              , Typeable val
              ) => HandlerT master IO (Maybe (Entity val))
+#endif
 maybeAuth = runMaybeT $ do
     aid <- MaybeT maybeAuthId
     MaybeT $ cachedAuth aid
@@ -385,6 +435,18 @@ newtype CachedMaybeAuth val = CachedMaybeAuth { unCachedMaybeAuth :: Maybe val }
 -- full informatin on a given user.
 --
 -- Since 1.2.0
+#if MIN_VERSION_persistent(2, 0, 0)
+type YesodAuthPersist master =
+    ( YesodAuth master
+    , YesodPersistBackend master
+        ~ PersistEntityBackend (AuthEntity master)
+    , Key (AuthEntity master) ~ AuthId master
+    , PersistStore (YesodPersistBackend master)
+    , PersistEntity (AuthEntity master)
+    , YesodPersist master
+    , Typeable (AuthEntity master)
+    )
+#else
 type YesodAuthPersist master =
     ( YesodAuth master
     , PersistMonadBackend (YesodPersistBackend master (HandlerT master IO))
@@ -395,6 +457,7 @@ type YesodAuthPersist master =
     , YesodPersist master
     , Typeable (AuthEntity master)
     )
+#endif
 
 -- | If the @AuthId@ for a given site is a persistent ID, this will give the
 -- value for that entity. E.g.:
diff --git a/yesod-auth/Yesod/Auth/HashDB.hs b/yesod-auth/Yesod/Auth/HashDB.hs
index d0509f26..a63d5532 100644
--- a/yesod-auth/Yesod/Auth/HashDB.hs
+++ b/yesod-auth/Yesod/Auth/HashDB.hs
@@ -134,6 +134,18 @@ setPassword pwd u = do salt <- randomSalt
 
 -- | Given a user ID and password in plaintext, validate them against
 --   the database values.
+#if MIN_VERSION_persistent(2, 0, 0)
+validateUser :: ( YesodPersist yesod
+                , b ~ YesodPersistBackend yesod
+                , b ~ PersistEntityBackend user
+                , PersistUnique b
+                , PersistEntity user
+                , HashDBUser    user
+                ) => 
+                Unique user     -- ^ User unique identifier
+             -> Text            -- ^ Password in plaint-text
+             -> HandlerT yesod IO Bool
+#else
 validateUser :: ( YesodPersist yesod
                 , b ~ YesodPersistBackend yesod
                 , PersistMonadBackend (b (HandlerT yesod IO)) ~ PersistEntityBackend user
@@ -144,6 +156,7 @@ validateUser :: ( YesodPersist yesod
                 Unique user     -- ^ User unique identifier
              -> Text            -- ^ Password in plaint-text
              -> HandlerT yesod IO Bool
+#endif
 validateUser userID passwd = do
   -- Checks that hash and password match
   let validate u = do hash <- userPasswordHash u
@@ -160,6 +173,16 @@ login = PluginR "hashdb" ["login"]
 
 -- | Handle the login form. First parameter is function which maps
 --   username (whatever it might be) to unique user ID.
+#if MIN_VERSION_persistent(2, 0, 0)
+postLoginR :: ( YesodAuth y, YesodPersist y
+              , HashDBUser user, PersistEntity user
+              , b ~ YesodPersistBackend y
+              , b ~ PersistEntityBackend user
+              , PersistUnique b
+              )
+           => (Text -> Maybe (Unique user))
+           -> HandlerT Auth (HandlerT y IO) ()
+#else
 postLoginR :: ( YesodAuth y, YesodPersist y
               , HashDBUser user, PersistEntity user
               , b ~ YesodPersistBackend y
@@ -168,6 +191,7 @@ postLoginR :: ( YesodAuth y, YesodPersist y
               )
            => (Text -> Maybe (Unique user))
            -> HandlerT Auth (HandlerT y IO) ()
+#endif
 postLoginR uniq = do
     (mu,mp) <- lift $ runInputPost $ (,)
         <$> iopt textField "username"
@@ -184,6 +208,19 @@ postLoginR uniq = do
 
 -- | A drop in for the getAuthId method of your YesodAuth instance which
 --   can be used if authHashDB is the only plugin in use.
+#if MIN_VERSION_persistent(2, 0, 0)
+getAuthIdHashDB :: ( YesodAuth master, YesodPersist master
+                   , HashDBUser user, PersistEntity user
+                   , Key user ~ AuthId master
+                   , b ~ YesodPersistBackend master
+                   , b ~ PersistEntityBackend user
+                   , PersistUnique b
+                   )
+                => (AuthRoute -> Route master)   -- ^ your site's Auth Route
+                -> (Text -> Maybe (Unique user)) -- ^ gets user ID
+                -> Creds master                  -- ^ the creds argument
+                -> HandlerT master IO (Maybe (AuthId master))
+#else
 getAuthIdHashDB :: ( YesodAuth master, YesodPersist master
                    , HashDBUser user, PersistEntity user
                    , Key user ~ AuthId master
@@ -195,6 +232,7 @@ getAuthIdHashDB :: ( YesodAuth master, YesodPersist master
                 -> (Text -> Maybe (Unique user)) -- ^ gets user ID
                 -> Creds master                  -- ^ the creds argument
                 -> HandlerT master IO (Maybe (AuthId master))
+#endif
 getAuthIdHashDB authR uniq creds = do
     muid <- maybeAuthId
     case muid of
@@ -211,6 +249,16 @@ getAuthIdHashDB authR uniq creds = do
 
 -- | Prompt for username and password, validate that against a database
 --   which holds the username and a hash of the password
+#if MIN_VERSION_persistent(2, 0, 0)
+authHashDB :: ( YesodAuth m, YesodPersist m
+              , HashDBUser user
+              , PersistEntity user
+              , b ~ YesodPersistBackend m
+              , b ~ PersistEntityBackend user
+              , PersistUnique b
+              )
+           => (Text -> Maybe (Unique user)) -> AuthPlugin m
+#else
 authHashDB :: ( YesodAuth m, YesodPersist m
               , HashDBUser user
               , PersistEntity user
@@ -218,6 +266,7 @@ authHashDB :: ( YesodAuth m, YesodPersist m
               , PersistMonadBackend (b (HandlerT m IO)) ~ PersistEntityBackend user
               , PersistUnique (b (HandlerT m IO)))
            => (Text -> Maybe (Unique user)) -> AuthPlugin m
+#endif
 authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> toWidget [hamlet|
 $newline never
     <div id="header">
diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index 7c35019d..3cc336fc 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -34,8 +34,8 @@ library
                    , unordered-containers
                    , yesod-form              >= 1.3       && < 1.4
                    , transformers            >= 0.2.2
-                   , persistent              >= 1.2       && < 1.4
-                   , persistent-template     >= 1.2       && < 1.4
+                   , persistent              >= 1.2       && < 2.1
+                   , persistent-template     >= 1.2       && < 2.1
                    , SHA                     >= 1.4.1.3
                    , http-conduit            >= 1.5
                    , aeson                   >= 0.5
diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs
index ea0c85c5..bb05b969 100644
--- a/yesod-form/Yesod/Form/Fields.hs
+++ b/yesod-form/Yesod/Form/Fields.hs
@@ -73,7 +73,11 @@ import Data.Maybe (listToMaybe, fromMaybe)
 import qualified Blaze.ByteString.Builder.Html.Utf8 as B
 import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
 import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
+#if MIN_VERSION_persistent(2, 0, 0)
+import Database.Persist (PersistEntityBackend)
+#else
 import Database.Persist (PersistMonadBackend, PersistEntityBackend)
+#endif
 
 import Text.Blaze.Html.Renderer.String (renderHtml)
 import qualified Data.ByteString as S
@@ -525,12 +529,21 @@ optionsPairs opts = do
 optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a)
 optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
 
+#if MIN_VERSION_persistent(2, 0, 0)
+optionsPersist :: ( YesodPersist site, PersistEntity a
+                  , PersistQuery (PersistEntityBackend a)
+                  , PathPiece (Key a)
+                  , RenderMessage site msg
+                  , YesodPersistBackend site ~ PersistEntityBackend a
+                  )
+#else
 optionsPersist :: ( YesodPersist site, PersistEntity a
                   , PersistQuery (YesodDB site)
                   , PathPiece (Key a)
                   , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site)
                   , RenderMessage site msg
                   )
+#endif
                => [Filter a]
                -> [SelectOpt a]
                -> (a -> msg)
@@ -548,6 +561,16 @@ optionsPersist filts ords toDisplay = fmap mkOptionList $ do
 -- the entire @Entity@.
 --
 -- Since 1.3.2
+#if MIN_VERSION_persistent(2, 0, 0)
+optionsPersistKey
+  :: (YesodPersist site
+     , PersistEntity a
+     , PersistQuery (PersistEntityBackend a)
+     , PathPiece (Key a)
+     , RenderMessage site msg
+     , YesodPersistBackend site ~ PersistEntityBackend a
+     )
+#else
 optionsPersistKey
   :: (YesodPersist site
      , PersistEntity a
@@ -555,6 +578,7 @@ optionsPersistKey
      , PathPiece (Key a)
      , RenderMessage site msg
      , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site))
+#endif
   => [Filter a]
   -> [SelectOpt a]
   -> (a -> msg)
diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal
index 944af2f1..cb06054a 100644
--- a/yesod-form/yesod-form.cabal
+++ b/yesod-form/yesod-form.cabal
@@ -20,7 +20,7 @@ library
                    , hamlet                >= 1.1      && < 1.2
                    , shakespeare-css       >= 1.0      && < 1.1
                    , shakespeare-js        >= 1.0.2    && < 1.3
-                   , persistent            >= 1.2      && < 1.4
+                   , persistent            >= 1.2      && < 2.1
                    , template-haskell
                    , transformers          >= 0.2.2
                    , data-default
diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs
index 1463fada..d290107b 100644
--- a/yesod-persistent/Yesod/Persist/Core.hs
+++ b/yesod-persistent/Yesod/Persist/Core.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -19,8 +20,10 @@ module Yesod.Persist.Core
     ) where
 
 import Database.Persist
+#if !MIN_VERSION_persistent(2, 0, 0)
 import Database.Persist.Sql (SqlPersistT, unSqlPersistT)
-import Control.Monad.Trans.Reader (runReaderT)
+#endif
+import Control.Monad.Trans.Reader (ReaderT, runReaderT)
 
 import Yesod.Core
 import Data.Conduit
@@ -32,10 +35,24 @@ import Control.Exception (throwIO)
 import Yesod.Core.Types (HandlerContents (HCError))
 import qualified Database.Persist.Sql as SQL
 
-type YesodDB site = YesodPersistBackend site (HandlerT site IO)
+#if MIN_VERSION_persistent(2, 0, 0)
+unSqlPersistT :: a -> a
+unSqlPersistT = id
+#endif
 
+#if MIN_VERSION_persistent(2, 0, 0)
+type YesodDB site = ReaderT (YesodPersistBackend site) (HandlerT site IO)
+#else
+type YesodDB site = YesodPersistBackend site (HandlerT site IO)
+#endif
+
+#if MIN_VERSION_persistent(2, 0, 0)
+class Monad (YesodDB site) => YesodPersist site where
+    type YesodPersistBackend site
+#else
 class Monad (YesodPersistBackend site (HandlerT site IO)) => YesodPersist site where
     type YesodPersistBackend site :: (* -> *) -> * -> *
+#endif
     runDB :: YesodDB site a -> HandlerT site IO a
 
 -- | Helper for creating 'runDB'.
@@ -78,7 +95,11 @@ newtype DBRunner site = DBRunner
 -- | Helper for implementing 'getDBRunner'.
 --
 -- Since 1.2.0
+#if MIN_VERSION_persistent(2, 0, 0)
+defaultGetDBRunner :: YesodPersistBackend site ~ SQL.SqlBackend
+#else
 defaultGetDBRunner :: YesodPersistBackend site ~ SqlPersistT
+#endif
                    => (site -> Pool SQL.Connection)
                    -> HandlerT site IO (DBRunner site, HandlerT site IO ())
 defaultGetDBRunner getPool = do
@@ -123,6 +144,11 @@ respondSourceDB :: YesodPersistRunner site
 respondSourceDB ctype = respondSource ctype . runDBSource
 
 -- | Get the given entity by ID, or return a 404 not found if it doesn't exist.
+#if MIN_VERSION_persistent(2, 0, 0)
+get404 :: (MonadIO m, PersistStore (PersistEntityBackend val), PersistEntity val)
+       => Key val
+       -> ReaderT (PersistEntityBackend val) m val
+#else
 get404 :: ( PersistStore (t m)
           , PersistEntity val
           , Monad (t m)
@@ -131,6 +157,7 @@ get404 :: ( PersistStore (t m)
           , PersistMonadBackend (t m) ~ PersistEntityBackend val
           )
        => Key val -> t m val
+#endif
 get404 key = do
     mres <- get key
     case mres of
@@ -139,6 +166,11 @@ get404 key = do
 
 -- | Get the given entity by unique key, or return a 404 not found if it doesn't
 --   exist.
+#if MIN_VERSION_persistent(2, 0, 0)
+getBy404 :: (PersistUnique (PersistEntityBackend val), PersistEntity val, MonadIO m)
+         => Unique val
+         -> ReaderT (PersistEntityBackend val) m (Entity val)
+#else
 getBy404 :: ( PersistUnique (t m)
             , PersistEntity val
             , m ~ HandlerT site IO
@@ -147,6 +179,7 @@ getBy404 :: ( PersistUnique (t m)
             , PersistEntityBackend val ~ PersistMonadBackend (t m)
             )
          => Unique val -> t m (Entity val)
+#endif
 getBy404 key = do
     mres <- getBy key
     case mres of
@@ -158,8 +191,10 @@ getBy404 key = do
 notFound' :: MonadIO m => m a
 notFound' = liftIO $ throwIO $ HCError NotFound
 
+#if !MIN_VERSION_persistent(2, 0, 0)
 instance MonadHandler m => MonadHandler (SqlPersistT m) where
     type HandlerSite (SqlPersistT m) = HandlerSite m
     liftHandlerT = lift . liftHandlerT
 instance MonadWidget m => MonadWidget (SqlPersistT m) where
     liftWidgetT = lift . liftWidgetT
+#endif
diff --git a/yesod-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal
index e01786d2..2e085849 100644
--- a/yesod-persistent/yesod-persistent.cabal
+++ b/yesod-persistent/yesod-persistent.cabal
@@ -15,8 +15,8 @@ description:     Some helpers for using Persistent from Yesod.
 library
     build-depends:   base                      >= 4        && < 5
                    , yesod-core                >= 1.2.2    && < 1.3
-                   , persistent                >= 1.2      && < 1.4
-                   , persistent-template       >= 1.2      && < 1.4
+                   , persistent                >= 1.2      && < 2.1
+                   , persistent-template       >= 1.2      && < 2.1
                    , transformers              >= 0.2.2    && < 0.4
                    , blaze-builder
                    , conduit