Allow esqueleto's functions to be used on top of transformers.
Instead of using SqlPersistT, now it uses MonadSqlPersist.
This commit is contained in:
parent
951f027d68
commit
3bd5c8506a
@ -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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user