persistent2

esqueleto.cabal

@@ -1,5 +1,5 @@
 name:                esqueleto
-version:             1.3.4.2
+version:             2.0.0
 synopsis:            Bare bones, type-safe EDSL for SQL queries on persistent backends.
 homepage:            https://github.com/meteficha/esqueleto
 license:             BSD3
@@ -65,7 +65,7 @@ library
   build-depends:
       base                 >= 4.5    && < 4.7
     , text                 == 0.11.*
-    , persistent           >= 1.2    && < 1.4
+    , persistent           >= 2.0    && < 2.1
     , transformers         >= 0.2
     , unordered-containers >= 0.2
     , tagged               >= 0.2
@@ -91,8 +91,8 @@ test-suite test
     , HUnit
     , QuickCheck
     , hspec               >= 1.3 && < 1.8
-    , persistent-sqlite   >= 1.2 && < 1.4
+    , persistent-sqlite   >= 2.0 && < 2.1
-    , persistent-template >= 1.2 && < 1.4
+    , persistent-template >= 2.0 && < 2.1
     , monad-control
     , monad-logger        >= 0.3
 
@@ -103,7 +103,7 @@ test-suite test
     build-depends:
         postgresql-simple     >= 0.2
       , postgresql-libpq      >= 0.6
-      , persistent-postgresql >= 1.2.0
+      , persistent-postgresql >= 2.0
     
     cpp-options: -DWITH_POSTGRESQL
 
@@ -111,7 +111,7 @@ test-suite test
     build-depends:
         mysql-simple          >= 0.2.2.3
       , mysql                 >= 0.1.1.3
-      , persistent-mysql      >= 1.2.0
+      , persistent-mysql      >= 2.0
 
     cpp-options: -DWITH_MYSQL
 

src/Database/Esqueleto.hs

@@ -87,6 +87,8 @@ module Database.Esqueleto
   , module Database.Esqueleto.Internal.PersistentImport
   ) where
 
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Trans.Reader (ReaderT)
 import Data.Int (Int64)
 import Database.Esqueleto.Internal.Language
 import Database.Esqueleto.Internal.Sql
@@ -380,8 +382,8 @@ valkey = val . Key . PersistInt64
 
 -- | Synonym for 'Database.Persist.Store.delete' that does not
 -- clash with @esqueleto@'s 'delete'.
-deleteKey :: ( PersistStore m
+deleteKey :: ( PersistStore (PersistEntityBackend val)
-             , PersistMonadBackend m ~ PersistEntityBackend val
+             , MonadIO m
              , PersistEntity val )
-          => Key val -> m ()
+          => Key val -> ReaderT (PersistEntityBackend val) m ()
 deleteKey = Database.Persist.delete

src/Database/Esqueleto/Internal/PersistentImport.hs

@@ -9,4 +9,4 @@ import Database.Persist.Sql hiding
   , Update(..), delete, deleteWhereCount, updateWhereCount, selectList
   , selectKeysList, deleteCascadeWhere, (=.), (+=.), (-=.), (*=.), (/=.)
   , (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.)
-  , listToJSON, mapToJSON, getPersistMap, limitOffsetOrder )
+  , listToJSON, mapToJSON, getPersistMap, limitOffsetOrder, selectSource )

src/Database/Esqueleto/Internal/Sql.hs

@@ -45,11 +45,10 @@ module Database.Esqueleto.Internal.Sql
 import Control.Applicative (Applicative(..), (<$>), (<$))
 import Control.Arrow ((***), first)
 import Control.Exception (throw, throwIO)
-import Control.Monad ((>=>), ap, void, MonadPlus(..))
+import Control.Monad (ap, MonadPlus(..), liftM)
 import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Logger (MonadLogger)
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Resource (MonadResourceBase)
+import qualified Control.Monad.Trans.Resource as Res
 import Data.Int (Int64)
 import Data.List (intersperse)
 import Data.Monoid (Monoid(..), (<>))
