Merge remote-tracking branch 'upstream/master' into explode-from-gadt

.github/workflows/haskell.yml

@@ -38,7 +38,7 @@ jobs:
       CONFIG: "--enable-tests --enable-benchmarks "
     steps:
       - uses: actions/checkout@v2
-      - uses: actions/setup-haskell@v1.1.2
+      - uses: actions/setup-haskell@v1.1.4
         id: setup-haskell-cabal
         with:
           ghc-version: ${{ matrix.ghc }}

cabal.project

@@ -0,0 +1 @@
+packages: .

changelog.md

@@ -9,6 +9,9 @@
 - @arthurxavierx
   - [#221](https://github.com/bitemyapp/esqueleto/pull/221)
     - Deprecate `ToAliasT` and `ToAliasReferenceT`
+- @parsonsmatt
+  - [#226](https://github.com/bitemyapp/esqueleto/pull/226)
+    - Support `persistent-2.11`
 - @belevy
   - [#225](https://github.com/bitemyapp/esqueleto/pull/225)
     - Simplify `ToFromT` extracting the overlapping and type error instances

esqueleto.cabal

@@ -60,7 +60,7 @@ library
       , conduit >=1.3
       , containers
       , monad-logger
-      , persistent >=2.10.0 && <2.11
+      , persistent >=2.10.0 && <2.12
       , resourcet >=1.2
       , tagged >=0.2
       , text >=0.11 && <1.3
@@ -105,7 +105,7 @@ test-suite mysql
       , mtl
       , mysql
       , mysql-simple
-      , persistent >=2.8.0 && <2.11
+      , persistent
       , persistent-mysql
       , persistent-template
       , resourcet >=1.2
@@ -126,7 +126,7 @@ test-suite postgresql
         Paths_esqueleto
     hs-source-dirs:
         test
-    ghc-options: -Wall
+    ghc-options: -Wall -threaded
     build-depends:
         base >=4.8 && <5.0
       , aeson
@@ -140,8 +140,8 @@ test-suite postgresql
       , hspec
       , monad-logger
       , mtl
-      , persistent >=2.10.0 && <2.11
+      , persistent
-      , persistent-postgresql >= 2.10.0 && <2.11
+      , persistent-postgresql
       , persistent-template
       , postgresql-libpq
       , postgresql-simple
@@ -176,7 +176,7 @@ test-suite sqlite
       , hspec
       , monad-logger
       , mtl
-      , persistent >=2.8.0 && <2.11
+      , persistent
       , persistent-sqlite
       , persistent-template
       , resourcet >=1.2

examples/Main.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE DerivingStrategies, FlexibleContexts           #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -26,9 +28,9 @@ import           Control.Monad.Reader        (MonadReader (..), runReaderT)
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Monoid ((<>))
 import Database.Esqueleto
-import           Database.Persist.Postgresql (ConnectionString,
+import Database.Persist.Postgresql (ConnectionString, withPostgresqlConn)
-                                              withPostgresqlConn)
+import Database.Persist.TH
-import           Database.Persist.TH         ( AtLeastOneUniqueKey(..)
+       ( AtLeastOneUniqueKey(..)
        , OnlyOneUniqueKey(..)
        , mkDeleteCascade
        , mkMigrate

src/Database/Esqueleto/Internal/PersistentImport.hs

@@ -174,4 +174,5 @@ import Database.Persist.Sql hiding
        , (>.)
        , (>=.)
        , (||.)
+       , exists
        )

src/Database/Esqueleto/PostgreSQL.hs

@@ -40,6 +40,7 @@ import Control.Monad.IO.Class (MonadIO(..))
 import qualified Control.Monad.Trans.Reader as R
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty((:|)))
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Proxy (Proxy(..))
 import qualified Data.Text.Internal.Builder as TLB
 import Data.Time.Clock (UTCTime)
@@ -205,17 +206,33 @@ upsertBy
     -- ^ the record in the database after the operation
 upsertBy uniqueKey record updates = do
     sqlB <- R.ask
-    maybe
+    case connUpsertSql sqlB of
-      (throw (UnexpectedCaseErr OperationNotSupported)) -- Postgres backend should have connUpsertSql, if this error is thrown, check changes on persistent
+        Nothing ->
-      (handler sqlB)
+            -- Postgres backend should have connUpsertSql, if this error is
-      (connUpsertSql sqlB)
+            -- thrown, check changes on persistent
+            throw (UnexpectedCaseErr OperationNotSupported)
+        Just upsertSql ->
+            handler sqlB upsertSql
   where
     addVals l = map toPersistValue (toPersistFields record) ++ l ++ persistUniqueToValues uniqueKey
     entDef = entityDef (Just record)
-    uDef = toUniqueDef uniqueKey
     updatesText conn = first builderToText $ renderUpdates conn updates
+#if MIN_VERSION_persistent(2,11,0)
+    uniqueFields = NonEmpty.fromList (persistUniqueToFieldNames uniqueKey)
+    handler sqlB upsertSql = do
+        let (updateText, updateVals) =
+                updatesText sqlB
+            queryText =
+                upsertSql entDef uniqueFields updateText
+            queryVals =
+                addVals updateVals
+        xs <- rawSql queryText queryVals
+        pure (head xs)
+#else
+    uDef = toUniqueDef uniqueKey
     handler conn f = fmap head $ uncurry rawSql $
         (***) (f entDef (uDef :| [])) addVals $ updatesText conn
+#endif
 
 -- | Inserts into a table the results of a query similar to 'insertSelect' but allows
 -- to update values that violate a constraint during insertions.

stack-8.6.yaml

@@ -5,9 +5,11 @@ packages:
   - 'examples'
 
 extra-deps:
-  - persistent-2.10.0
+  - git: https://github.com/yesodweb/persistent
-  - persistent-template-2.7.0
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
-  - persistent-mysql-2.10.0
+    subdirs:
-  - persistent-postgresql-2.10.0
+      - persistent
-  - persistent-sqlite-2.10.0
+      - persistent-template
-  - postgresql-simple-0.6.1
+      - persistent-mysql
+      - persistent-postgresql
+      - persistent-sqlite

stack-8.8.yaml

@@ -3,3 +3,10 @@ resolver: lts-16.14
 packages:
   - '.'
   - 'examples'
+
+extra-deps:
+- persistent-2.11.0.0
+- persistent-template-2.9.1.0
+- persistent-mysql-2.10.3
+- persistent-postgresql-2.11.0.0
+- persistent-sqlite-2.11.0.0

stack-8.8.yaml.lock

@@ -3,7 +3,72 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files
 
-packages: []
+packages:
+- completed:
+    subdir: persistent
+    name: persistent
+    version: 2.11.0.0
+    git: https://github.com/yesodweb/persistent
+    pantry-tree:
+      size: 2099
+      sha256: cd4d895557a60b40543c4a6804d32346a1c14c39e28658bb6852d8f4904ef1de
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
+  original:
+    subdir: persistent
+    git: https://github.com/yesodweb/persistent
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
+- completed:
+    subdir: persistent-template
+    name: persistent-template
+    version: '2.9'
+    git: https://github.com/yesodweb/persistent
+    pantry-tree:
+      size: 620
+      sha256: 0602872c9c38ccc6966b4a1fd1d102a345f94ad855077157d588536ee6803343
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
+  original:
+    subdir: persistent-template
+    git: https://github.com/yesodweb/persistent
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
+- completed:
+    subdir: persistent-mysql
+    name: persistent-mysql
+    version: 2.10.3
+    git: https://github.com/yesodweb/persistent
+    pantry-tree:
+      size: 577
+      sha256: a3b9d2ef77af25dca203a4dbe2857b6a1d4e421bbe376f261288e9a8ebfda28f
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
+  original:
+    subdir: persistent-mysql
+    git: https://github.com/yesodweb/persistent
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
+- completed:
+    subdir: persistent-postgresql
+    name: persistent-postgresql
+    version: 2.11.0.0
+    git: https://github.com/yesodweb/persistent
+    pantry-tree:
+      size: 907
+      sha256: 6f1ad1c5b0b22cf455c6b1b4551a749d21bb72042597450c8ef9ff1eb5a74782
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
+  original:
+    subdir: persistent-postgresql
+    git: https://github.com/yesodweb/persistent
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
+- completed:
+    subdir: persistent-sqlite
+    name: persistent-sqlite
+    version: 2.11.0.0
+    git: https://github.com/yesodweb/persistent
+    pantry-tree:
+      size: 891
+      sha256: fc9106077e16b406a5a823c732e3b543822a530f2befc446e49acf68797f6d42
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
+  original:
+    subdir: persistent-sqlite
+    git: https://github.com/yesodweb/persistent
+    commit: 0b8f9f3305c9b60c947565de882abfbfd8cb5702
 snapshots:
 - completed:
     size: 532382

stack.yaml

@@ -1 +1 @@
-stack-8.6.yaml
+stack-8.8.yaml

test/Common/Test.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}

test/PostgreSQL/MigrateJSON.hs

@@ -1,17 +1,19 @@
-{-# LANGUAGE FlexibleContexts
+{-# LANGUAGE DataKinds #-}
-           , GADTs
+{-# LANGUAGE DerivingStrategies #-}
-           , GeneralizedNewtypeDeriving
+{-# LANGUAGE FlexibleContexts #-}
-           , DerivingStrategies
+{-# LANGUAGE FlexibleInstances #-}
-           , StandaloneDeriving
+{-# LANGUAGE GADTs #-}
-           , MultiParamTypeClasses
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-           , OverloadedStrings
+{-# LANGUAGE MultiParamTypeClasses #-}
-           , QuasiQuotes
+{-# LANGUAGE OverloadedStrings #-}
-           , RankNTypes
+{-# LANGUAGE QuasiQuotes #-}
-           , ScopedTypeVariables
+{-# LANGUAGE RankNTypes #-}
-           , TemplateHaskell
+{-# LANGUAGE ScopedTypeVariables #-}
-           , TypeFamilies
+{-# LANGUAGE StandaloneDeriving #-}
-           , UndecidableInstances
+{-# LANGUAGE TemplateHaskell #-}
- #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
 module PostgreSQL.MigrateJSON where
 
 import Control.Monad.Trans.Resource (ResourceT)

test/PostgreSQL/Test.hs

@@ -559,7 +559,7 @@ testPostgresModule = do
       run $ do
         nowDb <- select $ return EP.now_
         nowUtc <- liftIO getCurrentTime
-        let halfSecond = realToFrac (0.5 :: Double)
+        let oneSecond = realToFrac (1 :: Double)
 
         -- | Check the result is not null
         liftIO $ nowDb `shouldSatisfy` (not . null)
@@ -567,8 +567,8 @@ testPostgresModule = do
         -- | Unpack the now value
         let (Value now: _) = nowDb
 
-        -- | Get the time diff and check it's less than half a second
+        -- | Get the time diff and check it's less than a second
-        liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< halfSecond)
+        liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< oneSecond)
 
 
 --------------- JSON --------------- JSON --------------- JSON ---------------
@@ -1379,7 +1379,6 @@ main = do
                 testJSONOperators
             testLateralQuery
 
-
 run, runSilent, runVerbose :: Run
 runSilent  act = runNoLoggingT     $ run_worker act
 runVerbose act = runStderrLoggingT $ run_worker act