haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

persistent2

Browse Source
This commit is contained in:
Michael Snoyman 2014-01-16 08:24:43 +02:00
parent 646c115257
commit 7f6ae061da
5 changed files with 66 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
esqueleto.cabal
View File

@ -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

8
src/Database/Esqueleto.hs
View File

@ -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

2
src/Database/Esqueleto/Internal/PersistentImport.hs
View File

@ -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 )

95
src/Database/Esqueleto/Internal/Sql.hs
View File

@ -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

7
test/Test.hs
View File

@ -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