diff --git a/esqueleto.cabal b/esqueleto.cabal index e98e702..87ef124 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.4.4 +version: 2.0.0 synopsis: Type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/prowdsponsor/esqueleto license: BSD3 @@ -63,15 +63,15 @@ library Database.Esqueleto.Internal.PersistentImport build-depends: base >= 4.5 && < 4.8 - , text >= 0.11 - , persistent >= 1.3 && < 1.4 + , text >= 0.11 && < 1.2 + , persistent >= 2.0.2 && < 2.1 , transformers >= 0.2 , unordered-containers >= 0.2 , tagged >= 0.2 , monad-logger , conduit >= 1.1 - , resourcet + , resourcet >= 1.1 hs-source-dirs: src/ ghc-options: -Wall @@ -91,8 +91,8 @@ test-suite test , HUnit , QuickCheck , hspec >= 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,14 +103,14 @@ 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 if flag(mysql) 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 113a67a..aa45254 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -90,6 +90,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 @@ -373,9 +375,9 @@ import qualified Database.Persist -- | @valkey i = val (Key (PersistInt64 i))@ -- (). -valkey :: Esqueleto query expr backend => +valkey :: (Esqueleto query expr backend, IsSqlKey (Key entity), PersistField (Key entity)) => Int64 -> expr (Value (Key entity)) -valkey = val . Key . PersistInt64 +valkey = val . toSqlKey -- | @valJ@ is like @val@ but for something that is already a @Value@. The use @@ -388,7 +390,7 @@ valkey = val . Key . PersistInt64 -- (). -- -- /Since: 1.4.2/ -valJ :: Esqueleto query expr backend => +valJ :: (Esqueleto query expr backend, PersistField (Key entity)) => Value (Key entity) -> expr (Value (Key entity)) valJ = val . unValue @@ -398,8 +400,8 @@ valJ = val . unValue -- | 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..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 ) + , listToJSON, mapToJSON, getPersistMap, limitOffsetOrder, selectSource + , update ) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index f5351a5..153a9d9 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -48,10 +48,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.Trans.Class (lift) -import Control.Monad.Trans.Resource (MonadResource) +import qualified Control.Monad.Trans.Reader as R import Data.Int (Int64) import Data.List (intersperse) import Data.Monoid (Monoid(..), (<>)) @@ -65,6 +65,8 @@ import qualified Data.HashSet as HS import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB +import Data.Acquire (with, allocateAcquire, Acquire) +import Control.Monad.Trans.Resource (MonadResource) import Database.Esqueleto.Internal.Language @@ -111,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)) @@ -544,19 +546,20 @@ veryUnsafeCoerceSqlExprValueList EEmptyList = -- | (Internal) Execute an @esqueleto@ @SELECT@ 'SqlQuery' inside -- @persistent@'s 'SqlPersistT' monad. rawSelectSource :: ( SqlSelect a r - , MonadResource m - , MonadSqlPersist m ) + , MonadIO m1 + , MonadIO m2 ) => Mode -> SqlQuery a - -> m (C.Source m r) -rawSelectSource mode query = src + -> SqlPersistT m1 (Acquire (C.Source m2 r)) +rawSelectSource mode query = + do + conn <- R.ask + res <- run conn + return $ (C.$= massage) `fmap` res where - src = do - conn <- askSqlConn - return $ run conn C.$= massage run conn = - uncurry rawQuery $ + uncurry rawQueryRes $ first builderToText $ toRawSql mode (conn, initialIdentState) query @@ -573,11 +576,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 - , MonadResource m - , MonadSqlPersist m ) + , MonadResource m ) => SqlQuery a - -> m (C.Source m r) -selectSource = rawSelectSource SELECT + -> C.Source (SqlPersistT m) r +selectSource query = do + src <- lift $ do + res <- rawSelectSource SELECT query + fmap snd $ allocateAcquire res + src -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s @@ -622,10 +628,12 @@ selectSource = rawSelectSource SELECT -- function composition that the @p@ inside the query is of type -- @SqlExpr (Entity Person)@. select :: ( SqlSelect a r - , MonadResource m - , MonadSqlPersist m ) - => SqlQuery a -> m [r] -select = selectSource >=> runSource + , MonadIO m ) + => SqlQuery a -> SqlPersistT m [r] +select query = do + res <- rawSelectSource SELECT query + conn <- R.ask + liftIO $ with res $ flip R.runReaderT conn . runSource -- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside @@ -633,26 +641,31 @@ select = selectSource >=> runSource -- rows. selectDistinctSource :: ( SqlSelect a r - , MonadResource m - , MonadSqlPersist m ) + , MonadResource m ) => SqlQuery a - -> m (C.Source m r) -selectDistinctSource = rawSelectSource SELECT_DISTINCT + -> C.Source (SqlPersistT m) r +selectDistinctSource query = do + src <- lift $ do + res <- rawSelectSource SELECT_DISTINCT query + fmap snd $ allocateAcquire res + src -- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside -- @persistent@'s 'SqlPersistT' monad and return a list of rows. selectDistinct :: ( SqlSelect a r - , MonadResource m - , MonadSqlPersist m ) - => SqlQuery a -> m [r] -selectDistinct = selectDistinctSource >=> runSource + , MonadIO m ) + => SqlQuery a -> SqlPersistT m [r] +selectDistinct query = do + res <- rawSelectSource SELECT_DISTINCT query + conn <- R.ask + liftIO $ with res $ flip R.runReaderT conn . runSource -- | (Internal) Run a 'C.Source' of rows. -runSource :: MonadResource m => - C.Source m r - -> m [r] +runSource :: Monad m => + C.Source (SqlPersistT m) r + -> SqlPersistT m [r] runSource src = src C.$$ CL.consume @@ -661,14 +674,12 @@ runSource src = src C.$$ CL.consume -- | (Internal) Execute an @esqueleto@ statement inside -- @persistent@'s 'SqlPersistT' monad. -rawEsqueleto :: ( MonadResource m - , MonadSqlPersist m - , SqlSelect a r ) +rawEsqueleto :: ( MonadIO m, SqlSelect a r ) => Mode -> SqlQuery a - -> m Int64 + -> SqlPersistT m Int64 rawEsqueleto mode query = do - conn <- askSqlConn + conn <- R.ask uncurry rawExecuteCount $ first builderToText $ toRawSql mode (conn, initialIdentState) query @@ -696,18 +707,16 @@ rawEsqueleto mode query = do -- from $ \\(appointment :: SqlExpr (Entity Appointment)) -> -- return () -- @ -delete :: ( MonadResource m - , MonadSqlPersist m ) +delete :: ( MonadIO m ) => SqlQuery () - -> m () -delete = void . deleteCount + -> SqlPersistT m () +delete = liftM (const ()) . deleteCount -- | Same as 'delete', but returns the number of rows affected. -deleteCount :: ( MonadResource m - , MonadSqlPersist m ) +deleteCount :: ( MonadIO m ) => SqlQuery () - -> m Int64 + -> SqlPersistT m Int64 deleteCount = rawEsqueleto DELETE @@ -723,42 +732,21 @@ deleteCount = rawEsqueleto DELETE -- set p [ PersonAge =. just (val thisYear) -. p ^. PersonBorn ] -- where_ $ isNothing (p ^. PersonAge) -- @ -update :: ( MonadResource m - , MonadSqlPersist m +update :: ( MonadIO m , SqlEntity val ) => (SqlExpr (Entity val) -> SqlQuery ()) - -> m () -update = void . updateCount + -> SqlPersistT m () +update = liftM (const ()) . updateCount -- | Same as 'update', but returns the number of rows affected. -updateCount :: ( MonadResource m - , MonadSqlPersist m +updateCount :: ( MonadIO m , SqlEntity val ) => (SqlExpr (Entity val) -> SqlQuery ()) - -> m Int64 + -> SqlPersistT m Int64 updateCount = rawEsqueleto UPDATE . from --- | Insert a 'PersistField' for every selected value. -insertSelect :: ( MonadResource m - , MonadSqlPersist m - , PersistEntity a ) - => SqlQuery (SqlExpr (Insertion a)) -> m () -insertSelect = - void . rawEsqueleto (INSERT_INTO SELECT) . fmap EInsertFinal - - --- | Insert a 'PersistField' for every unique selected value. -insertSelectDistinct - :: ( MonadResource m - , MonadSqlPersist m - , PersistEntity a ) - => SqlQuery (SqlExpr (Insertion a)) -> m () -insertSelectDistinct = - void . rawEsqueleto (INSERT_INTO SELECT_DISTINCT) . fmap EInsertFinal - - ---------------------------------------------------------------------- @@ -1515,3 +1503,21 @@ from16P = const Proxy 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,l,m,n,o,p) 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,l,m,n,o,p) + + +-- | Insert a 'PersistField' for every selected value. +insertSelect :: (MonadIO m, PersistEntity a) => + SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () +insertSelect = insertGeneralSelect SELECT + + +-- | Insert a 'PersistField' for every unique selected value. +insertSelectDistinct :: (MonadIO m, PersistEntity a) => + SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () +insertSelectDistinct = insertGeneralSelect SELECT_DISTINCT + + +insertGeneralSelect :: (MonadIO m, PersistEntity a) => + Mode -> SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () +insertGeneralSelect mode = + liftM (const ()) . rawEsqueleto (INSERT_INTO mode) . fmap EInsertFinal diff --git a/test/Test.hs b/test/Test.hs index 0ed8a23..7921272 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -20,6 +20,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 #if defined (WITH_POSTGRESQL) import Database.Persist.Postgresql (withPostgresqlConn) @@ -865,10 +866,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