Hello community,

here is the log from the commit of package ghc-persistent for openSUSE:Factory 
checked in at 2016-10-18 10:41:03
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-persistent (Old)
 and      /work/SRC/openSUSE:Factory/.ghc-persistent.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Package is "ghc-persistent"

Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-persistent/ghc-persistent.changes    
2016-07-21 08:16:03.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-persistent.new/ghc-persistent.changes       
2016-10-18 10:41:03.000000000 +0200
@@ -1,0 +2,10 @@
+Fri Sep 30 08:18:50 UTC 2016 - psim...@suse.com
+
+- Update to version 2.6 revision 2 with cabal2obs.
+
+-------------------------------------------------------------------
+Thu Sep 15 07:09:44 UTC 2016 - psim...@suse.com
+
+- Update to version 2.6 revision 1 with cabal2obs.
+
+-------------------------------------------------------------------

Old:
----
  persistent-2.2.4.1.tar.gz

New:
----
  persistent-2.6.tar.gz
  persistent.cabal

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Other differences:
------------------
++++++ ghc-persistent.spec ++++++
--- /var/tmp/diff_new_pack.43DcLl/_old  2016-10-18 10:41:05.000000000 +0200
+++ /var/tmp/diff_new_pack.43DcLl/_new  2016-10-18 10:41:05.000000000 +0200
@@ -19,15 +19,15 @@
 %global pkg_name persistent
 %bcond_with tests
 Name:           ghc-%{pkg_name}
-Version:        2.2.4.1
+Version:        2.6
 Release:        0
 Summary:        Type-safe, multi-backend data serialization
 License:        MIT
-Group:          System/Libraries
+Group:          Development/Languages/Other
 Url:            https://hackage.haskell.org/package/%{pkg_name}
 Source0:        
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
+Source1:        
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal#/%{pkg_name}.cabal
 BuildRequires:  ghc-Cabal-devel
-# Begin cabal-rpm deps:
 BuildRequires:  ghc-aeson-devel
 BuildRequires:  ghc-attoparsec-devel
 BuildRequires:  ghc-base64-bytestring-devel
@@ -62,7 +62,6 @@
 %if %{with tests}
 BuildRequires:  ghc-hspec-devel
 %endif
-# End cabal-rpm deps
 
 %description
 Hackage documentation generation is not reliable. For up to date documentation,
@@ -81,21 +80,16 @@
 
 %prep
 %setup -q -n %{pkg_name}-%{version}
-
+cp -p %{SOURCE1} %{pkg_name}.cabal
 
 %build
 %ghc_lib_build
 
-
 %install
 %ghc_lib_install
 
-
 %check
-%if %{with tests}
-%{cabal} test
-%endif
-
+%cabal_test
 
 %post devel
 %ghc_pkg_recache
@@ -109,6 +103,5 @@
 
 %files devel -f %{name}-devel.files
 %defattr(-,root,root,-)
-%doc ChangeLog.md README.md
 
 %changelog

