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