@@ -520,19 +519,20 @@ veryUnsafeCoerceSqlExprValueList EEmptyList =
 -- | (Internal) Execute an @esqueleto@ @SELECT@ 'SqlQuery' inside
 -- @persistent@'s 'SqlPersistT' monad.
 rawSelectSource :: ( SqlSelect a r
-                   , MonadLogger m
+                   , MonadIO m1
-                   , MonadResourceBase m )
+                   , MonadIO m2 )
                  => Mode
                  -> SqlQuery a
-                 -> SqlPersistT m (C.Source (C.ResourceT (SqlPersistT m)) r)
+                 -> SqlPersistT m1 (Res.Resource (C.Source m2 r))
-rawSelectSource mode query = src
+rawSelectSource mode query =
+      do
+        conn <- R.ask
+        res <- run conn
+        return $ (C.$= massage) `fmap` res
     where
-      src = do
-        conn <- SqlPersistT R.ask
-        return $ run conn C.$= massage
 
       run conn =
-        uncurry rawQuery $
+        uncurry rawQueryRes $
         first builderToText $
         toRawSql mode pureQuery (conn, initialIdentState) query
 
@@ -549,11 +549,14 @@ rawSelectSource mode query = src
 -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
 -- 'SqlPersistT' monad and return a 'C.Source' of rows.
 selectSource :: ( SqlSelect a r
-                , MonadLogger m
+                , C.MonadResource m )
-                , MonadResourceBase m )
              => SqlQuery a
-             -> SqlPersistT m (C.Source (C.ResourceT (SqlPersistT m)) r)
+             -> C.Source (SqlPersistT m) r
-selectSource = rawSelectSource SELECT
+selectSource query = do
+    src <- lift $ do
+        res <- rawSelectSource SELECT query
+        fmap snd $ Res.allocateResource res
+    src
 
 
 -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
@@ -598,10 +601,12 @@ selectSource = rawSelectSource SELECT
 -- function composition that the @p@ inside the query is of type
 -- @SqlExpr (Entity Person)@.
 select :: ( SqlSelect a r
-          , MonadLogger m
+          , MonadIO m )
-          , MonadResourceBase m )
        => SqlQuery a -> SqlPersistT m [r]
-select = selectSource >=> runSource
+select query = do
+    res <- rawSelectSource SELECT query
+    conn <- R.ask
+    liftIO $ Res.with res $ flip R.runReaderT conn . runSource
 
 
 -- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside
@@ -609,27 +614,32 @@ select = selectSource >=> runSource
 -- rows.
 selectDistinctSource
   :: ( SqlSelect a r
-     , MonadLogger m
+     , C.MonadResource m )
-     , MonadResourceBase m )
   => SqlQuery a
-  -> SqlPersistT m (C.Source (C.ResourceT (SqlPersistT m)) r)
+  -> C.Source (SqlPersistT m) r
-selectDistinctSource = rawSelectSource SELECT_DISTINCT
+selectDistinctSource query = do
+    src <- lift $ do
+        res <- rawSelectSource SELECT_DISTINCT query
+        fmap snd $ Res.allocateResource res
+    src
 
 
 -- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside
 -- @persistent@'s 'SqlPersistT' monad and return a list of rows.
 selectDistinct :: ( SqlSelect a r
-                  , MonadLogger m
+                  , MonadIO m )
-                  , MonadResourceBase m )
                => SqlQuery a -> SqlPersistT m [r]
-selectDistinct = selectDistinctSource >=> runSource
+selectDistinct query = do
+    res <- rawSelectSource SELECT_DISTINCT query
+    conn <- R.ask
+    liftIO $ Res.with res $ flip R.runReaderT conn . runSource
 
 
 -- | (Internal) Run a 'C.Source' of rows.
-runSource :: MonadResourceBase m =>
+runSource :: Monad m =>
-             C.Source (C.ResourceT (SqlPersistT m)) r
+             C.Source (SqlPersistT m) r
           -> SqlPersistT m [r]
-runSource src = C.runResourceT $ src C.$$ CL.consume
+runSource src = src C.$$ CL.consume
 
 
 ----------------------------------------------------------------------
@@ -637,13 +647,12 @@ runSource src = C.runResourceT $ src C.$$ CL.consume
 
 -- | (Internal) Execute an @esqueleto@ statement inside
 -- @persistent@'s 'SqlPersistT' monad.