++++++ persistent-2.2.4.1.tar.gz -> persistent-2.6.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/persistent-2.2.4.1/ChangeLog.md 
new/persistent-2.6/ChangeLog.md
--- old/persistent-2.2.4.1/ChangeLog.md 2016-03-08 09:18:27.000000000 +0100
+++ new/persistent-2.6/ChangeLog.md     2016-08-10 05:29:36.000000000 +0200
@@ -1,3 +1,12 @@
+## 2.6
+
+* Add `connUpsertSql` type for providing backend-specific upsert sql support.
+
+## 2.5
+
+* read/write typeclass split
+* add insertOrGet convenience function to PersistUnique
+
 ## 2.2.4.1
 
 * Documentation updates [#515](https://github.com/yesodweb/persistent/pull/515)
@@ -14,6 +23,7 @@
 ## 2.2.2
 
 * Add liftSqlPersistMPool function
+* support http-api-data for url serialization
 
 ## 2.2.1
 
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' 
old/persistent-2.2.4.1/Database/Persist/Class/DeleteCascade.hs 
new/persistent-2.6/Database/Persist/Class/DeleteCascade.hs
--- old/persistent-2.2.4.1/Database/Persist/Class/DeleteCascade.hs      
2016-03-08 09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Class/DeleteCascade.hs  2016-07-17 
04:15:37.000000000 +0200
@@ -18,7 +18,7 @@
 -- | For combinations of backends and entities that support
 -- cascade-deletion. “Cascade-deletion” means that entries that depend on
 -- other entries to be deleted will be deleted as well.
-class (PersistStore backend, PersistEntity record, backend ~ 
PersistEntityBackend record)
+class (PersistStoreWrite backend, PersistEntity record, BaseBackend backend ~ 
PersistEntityBackend record)
   => DeleteCascade record backend where
 
     -- | Perform cascade-deletion of single database
@@ -26,7 +26,7 @@
     deleteCascade :: MonadIO m => Key record -> ReaderT backend m ()
 
 -- | Cascade-deletion of entries satisfying given filters.
-deleteCascadeWhere :: (MonadIO m, DeleteCascade record backend, PersistQuery 
backend)
+deleteCascadeWhere :: (MonadIO m, DeleteCascade record backend, 
PersistQueryWrite backend)
                    => [Filter record] -> ReaderT backend m ()
 deleteCascadeWhere filts = do
     srcRes <- selectKeysRes filts []
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' 
old/persistent-2.2.4.1/Database/Persist/Class/PersistQuery.hs 
new/persistent-2.6/Database/Persist/Class/PersistQuery.hs
--- old/persistent-2.2.4.1/Database/Persist/Class/PersistQuery.hs       
2016-03-08 09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Class/PersistQuery.hs   2016-07-17 
04:15:37.000000000 +0200
@@ -1,7 +1,10 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Database.Persist.Class.PersistQuery
-    ( PersistQuery (..)
+    ( PersistQueryRead (..)
+    , PersistQueryWrite (..)
     , selectSource
     , selectKeys
     , selectList
@@ -19,51 +22,53 @@
 import Control.Monad.Trans.Resource (MonadResource, release)
 import Data.Acquire (Acquire, allocateAcquire, with)
 
--- | Backends supporting conditional operations.
-class PersistStore backend => PersistQuery backend where
-    -- | Update individual fields on any record matching the given criterion.
-    updateWhere :: (MonadIO m, PersistEntity val, backend ~ 
PersistEntityBackend val)
-                => [Filter val] -> [Update val] -> ReaderT backend m ()
-
-    -- | Delete all records matching the given criterion.
-    deleteWhere :: (MonadIO m, PersistEntity val, backend ~ 
PersistEntityBackend val)
-                => [Filter val] -> ReaderT backend m ()
-
+-- | Backends supporting conditional read operations.
+class (PersistCore backend, PersistStoreRead backend) => PersistQueryRead 
backend where
     -- | Get all records matching the given criterion in the specified order.
     -- Returns also the identifiers.
     selectSourceRes
-           :: (PersistEntity val, PersistEntityBackend val ~ backend, MonadIO 
m1, MonadIO m2)
-           => [Filter val]
-           -> [SelectOpt val]
-           -> ReaderT backend m1 (Acquire (C.Source m2 (Entity val)))
+           :: (PersistRecordBackend record backend, MonadIO m1, MonadIO m2)
+           => [Filter record]
+           -> [SelectOpt record]
+           -> ReaderT backend m1 (Acquire (C.Source m2 (Entity record)))
 
     -- | Get just the first record for the criterion.
-    selectFirst :: (MonadIO m, PersistEntity val, backend ~ 
PersistEntityBackend val)
-                => [Filter val]
-                -> [SelectOpt val]
-                -> ReaderT backend m (Maybe (Entity val))
+    selectFirst :: (MonadIO m, PersistRecordBackend record backend)
+                => [Filter record]
+                -> [SelectOpt record]
+                -> ReaderT backend m (Maybe (Entity record))
     selectFirst filts opts = do
         srcRes <- selectSourceRes filts (LimitTo 1 : opts)
         liftIO $ with srcRes (C.$$ CL.head)
 
     -- | Get the 'Key's of all records matching the given criterion.
     selectKeysRes
-        :: (MonadIO m1, MonadIO m2, PersistEntity val, backend ~ 
PersistEntityBackend val)
-        => [Filter val]
-        -> [SelectOpt val]
-        -> ReaderT backend m1 (Acquire (C.Source m2 (Key val)))
+        :: (MonadIO m1, MonadIO m2, PersistRecordBackend record backend)
+        => [Filter record]
+        -> [SelectOpt record]
+        -> ReaderT backend m1 (Acquire (C.Source m2 (Key record)))
 
     -- | The total number of records fulfilling the given criterion.
-    count :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
-          => [Filter val] -> ReaderT backend m Int
+    count :: (MonadIO m, PersistRecordBackend record backend)
+          => [Filter record] -> ReaderT backend m Int
+
+-- | Backends supporting conditional write operations
+class (PersistQueryRead backend, PersistStoreWrite backend) => 
PersistQueryWrite backend where
+    -- | Update individual fields on any record matching the given criterion.
+    updateWhere :: (MonadIO m, PersistRecordBackend record backend)
+                => [Filter record] -> [Update record] -> ReaderT backend m ()
+
+    -- | Delete all records matching the given criterion.
+    deleteWhere :: (MonadIO m, PersistRecordBackend record backend)
+                => [Filter record] -> ReaderT backend m ()
 
 -- | Get all records matching the given criterion in the specified order.
 -- Returns also the identifiers.
 selectSource
-       :: (PersistQuery backend, MonadResource m, PersistEntity val, 
PersistEntityBackend val ~ backend, MonadReader env m, HasPersistBackend env 
backend)
-       => [Filter val]
-       -> [SelectOpt val]
-       -> C.Source m (Entity val)
+       :: (PersistQueryRead (BaseBackend backend), MonadResource m, 
PersistEntity record, PersistEntityBackend record ~ BaseBackend (BaseBackend 
backend), MonadReader backend m, HasPersistBackend backend)
+       => [Filter record]
+       -> [SelectOpt record]
+       -> C.Source m (Entity record)
 selectSource filts opts = do
     srcRes <- liftPersist $ selectSourceRes filts opts
     (releaseKey, src) <- allocateAcquire srcRes
@@ -71,10 +76,10 @@
     release releaseKey
 
 -- | Get the 'Key's of all records matching the given criterion.
-selectKeys :: (PersistQuery backend, MonadResource m, PersistEntity val, 
backend ~ PersistEntityBackend val, MonadReader env m, HasPersistBackend env 
backend)
-           => [Filter val]
-           -> [SelectOpt val]
-           -> C.Source m (Key val)
+selectKeys :: (PersistQueryRead (BaseBackend backend), MonadResource m, 
PersistEntity record, BaseBackend (BaseBackend backend) ~ PersistEntityBackend 
record, MonadReader backend m, HasPersistBackend backend)
+           => [Filter record]
+           -> [SelectOpt record]
+           -> C.Source m (Key record)
 selectKeys filts opts = do
     srcRes <- liftPersist $ selectKeysRes filts opts
     (releaseKey, src) <- allocateAcquire srcRes
@@ -82,19 +87,19 @@
     release releaseKey
 
 -- | Call 'selectSource' but return the result as a list.
-selectList :: (MonadIO m, PersistEntity val, PersistQuery backend, 
PersistEntityBackend val ~ backend)
-           => [Filter val]
-           -> [SelectOpt val]
-           -> ReaderT backend m [Entity val]
+selectList :: (MonadIO m, PersistQueryRead backend, PersistRecordBackend 
record backend)
+           => [Filter record]
+           -> [SelectOpt record]
+           -> ReaderT backend m [Entity record]
 selectList filts opts = do
     srcRes <- selectSourceRes filts opts
     liftIO $ with srcRes (C.$$ CL.consume)
 
 -- | Call 'selectKeys' but return the result as a list.
-selectKeysList :: (MonadIO m, PersistEntity val, PersistQuery backend, 
PersistEntityBackend val ~ backend)
-               => [Filter val]
-               -> [SelectOpt val]
-               -> ReaderT backend m [Key val]
+selectKeysList :: (MonadIO m, PersistQueryRead backend, PersistRecordBackend 
record backend)
+               => [Filter record]
+               -> [SelectOpt record]
+               -> ReaderT backend m [Key record]
 selectKeysList filts opts = do
     srcRes <- selectKeysRes filts opts
     liftIO $ with srcRes (C.$$ CL.consume)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' 
old/persistent-2.2.4.1/Database/Persist/Class/PersistStore.hs 
new/persistent-2.6/Database/Persist/Class/PersistStore.hs
--- old/persistent-2.2.4.1/Database/Persist/Class/PersistStore.hs       
2016-03-08 09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Class/PersistStore.hs   2016-07-17 
04:15:37.000000000 +0200
@@ -1,10 +1,15 @@
 {-# LANGUAGE TypeFamilies, FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE ConstraintKinds #-}
 module Database.Persist.Class.PersistStore
     ( HasPersistBackend (..)
+    , IsPersistBackend (..)
+    , PersistRecordBackend
     , liftPersist
-    , PersistStore (..)
+    , PersistCore (..)
+    , PersistStoreRead (..)
+    , PersistStoreWrite (..)
     , getJust
     , belongsTo
     , belongsToJust
@@ -22,12 +27,30 @@
 import Database.Persist.Types
 import qualified Data.Aeson as A
 
-class HasPersistBackend env backend | env -> backend where
-    persistBackend :: env -> backend
-
-liftPersist :: (MonadReader env m, HasPersistBackend env backend, MonadIO m)
-            => ReaderT backend IO a
-            -> m a
+-- | Class which allows the plucking of a @BaseBackend backend@ from some 
larger type.
+-- For example,
+-- @
+-- instance HasPersistBackend (SqlReadBackend, Int) where
+--   type BaseBackend (SqlReadBackend, Int) = SqlBackend
+--   persistBackend = unSqlReadBackend . fst
+-- @
+class HasPersistBackend backend where
+    type BaseBackend backend
+    persistBackend :: backend -> BaseBackend backend
+-- | Class which witnesses that @backend@ is essentially the same as 
@BaseBackend backend@.
+-- That is, they're isomorphic and @backend@ is just some wrapper over 
@BaseBackend backend@.
+class (HasPersistBackend backend) => IsPersistBackend backend where
+    -- | This function is how we actually construct and tag a backend as 
having read or write capabilities.
+    -- It should be used carefully and only when actually constructing a 
@backend@. Careless use allows us
+    -- to accidentally run a write query against a read-only database.
+    mkPersistBackend :: BaseBackend backend -> backend
+
+-- | A convenient alias for common type signatures
+type PersistRecordBackend record backend = (PersistEntity record, 
PersistEntityBackend record ~ BaseBackend backend)
+
+liftPersist
+    :: (MonadIO m, MonadReader backend m, HasPersistBackend backend)
+    => ReaderT (BaseBackend backend) IO b -> m b
 liftPersist f = do
     env <- ask
     liftIO $ runReaderT f (persistBackend env)
@@ -43,31 +66,40 @@
 -- 'ToBackendKey'.
 class ( PersistEntity record
       , PersistEntityBackend record ~ backend
-      , PersistStore backend
+      , PersistCore backend
       ) => ToBackendKey backend record where
     toBackendKey   :: Key record -> BackendKey backend
     fromBackendKey :: BackendKey backend -> Key record
 
+class PersistCore backend where
+    data BackendKey backend
+
 class
   ( Show (BackendKey backend), Read (BackendKey backend)
   , Eq (BackendKey backend), Ord (BackendKey backend)
+  , PersistCore backend
   , PersistField (BackendKey backend), A.ToJSON (BackendKey backend), 
A.FromJSON (BackendKey backend)
-  ) => PersistStore backend where
-    data BackendKey backend
-
+  ) => PersistStoreRead backend where
     -- | Get a record by identifier, if available.
-    get :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val)
-        => Key val -> ReaderT backend m (Maybe val)
+    get :: (MonadIO m, PersistRecordBackend record backend)
+        => Key record -> ReaderT backend m (Maybe record)
+
+class
+  ( Show (BackendKey backend), Read (BackendKey backend)
+  , Eq (BackendKey backend), Ord (BackendKey backend)
+  , PersistStoreRead backend
+  , PersistField (BackendKey backend), A.ToJSON (BackendKey backend), 
A.FromJSON (BackendKey backend)
+  ) => PersistStoreWrite backend where
 
     -- | Create a new record in the database, returning an automatically 
created
     -- key (in SQL an auto-increment id).
-    insert :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity 
val)
-           => val -> ReaderT backend m (Key val)
+    insert :: (MonadIO m, PersistRecordBackend record backend)
+           => record -> ReaderT backend m (Key record)
 
     -- | Same as 'insert', but doesn't return a @Key@.
-    insert_ :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity 
val)
-            => val -> ReaderT backend m ()
-    insert_ val = insert val >> return ()
+    insert_ :: (MonadIO m, PersistRecordBackend record backend)
+            => record -> ReaderT backend m ()
+    insert_ record = insert record >> return ()
 
     -- | Create multiple records in the database and return their 'Key's.
     --
@@ -78,16 +110,16 @@
     --
     -- The SQLite and MySQL backends use the slow, default implementation of
     -- @mapM insert@.
-    insertMany :: (MonadIO m, backend ~ PersistEntityBackend val, 
PersistEntity val)
-               => [val] -> ReaderT backend m [Key val]
+    insertMany :: (MonadIO m, PersistRecordBackend record backend)
+               => [record] -> ReaderT backend m [Key record]
     insertMany = mapM insert
 
     -- | Same as 'insertMany', but doesn't return any 'Key's.
     --
     -- The MongoDB, PostgreSQL, SQLite and MySQL backends insert all records in
     -- one database query.
-    insertMany_ :: (MonadIO m, backend ~ PersistEntityBackend val, 
PersistEntity val)
-                => [val] -> ReaderT backend m ()
+    insertMany_ :: (MonadIO m, PersistRecordBackend record backend)
+                => [record] -> ReaderT backend m ()
     insertMany_ x = insertMany x >> return ()
 
     -- | Same as 'insertMany_', but takes an 'Entity' instead of just a record.
@@ -99,43 +131,43 @@
     --
     -- The SQL backends use the slow, default implementation of
     -- @mapM_ insertKey@.
-    insertEntityMany :: (MonadIO m, backend ~ PersistEntityBackend val, 
PersistEntity val)
-                     => [Entity val] -> ReaderT backend m ()
+    insertEntityMany :: (MonadIO m, PersistRecordBackend record backend)
+                     => [Entity record] -> ReaderT backend m ()
     insertEntityMany = mapM_ (\(Entity k record) -> insertKey k record)
 
     -- | Create a new record in the database using the given key.
-    insertKey :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity 
val)
-              => Key val -> val -> ReaderT backend m ()
+    insertKey :: (MonadIO m, PersistRecordBackend record backend)
+              => Key record -> record -> ReaderT backend m ()
 
     -- | Put the record in the database with the given key.
     -- Unlike 'replace', if a record with the given key does not
     -- exist then a new record will be inserted.
-    repsert :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity 
val)
-            => Key val -> val -> ReaderT backend m ()
+    repsert :: (MonadIO m, PersistRecordBackend record backend)
+            => Key record -> record -> ReaderT backend m ()
 
     -- | Replace the record in the database with the given
     -- key. Note that the result is undefined if such record does
     -- not exist, so you must use 'insertKey or 'repsert' in
     -- these cases.
-    replace :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity 
val)
-            => Key val -> val -> ReaderT backend m ()
+    replace :: (MonadIO m, PersistRecordBackend record backend)
+            => Key record -> record -> ReaderT backend m ()
 
     -- | Delete a specific record by identifier. Does nothing if record does
     -- not exist.
-    delete :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity 
val)
-           => Key val -> ReaderT backend m ()
+    delete :: (MonadIO m, PersistRecordBackend record backend)
+           => Key record -> ReaderT backend m ()
 
     -- | Update individual fields on a specific record.
-    update :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend 
val)
-           => Key val -> [Update val] -> ReaderT backend m ()
+    update :: (MonadIO m, PersistRecordBackend record backend)
+           => Key record -> [Update record] -> ReaderT backend m ()
 
     -- | Update individual fields on a specific record, and retrieve the
     -- updated value from the database.
     --
     -- Note that this function will throw an exception if the given key is not
     -- found in the database.
