Matt's SQL compatible changes

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
+    , conduit              >= 1.3
-    , resourcet            >= 1.1
+    , 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

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
 

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
+        conn <- projectBackend <$> R.ask
-        res <- run conn
+        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
+update
-          , SqlEntity val )
+  ::
-       => (SqlExpr (Entity val) -> SqlQuery ())
+  ( PersistEntityBackend val ~ backend
-       -> SqlWriteT m ()
+  , 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

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

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

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