diff --git a/esqueleto.cabal b/esqueleto.cabal index 9b16d89..8412ac6 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -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 diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index f3ed0d0..3017b6c 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -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 diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 5600fdd..f7cd378 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -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 diff --git a/stack-7.10.yaml b/stack-7.10.yaml index f3e0bd7..3db00fd 100644 --- a/stack-7.10.yaml +++ b/stack-7.10.yaml @@ -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 diff --git a/stack-8.0.yaml b/stack-8.0.yaml index 5b854e7..4f41cf0 100644 --- a/stack-8.0.yaml +++ b/stack-8.0.yaml @@ -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 diff --git a/stack-8.2.yaml b/stack-8.2.yaml new file mode 100644 index 0000000..57b8420 --- /dev/null +++ b/stack-8.2.yaml @@ -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