Allow esqueleto's functions to be used on top of transformers.

Instead of using SqlPersistT, now it uses MonadSqlPersist.
This commit is contained in:
Felipe Lessa 2014-04-23 11:42:07 -03:00
parent 951f027d68
commit 3bd5c8506a

View File

@ -50,15 +50,13 @@ import Control.Arrow ((***), first)
import Control.Exception (throw, throwIO) import Control.Exception (throw, throwIO)
import Control.Monad ((>=>), ap, void, MonadPlus(..)) import Control.Monad ((>=>), ap, void, MonadPlus(..))
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Resource (runResourceT, ResourceT, MonadResourceBase) import Control.Monad.Trans.Resource (MonadResource)
import Data.Int (Int64) import Data.Int (Int64)
import Data.List (intersperse) import Data.List (intersperse)
import Data.Monoid (Monoid(..), (<>)) import Data.Monoid (Monoid(..), (<>))
import Data.Proxy (Proxy(..)) import Data.Proxy (Proxy(..))
import Database.Esqueleto.Internal.PersistentImport import Database.Esqueleto.Internal.PersistentImport
import qualified Control.Monad.Trans.Reader as R
import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.State as S
import qualified Control.Monad.Trans.Writer as W import qualified Control.Monad.Trans.Writer as W
import qualified Data.Conduit as C import qualified Data.Conduit as C
@ -543,15 +541,15 @@ veryUnsafeCoerceSqlExprValueList EEmptyList =
-- | (Internal) Execute an @esqueleto@ @SELECT@ 'SqlQuery' inside -- | (Internal) Execute an @esqueleto@ @SELECT@ 'SqlQuery' inside
-- @persistent@'s 'SqlPersistT' monad. -- @persistent@'s 'SqlPersistT' monad.
rawSelectSource :: ( SqlSelect a r rawSelectSource :: ( SqlSelect a r
, MonadLogger m , MonadResource m
, MonadResourceBase m ) , MonadSqlPersist m )
=> Mode => Mode
-> SqlQuery a -> SqlQuery a
-> SqlPersistT m (C.Source (ResourceT (SqlPersistT m)) r) -> m (C.Source m r)
rawSelectSource mode query = src rawSelectSource mode query = src
where where
src = do src = do
conn <- SqlPersistT R.ask conn <- askSqlConn
return $ run conn C.$= massage return $ run conn C.$= massage
run conn = run conn =
@ -572,10 +570,10 @@ rawSelectSource mode query = src
-- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
-- 'SqlPersistT' monad and return a 'C.Source' of rows. -- 'SqlPersistT' monad and return a 'C.Source' of rows.
selectSource :: ( SqlSelect a r selectSource :: ( SqlSelect a r
, MonadLogger m , MonadResource m
, MonadResourceBase m ) , MonadSqlPersist m )
=> SqlQuery a => SqlQuery a
-> SqlPersistT m (C.Source (ResourceT (SqlPersistT m)) r) -> m (C.Source m r)
selectSource = rawSelectSource SELECT selectSource = rawSelectSource SELECT
@ -621,9 +619,9 @@ selectSource = rawSelectSource SELECT
-- function composition that the @p@ inside the query is of type -- function composition that the @p@ inside the query is of type
-- @SqlExpr (Entity Person)@. -- @SqlExpr (Entity Person)@.
select :: ( SqlSelect a r select :: ( SqlSelect a r
, MonadLogger m , MonadResource m
, MonadResourceBase m ) , MonadSqlPersist m )
=> SqlQuery a -> SqlPersistT m [r] => SqlQuery a -> m [r]
select = selectSource >=> runSource select = selectSource >=> runSource
@ -632,27 +630,27 @@ select = selectSource >=> runSource
-- rows. -- rows.
selectDistinctSource selectDistinctSource
:: ( SqlSelect a r :: ( SqlSelect a r
, MonadLogger m , MonadResource m
, MonadResourceBase m ) , MonadSqlPersist m )
=> SqlQuery a => SqlQuery a
-> SqlPersistT m (C.Source (ResourceT (SqlPersistT m)) r) -> m (C.Source m r)
selectDistinctSource = rawSelectSource SELECT_DISTINCT selectDistinctSource = rawSelectSource SELECT_DISTINCT
-- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside -- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside
-- @persistent@'s 'SqlPersistT' monad and return a list of rows. -- @persistent@'s 'SqlPersistT' monad and return a list of rows.
selectDistinct :: ( SqlSelect a r selectDistinct :: ( SqlSelect a r
, MonadLogger m , MonadResource m
, MonadResourceBase m ) , MonadSqlPersist m )
=> SqlQuery a -> SqlPersistT m [r] => SqlQuery a -> m [r]
selectDistinct = selectDistinctSource >=> runSource selectDistinct = selectDistinctSource >=> runSource
-- | (Internal) Run a 'C.Source' of rows. -- | (Internal) Run a 'C.Source' of rows.
runSource :: MonadResourceBase m => runSource :: MonadResource m =>
C.Source (ResourceT (SqlPersistT m)) r C.Source m r
-> SqlPersistT m [r] -> m [r]
runSource src = runResourceT $ src C.$$ CL.consume runSource src = src C.$$ CL.consume
---------------------------------------------------------------------- ----------------------------------------------------------------------
@ -660,14 +658,14 @@ runSource src = runResourceT $ src C.$$ CL.consume
-- | (Internal) Execute an @esqueleto@ statement inside -- | (Internal) Execute an @esqueleto@ statement inside
-- @persistent@'s 'SqlPersistT' monad. -- @persistent@'s 'SqlPersistT' monad.
rawEsqueleto :: ( MonadLogger m rawEsqueleto :: ( MonadResource m
, MonadResourceBase m , MonadSqlPersist m
, SqlSelect a r ) , SqlSelect a r )
=> Mode => Mode
-> SqlQuery a -> SqlQuery a
-> SqlPersistT m Int64 -> m Int64
rawEsqueleto mode query = do rawEsqueleto mode query = do
conn <- SqlPersistT R.ask conn <- askSqlConn
uncurry rawExecuteCount $ uncurry rawExecuteCount $
first builderToText $ first builderToText $
toRawSql mode (conn, initialIdentState) query toRawSql mode (conn, initialIdentState) query
@ -695,18 +693,18 @@ rawEsqueleto mode query = do
-- from $ \\(appointment :: SqlExpr (Entity Appointment)) -> -- from $ \\(appointment :: SqlExpr (Entity Appointment)) ->
-- return () -- return ()
-- @ -- @
delete :: ( MonadLogger m delete :: ( MonadResource m
, MonadResourceBase m ) , MonadSqlPersist m )
=> SqlQuery () => SqlQuery ()
-> SqlPersistT m () -> m ()
delete = void . deleteCount delete = void . deleteCount
-- | Same as 'delete', but returns the number of rows affected. -- | Same as 'delete', but returns the number of rows affected.
deleteCount :: ( MonadLogger m deleteCount :: ( MonadResource m
, MonadResourceBase m ) , MonadSqlPersist m )
=> SqlQuery () => SqlQuery ()
-> SqlPersistT m Int64 -> m Int64
deleteCount = rawEsqueleto DELETE deleteCount = rawEsqueleto DELETE
@ -722,38 +720,38 @@ deleteCount = rawEsqueleto DELETE
-- set p [ PersonAge =. just (val thisYear) -. p ^. PersonBorn ] -- set p [ PersonAge =. just (val thisYear) -. p ^. PersonBorn ]
-- where_ $ isNull (p ^. PersonAge) -- where_ $ isNull (p ^. PersonAge)
-- @ -- @
update :: ( MonadLogger m update :: ( MonadResource m
, MonadResourceBase m , MonadSqlPersist m
, SqlEntity val ) , SqlEntity val )
=> (SqlExpr (Entity val) -> SqlQuery ()) => (SqlExpr (Entity val) -> SqlQuery ())
-> SqlPersistT m () -> m ()
update = void . updateCount update = void . updateCount
-- | Same as 'update', but returns the number of rows affected. -- | Same as 'update', but returns the number of rows affected.
updateCount :: ( MonadLogger m updateCount :: ( MonadResource m
, MonadResourceBase m , MonadSqlPersist m
, SqlEntity val ) , SqlEntity val )
=> (SqlExpr (Entity val) -> SqlQuery ()) => (SqlExpr (Entity val) -> SqlQuery ())
-> SqlPersistT m Int64 -> m Int64
updateCount = rawEsqueleto UPDATE . from updateCount = rawEsqueleto UPDATE . from
-- | Insert a 'PersistField' for every selected value. -- | Insert a 'PersistField' for every selected value.
insertSelect :: ( MonadLogger m insertSelect :: ( MonadResource m
, MonadResourceBase m , MonadSqlPersist m
, PersistEntity a ) , PersistEntity a )
=> SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () => SqlQuery (SqlExpr (Insertion a)) -> m ()
insertSelect = insertSelect =
void . rawEsqueleto (INSERT_INTO SELECT) . fmap EInsertFinal void . rawEsqueleto (INSERT_INTO SELECT) . fmap EInsertFinal
-- | Insert a 'PersistField' for every unique selected value. -- | Insert a 'PersistField' for every unique selected value.
insertSelectDistinct insertSelectDistinct
:: ( MonadLogger m :: ( MonadResource m
, MonadResourceBase m , MonadSqlPersist m
, PersistEntity a ) , PersistEntity a )
=> SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () => SqlQuery (SqlExpr (Insertion a)) -> m ()
insertSelectDistinct = insertSelectDistinct =
void . rawEsqueleto (INSERT_INTO SELECT_DISTINCT) . fmap EInsertFinal void . rawEsqueleto (INSERT_INTO SELECT_DISTINCT) . fmap EInsertFinal