-    updateGet :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend 
val)
-              => Key val -> [Update val] -> ReaderT backend m val
+    updateGet :: (MonadIO m, PersistRecordBackend record backend)
+              => Key record -> [Update record] -> ReaderT backend m record
     updateGet key ups = do
         update key ups
         get key >>= maybe (liftIO $ throwIO $ KeyNotFound $ show key) return
@@ -143,12 +175,11 @@
 
 -- | Same as get, but for a non-null (not Maybe) foreign key
 -- Unsafe unless your database is enforcing that the foreign key is valid.
-getJust :: ( PersistStore backend
-           , PersistEntity val
-           , Show (Key val)
-           , backend ~ PersistEntityBackend val
+getJust :: ( PersistStoreRead backend
+           , Show (Key record)
+           , PersistRecordBackend record backend
            , MonadIO m
-           ) => Key val -> ReaderT backend m val
+           ) => Key record -> ReaderT backend m record
 getJust key = get key >>= maybe
   (liftIO $ throwIO $ PersistForeignConstraintUnmet $ T.pack $ show key)
   return
@@ -157,10 +188,9 @@
 --
 -- > foreign = belongsTo foreignId
 belongsTo ::
-  ( PersistStore backend
+  ( PersistStoreRead backend
   , PersistEntity ent1
-  , PersistEntity ent2
-  , backend ~ PersistEntityBackend ent2
+  , PersistRecordBackend ent2 backend
   , MonadIO m
   ) => (ent1 -> Maybe (Key ent2)) -> ent1 -> ReaderT backend m (Maybe ent2)
 belongsTo foreignKeyField model = case foreignKeyField model of
@@ -169,10 +199,9 @@
 
 -- | Same as 'belongsTo', but uses @getJust@ and therefore is similarly unsafe.
 belongsToJust ::
-  ( PersistStore backend
+  ( PersistStoreRead backend
   , PersistEntity ent1
-  , PersistEntity ent2
-  , backend ~ PersistEntityBackend ent2
+  , PersistRecordBackend ent2 backend
   , MonadIO m
   )
   => (ent1 -> Key ent2) -> ent1 -> ReaderT backend m ent2
@@ -180,9 +209,8 @@
 
 -- | Like @insert@, but returns the complete @Entity@.
 insertEntity ::
-    ( PersistStore backend
-    , PersistEntity e
-    , backend ~ PersistEntityBackend e
+    ( PersistStoreWrite backend
+    , PersistRecordBackend e backend
     , MonadIO m
     ) => e -> ReaderT backend m (Entity e)
 insertEntity e = do
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' 
old/persistent-2.2.4.1/Database/Persist/Class/PersistUnique.hs 
new/persistent-2.6/Database/Persist/Class/PersistUnique.hs
--- old/persistent-2.2.4.1/Database/Persist/Class/PersistUnique.hs      
2016-03-08 09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Class/PersistUnique.hs  2016-08-01 
15:46:55.000000000 +0200
@@ -1,7 +1,8 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
 module Database.Persist.Class.PersistUnique
-    ( PersistUnique (..)
+    ( PersistUniqueRead (..)
+    , PersistUniqueWrite (..)
     , getByValue
     , insertBy
     , replaceUnique
@@ -35,7 +36,11 @@
 -- you must manually place a unique index on a field to have a uniqueness
 -- constraint.
 --
--- Some functions in this module ('insertUnique', 'insertBy', and
+class (PersistCore backend, PersistStoreRead backend) => PersistUniqueRead 
backend where
+    -- | Get a record by unique key, if available. Returns also the identifier.
+    getBy :: (MonadIO m, PersistRecordBackend record backend) => Unique record 
-> ReaderT backend m (Maybe (Entity record))
+
+-- | Some functions in this module ('insertUnique', 'insertBy', and
 -- 'replaceUnique') first query the unique indexes to check for
 -- conflicts. You could instead optimistically attempt to perform the
 -- operation (e.g. 'replace' instead of 'replaceUnique'). However,
@@ -44,17 +49,15 @@
 --  determing the column of failure;
 --
 --  * an exception will automatically abort the current SQL transaction.
-class PersistStore backend => PersistUnique backend where
-    -- | Get a record by unique key, if available. Returns also the identifier.
-    getBy :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity 
val) => Unique val -> ReaderT backend m (Maybe (Entity val))
+class (PersistUniqueRead backend, PersistStoreWrite backend) => 
PersistUniqueWrite backend where
 
     -- | Delete a specific record by unique key. Does nothing if no record
     -- matches.
-    deleteBy :: (MonadIO m, PersistEntityBackend val ~ backend, PersistEntity 
val) => Unique val -> ReaderT backend m ()
+    deleteBy :: (MonadIO m, PersistRecordBackend record backend) => Unique 
record -> ReaderT backend m ()
 
     -- | Like 'insert', but returns 'Nothing' when the record
     -- couldn't be inserted because of a uniqueness constraint.
-    insertUnique :: (MonadIO m, PersistEntityBackend val ~ backend, 
PersistEntity val) => val -> ReaderT backend m (Maybe (Key val))
+    insertUnique :: (MonadIO m, PersistRecordBackend record backend) => record 
-> ReaderT backend m (Maybe (Key record))
     insertUnique datum = do
         conflict <- checkUnique datum
         case conflict of
@@ -67,16 +70,32 @@
     -- * update the existing record that matches the uniqueness contraint.
     --
     -- Throws an exception if there is more than 1 uniqueness contraint.
-    upsert :: (MonadIO m, PersistEntityBackend val ~ backend, PersistEntity 
val)
-           => val          -- ^ new record to insert
-           -> [Update val]
+    upsert :: (MonadIO m, PersistRecordBackend record backend)
+           => record          -- ^ new record to insert
+           -> [Update record]
            -- ^ updates to perform if the record already exists (leaving
            -- this empty is the equivalent of performing a 'repsert' on a
            -- unique key)
-           -> ReaderT backend m (Entity val)
+           -> ReaderT backend m (Entity record)
            -- ^ the record in the database after the operation
     upsert record updates = do
         uniqueKey <- onlyUnique record
+        upsertBy uniqueKey record updates
+
+    -- | Update based on a given uniqueness constraint or insert:
+    --
+    -- * insert the new record if it does not exist;
+    -- * update the existing record that matches the given uniqueness 
contraint.
+    upsertBy :: (MonadIO m, PersistRecordBackend record backend)
+            => Unique record -- ^ uniqueness constraint to find by
+            -> record          -- ^ new record to insert
+            -> [Update record]
+            -- ^ updates to perform if the record already exists (leaving
+            -- this empty is the equivalent of performing a 'repsert' on a
+            -- unique key)
+            -> ReaderT backend m (Entity record)
+            -- ^ the record in the database after the operation
+    upsertBy uniqueKey record updates = do
         mExists <- getBy uniqueKey
         k <- case mExists of
             Just (Entity k _) -> do
@@ -89,22 +108,33 @@
 -- | Insert a value, checking for conflicts with any unique constraints.  If a
 -- duplicate exists in the database, it is returned as 'Left'. Otherwise, the
 -- new 'Key is returned as 'Right'.
-insertBy :: (MonadIO m, PersistEntity val, PersistUnique backend, 
PersistEntityBackend val ~ backend)
-         => val -> ReaderT backend m (Either (Entity val) (Key val))
+insertBy :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend 
record backend)
+         => record -> ReaderT backend m (Either (Entity record) (Key record))
 insertBy val = do
     res <- getByValue val
     case res of
       Nothing -> Right `liftM` insert val
       Just z -> return $ Left z
 
+-- | Insert a value, checking for conflicts with any unique constraints. If a
+-- duplicate exists in the database, it is left untouched. The key of the
+-- existing or new entry is returned
+insertOrGet :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend 
record backend)
+            => record -> ReaderT backend m (Key record)
+insertOrGet val = do
+    res <- getByValue val
+    case res of
+        Nothing -> insert val
+        Just (Entity key _) -> return key
+
 -- | Return the single unique key for a record.
-onlyUnique :: (MonadIO m, PersistEntity val, PersistUnique backend, 
PersistEntityBackend val ~ backend)
-           => val -> ReaderT backend m (Unique val)
+onlyUnique :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend 
record backend)
+           => record -> ReaderT backend m (Unique record)
 onlyUnique record = case onlyUniqueEither record of
     Right u -> return u
     Left us -> requireUniques record us >>= liftIO . throwIO . 
OnlyUniqueException . show . length
 
-onlyUniqueEither :: (PersistEntity val) => val -> Either [Unique val] (Unique 
val)
+onlyUniqueEither :: (PersistEntity record) => record -> Either [Unique record] 
(Unique record)
 onlyUniqueEither record = case persistUniqueKeys record of
     [u] -> Right u
     us  -> Left us
@@ -113,7 +143,7 @@
 -- of a 'Unique' record. Returns a record matching /one/ of the unique keys. 
This
 -- function makes the most sense on entities with a single 'Unique'
 -- constructor.
-getByValue :: (MonadIO m, PersistEntity record, PersistUnique backend, 
PersistEntityBackend record ~ backend)
+getByValue :: (MonadIO m, PersistUniqueRead backend, PersistRecordBackend 
record backend)
            => record -> ReaderT backend m (Maybe (Entity record))
 getByValue record = checkUniques =<< requireUniques record (persistUniqueKeys 
record)
   where
@@ -142,7 +172,7 @@
 -- If uniqueness is violated, return a 'Just' with the 'Unique' violation
 --
 -- Since 1.2.2.0
-replaceUnique :: (MonadIO m, Eq record, Eq (Unique record), 
PersistEntityBackend record ~ backend, PersistEntity record, PersistUnique 
backend)
+replaceUnique :: (MonadIO m, Eq record, Eq (Unique record), 
PersistRecordBackend record backend, PersistUniqueWrite backend)
               => Key record -> record -> ReaderT backend m (Maybe (Unique 
record))
 replaceUnique key datumNew = getJust key >>= replaceOriginal
   where
@@ -161,11 +191,11 @@
 --
 -- Returns 'Nothing' if the entity would be unique, and could thus safely be 
inserted.
 -- on a conflict returns the conflicting key
-checkUnique :: (MonadIO m, PersistEntityBackend record ~ backend, 
PersistEntity record, PersistUnique backend)
+checkUnique :: (MonadIO m, PersistRecordBackend record backend, 
PersistUniqueRead backend)
             => record -> ReaderT backend m (Maybe (Unique record))
 checkUnique = checkUniqueKeys . persistUniqueKeys
 
-checkUniqueKeys :: (MonadIO m, PersistEntity record, PersistUnique backend, 
PersistEntityBackend record ~ backend)
+checkUniqueKeys :: (MonadIO m, PersistEntity record, PersistUniqueRead 
backend, PersistRecordBackend record backend)
                 => [Unique record] -> ReaderT backend m (Maybe (Unique record))
 checkUniqueKeys [] = return Nothing
 checkUniqueKeys (x:xs) = do
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/persistent-2.2.4.1/Database/Persist/Class.hs 
new/persistent-2.6/Database/Persist/Class.hs
--- old/persistent-2.2.4.1/Database/Persist/Class.hs    2016-03-08 
09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Class.hs        2016-07-17 
04:15:37.000000000 +0200
@@ -1,15 +1,24 @@
+{-# LANGUAGE ConstraintKinds #-}
+
 module Database.Persist.Class
     ( ToBackendKey (..)
 
     -- * PersistStore
-    , PersistStore (..)
+    , PersistCore (..)
+    , PersistStore
+    , PersistStoreRead (..)
+    , PersistStoreWrite (..)
+    , BaseBackend(..)
+    , PersistRecordBackend
     , getJust
     , belongsTo
     , belongsToJust
     , insertEntity
 
     -- * PersistUnique
-    , PersistUnique (..)
+    , PersistUnique
+    , PersistUniqueRead (..)
+    , PersistUniqueWrite (..)
     , getByValue
     , insertBy
     , replaceUnique
@@ -17,7 +26,9 @@
     , onlyUnique
 
     -- * PersistQuery
-    , PersistQuery (..)
+    , PersistQuery
+    , PersistQueryRead (..)
+    , PersistQueryWrite (..)
     , selectSource
     , selectKeys
     , selectList
@@ -37,6 +48,7 @@
 
     -- * Lifting
     , HasPersistBackend (..)
+    , IsPersistBackend ()
     , liftPersist
 
     -- * JSON utilities
@@ -52,3 +64,16 @@
 import Database.Persist.Class.PersistConfig
 import Database.Persist.Class.PersistField
 import Database.Persist.Class.PersistStore
+
+
+-- | A backwards-compatible alias for those that don't care about 
distinguishing between read and write queries.
+-- It signifies the assumption that, by default, a backend can write as well 
as read.
+type PersistUnique a = PersistUniqueWrite a
+
+-- | A backwards-compatible alias for those that don't care about 
distinguishing between read and write queries.
+-- It signifies the assumption that, by default, a backend can write as well 
as read.
+type PersistQuery a = PersistQueryWrite a
+
+-- | A backwards-compatible alias for those that don't care about 
distinguishing between read and write queries.
+-- It signifies the assumption that, by default, a backend can write as well 
as read.
+type PersistStore a = PersistStoreWrite a
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/persistent-2.2.4.1/Database/Persist/Quasi.hs 
new/persistent-2.6/Database/Persist/Quasi.hs
--- old/persistent-2.2.4.1/Database/Persist/Quasi.hs    2016-03-08 
09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Quasi.hs        2016-07-17 
04:15:37.000000000 +0200
@@ -456,8 +456,10 @@
     (_, attrs) = break ("!" `T.isPrefixOf`) pkcols
     getDef [] t = error $ "Unknown column in primary key constraint: " ++ show 
t
     getDef (d:ds) t
-        | nullable (fieldAttrs d) /= NotNullable = error $ "primary key column 
cannot be nullable: " ++ show t
-        | fieldHaskell d == HaskellName t = d
+        | fieldHaskell d == HaskellName t =
+            if nullable (fieldAttrs d) /= NotNullable
+                then error $ "primary key column cannot be nullable: " ++ show 
t
+                else d
         | otherwise = getDef ds t
 
 -- Unique UppercaseConstraintName list of lowercasefields    
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/persistent-2.2.4.1/Database/Persist/Sql/Class.hs 
new/persistent-2.6/Database/Persist/Sql/Class.hs
--- old/persistent-2.2.4.1/Database/Persist/Sql/Class.hs        2016-03-08 
09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Sql/Class.hs    2016-07-17 
04:15:37.000000000 +0200
@@ -4,7 +4,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
 #ifndef NO_OVERLAP
 {-# LANGUAGE OverlappingInstances #-}
 #endif
@@ -58,15 +60,18 @@
     rawSqlProcessRow [pv]  = Single <$> fromPersistValue pv
     rawSqlProcessRow _     = Left $ pack "RawSql (Single a): wrong number of 
columns."
 
-instance (PersistEntity a, PersistEntityBackend a ~ SqlBackend) => RawSql (Key 
a) where
-  rawSqlCols _ key         = (length $ keyToValues key, [])
-  rawSqlColCountReason key = "The primary key is composed of "
-                             ++ (show $ length $ keyToValues key)
-                             ++ " columns"
-  rawSqlProcessRow         = keyFromValues
-
-instance (PersistEntity record, PersistEntityBackend record ~ SqlBackend)
-         => RawSql (Entity record) where
+instance
+    (PersistEntity a, PersistEntityBackend a ~ backend, IsPersistBackend 
backend) =>
+    RawSql (Key a) where
+    rawSqlCols _ key         = (length $ keyToValues key, [])
+    rawSqlColCountReason key = "The primary key is composed of "
+                               ++ (show $ length $ keyToValues key)
+                               ++ " columns"
+    rawSqlProcessRow         = keyFromValues
+
+instance
+    (PersistEntity record, PersistEntityBackend record ~ backend, 
IsPersistBackend backend) =>
+    RawSql (Entity record) where
     rawSqlCols escape ent = (length sqlFields, [intercalate ", " sqlFields])
         where
           sqlFields = map (((name <> ".") <>) . escape)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' 
old/persistent-2.2.4.1/Database/Persist/Sql/Orphan/PersistQuery.hs 
new/persistent-2.6/Database/Persist/Sql/Orphan/PersistQuery.hs
--- old/persistent-2.2.4.1/Database/Persist/Sql/Orphan/PersistQuery.hs  
2016-03-08 09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Sql/Orphan/PersistQuery.hs      
2016-07-17 04:15:37.000000000 +0200
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -20,7 +21,7 @@
 import Data.Monoid (Monoid (..), (<>))
 import Data.Int (Int64)
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Reader (ReaderT, ask)
+import Control.Monad.Trans.Reader (ReaderT, ask, withReaderT)
 import Control.Exception (throwIO)
 import qualified Data.Conduit.List as CL
 import Data.Conduit
@@ -29,7 +30,7 @@
 import Data.List (transpose, inits, find)
 
 -- orphaned instance for convenience of modularity
-instance PersistQuery SqlBackend where
+instance PersistQueryRead SqlBackend where
     count filts = do
         conn <- ask
         let wher = if null filts
@@ -45,7 +46,7 @@
             case mm of
               Just [PersistInt64 i] -> return $ fromIntegral i
               Just [PersistDouble i] ->return $ fromIntegral (truncate i :: 
Int64) -- gb oracle
-              Just [PersistByteString i] -> case readInteger i of -- gb mssql 
+              Just [PersistByteString i] -> case readInteger i of -- gb mssql
                                               Just (ret,"") -> return $ 
fromIntegral ret
                                               xs -> error $ "invalid number 
i["++show i++"] xs[" ++ show xs ++ "]"
               Just xs -> error $ "count:invalid sql  return xs["++show xs++"] 
sql["++show sql++"]"
@@ -88,7 +89,7 @@
       where
         t = entityDef $ dummyFromFilts filts
         cols conn = T.intercalate "," $ dbIdColumns conn t
-                      
+
 
         wher conn = if null filts
                     then ""
@@ -111,36 +112,45 @@
 
         parse xs = do
             keyvals <- case entityPrimary t of
-                      Nothing -> 
+                      Nothing ->
                         case xs of
                            [PersistInt64 x] -> return [PersistInt64 x]
-                           [PersistDouble x] -> return [PersistInt64 (truncate 
x)] -- oracle returns Double 
+                           [PersistDouble x] -> return [PersistInt64 (truncate 
x)] -- oracle returns Double
                            _ -> liftIO $ throwIO $ PersistMarshalError $ 
"Unexpected in selectKeys False: " <> T.pack (show xs)
-                      Just pdef -> 
+                      Just pdef ->
                            let pks = map fieldHaskell $ compositeFields pdef
                                keyvals = map snd $ filter (\(a, _) -> let 
ret=isJust (find (== a) pks) in ret) $ zip (map fieldHaskell $ entityFields t) 
xs
                            in return keyvals
             case keyFromValues keyvals of
                 Right k -> return k
                 Left _ -> error "selectKeysImpl: keyFromValues failed"
+instance PersistQueryRead SqlReadBackend where
+    count filts = withReaderT persistBackend $ count filts
+    selectSourceRes filts opts = withReaderT persistBackend $ selectSourceRes 
filts opts
+    selectKeysRes filts opts = withReaderT persistBackend $ selectKeysRes 
filts opts
+instance PersistQueryRead SqlWriteBackend where
+    count filts = withReaderT persistBackend $ count filts
+    selectSourceRes filts opts = withReaderT persistBackend $ selectSourceRes 
filts opts
+    selectKeysRes filts opts = withReaderT persistBackend $ selectKeysRes 
filts opts
 
-
-
+instance PersistQueryWrite SqlBackend where
     deleteWhere filts = do
         _ <- deleteWhereCount filts
         return ()
-
     updateWhere filts upds = do
         _ <- updateWhereCount filts upds
         return ()
+instance PersistQueryWrite SqlWriteBackend where
+    deleteWhere filts = withReaderT persistBackend $ deleteWhere filts
+    updateWhere filts upds = withReaderT persistBackend $ updateWhere filts 
upds
 
 -- | Same as 'deleteWhere', but returns the number of rows affected.
 --
 -- Since 1.1.5
-deleteWhereCount :: (PersistEntity val, MonadIO m, PersistEntityBackend val ~ 
SqlBackend)
+deleteWhereCount :: (PersistEntity val, MonadIO m, PersistEntityBackend val ~ 
SqlBackend, IsSqlBackend backend)
                  => [Filter val]
-                 -> ReaderT SqlBackend m Int64
-deleteWhereCount filts = do
+                 -> ReaderT backend m Int64
+deleteWhereCount filts = withReaderT persistBackend $ do
     conn <- ask
     let t = entityDef $ dummyFromFilts filts
     let wher = if null filts
@@ -156,12 +166,12 @@
 -- | Same as 'updateWhere', but returns the number of rows affected.
 --
 -- Since 1.1.5
-updateWhereCount :: (PersistEntity val, MonadIO m, SqlBackend ~ 
PersistEntityBackend val)
+updateWhereCount :: (PersistEntity val, MonadIO m, SqlBackend ~ 
PersistEntityBackend val, IsSqlBackend backend)
                  => [Filter val]
                  -> [Update val]
-                 -> ReaderT SqlBackend m Int64
+                 -> ReaderT backend m Int64
 updateWhereCount _ [] = return 0
-updateWhereCount filts upds = do
+updateWhereCount filts upds = withReaderT persistBackend $ do
     conn <- ask
     let wher = if null filts
                 then ""
@@ -228,7 +238,7 @@
     go (FilterAnd fs) = combineAND fs
     go (FilterOr []) = ("1=0", [])
     go (FilterOr fs)  = combine " OR " fs
-    go (Filter field value pfilter) = 
+    go (Filter field value pfilter) =
         let t = entityDef $ dummyFromFilts [Filter field value pfilter]
         in case (isIdField field, entityPrimary t, allVals) of
                  (True, Just pdef, PersistList ys:_) ->
@@ -236,21 +246,21 @@
                        then error $ "wrong number of entries in 
compositeFields vs PersistList allVals=" ++ show allVals
                     else
                       case (allVals, pfilter, isCompFilter pfilter) of
-                        ([PersistList xs], Eq, _) -> 
+                        ([PersistList xs], Eq, _) ->
                            let sqlcl=T.intercalate " and " (map (\a -> 
connEscapeName conn (fieldDB a) <> showSqlFilter pfilter <> "? ")  
(compositeFields pdef))
                            in (wrapSql sqlcl,xs)
-                        ([PersistList xs], Ne, _) -> 
+                        ([PersistList xs], Ne, _) ->
                            let sqlcl=T.intercalate " or " (map (\a -> 
connEscapeName conn (fieldDB a) <> showSqlFilter pfilter <> "? ")  
(compositeFields pdef))
                            in (wrapSql sqlcl,xs)
-                        (_, In, _) -> 
+                        (_, In, _) ->
                            let xxs = transpose (map fromPersistList allVals)
                                sqls=map (\(a,xs) -> connEscapeName conn 
(fieldDB a) <> showSqlFilter pfilter <> "(" <> T.intercalate "," (replicate 
(length xs) " ?") <> ") ") (zip (compositeFields pdef) xxs)
                            in (wrapSql (T.intercalate " and " (map wrapSql 
sqls)), concat xxs)
-                        (_, NotIn, _) -> 
+                        (_, NotIn, _) ->
                            let xxs = transpose (map fromPersistList allVals)
                                sqls=map (\(a,xs) -> connEscapeName conn 
(fieldDB a) <> showSqlFilter pfilter <> "(" <> T.intercalate "," (replicate 
(length xs) " ?") <> ") ") (zip (compositeFields pdef) xxs)
                            in (wrapSql (T.intercalate " or " (map wrapSql 
sqls)), concat xxs)
-                        ([PersistList xs], _, True) -> 
+                        ([PersistList xs], _, True) ->
                            let zs = tail (inits (compositeFields pdef))
                                sql1 = map (\b -> wrapSql (T.intercalate " and 
" (map (\(i,a) -> sql2 (i==length b) a) (zip [1..] b)))) zs
                                sql2 islast a = connEscapeName conn (fieldDB a) 
<> (if islast then showSqlFilter pfilter else showSqlFilter Eq) <> "? "
@@ -258,7 +268,10 @@
                            in (wrapSql sqlcl, concat (tail (inits xs)))
                         (_, BackendSpecificFilter _, _) -> error "unhandled 
type BackendSpecificFilter for composite/non id primary keys"
                         _ -> error $ "unhandled type/filter for composite/non 
id primary keys pfilter=" ++ show pfilter ++ " persistList="++show allVals
-                 (True, Just pdef, _) -> error $ "unhandled error for 
composite/non id primary keys pfilter=" ++ show pfilter ++ " persistList=" ++ 
show allVals ++ " pdef=" ++ show pdef
+                 (True, Just pdef, []) ->
+                     error $ "empty list given as filter value filter=" ++ 
show pfilter ++ " persistList=" ++ show allVals ++ " pdef=" ++ show pdef
+                 (True, Just pdef, _) ->
+                     error $ "unhandled error for composite/non id primary 
keys filter=" ++ show pfilter ++ " persistList=" ++ show allVals ++ " pdef=" ++ 
show pdef
 
                  _ ->   case (isNull, pfilter, varCount) of
                             (True, Eq, _) -> (name <> " IS NULL", [])
@@ -304,7 +317,7 @@
                                 , qmarks
                                 , ")"
                                 ], notNullVals)
-                            _ -> (name <> showSqlFilter pfilter <> "?" <> 
orNullSuffix, allVals) 
+                            _ -> (name <> showSqlFilter pfilter <> "?" <> 
orNullSuffix, allVals)
 
       where
         isCompFilter Lt = True
@@ -312,11 +325,11 @@
         isCompFilter Gt = True
         isCompFilter Ge = True
         isCompFilter _ =  False
-        
+
         wrapSql sqlcl = "(" <> sqlcl <> ")"
         fromPersistList (PersistList xs) = xs
         fromPersistList other = error $ "expected PersistList but found " ++ 
show other
-        
+
         filterValueToPersistValues :: forall a.  PersistField a => Either a 
[a] -> [PersistValue]
         filterValueToPersistValues v = map toPersistValue $ either return id v
 
@@ -389,8 +402,8 @@
         $ connEscapeName conn $ fieldName x
 
 -- | Generates sql for limit and offset for postgres, sqlite and mysql.
-decorateSQLWithLimitOffset::Text -> (Int,Int) -> Bool -> Text -> Text 
-decorateSQLWithLimitOffset nolimit (limit,offset) _ sql = 
+decorateSQLWithLimitOffset::Text -> (Int,Int) -> Bool -> Text -> Text
+decorateSQLWithLimitOffset nolimit (limit,offset) _ sql =
     let
         lim = case (limit, offset) of
                 (0, 0) -> ""
@@ -403,4 +416,4 @@
             [ sql
             , lim
             , off
-            ]            
+            ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' 
old/persistent-2.2.4.1/Database/Persist/Sql/Orphan/PersistStore.hs 
new/persistent-2.6/Database/Persist/Sql/Orphan/PersistStore.hs
--- old/persistent-2.2.4.1/Database/Persist/Sql/Orphan/PersistStore.hs  
2016-03-08 09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Sql/Orphan/PersistStore.hs      
2016-07-17 04:15:37.000000000 +0200
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -30,7 +31,7 @@
 import Data.ByteString.Char8 (readInteger)
 import Data.Maybe (isJust)
 import Data.List (find)
-import Control.Monad.Trans.Reader (ReaderT, ask)
+import Control.Monad.Trans.Reader (ReaderT, ask, withReaderT)
 import Data.Acquire (with)
 import Data.Int (Int64)
 import Web.PathPieces (PathPiece)
@@ -68,20 +69,18 @@
 --
 -- Your backend may provide a more convenient tableName function
 -- which does not operate in a Monad
-getTableName :: forall record m.
+getTableName :: forall record m backend.
              ( PersistEntity record
              , PersistEntityBackend record ~ SqlBackend
+             , IsSqlBackend backend
              , Monad m
-             ) => record -> ReaderT SqlBackend m Text
-getTableName rec = do
+             ) => record -> ReaderT backend m Text
+getTableName rec = withReaderT persistBackend $ do
     conn <- ask
     return $ connEscapeName conn $ tableDBName rec
 
 -- | useful for a backend to implement tableName by adding escaping
-tableDBName :: forall record.
-            ( PersistEntity record
-            , PersistEntityBackend record ~ SqlBackend
-            ) => record -> DBName
+tableDBName :: (PersistEntity record) => record -> DBName
 tableDBName rec = entityDB $ entityDef (Just rec)
 
 -- | get the SQL string for the field that an EntityField represents
@@ -89,13 +88,14 @@
 --
 -- Your backend may provide a more convenient fieldName function
 -- which does not operate in a Monad
-getFieldName :: forall record typ m.
+getFieldName :: forall record typ m backend.
              ( PersistEntity record
              , PersistEntityBackend record ~ SqlBackend
+             , IsSqlBackend backend
              , Monad m
              )
-             => EntityField record typ -> ReaderT SqlBackend m Text
-getFieldName rec = do
+             => EntityField record typ -> ReaderT backend m Text
+getFieldName rec = withReaderT persistBackend $ do
     conn <- ask
     return $ connEscapeName conn $ fieldDBName rec
 
@@ -104,10 +104,17 @@
 fieldDBName = fieldDB . persistFieldDef
 
 
-instance PersistStore SqlBackend where
+instance PersistCore SqlBackend where
     newtype BackendKey SqlBackend = SqlBackendKey { unSqlBackendKey :: Int64 }
         deriving (Show, Read, Eq, Ord, Num, Integral, PersistField, 
PersistFieldSql, PathPiece, ToHttpApiData, FromHttpApiData, Real, Enum, 
Bounded, A.ToJSON, A.FromJSON)
+instance PersistCore SqlReadBackend where
+    newtype BackendKey SqlReadBackend = SqlReadBackendKey { 
unSqlReadBackendKey :: Int64 }
+        deriving (Show, Read, Eq, Ord, Num, Integral, PersistField, 
PersistFieldSql, PathPiece, ToHttpApiData, FromHttpApiData, Real, Enum, 
Bounded, A.ToJSON, A.FromJSON)
+instance PersistCore SqlWriteBackend where
+    newtype BackendKey SqlWriteBackend = SqlWriteBackendKey { 
unSqlWriteBackendKey :: Int64 }
+        deriving (Show, Read, Eq, Ord, Num, Integral, PersistField, 
PersistFieldSql, PathPiece, ToHttpApiData, FromHttpApiData, Real, Enum, 
Bounded, A.ToJSON, A.FromJSON)
 
+instance PersistStoreWrite SqlBackend where
     update _ [] = return ()
     update k upds = do
         conn <- ask
@@ -247,6 +254,29 @@
           Nothing -> insertKey key value
           Just _ -> replace key value
 
+    delete k = do
+        conn <- ask
+        rawExecute (sql conn) (keyToValues k)
+      where
+        wher conn = whereStmtForKey conn k
+        sql conn = T.concat
+            [ "DELETE FROM "
+            , connEscapeName conn $ tableDBName $ recordTypeFromKey k
+            , " WHERE "
+            , wher conn
+            ]
+instance PersistStoreWrite SqlWriteBackend where
+    insert v = withReaderT persistBackend $ insert v
+    insertMany vs = withReaderT persistBackend $ insertMany vs
+    insertMany_ vs = withReaderT persistBackend $ insertMany_ vs
+    insertKey k v = withReaderT persistBackend $ insertKey k v
+    repsert k v = withReaderT persistBackend $ repsert k v
+    replace k v = withReaderT persistBackend $ replace k v
+    delete k = withReaderT persistBackend $ delete k
+    update k upds = withReaderT persistBackend $ update k upds
+
+
+instance PersistStoreRead SqlBackend where
     get k = do
         conn <- ask
         let t = entityDef $ dummyFromKey k
@@ -271,18 +301,10 @@
                     case fromPersistValues $ if noColumns then [] else vals of
                         Left e -> error $ "get " ++ show k ++ ": " ++ unpack e
                         Right v -> return $ Just v
-
-    delete k = do
-        conn <- ask
-        rawExecute (sql conn) (keyToValues k)
-      where
-        wher conn = whereStmtForKey conn k
-        sql conn = T.concat
-            [ "DELETE FROM "
-            , connEscapeName conn $ tableDBName $ recordTypeFromKey k
-            , " WHERE "
-            , wher conn
-            ]
+instance PersistStoreRead SqlReadBackend where
+    get k = withReaderT persistBackend $ get k
+instance PersistStoreRead SqlWriteBackend where
+    get k = withReaderT persistBackend $ get k
 
 dummyFromKey :: Key record -> Maybe record
 dummyFromKey = Just . recordTypeFromKey
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' 
old/persistent-2.2.4.1/Database/Persist/Sql/Orphan/PersistUnique.hs 
new/persistent-2.6/Database/Persist/Sql/Orphan/PersistUnique.hs
--- old/persistent-2.2.4.1/Database/Persist/Sql/Orphan/PersistUnique.hs 
2016-03-08 09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Sql/Orphan/PersistUnique.hs     
2016-08-10 05:20:24.000000000 +0200
@@ -1,20 +1,60 @@
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Database.Persist.Sql.Orphan.PersistUnique () where
 
 import Control.Exception (throwIO)
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import Control.Monad.Trans.Reader (ReaderT)
 import Database.Persist
 import Database.Persist.Sql.Types
 import Database.Persist.Sql.Raw
 import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)
 import Database.Persist.Sql.Util (dbColumns, parseEntityValues)
 import qualified Data.Text as T
-import Data.Monoid (mappend)
+import Data.Monoid (mappend, (<>))
 import qualified Data.Conduit.List as CL
-import Control.Monad.Trans.Reader (ask)
+import Control.Monad.Trans.Reader (ask, withReaderT)
+import Control.Monad (when, liftM)
+
+defaultUpsert :: (MonadIO m, PersistEntity record, PersistUniqueWrite backend
+                 , PersistEntityBackend record ~ BaseBackend backend) 
+                => record -> [Update record] -> ReaderT backend m (Entity 
record)
+defaultUpsert record updates = do
+  uniqueKey <- onlyUnique record
+  upsertBy uniqueKey record updates
+
+instance PersistUniqueWrite SqlBackend where
+
+    upsert record updates = do
+      conn <- ask
+      uniqueKey <- onlyUnique record
+      case connUpsertSql conn of
+        Just upsertSql -> case updates of
+                            [] -> defaultUpsert record updates
+                            xs -> do
+                                let upds = T.intercalate "," $ map (go' . go) 
updates
+                                    sql = upsertSql t upds
+                                    vals = (map toPersistValue $ 
toPersistFields record) ++ (map updatePersistValue updates) ++ (unqs uniqueKey)
+                                           
+                                    go'' n Assign = n <> "=?"
+                                    go'' n Add = T.concat [n, "=", n, "+?"]
+                                    go'' n Subtract = T.concat [n, "=", n, 
"-?"]
+                                    go'' n Multiply = T.concat [n, "=", n, 
"*?"]
+                                    go'' n Divide = T.concat [n, "=", n, "/?"]
+                                    go'' _ (BackendSpecificUpdate up) = error 
$ T.unpack $ "BackendSpecificUpdate" `mappend` up `mappend` "not supported"
+                                              
+                                    go' (x, pu) = go'' (connEscapeName conn x) 
pu
+                                    go x = (fieldDB $ updateFieldDef x, 
updateUpdate x)
+
+                                x <- rawSql sql vals
+                                return $ head x
+        Nothing -> defaultUpsert record updates
+        where
+          t = entityDef $ Just record
+          unqs uniqueKey = concat $ map (persistUniqueToValues) [uniqueKey]
 
-instance PersistUnique SqlBackend where
     deleteBy uniq = do
         conn <- ask
         let sql' = sql conn
@@ -30,7 +70,10 @@
             , " WHERE "
             , T.intercalate " AND " $ map (go' conn) $ go uniq
             ]
+instance PersistUniqueWrite SqlWriteBackend where
+    deleteBy uniq = withReaderT persistBackend $ deleteBy uniq
 
+instance PersistUniqueRead SqlBackend where
     getBy uniq = do
         conn <- ask
         let sql = T.concat
@@ -56,6 +99,19 @@
         go conn x = connEscapeName conn x `mappend` "=?"
         t = entityDef $ dummyFromUnique uniq
         toFieldNames' = map snd . persistUniqueToFieldNames
+instance PersistUniqueRead SqlReadBackend where
+    getBy uniq = withReaderT persistBackend $ getBy uniq
+instance PersistUniqueRead SqlWriteBackend where
+    getBy uniq = withReaderT persistBackend $ getBy uniq
 
 dummyFromUnique :: Unique v -> Maybe v
 dummyFromUnique _ = Nothing
+
+
+updateFieldDef :: PersistEntity v => Update v -> FieldDef
+updateFieldDef (Update f _ _) = persistFieldDef f
+updateFieldDef (BackendUpdate {}) = error "updateFieldDef did not expect 
BackendUpdate"
+
+updatePersistValue :: Update v -> PersistValue
+updatePersistValue (Update _ v _) = toPersistValue v
+updatePersistValue (BackendUpdate {}) = error "updatePersistValue did not 
expect BackendUpdate"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/persistent-2.2.4.1/Database/Persist/Sql/Raw.hs 
new/persistent-2.6/Database/Persist/Sql/Raw.hs
--- old/persistent-2.2.4.1/Database/Persist/Sql/Raw.hs  2016-03-08 
09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Sql/Raw.hs      2016-07-17 
04:15:37.000000000 +0200
@@ -1,5 +1,7 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 module Database.Persist.Sql.Raw where
 
 import Database.Persist
@@ -9,6 +11,7 @@
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Reader (ReaderT, ask, MonadReader)
 import Data.Acquire (allocateAcquire, Acquire, mkAcquire, with)
+import Data.Functor ((<$>))
 import Data.IORef (writeIORef, readIORef, newIORef)
 import Control.Exception (throwIO)
 import Control.Monad (when, liftM)
@@ -19,7 +22,7 @@
 import Data.Conduit
 import Control.Monad.Trans.Resource (MonadResource,release)
 
-rawQuery :: (MonadResource m, MonadReader env m, HasPersistBackend env 
SqlBackend)
+rawQuery :: (MonadResource m, MonadReader env m, HasPersistBackend env, 
BaseBackend env ~ SqlBackend)
          => Text
          -> [PersistValue]
          -> Source m [PersistValue]
@@ -30,12 +33,12 @@
     release releaseKey
 
 rawQueryRes
-    :: (MonadIO m1, MonadIO m2)
+    :: (MonadIO m1, MonadIO m2, IsSqlBackend env)
     => Text
     -> [PersistValue]
-    -> ReaderT SqlBackend m1 (Acquire (Source m2 [PersistValue]))
+    -> ReaderT env m1 (Acquire (Source m2 [PersistValue]))
 rawQueryRes sql vals = do
-    conn <- ask
+    conn <- persistBackend `liftM` ask
     let make = do
             runLoggingT (logDebugNS (pack "SQL") $ T.append sql $ pack $ "; " 
++ show vals)
                 (connLogFunc conn)
@@ -53,12 +56,12 @@
 
 -- | Execute a raw SQL statement and return the number of
 -- rows it has modified.
-rawExecuteCount :: MonadIO m
+rawExecuteCount :: (MonadIO m, IsSqlBackend backend)
                 => Text            -- ^ SQL statement, possibly with 
placeholders.
                 -> [PersistValue]  -- ^ Values to fill the placeholders.
-                -> ReaderT SqlBackend m Int64
+                -> ReaderT backend m Int64
 rawExecuteCount sql vals = do
-    conn <- ask
+    conn <- persistBackend `liftM` ask
     runLoggingT (logDebugNS (pack "SQL") $ T.append sql $ pack $ "; " ++ show 
vals)
         (connLogFunc conn)
     stmt <- getStmt sql
@@ -66,9 +69,11 @@
     liftIO $ stmtReset stmt
     return res
 
-getStmt :: MonadIO m => Text -> ReaderT SqlBackend m Statement
+getStmt
+  :: (MonadIO m, IsSqlBackend backend)
+  => Text -> ReaderT backend m Statement
 getStmt sql = do
-    conn <- ask
+    conn <- persistBackend `liftM` ask
     liftIO $ getStmtConn conn sql
 
 getStmtConn :: SqlBackend -> Text -> IO Statement
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/persistent-2.2.4.1/Database/Persist/Sql/Run.hs 
new/persistent-2.6/Database/Persist/Sql/Run.hs
--- old/persistent-2.2.4.1/Database/Persist/Sql/Run.hs  2016-03-08 
09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Sql/Run.hs      2016-07-17 
04:15:37.000000000 +0200
@@ -1,7 +1,10 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 module Database.Persist.Sql.Run where
 
+import Database.Persist.Class.PersistStore
 import Database.Persist.Sql.Types
 import Database.Persist.Sql.Raw
 import Control.Monad.Trans.Control
@@ -24,7 +27,9 @@
 -- Note: This function previously timed out after 2 seconds, but this behavior
 -- was buggy and caused more problems than it solved. Since version 2.1.2, it
 -- performs no timeout checks.
-runSqlPool :: MonadBaseControl IO m => SqlPersistT m a -> Pool SqlBackend -> m 
a
+runSqlPool
+    :: (MonadBaseControl IO m, IsSqlBackend backend)
+    => ReaderT backend m a -> Pool backend -> m a
 runSqlPool r pconn = withResource pconn $ runSqlConn r
 
 -- | Like 'withResource', but times out the operation if resource
@@ -49,37 +54,46 @@
             return ret
 {-# INLINABLE withResourceTimeout #-}
 
-runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> SqlBackend -> m a
+runSqlConn :: (MonadBaseControl IO m, IsSqlBackend backend) => ReaderT backend 
m a -> backend -> m a
 runSqlConn r conn = control $ \runInIO -> mask $ \restore -> do
-    let getter = getStmtConn conn
-    restore $ connBegin conn getter
+    let conn' = persistBackend conn
+        getter = getStmtConn conn'
+    restore $ connBegin conn' getter
     x <- onException
             (restore $ runInIO $ runReaderT r conn)
-            (restore $ connRollback conn getter)
-    restore $ connCommit conn getter
+            (restore $ connRollback conn' getter)
+    restore $ connCommit conn' getter
     return x
 
-runSqlPersistM :: SqlPersistM a -> SqlBackend -> IO a
+runSqlPersistM
+    :: (IsSqlBackend backend)
+    => ReaderT backend (NoLoggingT (ResourceT IO)) a -> backend -> IO a
 runSqlPersistM x conn = runResourceT $ runNoLoggingT $ runSqlConn x conn
 
-runSqlPersistMPool :: SqlPersistM a -> Pool SqlBackend -> IO a
+runSqlPersistMPool
+    :: (IsSqlBackend backend)
+    => ReaderT backend (NoLoggingT (ResourceT IO)) a -> Pool backend -> IO a
 runSqlPersistMPool x pool = runResourceT $ runNoLoggingT $ runSqlPool x pool
 
-liftSqlPersistMPool :: MonadIO m => SqlPersistM a -> Pool SqlBackend -> m a
+liftSqlPersistMPool
+    :: (MonadIO m, IsSqlBackend backend)
+    => ReaderT backend (NoLoggingT (ResourceT IO)) a -> Pool backend -> m a
 liftSqlPersistMPool x pool = liftIO (runSqlPersistMPool x pool)
 
-withSqlPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)
-            => (LogFunc -> IO SqlBackend) -- ^ create a new connection
-            -> Int -- ^ connection count
-            -> (Pool SqlBackend -> m a)
-            -> m a
-withSqlPool mkConn connCount f = do
+withSqlPool
+    :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, IsSqlBackend backend)
+    => (LogFunc -> IO backend) -- ^ create a new connection
+    -> Int -- ^ connection count
+    -> (Pool backend -> m a)
+    -> m a
+withSqlPool mkConn connCount f =
     bracket (createSqlPool mkConn connCount) (liftIO . destroyAllResources) f
 
-createSqlPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)
-              => (LogFunc -> IO SqlBackend)
-              -> Int
-              -> m (Pool SqlBackend)
+createSqlPool
+    :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, IsSqlBackend backend)
+    => (LogFunc -> IO backend)
+    -> Int
+    -> m (Pool backend)
 createSqlPool mkConn size = do
     logFunc <- askLogFunc
     liftIO $ createPool (mkConn logFunc) close' 1 20 size
@@ -99,13 +113,14 @@
         _ <- runInBase (monadLoggerLog a b c d)
         return ()
 
-withSqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m)
-            => (LogFunc -> IO SqlBackend) -> (SqlBackend -> m a) -> m a
+withSqlConn
+    :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsSqlBackend backend)
+    => (LogFunc -> IO backend) -> (backend -> m a) -> m a
 withSqlConn open f = do
     logFunc <- askLogFunc
     bracket (liftIO $ open logFunc) (liftIO . close') f
 
-close' :: SqlBackend -> IO ()
+close' :: (IsSqlBackend backend) => backend -> IO ()
 close' conn = do
-    readIORef (connStmtMap conn) >>= mapM_ stmtFinalize . Map.elems
-    connClose conn
+    readIORef (connStmtMap $ persistBackend conn) >>= mapM_ stmtFinalize . 
Map.elems
+    connClose $ persistBackend conn
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' 
old/persistent-2.2.4.1/Database/Persist/Sql/Types/Internal.hs 
new/persistent-2.6/Database/Persist/Sql/Types/Internal.hs
--- old/persistent-2.2.4.1/Database/Persist/Sql/Types/Internal.hs       
1970-01-01 01:00:00.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Sql/Types/Internal.hs   2016-08-10 
05:20:24.000000000 +0200
@@ -0,0 +1,141 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Database.Persist.Sql.Types.Internal
+    ( HasPersistBackend (..)
+    , IsPersistBackend (..)
+    , SqlReadBackend (unSqlReadBackend)
+    , SqlWriteBackend (unSqlWriteBackend)
+    , readToUnknown
+    , readToWrite
+    , writeToUnknown
+    , LogFunc
+    , InsertSqlResult (..)
+    , Statement (..)
+    , SqlBackend (..)
+    , SqlBackendCanRead
+    , SqlBackendCanWrite
+    , SqlReadT
+    , SqlWriteT
+    , IsSqlBackend
+    ) where
+
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Logger (LogSource, LogLevel)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)
+import Data.Acquire (Acquire)
+import Data.Conduit (Source)
+import Data.Int (Int64)
+import Data.IORef (IORef)
+import Data.Map (Map)
+import Data.Text (Text)
+import Data.Typeable (Typeable)
+import Database.Persist.Class
+  ( HasPersistBackend (..)
+  , PersistQueryRead, PersistQueryWrite
+  , PersistStoreRead, PersistStoreWrite
+  , PersistUniqueRead, PersistUniqueWrite
+  )
+import Database.Persist.Class.PersistStore (IsPersistBackend (..))
+import Database.Persist.Types
+import Language.Haskell.TH.Syntax (Loc)
+import System.Log.FastLogger (LogStr)
+
+type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
+
+data InsertSqlResult = ISRSingle Text
+                     | ISRInsertGet Text Text
+                     | ISRManyKeys Text [PersistValue]
+
+data Statement = Statement
+    { stmtFinalize :: IO ()
+    , stmtReset :: IO ()
+    , stmtExecute :: [PersistValue] -> IO Int64
+    , stmtQuery :: forall m. MonadIO m
+                => [PersistValue]
+                -> Acquire (Source m [PersistValue])
+    }
+
+data SqlBackend = SqlBackend
+    { connPrepare :: Text -> IO Statement
+    -- | table name, column names, id name, either 1 or 2 statements to run
+    , connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult
+    , connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> 
InsertSqlResult) -- ^ SQL for inserting many rows and returning their primary 
keys, for backends that support this functioanlity. If 'Nothing', rows will be 
inserted one-at-a-time using 'connInsertSql'.
+    , connUpsertSql :: Maybe (EntityDef -> Text -> Text)
+    , connStmtMap :: IORef (Map Text Statement)
+    , connClose :: IO ()
+    , connMigrateSql
+        :: [EntityDef]
+        -> (Text -> IO Statement)
+        -> EntityDef
+        -> IO (Either [Text] [(Bool, Text)])
+    , connBegin :: (Text -> IO Statement) -> IO ()
+    , connCommit :: (Text -> IO Statement) -> IO ()
+    , connRollback :: (Text -> IO Statement) -> IO ()
+    , connEscapeName :: DBName -> Text
+    , connNoLimit :: Text
+    , connRDBMS :: Text
+    , connLimitOffset :: (Int,Int) -> Bool -> Text -> Text
+    , connLogFunc :: LogFunc
+    }
+    deriving Typeable
+instance HasPersistBackend SqlBackend where
+    type BaseBackend SqlBackend = SqlBackend
+    persistBackend = id
+instance IsPersistBackend SqlBackend where
+    mkPersistBackend = id
+
+-- | An SQL backend which can only handle read queries
+newtype SqlReadBackend = SqlReadBackend { unSqlReadBackend :: SqlBackend } 
deriving Typeable
+instance HasPersistBackend SqlReadBackend where
+    type BaseBackend SqlReadBackend = SqlBackend
+    persistBackend = unSqlReadBackend
+instance IsPersistBackend SqlReadBackend where
+    mkPersistBackend = SqlReadBackend
+
+-- | An SQL backend which can handle read or write queries
+newtype SqlWriteBackend = SqlWriteBackend { unSqlWriteBackend :: SqlBackend } 
deriving Typeable
+instance HasPersistBackend SqlWriteBackend where
+    type BaseBackend SqlWriteBackend = SqlBackend
+    persistBackend = unSqlWriteBackend
+instance IsPersistBackend SqlWriteBackend where
+    mkPersistBackend = SqlWriteBackend
+
+-- | Useful for running a write query against an untagged backend with unknown 
capabilities.
+writeToUnknown :: Monad m => ReaderT SqlWriteBackend m a -> ReaderT SqlBackend 
m a
+writeToUnknown ma = do
+  unknown <- ask
+  lift . runReaderT ma $ SqlWriteBackend unknown
+
+-- | Useful for running a read query against a backend with read and write 
capabilities.
+readToWrite :: Monad m => ReaderT SqlReadBackend m a -> ReaderT 
SqlWriteBackend m a
+readToWrite ma = do
+  write <- ask
+  lift . runReaderT ma . SqlReadBackend $ unSqlWriteBackend write
+
+-- | Useful for running a read query against a backend with unknown 
capabilities.
+readToUnknown :: Monad m => ReaderT SqlReadBackend m a -> ReaderT SqlBackend m 
a
+readToUnknown ma = do
+  unknown <- ask
+  lift . runReaderT ma $ SqlReadBackend unknown
+
+-- | A constraint synonym which witnesses that a backend is SQL and can run 
read queries.
+type SqlBackendCanRead backend =
+  ( IsSqlBackend backend
+  , PersistQueryRead backend, PersistStoreRead backend, PersistUniqueRead 
backend
+  )
+-- | A constraint synonym which witnesses that a backend is SQL and can run 
read and write queries.
+type SqlBackendCanWrite backend =
+  ( SqlBackendCanRead backend
+  , PersistQueryWrite backend, PersistStoreWrite backend, PersistUniqueWrite 
backend
+  )
+-- | Like @SqlPersistT@ but compatible with any SQL backend which can handle 
read queries.
+type SqlReadT m a = forall backend. (SqlBackendCanRead backend) => ReaderT 
backend m a
+-- | Like @SqlPersistT@ but compatible with any SQL backend which can handle 
read and write queries.
+type SqlWriteT m a = forall backend. (SqlBackendCanWrite backend) => ReaderT 
backend m a
+-- | A backend which is a wrapper around @SqlBackend@.
+type IsSqlBackend backend = (IsPersistBackend backend, BaseBackend backend ~ 
SqlBackend)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/persistent-2.2.4.1/Database/Persist/Sql/Types.hs 
new/persistent-2.6/Database/Persist/Sql/Types.hs
--- old/persistent-2.2.4.1/Database/Persist/Sql/Types.hs        2016-03-08 
09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Sql/Types.hs    2016-07-17 
04:15:37.000000000 +0200
@@ -1,13 +1,21 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-module Database.Persist.Sql.Types where
+module Database.Persist.Sql.Types
+    ( module Database.Persist.Sql.Types
+    , SqlBackend (..), SqlReadBackend (..), SqlWriteBackend (..)
+    , Statement (..), LogFunc, InsertSqlResult (..)
+    , readToUnknown, readToWrite, writeToUnknown
+    , SqlBackendCanRead, SqlBackendCanWrite, SqlReadT, SqlWriteT, IsSqlBackend
+    ) where
 
 import Control.Exception (Exception)
 import Control.Monad.Trans.Resource (ResourceT)
