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

Matt's SQL compatible changes

Browse Source
This commit is contained in:
Chris Allen 2018-02-27 16:47:32 -06:00
commit 52d546f60b
6 changed files with 102 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
esqueleto.cabal
View File

@ -58,14 +58,14 @@ library
base >= 4.8 && < 5.0
, bytestring
, text >= 0.11 && < 1.3
, persistent >= 2.5 && < 2.8
, persistent >= 2.8.0 && < 2.9
, transformers >= 0.2
, unordered-containers >= 0.2
, tagged >= 0.2
, monad-logger
, conduit >= 1.1
, resourcet >= 1.1
, conduit >= 1.3
, resourcet >= 1.2
, time >= 1.5.0.1 && <= 1.8.0.2
, blaze-html
hs-source-dirs: src/
@ -101,6 +101,7 @@ test-suite postgresql
, postgresql-simple >= 0.2
, postgresql-libpq >= 0.6
, persistent-postgresql >= 2.0
-- , persistent-sqlite >= 2.8.0
, persistent-template >= 2.1
, monad-control
, monad-logger >= 0.3

10
src/Database/Esqueleto/Internal/Language.hs
View File

@ -35,6 +35,7 @@ module Database.Esqueleto.Internal.Language
-- * The guts
, JoinKind(..)
, IsJoinKind(..)
, BackendCompatible(..)
, PreprocessedFrom
, From
, FromPreprocess
@ -53,7 +54,6 @@ import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
-- | Finally tagless representation of @esqueleto@'s EDSL.
class (Functor query, Applicative query, Monad query) =>
Esqueleto query expr backend | query -> expr backend, expr -> query backend where
@ -72,12 +72,12 @@ class (Functor query, Applicative query, Monad query) =>
-- @JOIN@.
fromStart
:: ( PersistEntity a
, PersistEntityBackend a ~ backend )
, BackendCompatible backend (PersistEntityBackend a) )
=> query (expr (PreprocessedFrom (expr (Entity a))))
-- | (Internal) Same as 'fromStart', but entity may be missing.
fromStartMaybe
:: ( PersistEntity a
, PersistEntityBackend a ~ backend )
, BackendCompatible backend (PersistEntityBackend a) )
=> query (expr (PreprocessedFrom (expr (Maybe (Entity a)))))
-- | (Internal) Do a @JOIN@.
fromJoin
@ -1047,13 +1047,13 @@ class Esqueleto query expr backend => FromPreprocess query expr backend a where
instance ( Esqueleto query expr backend
, PersistEntity val
, PersistEntityBackend val ~ backend
, BackendCompatible backend (PersistEntityBackend val)
) => FromPreprocess query expr backend (expr (Entity val)) where
fromPreprocess = fromStart
instance ( Esqueleto query expr backend
, PersistEntity val
, PersistEntityBackend val ~ backend
, BackendCompatible backend (PersistEntityBackend val)
) => FromPreprocess query expr backend (expr (Maybe (Entity val))) where
fromPreprocess = fromStartMaybe

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