-rawEsqueleto :: ( MonadLogger m
+rawEsqueleto :: ( MonadIO m )
-              , MonadResourceBase m )
            => Mode
            -> SqlQuery ()
            -> SqlPersistT m Int64
 rawEsqueleto mode query = do
-  conn <- SqlPersistT R.ask
+  conn <- R.ask
   uncurry rawExecuteCount $
     first builderToText $
     toRawSql mode pureQuery (conn, initialIdentState) query
@@ -671,16 +680,14 @@ rawEsqueleto mode query = do
 -- from $ \\(appointment :: SqlExpr (Entity Appointment)) ->
 -- return ()
 -- @
-delete :: ( MonadLogger m
+delete :: ( MonadIO m )
-          , MonadResourceBase m )
        => SqlQuery ()
        -> SqlPersistT m ()
-delete = void . deleteCount
+delete = liftM (const ()) . deleteCount
 
 
 -- | Same as 'delete', but returns the number of rows affected.
-deleteCount :: ( MonadLogger m
+deleteCount :: ( MonadIO m )
-               , MonadResourceBase m )
             => SqlQuery ()
             -> SqlPersistT m Int64
 deleteCount = rawEsqueleto DELETE
@@ -698,17 +705,15 @@ deleteCount = rawEsqueleto DELETE
 -- set p [ PersonAge =. just (val thisYear) -. p ^. PersonBorn ]
 -- where_ $ isNull (p ^. PersonAge)
 -- @
-update :: ( MonadLogger m
+update :: ( MonadIO m
-          , MonadResourceBase m
           , SqlEntity val )
        => (SqlExpr (Entity val) -> SqlQuery ())
        -> SqlPersistT m ()
-update = void . updateCount
+update = liftM (const ()) . updateCount
 
 
 -- | Same as 'update', but returns the number of rows affected.
-updateCount :: ( MonadLogger m
+updateCount :: ( MonadIO m
-               , MonadResourceBase m
                , SqlEntity val )
             => (SqlExpr (Entity val) -> SqlQuery ())
             -> SqlPersistT m Int64
@@ -1473,19 +1478,19 @@ to16 ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) = (a,b,c,d,e,f,g,h,i,j,k,
 
 
 -- | Insert a 'PersistField' for every selected value.
-insertSelect :: (MonadLogger m, MonadResourceBase m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) =>
+insertSelect :: (MonadIO m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) =>
   SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m ()
 insertSelect = insertGeneralSelect SELECT
 
 
 -- | Insert a 'PersistField' for every unique selected value.
-insertSelectDistinct :: (MonadLogger m, MonadResourceBase m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) =>
+insertSelectDistinct :: (MonadIO m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) =>
   SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m ()
 insertSelectDistinct = insertGeneralSelect SELECT_DISTINCT
 
 
-insertGeneralSelect :: (MonadLogger m, MonadResourceBase m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) =>
+insertGeneralSelect :: (MonadIO m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) =>
   Mode -> SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m ()
 insertGeneralSelect mode query = do
-  conn <- SqlPersistT R.ask
+  conn <- R.ask
   uncurry rawExecute $ first builderToText $ toRawSql mode insertQuery (conn, initialIdentState) query

test/Test.hs

@@ -19,6 +19,7 @@ import Control.Monad (replicateM, replicateM_)
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT)
 import Control.Monad.Trans.Control (MonadBaseControl(..))
+import Control.Monad.Trans.Reader (ReaderT)
 import Database.Esqueleto
 import Database.Persist.Sqlite (withSqliteConn)
 #if   defined (WITH_POSTGRESQL)
@@ -793,10 +794,10 @@ main = do
 
 
 insert' :: ( Functor m
-           , PersistStore m
+           , PersistStore (PersistEntityBackend val)
-           , PersistMonadBackend m ~ PersistEntityBackend val
+           , MonadIO m
            , PersistEntity val )
-        => val -> m (Entity val)
+        => val -> ReaderT (PersistEntityBackend val) m (Entity val)
 insert' v = flip Entity v <$> insert v