@@ -18,7 +26,7 @@
 import Control.Monad.Trans.Writer (WriterT)
 import Data.Typeable (Typeable)
 import Database.Persist.Types
-import Database.Persist.Class (HasPersistBackend (..))
+import Database.Persist.Sql.Types.Internal
 import Data.IORef (IORef)
 import Data.Map (Map)
 import Data.Int (Int64)
@@ -29,50 +37,10 @@
 import System.Log.FastLogger (LogStr)
 import Data.Text (Text)
 
-data InsertSqlResult = ISRSingle Text
-                     | ISRInsertGet Text Text
-                     | ISRManyKeys Text [PersistValue]
-
 -- | Deprecated synonym for @SqlBackend@.
 type Connection = SqlBackend
 {-# DEPRECATED Connection "Please use SqlBackend instead" #-}
 
-data SqlBackend = SqlBackend
-    { connPrepare :: Text -> IO Statement
-    -- | table name, column names, id name, either 1 or 2 statements to run
-    , connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult
-    , connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> 
InsertSqlResult) -- ^ SQL for inserting many rows and returning their primary 
keys, for backends that support this functioanlity. If 'Nothing', rows will be 
inserted one-at-a-time using 'connInsertSql'.
-    , connStmtMap :: IORef (Map Text Statement)
-    , connClose :: IO ()
-    , connMigrateSql
-        :: [EntityDef]
-        -> (Text -> IO Statement)
-        -> EntityDef
-        -> IO (Either [Text] [(Bool, Text)])
-    , connBegin :: (Text -> IO Statement) -> IO ()
-    , connCommit :: (Text -> IO Statement) -> IO ()
-    , connRollback :: (Text -> IO Statement) -> IO ()
-    , connEscapeName :: DBName -> Text
-    , connNoLimit :: Text
-    , connRDBMS :: Text
-    , connLimitOffset :: (Int,Int) -> Bool -> Text -> Text
-    , connLogFunc :: LogFunc
-    }
-    deriving Typeable
-instance HasPersistBackend SqlBackend SqlBackend where
-    persistBackend = id
-
-type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
-
-data Statement = Statement
-    { stmtFinalize :: IO ()
-    , stmtReset :: IO ()
-    , stmtExecute :: [PersistValue] -> IO Int64
-    , stmtQuery :: forall m. MonadIO m
-                => [PersistValue]
-                -> Acquire (Source m [PersistValue])
-    }
-
 data Column = Column
     { cName      :: !DBName
     , cNull      :: !Bool
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/persistent-2.2.4.1/Database/Persist/Types/Base.hs 
new/persistent-2.6/Database/Persist/Types/Base.hs
--- old/persistent-2.2.4.1/Database/Persist/Types/Base.hs       2016-03-08 
09:18:27.000000000 +0100
+++ new/persistent-2.6/Database/Persist/Types/Base.hs   2016-08-10 
05:20:24.000000000 +0200
@@ -218,8 +218,20 @@
                         _ -> Nothing
                     }
 