@ -789,19 +789,20 @@ veryUnsafeCoerceSqlExprValueList EEmptyList = throw (UnexpectedCaseErr EmptySqlE
----------------------------------------------------------------------
-- | (Internal) Execute an @esqueleto@ @SELECT@ 'SqlQuery' inside
-- @persistent@'s 'SqlPersistT' monad.
rawSelectSource :: ( SqlSelect a r
, MonadIO m1
, MonadIO m2 )
, MonadIO m2
)
=> Mode
-> SqlQuery a
-> SqlReadT m1 (Acquire (C.Source m2 r))
rawSelectSource mode query =
do
conn <- persistBackend <$> R.ask
res <- run conn
conn <- projectBackend <$> R.ask
let _ = conn :: SqlBackend
res <- R.withReaderT (const conn) (run conn)
return $ (C.$= massage) `fmap` res
where
@ -823,9 +824,13 @@ rawSelectSource mode query =
-- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
-- 'SqlPersistT' monad and return a 'C.Source' of rows.
selectSource :: ( SqlSelect a r
, MonadResource m )
, BackendCompatible SqlBackend backend
, IsPersistBackend backend
, PersistQueryRead backend
, PersistStoreRead backend, PersistUniqueRead backend
, MonadResource m )
=> SqlQuery a
-> C.Source (SqlPersistT m) r
-> C.Source (R.ReaderT backend m) r
selectSource query = do
res <- lift $ rawSelectSource SELECT query
(key, src) <- lift $ allocateAcquire res
@ -874,7 +879,8 @@ selectSource query = do
-- function composition that the @p@ inside the query is of type
-- @SqlExpr (Entity Person)@.
select :: ( SqlSelect a r
, MonadIO m )
, MonadIO m
)
=> SqlQuery a -> SqlReadT m [r]
select query = do
res <- rawSelectSource SELECT query
@ -915,12 +921,12 @@ runSource src = src C.$$ CL.consume
-- | (Internal) Execute an @esqueleto@ statement inside
-- @persistent@'s 'SqlPersistT' monad.
rawEsqueleto :: ( MonadIO m, SqlSelect a r, IsSqlBackend backend)
rawEsqueleto :: ( MonadIO m, SqlSelect a r, BackendCompatible SqlBackend backend)
=> Mode
-> SqlQuery a
-> R.ReaderT backend m Int64
rawEsqueleto mode query = do
conn <- persistBackend <$> R.ask
conn <- R.ask
uncurry rawExecuteCount $
first builderToText $
toRawSql mode (conn, initialIdentState) query
@ -972,17 +978,29 @@ deleteCount = rawEsqueleto DELETE
-- 'set' p [ PersonAge '=.' 'just' ('val' thisYear) -. p '^.' PersonBorn ]
-- 'where_' $ isNothing (p '^.' PersonAge)
-- @
update :: ( MonadIO m
, SqlEntity val )
=> (SqlExpr (Entity val) -> SqlQuery ())
-> SqlWriteT m ()
update
::
( PersistEntityBackend val ~ backend
, PersistEntity val
, PersistUniqueWrite backend
, PersistQueryWrite backend
, BackendCompatible SqlBackend backend
, PersistEntity val
, MonadIO m
)
=> (SqlExpr (Entity val) -> SqlQuery ())
-> R.ReaderT backend m ()
update = void . updateCount
-- | Same as 'update', but returns the number of rows affected.
updateCount :: ( MonadIO m
, SqlEntity val )
, PersistEntity val
, PersistEntityBackend val ~ backend
, BackendCompatible SqlBackend backend
, PersistQueryWrite backend
, PersistUniqueWrite backend)
=> (SqlExpr (Entity val) -> SqlQuery ())
-> SqlWriteT m Int64
-> R.ReaderT backend m Int64
updateCount = rawEsqueleto UPDATE . from
@ -1002,7 +1020,7 @@ builderToText = TL.toStrict . TLB.toLazyTextWith defaultChunkSize
-- possible but tedious), you may just turn on query logging of
-- @persistent@.
toRawSql
:: (IsSqlBackend backend, SqlSelect a r)
:: (SqlSelect a r, BackendCompatible SqlBackend backend)
=> Mode -> (backend, IdentState) -> SqlQuery a -> (TLB.Builder, [PersistValue])
toRawSql mode (conn, firstIdentState) query =
let ((ret, sd), finalIdentState) =
@ -1022,7 +1040,7 @@ toRawSql mode (conn, firstIdentState) query =
-- that were used) to the subsequent calls. This ensures
-- that no name clashes will occur on subqueries that may
-- appear on the expressions below.
info = (persistBackend conn, finalIdentState)
info = (projectBackend conn, finalIdentState)
in mconcat
[ makeInsertInto info mode ret
, makeSelect info mode distinctClause ret

9
stack-7.10.yaml
View File

@ -1,6 +1,13 @@
flags: {}
packages:
- '.'
- location:
git: https://github.com/parsonsmatt/persistent
commit: a4f21ad5db9b65a5febf79a1be091597210a73ca
subdirs:
- persistent
extra-dep: true
resolver: lts-6.12
extra-deps:
- persistent-2.5
# - persistent-2.7.1

8
stack-8.0.yaml
View File

@ -4,9 +4,17 @@ resolver: lts-8.8
packages:
- '.'
- location:
git: https://github.com/parsonsmatt/persistent
commit: a4f21ad5db9b65a5febf79a1be091597210a73ca
subdirs:
- persistent
extra-dep: true
extra-deps:
- doctest-prop-0.2.0.1
- quickcheck-properties-0.1
# - persistent-2.7.1
# - http-client-0.5.0
# - fail-4.9.0.0
# - http-types-0.9

42
stack-8.2.yaml Normal file
View File

@ -0,0 +1,42 @@
# resolver: nightly-2017-01-10
resolver: lts-10.4
# compiler: ghc-8.0.2
packages:
- '.'
# - location:
# git: https://github.com/yesodweb/persistent
# commit: 4d0a6f3a4abde46c82691414e0e283a933a39f3e
# extra-dep: true
# subdirs:
# - persistent
# - persistent-sqlite
# - location:
# git: https://github.com/snoyberg/conduit
# commit: 7f75bfca8d479e1737861a75437a288af662a3cf
# extra-dep: true
# subdirs:
# - conduit
# - conduit-extra
# - resourcet
extra-deps:
# - doctest-prop-0.2.0.1
# - quickcheck-properties-0.1
# - monad-logger-0.3.28
# - mono-traversable-1.0.8.1
# - typed-process-0.2.1.0
- persistent-2.8.0
- persistent-sqlite-2.8.0
- conduit-1.3.0
- conduit-extra-1.3.0
- resourcet-1.2.0
# - persistent-2.7.1
# - http-client-0.5.0
# - fail-4.9.0.0
# - http-types-0.9
# - attoparsec-0.13.0.1
# - doctest-0.10.1
# - semigroups-0.18.0.1
# - uri-bytestring-0.1.9
# - temporary-resourcet-0.1.0.0