From 7f6ae061daa52e7f5aee9d8bb2ee8e795cff95cf Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 16 Jan 2014 08:24:43 +0200 Subject: [PATCH 1/4] persistent2 --- esqueleto.cabal | 12 +-- src/Database/Esqueleto.hs | 8 +- .../Esqueleto/Internal/PersistentImport.hs | 2 +- src/Database/Esqueleto/Internal/Sql.hs | 95 ++++++++++--------- test/Test.hs | 7 +- 5 files changed, 66 insertions(+), 58 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 93cbbe0..31e2ae8 100644 --- a/esqueleto.cabal +++ b/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-template >= 1.2 && < 1.4 + , persistent-sqlite >= 2.0 && < 2.1 + , 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 diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 65954c4..d6cf63c 100644 --- a/src/Database/Esqueleto.hs +++ b/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 - , PersistMonadBackend m ~ PersistEntityBackend val +deleteKey :: ( PersistStore (PersistEntityBackend val) + , MonadIO m , PersistEntity val ) - => Key val -> m () + => Key val -> ReaderT (PersistEntityBackend val) m () deleteKey = Database.Persist.delete diff --git a/src/Database/Esqueleto/Internal/PersistentImport.hs b/src/Database/Esqueleto/Internal/PersistentImport.hs index be020d3..3132ff4 100644 --- a/src/Database/Esqueleto/Internal/PersistentImport.hs +++ b/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 ) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 660e409..c552e3b 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/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 - , MonadResourceBase m ) + , MonadIO m1 + , MonadIO m2 ) => Mode -> SqlQuery a - -> SqlPersistT m (C.Source (C.ResourceT (SqlPersistT m)) r) -rawSelectSource mode query = src + -> SqlPersistT m1 (Res.Resource (C.Source m2 r)) +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 - , MonadResourceBase m ) + , C.MonadResource m ) => SqlQuery a - -> SqlPersistT m (C.Source (C.ResourceT (SqlPersistT m)) r) -selectSource = rawSelectSource SELECT + -> C.Source (SqlPersistT m) r +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 - , MonadResourceBase m ) + , MonadIO 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 - , MonadResourceBase m ) + , C.MonadResource m ) => SqlQuery a - -> SqlPersistT m (C.Source (C.ResourceT (SqlPersistT m)) r) -selectDistinctSource = rawSelectSource SELECT_DISTINCT + -> C.Source (SqlPersistT m) r +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 - , MonadResourceBase m ) + , MonadIO 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 => - C.Source (C.ResourceT (SqlPersistT m)) r +runSource :: Monad m => + 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 - , MonadResourceBase m ) +rawEsqueleto :: ( MonadIO 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 - , MonadResourceBase m ) +delete :: ( MonadIO m ) => SqlQuery () -> SqlPersistT m () -delete = void . deleteCount +delete = liftM (const ()) . deleteCount -- | Same as 'delete', but returns the number of rows affected. -deleteCount :: ( MonadLogger m - , MonadResourceBase m ) +deleteCount :: ( MonadIO 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 - , MonadResourceBase m +update :: ( MonadIO 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 - , MonadResourceBase m +updateCount :: ( MonadIO 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 diff --git a/test/Test.hs b/test/Test.hs index b084802..ace8342 100644 --- a/test/Test.hs +++ b/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 - , PersistMonadBackend m ~ PersistEntityBackend val + , PersistStore (PersistEntityBackend val) + , MonadIO m , PersistEntity val ) - => val -> m (Entity val) + => val -> ReaderT (PersistEntityBackend val) m (Entity val) insert' v = flip Entity v <$> insert v From d47a1a00e38fadb6cd569013dcc5c2ce327c44f4 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Fri, 18 Apr 2014 14:53:50 +0300 Subject: [PATCH 2/4] resourcet 1.1 --- esqueleto.cabal | 2 +- src/Database/Esqueleto/Internal/Sql.hs | 16 +++++++++------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 31e2ae8..2dfcb67 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -72,7 +72,7 @@ library , monad-logger , conduit - , resourcet + , resourcet >= 1.1 hs-source-dirs: src/ ghc-options: -Wall diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index c552e3b..732dd03 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -64,6 +64,8 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Builder.Int as TLBI +import Data.Acquire (with, allocateAcquire, Acquire) +import Control.Monad.Trans.Resource (MonadResource) import Database.Esqueleto.Internal.Language @@ -523,7 +525,7 @@ rawSelectSource :: ( SqlSelect a r , MonadIO m2 ) => Mode -> SqlQuery a - -> SqlPersistT m1 (Res.Resource (C.Source m2 r)) + -> SqlPersistT m1 (Acquire (C.Source m2 r)) rawSelectSource mode query = do conn <- R.ask @@ -549,13 +551,13 @@ rawSelectSource mode query = -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s -- 'SqlPersistT' monad and return a 'C.Source' of rows. selectSource :: ( SqlSelect a r - , C.MonadResource m ) + , MonadResource m ) => SqlQuery a -> C.Source (SqlPersistT m) r selectSource query = do src <- lift $ do res <- rawSelectSource SELECT query - fmap snd $ Res.allocateResource res + fmap snd $ allocateAcquire res src @@ -606,7 +608,7 @@ select :: ( SqlSelect a r select query = do res <- rawSelectSource SELECT query conn <- R.ask - liftIO $ Res.with res $ flip R.runReaderT conn . runSource + liftIO $ with res $ flip R.runReaderT conn . runSource -- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside @@ -614,13 +616,13 @@ select query = do -- rows. selectDistinctSource :: ( SqlSelect a r - , C.MonadResource m ) + , MonadResource m ) => SqlQuery a -> C.Source (SqlPersistT m) r selectDistinctSource query = do src <- lift $ do res <- rawSelectSource SELECT_DISTINCT query - fmap snd $ Res.allocateResource res + fmap snd $ allocateAcquire res src @@ -632,7 +634,7 @@ selectDistinct :: ( SqlSelect a r selectDistinct query = do res <- rawSelectSource SELECT_DISTINCT query conn <- R.ask - liftIO $ Res.with res $ flip R.runReaderT conn . runSource + liftIO $ with res $ flip R.runReaderT conn . runSource -- | (Internal) Run a 'C.Source' of rows. From 55267dd2d9878f42d0ef05cba0d0cdcb0f16a7b8 Mon Sep 17 00:00:00 2001 From: Emanuel Borsboom Date: Tue, 13 May 2014 15:24:26 -0700 Subject: [PATCH 3/4] Bump upper bounds for base and text --- esqueleto.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 2dfcb67..ed0256e 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -63,8 +63,8 @@ library other-modules: Database.Esqueleto.Internal.PersistentImport build-depends: - base >= 4.5 && < 4.7 - , text == 0.11.* + base >= 4.5 && < 4.8 + , text >= 0.11 && < 1.2 , persistent >= 2.0 && < 2.1 , transformers >= 0.2 , unordered-containers >= 0.2 From 30964d950dbae7340f92e7411ed721e1c4fa18c3 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 27 Aug 2014 11:27:36 +0300 Subject: [PATCH 4/4] More persistent2 updates --- src/Database/Esqueleto.hs | 13 ------------- src/Database/Esqueleto/Internal/PersistentImport.hs | 3 ++- src/Database/Esqueleto/Internal/Sql.hs | 2 +- 3 files changed, 3 insertions(+), 15 deletions(-) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 4c78a71..22b9826 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -79,9 +79,6 @@ module Database.Esqueleto , (<#) , (<&>) - -- * Helpers - , valkey - -- * Re-exports -- $reexports , deleteKey @@ -371,16 +368,6 @@ import qualified Database.Persist ---------------------------------------------------------------------- --- | @valkey i = val (Key (PersistInt64 i))@ --- (). -valkey :: Esqueleto query expr backend => - Int64 -> expr (Value (Key entity)) -valkey = val . Key . PersistInt64 - - ----------------------------------------------------------------------- - - -- | Synonym for 'Database.Persist.Store.delete' that does not -- clash with @esqueleto@'s 'delete'. deleteKey :: ( PersistStore (PersistEntityBackend val) diff --git a/src/Database/Esqueleto/Internal/PersistentImport.hs b/src/Database/Esqueleto/Internal/PersistentImport.hs index 3132ff4..ad193e0 100644 --- a/src/Database/Esqueleto/Internal/PersistentImport.hs +++ b/src/Database/Esqueleto/Internal/PersistentImport.hs @@ -9,4 +9,5 @@ import Database.Persist.Sql hiding , Update(..), delete, deleteWhereCount, updateWhereCount, selectList , selectKeysList, deleteCascadeWhere, (=.), (+=.), (-=.), (*=.), (/=.) , (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.) - , listToJSON, mapToJSON, getPersistMap, limitOffsetOrder, selectSource ) + , listToJSON, mapToJSON, getPersistMap, limitOffsetOrder, selectSource + , update ) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index ad695f6..996e628 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -113,7 +113,7 @@ instance Monoid SideData where -- | A part of a @FROM@ clause. data FromClause = - FromStart Ident (EntityDef SqlType) + FromStart Ident EntityDef | FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool))) | OnClause (SqlExpr (Value Bool))