+-- Type for storing the Uniqueness constraint in the Schema.
+-- Assume you have the following schema with a uniqueness
+-- constraint:
+-- Person
+--   name String
+--   age Int
+--   UniqueAge age
+--
+-- This will be represented as:
+-- UniqueDef (HaskellName (packPTH "UniqueAge"))
+-- (DBName (packPTH "unique_age")) [(HaskellName (packPTH "age"), DBName 
(packPTH "age"))] []
+--
 data UniqueDef = UniqueDef
-    { uniqueHaskell :: !HaskellName
+    { uniqueHaskell :: !HaskellName 
     , uniqueDBName  :: !DBName
     , uniqueFields  :: ![(HaskellName, DBName)]
     , uniqueAttrs   :: ![Attr]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/persistent-2.2.4.1/persistent.cabal 
new/persistent-2.6/persistent.cabal
--- old/persistent-2.2.4.1/persistent.cabal     2016-03-08 09:18:27.000000000 
+0100
+++ new/persistent-2.6/persistent.cabal 2016-08-10 05:28:57.000000000 +0200
@@ -1,5 +1,5 @@
 name:            persistent
-version:         2.2.4.1
+version:         2.6
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <mich...@snoyman.com>
@@ -60,6 +60,7 @@
                      Database.Persist.Class
                      Database.Persist.Sql
                      Database.Persist.Sql.Util
+                     Database.Persist.Sql.Types.Internal
 
     other-modules:   Database.Persist.Types.Base
                      Database.Persist.Class.DeleteCascade

++++++ persistent.cabal ++++++
name:            persistent
version:         2.6
x-revision: 2
license:         MIT
license-file:    LICENSE
author:          Michael Snoyman <mich...@snoyman.com>
maintainer:      Michael Snoyman <mich...@snoyman.com>, Greg Weber 
<g...@gregweber.info>
synopsis:        Type-safe, multi-backend data serialization.
description:     Hackage documentation generation is not reliable. For up to 
date documentation, please see: <http://www.stackage.org/package/persistent>.
category:        Database, Yesod
stability:       Stable
cabal-version:   >= 1.8
build-type:      Simple
homepage:        http://www.yesodweb.com/book/persistent
bug-reports:     https://github.com/yesodweb/persistent/issues
extra-source-files: ChangeLog.md README.md

flag nooverlap
    default: False
    description: test out our assumption that OverlappingInstances is just for 
String

library
    if flag(nooverlap)
        cpp-options: -DNO_OVERLAP

    build-depends:   base                     >= 4.6       && < 5
                   , bytestring               >= 0.9
                   , transformers             >= 0.2.1
                   , time                     >= 1.1.4
                   , old-locale
                   , text                     >= 0.8
                   , containers               >= 0.2
                   , conduit                  >= 1.0
                   , resourcet                >= 1.1
                   , exceptions               >= 0.6
                   , monad-control            >= 0.3
                   , lifted-base              >= 0.1
                   , resource-pool            >= 0.2.2.0
                   , path-pieces              >= 0.1
                   , http-api-data            >= 0.2       && < 0.4
                   , aeson                    >= 0.5
                   , monad-logger             >= 0.3
                   , transformers-base
                   , base64-bytestring
                   , unordered-containers
                   , vector
                   , attoparsec
                   , template-haskell
                   , blaze-html               >= 0.5
                   , blaze-markup             >= 0.5.1
                   , silently
                   , mtl
                   , fast-logger              >= 2.1
                   , scientific
                   , tagged

    exposed-modules: Database.Persist
                     Database.Persist.Quasi

                     Database.Persist.Types
                     Database.Persist.Class
                     Database.Persist.Sql
                     Database.Persist.Sql.Util
                     Database.Persist.Sql.Types.Internal

    other-modules:   Database.Persist.Types.Base
                     Database.Persist.Class.DeleteCascade
                     Database.Persist.Class.PersistEntity
                     Database.Persist.Class.PersistQuery
                     Database.Persist.Class.PersistUnique
                     Database.Persist.Class.PersistConfig
                     Database.Persist.Class.PersistField
                     Database.Persist.Class.PersistStore

                     Database.Persist.Sql.Migration
                     Database.Persist.Sql.Internal
                     Database.Persist.Sql.Types
                     Database.Persist.Sql.Raw
                     Database.Persist.Sql.Run
                     Database.Persist.Sql.Class
                     Database.Persist.Sql.Orphan.PersistQuery
                     Database.Persist.Sql.Orphan.PersistStore
                     Database.Persist.Sql.Orphan.PersistUnique

    ghc-options:     -Wall

test-suite test
    type:          exitcode-stdio-1.0
    main-is:       test/main.hs

    build-depends:   base >= 4.6 && < 5
                   , hspec >= 1.3
                   , containers
                   , text
                   , unordered-containers
                   , time
                   , old-locale
                   , bytestring
                   , vector
                   , base64-bytestring
                   , attoparsec
                   , transformers
                   , path-pieces
                   , http-api-data            >= 0.2       && < 0.4
                   , aeson
                   , resourcet
                   , monad-logger
                   , conduit
                   , monad-control
                   , blaze-html
                   , scientific
                   , tagged
                   , fast-logger              >= 2.1
                   , lifted-base              >= 0.1
                   , mtl
                   , template-haskell
                   , resource-pool

    cpp-options: -DTEST

source-repository head
  type:     git
  location: git://github.com/yesodweb/persistent.git

Reply via email to