persistent-mtl 0.5.1 → 0.5.2

raw patch · 15 files changed

+1709/−1706 lines, 15 filesdep +skeletestdep −explainable-predicatesdep −tastydep −tasty-autocollectdep ~basedep ~conduitdep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: skeletest

Dependencies removed: explainable-predicates, tasty, tasty-autocollect, tasty-golden, tasty-hunit

Dependency ranges changed: base, conduit, containers, esqueleto, exceptions, monad-logger, mtl, persistent, resource-pool, resourcet, text, transformers, unliftio, unliftio-core, unliftio-pool

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• persistent-mtl.cabal +25/−30
• test/IntegrationSpec.hs +890/−0
• test/IntegrationTest.hs +0/−852
• test/Main.hs +1/−4
• test/MockedSpec.hs +663/−0
• test/MockedTest.hs +0/−622
• test/READMESpec.hs +30/−0
• test/READMETest.hs +0/−32
• test/SqlQueryRepSpec.hs +23/−0
• test/SqlQueryRepTest.hs +0/−33
• test/TestUtils/Esqueleto.hs +0/−1
• test/__snapshots__/SqlQueryRepSpec.snap.md +72/−0
• test/goldens/persistent-2.13/sqlqueryrep_show_representation.golden +0/−66
• test/goldens/persistent-2.14/sqlqueryrep_show_representation.golden +0/−66

@@ -1,3 +1,8 @@+# v0.5.2++* Add GHC 9.10 support+* Drop support for GHC < 9.8+ # v0.5.1  * Add GHC 9.8 support

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           persistent-mtl-version:        0.5.1+version:        0.5.2 synopsis:       Monad transformer for the persistent API description:    A monad transformer and mtl-style type class for using the                 persistent API directly in your monad transformer stack.@@ -19,8 +19,7 @@ extra-source-files:     CHANGELOG.md     README.md-    test/goldens/persistent-2.13/sqlqueryrep_show_representation.golden-    test/goldens/persistent-2.14/sqlqueryrep_show_representation.golden+    test/__snapshots__/SqlQueryRepSpec.snap.md  source-repository head   type: git@@ -44,20 +43,20 @@       src   ghc-options: -Wall -Wcompat -Wunused-packages   build-depends:-      base >=4.14 && <5-    , conduit <1.4-    , containers <0.7-    , exceptions <0.11-    , monad-logger <0.4-    , mtl <2.4-    , persistent >=2.13 && <2.15-    , resource-pool <1-    , resourcet <1.4-    , text <2.2-    , transformers <0.7-    , unliftio <0.3-    , unliftio-core <0.3-    , unliftio-pool <1+      base <5+    , conduit+    , containers+    , exceptions+    , monad-logger+    , mtl+    , persistent+    , resource-pool+    , resourcet+    , text+    , transformers+    , unliftio+    , unliftio-core+    , unliftio-pool   default-language: Haskell2010   if impl(ghc >= 9.4.0) && impl(ghc < 9.4.3) @@ -69,25 +68,24 @@   other-modules:       Example       Generated-      IntegrationTest-      MockedTest-      READMETest-      SqlQueryRepTest+      IntegrationSpec+      MockedSpec+      READMESpec+      SqlQueryRepSpec       TestUtils.DB       TestUtils.Esqueleto       Paths_persistent_mtl   hs-source-dirs:       test-  ghc-options: -Wall -Wcompat -Wunused-packages -F -pgmF=tasty-autocollect+  ghc-options: -Wall -Wcompat -Wunused-packages -F -pgmF=skeletest-preprocessor   build-tool-depends:-      tasty-autocollect:tasty-autocollect+      skeletest:skeletest-preprocessor   build-depends:       base     , bytestring     , conduit     , containers-    , esqueleto >=3.5-    , explainable-predicates >=0.1.2.0+    , esqueleto >=3.5.14.0     , monad-logger     , persistent     , persistent-mtl@@ -95,10 +93,7 @@     , persistent-sqlite >=2.13.0.3     , resource-pool     , resourcet-    , tasty-    , tasty-autocollect >=0.2.0.0-    , tasty-golden-    , tasty-hunit+    , skeletest >=0.2.1     , text     , unliftio   default-language: Haskell2010

@@ -0,0 +1,890 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module IntegrationSpec (spec) where++import Conduit (runConduit, (.|))+import qualified Conduit+import Control.Arrow ((&&&))+import Control.Monad (forM_)+import qualified Data.Acquire as Acquire+import Data.Bifunctor (first)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Typeable (Typeable)+import qualified Database.Esqueleto.Experimental as E+import Database.Persist.Sql (+  Entity (..),+  IsolationLevel (..),+  Migration,+  PersistField,+  PersistRecordBackend,+  PersistValue,+  Single (..),+  SqlBackend,+  fromPersistValue,+  (=.),+  (==.),+ )+import Skeletest+import qualified Skeletest.Predicate as P+import UnliftIO (MonadIO, MonadUnliftIO, liftIO)+import UnliftIO.Exception (+  Exception,+  SomeException,+  StringException (..),+  fromException,+  throwIO,+  throwString,+  try,+ )+import UnliftIO.IORef (atomicModifyIORef, newIORef, readIORef, writeIORef)++import Control.Monad.IO.Rerunnable (MonadRerunnableIO, rerunnableIO)+import Database.Persist.Monad+import Database.Persist.Monad.Internal.PersistentShim (SafeToInsert)+import Example+import TestUtils.DB (BackendType (..), allBackendTypes)+import TestUtils.Esqueleto (esqueletoSelect)++spec :: Spec+spec = do+  forM_ allBackendTypes $ \backendType ->+    describe (show backendType) $ do+      describe "withTransaction" $ do+        it "uses the same transaction" $ do+          -- without transactions, the INSERT shouldn't be rolled back+          resultWithoutTransactions <-+            runTestApp backendType $ do+              catchTestError $ insertAndFail $ person "Alice"+              getPeopleNames+          resultWithoutTransactions `shouldBe` ["Alice"]++          -- with transactions, the INSERT should be rolled back+          resultWithTransactions <-+            runTestApp backendType $ do+              catchTestError $ withTransaction $ insertAndFail $ person "Alice"+              getPeopleNames+          resultWithTransactions `shouldBe` []++        it "retries transactions" $ do+          let retryIf e = case fromException e of+                Just (StringException "retry me" _) -> True+                _ -> False+              setRetry env = env{retryIf, retryLimit = 5}++          counter <- newIORef (0 :: Int)++          (`shouldNotSatisfy` P.throws (P.anything @_ @SomeException)) $+            runTestAppWith backendType setRetry $+              withTransaction $+                rerunnableIO $ do+                  x <- atomicModifyIORef counter $ \x -> (x + 1, x)+                  if x > 2+                    then return ()+                    else throwString "retry me"++        it "throws error when retry hits limit" $ do+          let setRetry env = env{retryIf = const True, retryLimit = 2}++          result <-+            try @_ @TransactionError @() $+              runTestAppWith backendType setRetry $+                withTransaction $+                  rerunnableIO $+                    throwString "retry me"++          result `shouldBe` Left RetryLimitExceeded++        it "runs retryCallback" $ do+          callbackRef <- newIORef Nothing++          let setRetry env =+                env+                  { retryIf = const True+                  , retryLimit = 2+                  , retryCallback = writeIORef callbackRef . Just+                  }+          _ <-+            try @_ @TransactionError @() $+              runTestAppWith backendType setRetry . withTransaction $+                rerunnableIO (throwIO TestError)++          mError <- readIORef callbackRef+          (mError >>= fromException) `shouldBe` Just TestError++      describe "catchSqlTransaction" $ do+        let newCatchRef = do+              wasCaughtRef <- newIORef False+              let markCaught (_ :: SomeException) =+                    rerunnableIO $ writeIORef wasCaughtRef True+                  getWasCaught = readIORef wasCaughtRef+              pure (markCaught, getWasCaught)++        it "catches errors" $ do+          (markCaught, getWasCaught) <- newCatchRef+          runTestApp backendType . withTransaction $+            (`catchSqlTransaction` markCaught) $+              rerunnableIO (throwString "error")+          getWasCaught `shouldSatisfy` P.returns (P.eq True)++        it "does not catch retry errors" $ do+          let retryIf e = case fromException e of+                Just (StringException "retry me" _) -> True+                _ -> False+              setRetry env = env{retryIf, retryLimit = 2}++          (markCaught, getWasCaught) <- newCatchRef+          _ <-+            try @_ @SomeException $+              runTestAppWith backendType setRetry . withTransaction $+                (`catchSqlTransaction` markCaught) $+                  rerunnableIO (throwString "retry me")+          getWasCaught `shouldSatisfy` P.returns (P.eq False)++      -- should compile+      it "can compose operations" $ do+        let onlySql :: (MonadSqlQuery m) => m ()+            onlySql = do+              _ <- getPeople+              return ()++            sqlAndRerunnableIO :: (MonadSqlQuery m, MonadRerunnableIO m) => m ()+            sqlAndRerunnableIO = do+              _ <- getPeopleNames+              _ <- rerunnableIO $ newIORef True+              return ()++            onlyRerunnableIO :: (MonadRerunnableIO m) => m ()+            onlyRerunnableIO = do+              _ <- rerunnableIO $ newIORef True+              return ()++            arbitraryIO :: (MonadIO m) => m ()+            arbitraryIO = do+              _ <- liftIO $ newIORef True+              return ()++        -- everything should compose naturally by default+        runTestApp backendType $ do+          onlySql+          sqlAndRerunnableIO+          onlyRerunnableIO+          arbitraryIO++        -- in a transaction, you can compose everything except arbitrary IO+        runTestApp backendType $ withTransaction $ do+          onlySql+          sqlAndRerunnableIO+          onlyRerunnableIO+          -- uncomment this to get compile error+          -- arbitraryIO+          pure ()++      describe "Persistent API" $ do+        it "get" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            mapM get [1, 2]+          map (fmap personName) result `shouldBe` [Just "Alice", Nothing]++        it "getMany" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            getMany [1]+          personName <$> Map.lookup 1 result `shouldBe` Just "Alice"++        it "getJust" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            getJust 1+          personName result `shouldBe` "Alice"++        it "getJustEntity" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            getJustEntity 1+          getName result `shouldBe` "Alice"++        it "getEntity" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            mapM getEntity [1, 2]+          map (fmap getName) result `shouldBe` [Just "Alice", Nothing]++        it "belongsTo" $ do+          result <- runTestApp backendType $ do+            aliceKey <- insert $ person "Alice"+            let post1 = Post "Post #1" aliceKey (Just aliceKey)+                post2 = Post "Post #2" aliceKey Nothing+            insertMany_ [post1, post2]+            mapM (belongsTo postEditor) [post1, post2]+          map (fmap personName) result `shouldBe` [Just "Alice", Nothing]++        it "belongsToJust" $ do+          result <- runTestApp backendType $ do+            aliceKey <- insert $ person "Alice"+            let post1 = Post "Post #1" aliceKey Nothing+            insert_ post1+            belongsToJust postAuthor post1+          personName result `shouldBe` "Alice"++        it "insert" $ do+          result <- runTestApp backendType $ do+            aliceKey <- insert $ person "Alice"+            people <- getPeopleNames+            return (aliceKey, people)+          result `shouldBe` (1, ["Alice"])++        it "insert_" $ do+          result <- runTestApp backendType $ do+            result <- insert_ $ person "Alice"+            people <- getPeopleNames+            return (result, people)+          result `shouldBe` ((), ["Alice"])++        it "insertMany" $ do+          result <- runTestApp backendType $ do+            keys <- insertMany [person "Alice", person "Bob"]+            people <- getPeopleNames+            return (keys, people)+          result `shouldBe` ([1, 2], ["Alice", "Bob"])++        it "insertMany_" $ do+          result <- runTestApp backendType $ do+            result <- insertMany_ [person "Alice", person "Bob"]+            people <- getPeopleNames+            return (result, people)+          result `shouldBe` ((), ["Alice", "Bob"])++        it "insertEntityMany" $ do+          result <- runTestApp backendType $ do+            result <-+              insertEntityMany+                [ Entity 1 $ person "Alice"+                , Entity 2 $ person "Bob"+                ]+            people <- getPeopleNames+            return (result, people)+          result `shouldBe` ((), ["Alice", "Bob"])++        it "insertKey" $ do+          result <- runTestApp backendType $ do+            result <- insertKey 1 $ person "Alice"+            people <- getPeopleNames+            return (result, people)+          result `shouldBe` ((), ["Alice"])++        it "repsert" $ do+          result <- runTestApp backendType $ do+            let alice = person "Alice"+            insert_ alice+            repsert 1 $ alice{personAge = 100}+            repsert 2 $ person "Bob"+            getPeople+          map nameAndAge result+            `shouldBe` [ ("Alice", 100)+                       , ("Bob", 0)+                       ]++        it "repsertMany" $ do+          result <- runTestApp backendType $ do+            let alice = person "Alice"+            -- https://github.com/yesodweb/persistent/issues/832+            insert_ alice+            repsertMany+              [ (1, alice{personAge = 100})+              , (2, person "Bob")+              ]+            getPeople+          map nameAndAge result+            `shouldBe` [ ("Alice", 100)+                       , ("Bob", 0)+                       ]++        it "replace" $ do+          result <- runTestApp backendType $ do+            let alice = person "Alice"+            insert_ alice+            replace 1 $ alice{personAge = 100}+            getJust 1+          personAge result `shouldBe` 100++        it "delete" $ do+          result <- runTestApp backendType $ do+            aliceKey <- insert $ person "Alice"+            delete aliceKey+            getPeople+          result `shouldBe` []++        it "update" $ do+          result <- runTestApp backendType $ do+            key <- insert $ person "Alice"+            update key [PersonName =. "Alicia"]+            getPeopleNames+          result `shouldBe` ["Alicia"]++        it "updateGet" $ do+          (updateResult, getResult) <- runTestApp backendType $ do+            key <- insert $ person "Alice"+            updateResult <- updateGet key [PersonName =. "Alicia"]+            getResult <- getJust key+            return (updateResult, getResult)+          updateResult `shouldBe` getResult++        it "insertEntity" $ do+          (insertResult, getResult) <- runTestApp backendType $ do+            insertResult <- insertEntity $ person "Alice"+            getResult <- getJust $ entityKey insertResult+            return (insertResult, getResult)+          entityVal insertResult `shouldBe` getResult++        it "insertRecord" $ do+          (insertResult, getResult) <- runTestApp backendType $ do+            insertResult <- insertRecord $ person "Alice"+            getResult <- getJust 1+            return (insertResult, getResult)+          insertResult `shouldBe` getResult++        it "getBy" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            mapM getBy [UniqueName "Alice", UniqueName "Bob"]+          map (fmap getName) result `shouldBe` [Just "Alice", Nothing]++        it "getByValue" $ do+          result <- runTestApp backendType $ do+            let alice = person "Alice"+            insert_ alice+            mapM getByValue [alice, person "Bob"]+          map (fmap getName) result `shouldBe` [Just "Alice", Nothing]++        it "checkUnique" $ do+          result <- runTestApp backendType $ do+            let alice = person "Alice"+            insert_ alice+            mapM+              checkUnique+              [ alice+              , person "Bob"+              , (person "Alice"){personAge = 100}+              ]+          result `shouldBe` [Just (UniqueName "Alice"), Nothing, Just (UniqueName "Alice")]++        it "checkUniqueUpdateable" $ do+          result <- runTestApp backendType $ do+            let alice = person "Alice"+            insert_ alice+            mapM+              checkUniqueUpdateable+              [ Entity 1 alice+              , Entity 2 $ person "Bob"+              , Entity 3 $ (person "Alice"){personAge = 100}+              ]+          result `shouldBe` [Nothing, Nothing, Just (UniqueName "Alice")]++        it "deleteBy" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            deleteBy $ UniqueName "Alice"+            getPeople+          result `shouldBe` []++        it "insertUnique" $ do+          (result1, result2, people) <- runTestApp backendType $ do+            result1 <- insertUnique $ person "Alice"+            result2 <- insertUnique $ person "Alice"+            people <- getPeopleNames+            return (result1, result2, people)+          result1 `shouldBe` Just 1+          result2 `shouldBe` Nothing+          people `shouldBe` ["Alice"]++        it "upsert" $ do+          (result1, result2, people) <- runTestApp backendType $ do+            result1 <- upsert (person "Alice") [PersonAge =. 0]+            result2 <- upsert (person "Alice") [PersonAge =. 100]+            people <- getPeople+            return (result1, result2, people)+          entityKey result1 `shouldBe` entityKey result2+          nameAndAge (entityVal result1) `shouldBe` ("Alice", 0)+          nameAndAge (entityVal result2) `shouldBe` ("Alice", 100)+          map nameAndAge people `shouldBe` [("Alice", 100)]++        it "upsertBy" $ do+          (result1, result2, people) <- runTestApp backendType $ do+            result1 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 0]+            result2 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 100]+            people <- getPeople+            return (result1, result2, people)+          entityKey result1 `shouldBe` entityKey result2+          nameAndAge (entityVal result1) `shouldBe` ("Alice", 0)+          nameAndAge (entityVal result2) `shouldBe` ("Alice", 100)+          map nameAndAge people `shouldBe` [("Alice", 100)]++        it "putMany" $ do+          result <- runTestApp backendType $ do+            let alice = person "Alice"+            insert_ alice+            putMany+              [ alice{personAge = 100}+              , person "Bob"+              ]+            getPeople+          map nameAndAge result+            `shouldBe` [ ("Alice", 100)+                       , ("Bob", 0)+                       ]++        it "insertBy" $ do+          (result1, result2, people) <- runTestApp backendType $ do+            let alice = person "Alice"+            result1 <- insertBy alice+            result2 <- insertBy $ alice{personAge = 100}+            people <- getPeople+            return (result1, result2, people)+          result1 `shouldBe` Right 1+          first (entityKey &&& getName) result2 `shouldBe` Left (1, "Alice")+          map nameAndAge people `shouldBe` [("Alice", 0)]++        it "insertUniqueEntity" $ do+          (result1, result2, people) <- runTestApp backendType $ do+            let alice = person "Alice"+            result1 <- insertUniqueEntity alice+            result2 <- insertUniqueEntity $ alice{personAge = 100}+            people <- getPeople+            return (result1, result2, people)+          (entityKey &&& getName) <$> result1 `shouldBe` Just (1, "Alice")+          result2 `shouldBe` Nothing+          map nameAndAge people `shouldBe` [("Alice", 0)]++        it "replaceUnique" $ do+          (result1, result2, people) <- runTestApp backendType $ do+            let alice = person "Alice"+                bob = person "Bob"+            insertMany_ [alice, bob]+            result1 <- replaceUnique 1 $ alice{personName = "Bob"}+            result2 <- replaceUnique 2 $ bob{personAge = 100}+            people <- getPeople+            return (result1, result2, people)+          result1 `shouldBe` Just (UniqueName "Bob")+          result2 `shouldBe` Nothing+          map nameAndAge people `shouldBe` [("Alice", 0), ("Bob", 100)]++        it "onlyUnique" $ do+          result <- runTestApp backendType $ onlyUnique $ person "Alice"+          result `shouldBe` UniqueName "Alice"++        it "selectSourceRes" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            acquire <- selectSourceRes [] []+            Acquire.with acquire $ \conduit ->+              runConduit $ conduit .| Conduit.mapC getName .| Conduit.sinkList+          result `shouldBe` ["Alice", "Bob"]++        it "selectFirst" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            sequence+              [ selectFirst [PersonName ==. "Alice"] []+              , selectFirst [PersonName ==. "Bob"] []+              ]+          map (fmap getName) result `shouldBe` [Just "Alice", Nothing]++        it "selectKeysRes" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            acquire <- selectKeysRes @_ @Person [] []+            Acquire.with acquire $ \conduit ->+              runConduit $ conduit .| Conduit.sinkList+          result `shouldBe` [1, 2]++        it "count" $ do+          result <- runTestApp backendType $ do+            insertMany_ $ map (\p -> p{personAge = 100}) [person "Alice", person "Bob"]+            count [PersonAge ==. 100]+          result `shouldBe` 2++        it "exists" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            exists [PersonName ==. "Alice"]+          result `shouldBe` True++        it "selectSource" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList+          result `shouldBe` ["Alice", "Bob"]++        it "selectKeys" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            runConduit $ selectKeys @Person [] [] .| Conduit.sinkList+          result `shouldBe` [1, 2]++        it "selectList" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            insert_ $ person "Bob"+            selectList [] []+          map getName result `shouldBe` ["Alice", "Bob"]++        it "selectKeysList" $ do+          result <- runTestApp backendType $ do+            insert_ $ person "Alice"+            insert_ $ person "Bob"+            selectKeysList @Person [] []+          result `shouldBe` [1, 2]++        it "updateWhere" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            updateWhere [PersonName ==. "Alice"] [PersonAge =. 100]+            getPeople+          map nameAndAge result `shouldBe` [("Alice", 100), ("Bob", 0)]++        it "deleteWhere" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            deleteWhere [PersonName ==. "Alice"]+            getPeopleNames+          result `shouldBe` ["Bob"]++        it "updateWhereCount" $ do+          (rowsUpdated, people) <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            rowsUpdated <- updateWhereCount [PersonName ==. "Alice"] [PersonAge =. 100]+            people <- getPeople+            return (rowsUpdated, people)+          rowsUpdated `shouldBe` 1+          map nameAndAge people `shouldBe` [("Alice", 100), ("Bob", 0)]++        it "deleteWhereCount" $ do+          (rowsDeleted, names) <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            rowsDeleted <- deleteWhereCount [PersonName ==. "Alice"]+            names <- getPeopleNames+            return (rowsDeleted, names)+          rowsDeleted `shouldBe` 1+          names `shouldBe` ["Bob"]++        it "parseMigration" $ do+          result <- runTestApp backendType $ do+            setupUnsafeMigration+            parseMigration migration++          let sql = case backendType of+                Sqlite ->+                  [ P.eq+                      ( False+                      , Text.concat+                          [ "CREATE TEMP TABLE \"person_backup\"("+                          , "\"id\" INTEGER PRIMARY KEY,"+                          , "\"name\" VARCHAR NOT NULL,"+                          , "\"age\" INTEGER NOT NULL,"+                          , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"+                          ]+                      )+                  , P.anything+                  , P.eq (True, "DROP TABLE \"person\"")+                  , P.anything+                  , P.anything+                  , P.eq (False, "DROP TABLE \"person_backup\"")+                  ]+                Postgresql ->+                  [ P.eq (True, "ALTER TABLE \"person\" DROP COLUMN \"foo\"")+                  ]++          result `shouldSatisfy` P.right (P.list sql)++        it "parseMigration'" $ do+          let action :: (Migration -> TestApp a) -> IO a+              action f = runTestApp backendType $ do+                setupUnsafeMigration+                f migration++          result <- action parseMigration+          result' <- action parseMigration'+          Right result' `shouldBe` result++        it "printMigration" $+          runTestApp backendType $ do+            setupUnsafeMigration+            printMigration migration++        it "showMigration" $ do+          result <- runTestApp backendType $ do+            setupUnsafeMigration+            showMigration migration++          let sql = case backendType of+                Sqlite ->+                  [ P.eq $+                      Text.concat+                        [ "CREATE TEMP TABLE \"person_backup\"("+                        , "\"id\" INTEGER PRIMARY KEY,"+                        , "\"name\" VARCHAR NOT NULL,"+                        , "\"age\" INTEGER NOT NULL,"+                        , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"));"+                        ]+                  , P.anything+                  , P.eq "DROP TABLE \"person\";"+                  , P.anything+                  , P.anything+                  , P.eq "DROP TABLE \"person_backup\";"+                  ]+                Postgresql ->+                  [ P.eq "ALTER TABLE \"person\" DROP COLUMN \"foo\";"+                  ]++          result `shouldSatisfy` P.list sql++        it "getMigration" $ do+          result <- runTestApp backendType $ do+            setupUnsafeMigration+            getMigration migration++          let sql = case backendType of+                Sqlite ->+                  [ P.eq $+                      Text.concat+                        [ "CREATE TEMP TABLE \"person_backup\"("+                        , "\"id\" INTEGER PRIMARY KEY,"+                        , "\"name\" VARCHAR NOT NULL,"+                        , "\"age\" INTEGER NOT NULL,"+                        , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"+                        ]+                  , P.anything+                  , P.eq "DROP TABLE \"person\""+                  , P.anything+                  , P.anything+                  , P.eq "DROP TABLE \"person_backup\""+                  ]+                Postgresql ->+                  [ P.eq "ALTER TABLE \"person\" DROP COLUMN \"foo\""+                  ]++          result `shouldSatisfy` P.list sql++        it "runMigration" $ do+          result <- runTestApp backendType $ do+            setupSafeMigration+            runMigration migration+            getSchemaColumnNames backendType "person"+          result `shouldNotSatisfy` P.elem "removed_column"++        it "runMigrationQuiet" $ do+          (withQuiet, cols) <- runTestApp backendType $ do+            setupSafeMigration+            sql <- runMigrationQuiet migration+            cols <- getSchemaColumnNames backendType "person"+            return (sql, cols)+          withSilent <- runTestApp backendType $ do+            setupSafeMigration+            runMigrationSilent migration+          cols `shouldNotSatisfy` P.elem "removed_column"+          withQuiet `shouldBe` withSilent++        it "runMigrationSilent" $ do+          (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do+            setupSafeMigration+            sqlPlanned <- getMigration migration+            sqlExecuted <- runMigrationSilent migration+            cols <- getSchemaColumnNames backendType "person"+            return (sqlPlanned, sqlExecuted, cols)+          cols `shouldNotSatisfy` P.elem "removed_column"+          sqlExecuted `shouldBe` sqlPlanned++        it "runMigrationUnsafe" $ do+          result <- runTestApp backendType $ do+            setupUnsafeMigration+            runMigrationUnsafe migration+            getSchemaColumnNames backendType "person"+          result `shouldNotSatisfy` P.elem "removed_column"++        it "runMigrationUnsafeQuiet" $ do+          (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do+            setupUnsafeMigration+            sqlPlanned <- getMigration migration+            sqlExecuted <- runMigrationUnsafeQuiet migration+            cols <- getSchemaColumnNames backendType "person"+            return (sqlPlanned, sqlExecuted, cols)+          cols `shouldNotSatisfy` P.elem "removed_column"+          sqlExecuted `shouldBe` sqlPlanned++        it "getFieldName" $ do+          result <-+            runTestApp backendType $+              getFieldName PersonName+          result `shouldBe` "\"name\""++        it "getTableName" $ do+          result <-+            runTestApp backendType $+              getTableName $+                person "Alice"+          result `shouldBe` "\"person\""++        it "withRawQuery" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            withRawQuery "SELECT name FROM person" [] $+              Conduit.mapC (getFirstPersistValue @Text) .| Conduit.sinkList++          result `shouldBe` ["Alice", "Bob"]++        it "rawQueryRes" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            acquire <- rawQueryRes "SELECT name FROM person" []+            Acquire.with acquire $ \conduit ->+              runConduit $ conduit .| Conduit.mapC (getFirstPersistValue @Text) .| Conduit.sinkList+          result `shouldBe` ["Alice", "Bob"]++        it "rawQuery" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            runConduit $ rawQuery "SELECT name FROM person" [] .| Conduit.mapC (getFirstPersistValue @Text) .| Conduit.sinkList+          result `shouldBe` ["Alice", "Bob"]++        it "rawExecute" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            rawExecute "UPDATE person SET age = 100 WHERE name = 'Alice'" []+            getPeople+          map nameAndAge result `shouldBe` [("Alice", 100), ("Bob", 0)]++        it "rawExecuteCount" $ do+          (rowsUpdated, people) <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            rowsUpdated <- rawExecuteCount "UPDATE person SET age = 100 WHERE name = 'Alice'" []+            people <- getPeople+            return (rowsUpdated, people)+          rowsUpdated `shouldBe` 1+          map nameAndAge people `shouldBe` [("Alice", 100), ("Bob", 0)]++        it "rawSql" $ do+          result <- runTestApp backendType $ do+            insertMany_ [person "Alice", person "Bob"]+            rawSql @(Single String) "SELECT name FROM person" []+          map unSingle result `shouldBe` ["Alice", "Bob"]++        it "transactionSave" $ do+          result1 <- runTestApp backendType $ do+            catchTestError $ withTransaction $ do+              insert_ $ person "Alice"+              insertAndFail $ person "Bob"+            getPeopleNames+          result1 `shouldBe` []++          result2 <- runTestApp backendType $ do+            catchTestError $ withTransaction $ do+              insert_ $ person "Alice"+              transactionSave+              insertAndFail $ person "Bob"+            getPeopleNames+          result2 `shouldBe` ["Alice"]++        it "transactionSaveWithIsolation" $ do+          result1 <- runTestApp backendType $ do+            catchTestError $ withTransaction $ do+              insert_ $ person "Alice"+              insertAndFail $ person "Bob"+            getPeopleNames+          result1 `shouldBe` []++          result2 <- runTestApp backendType $ do+            catchTestError $ withTransaction $ do+              insert_ $ person "Alice"+              transactionSaveWithIsolation Serializable+              insertAndFail $ person "Bob"+            getPeopleNames+          result2 `shouldBe` ["Alice"]++        it "transactionUndo" $ do+          result <- runTestApp backendType $ withTransaction $ do+            insert_ $ person "Alice"+            transactionUndo+            getPeopleNames+          result `shouldBe` []++        it "transactionUndoWithIsolation" $ do+          result <- runTestApp backendType $ withTransaction $ do+            insert_ $ person "Alice"+            transactionUndoWithIsolation Serializable+            getPeopleNames+          result `shouldBe` []++      describe "Interop with third-party Persistent libraries" $ do+        it "unsafeLiftSql" $ do+          let alice = person "Alice"+          result <- runTestApp backendType $ do+            insert_ alice+            esqueletoSelect $+              E.from $+                E.table @Person+          result `shouldBe` [Entity 1 alice]++{- Persistent helpers -}++getFirstPersistValue :: (PersistField a) => [PersistValue] -> a+getFirstPersistValue = \case+  [] -> error "Unexpectedly got no values"+  v : _ -> fromPersistValueOrFail v++fromPersistValueOrFail :: (PersistField a) => PersistValue -> a+fromPersistValueOrFail = either (error . Text.unpack) id . fromPersistValue++{- Meta SQL helpers -}++-- | Put the database in a state where running a migration is safe.+setupSafeMigration :: (MonadSqlQuery m) => m ()+setupSafeMigration = rawExecute "ALTER TABLE person ADD COLUMN removed_column VARCHAR" []++-- | Put the database in a state where running a migration is unsafe.+setupUnsafeMigration :: (MonadSqlQuery m) => m ()+setupUnsafeMigration = rawExecute "ALTER TABLE person ADD COLUMN foo VARCHAR" []++-- | Get the names of all columns in the given table.+getSchemaColumnNames :: (MonadSqlQuery m) => BackendType -> String -> m [String]+getSchemaColumnNames backendType tableName = map unSingle <$> rawSql sql []+  where+    sql = Text.pack $ case backendType of+      Sqlite -> "SELECT name FROM pragma_table_info('" ++ tableName ++ "')"+      Postgresql ->+        unlines+          [ "SELECT column_name FROM information_schema.columns"+          , "WHERE table_schema = 'public' AND table_name = '" ++ tableName ++ "'"+          ]++{- Test helpers -}++data TestError = TestError+  deriving (Show, Eq)++instance Exception TestError++catchTestError :: (MonadUnliftIO m, Eq a, Show a) => m a -> m ()+catchTestError m = do+  result <- try m+  liftIO $ result `shouldBe` Left TestError++insertAndFail ::+  ( MonadRerunnableIO m+  , MonadSqlQuery m+  , PersistRecordBackend record SqlBackend+  , Typeable record+  , SafeToInsert record+  ) =>+  record+  -> m ()+insertAndFail record = do+  insert_ record+  rerunnableIO $ throwIO TestError

@@ -1,852 +0,0 @@-{- AUTOCOLLECT.TEST -}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}--module IntegrationTest (-  -- $AUTOCOLLECT.TEST.export$-) where--import Conduit (runConduit, (.|))-import qualified Conduit-import Control.Arrow ((&&&))-import qualified Data.Acquire as Acquire-import Data.Bifunctor (first)-import qualified Data.Map.Strict as Map-import Data.Text (Text)-import qualified Data.Text as Text-import Data.Typeable (Typeable)-import qualified Database.Esqueleto.Experimental as E-import Database.Persist.Sql (-  Entity (..),-  IsolationLevel (..),-  Migration,-  PersistField,-  PersistRecordBackend,-  PersistValue,-  Single (..),-  SqlBackend,-  fromPersistValue,-  (=.),-  (==.),- )-import Test.Predicates (anything, elemsAre, eq, right)-import Test.Predicates.HUnit ((@?~))-import Test.Tasty-import Test.Tasty.HUnit-import UnliftIO (MonadIO, MonadUnliftIO, liftIO)-import UnliftIO.Exception (-  Exception,-  SomeException,-  StringException (..),-  fromException,-  throwIO,-  throwString,-  try,- )-import UnliftIO.IORef (atomicModifyIORef, newIORef, readIORef, writeIORef)--import Control.Monad.IO.Rerunnable (MonadRerunnableIO, rerunnableIO)-import Database.Persist.Monad-import Database.Persist.Monad.Internal.PersistentShim (SafeToInsert)-import Example-import TestUtils.DB (BackendType (..), allBackendTypes)-import TestUtils.Esqueleto (esqueletoSelect)--test_batch =-  [ testGroup-    (show backendType)-    [ testWithTransaction backendType-    , testCatchTransaction backendType-    , testComposability backendType-    , testPersistentAPI backendType-    , testInterop backendType-    ]-  | backendType <- allBackendTypes-  ]--testWithTransaction :: BackendType -> TestTree-testWithTransaction backendType =-  testGroup-    "withTransaction"-    [ testCase "it uses the same transaction" $ do-        -- without transactions, the INSERT shouldn't be rolled back-        runTestApp backendType $ do-          catchTestError $ insertAndFail $ person "Alice"-          result <- getPeopleNames-          liftIO $ result @?= ["Alice"]--        -- with transactions, the INSERT should be rolled back-        runTestApp backendType $ do-          catchTestError $ withTransaction $ insertAndFail $ person "Alice"-          result <- getPeopleNames-          liftIO $ result @?= []-    , testCase "retries transactions" $ do-        let retryIf e = case fromException e of-              Just (StringException "retry me" _) -> True-              _ -> False-            setRetry env = env{retryIf, retryLimit = 5}--        counter <- newIORef (0 :: Int)--        result <- try @_ @SomeException $-          runTestAppWith backendType setRetry $-            withTransaction $-              rerunnableIO $ do-                x <- atomicModifyIORef counter $ \x -> (x + 1, x)-                if x > 2-                  then return ()-                  else throwString "retry me"--        case result of-          Right () -> return ()-          Left e -> error $ "Got unexpected error: " ++ show e-    , testCase "throws error when retry hits limit" $ do-        let setRetry env = env{retryIf = const True, retryLimit = 2}--        result <--          try @_ @TransactionError @() $-            runTestAppWith backendType setRetry $-              withTransaction $-                rerunnableIO $-                  throwString "retry me"--        result @?= Left RetryLimitExceeded-    , testCase "Runs retryCallback" $ do-        callbackRef <- newIORef Nothing--        let setRetry env =-              env-                { retryIf = const True-                , retryLimit = 2-                , retryCallback = writeIORef callbackRef . Just-                }-        _ <--          try @_ @TransactionError @() $-            runTestAppWith backendType setRetry . withTransaction $-              rerunnableIO (throwIO TestError)--        mError <- readIORef callbackRef-        case mError >>= fromException of-          Just TestError -> return ()-          _ -> assertFailure $ "Unexpected result: " ++ show mError-    ]--testCatchTransaction :: BackendType -> TestTree-testCatchTransaction backendType =-  testGroup-    "catchSqlTransaction"-    [ testCase "catches errors" $ do-        wasCaughtRef <- newIORef False-        runTestApp backendType . withTransaction $-          (`catchSqlTransaction` markCaught wasCaughtRef) $-            rerunnableIO (throwString "error")-        wasCaught <- readIORef wasCaughtRef-        wasCaught @?= True-    , testCase "does not catch retry errors" $ do-        let retryIf e = case fromException e of-              Just (StringException "retry me" _) -> True-              _ -> False-            setRetry env = env{retryIf, retryLimit = 2}--        wasCaughtRef <- newIORef False-        _ <--          try @_ @SomeException $-            runTestAppWith backendType setRetry . withTransaction $-              (`catchSqlTransaction` markCaught wasCaughtRef) $-                rerunnableIO (throwString "retry me")-        wasCaught <- readIORef wasCaughtRef-        wasCaught @?= False-    ]-  where-    markCaught wasCaughtRef (_ :: SomeException) =-      rerunnableIO $ writeIORef wasCaughtRef True---- this should compile-testComposability :: BackendType -> TestTree-testComposability backendType = testCase "Operations can be composed" $ do-  let onlySql :: (MonadSqlQuery m) => m ()-      onlySql = do-        _ <- getPeople-        return ()--      sqlAndRerunnableIO :: (MonadSqlQuery m, MonadRerunnableIO m) => m ()-      sqlAndRerunnableIO = do-        _ <- getPeopleNames-        _ <- rerunnableIO $ newIORef True-        return ()--      onlyRerunnableIO :: (MonadRerunnableIO m) => m ()-      onlyRerunnableIO = do-        _ <- rerunnableIO $ newIORef True-        return ()--      arbitraryIO :: (MonadIO m) => m ()-      arbitraryIO = do-        _ <- liftIO $ newIORef True-        return ()--  -- everything should compose naturally by default-  runTestApp backendType $ do-    onlySql-    sqlAndRerunnableIO-    onlyRerunnableIO-    arbitraryIO--  -- in a transaction, you can compose everything except arbitrary IO-  runTestApp backendType $ withTransaction $ do-    onlySql-    sqlAndRerunnableIO-    onlyRerunnableIO---- uncomment this to get compile error--- arbitraryIO--testPersistentAPI :: BackendType -> TestTree-testPersistentAPI backendType =-  testGroup-    "Persistent API"-    [ testCase "get" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          mapM get [1, 2]-        map (fmap personName) result @?= [Just "Alice", Nothing]-    , testCase "getMany" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          getMany [1]-        personName <$> Map.lookup 1 result @?= Just "Alice"-    , testCase "getJust" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          getJust 1-        personName result @?= "Alice"-    , testCase "getJustEntity" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          getJustEntity 1-        getName result @?= "Alice"-    , testCase "getEntity" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          mapM getEntity [1, 2]-        map (fmap getName) result @?= [Just "Alice", Nothing]-    , testCase "belongsTo" $ do-        result <- runTestApp backendType $ do-          aliceKey <- insert $ person "Alice"-          let post1 = Post "Post #1" aliceKey (Just aliceKey)-              post2 = Post "Post #2" aliceKey Nothing-          insertMany_ [post1, post2]-          mapM (belongsTo postEditor) [post1, post2]-        map (fmap personName) result @?= [Just "Alice", Nothing]-    , testCase "belongsToJust" $ do-        result <- runTestApp backendType $ do-          aliceKey <- insert $ person "Alice"-          let post1 = Post "Post #1" aliceKey Nothing-          insert_ post1-          belongsToJust postAuthor post1-        personName result @?= "Alice"-    , testCase "insert" $ do-        result <- runTestApp backendType $ do-          aliceKey <- insert $ person "Alice"-          people <- getPeopleNames-          return (aliceKey, people)-        result @?= (1, ["Alice"])-    , testCase "insert_" $ do-        result <- runTestApp backendType $ do-          result <- insert_ $ person "Alice"-          people <- getPeopleNames-          return (result, people)-        result @?= ((), ["Alice"])-    , testCase "insertMany" $ do-        result <- runTestApp backendType $ do-          keys <- insertMany [person "Alice", person "Bob"]-          people <- getPeopleNames-          return (keys, people)-        result @?= ([1, 2], ["Alice", "Bob"])-    , testCase "insertMany_" $ do-        result <- runTestApp backendType $ do-          result <- insertMany_ [person "Alice", person "Bob"]-          people <- getPeopleNames-          return (result, people)-        result @?= ((), ["Alice", "Bob"])-    , testCase "insertEntityMany" $ do-        result <- runTestApp backendType $ do-          result <--            insertEntityMany-              [ Entity 1 $ person "Alice"-              , Entity 2 $ person "Bob"-              ]-          people <- getPeopleNames-          return (result, people)-        result @?= ((), ["Alice", "Bob"])-    , testCase "insertKey" $ do-        result <- runTestApp backendType $ do-          result <- insertKey 1 $ person "Alice"-          people <- getPeopleNames-          return (result, people)-        result @?= ((), ["Alice"])-    , testCase "repsert" $ do-        result <- runTestApp backendType $ do-          let alice = person "Alice"-          insert_ alice-          repsert 1 $ alice{personAge = 100}-          repsert 2 $ person "Bob"-          getPeople-        map nameAndAge result-          @?= [ ("Alice", 100)-              , ("Bob", 0)-              ]-    , testCase "repsertMany" $ do-        result <- runTestApp backendType $ do-          let alice = person "Alice"-          -- https://github.com/yesodweb/persistent/issues/832-          insert_ alice-          repsertMany-            [ (1, alice{personAge = 100})-            , (2, person "Bob")-            ]-          getPeople-        map nameAndAge result-          @?= [ ("Alice", 100)-              , ("Bob", 0)-              ]-    , testCase "replace" $ do-        result <- runTestApp backendType $ do-          let alice = person "Alice"-          insert_ alice-          replace 1 $ alice{personAge = 100}-          getJust 1-        personAge result @?= 100-    , testCase "delete" $ do-        result <- runTestApp backendType $ do-          aliceKey <- insert $ person "Alice"-          delete aliceKey-          getPeople-        result @?= []-    , testCase "update" $ do-        result <- runTestApp backendType $ do-          key <- insert $ person "Alice"-          update key [PersonName =. "Alicia"]-          getPeopleNames-        result @?= ["Alicia"]-    , testCase "updateGet" $ do-        (updateResult, getResult) <- runTestApp backendType $ do-          key <- insert $ person "Alice"-          updateResult <- updateGet key [PersonName =. "Alicia"]-          getResult <- getJust key-          return (updateResult, getResult)-        updateResult @?= getResult-    , testCase "insertEntity" $ do-        (insertResult, getResult) <- runTestApp backendType $ do-          insertResult <- insertEntity $ person "Alice"-          getResult <- getJust $ entityKey insertResult-          return (insertResult, getResult)-        entityVal insertResult @?= getResult-    , testCase "insertRecord" $ do-        (insertResult, getResult) <- runTestApp backendType $ do-          insertResult <- insertRecord $ person "Alice"-          getResult <- getJust 1-          return (insertResult, getResult)-        insertResult @?= getResult-    , testCase "getBy" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          mapM getBy [UniqueName "Alice", UniqueName "Bob"]-        map (fmap getName) result @?= [Just "Alice", Nothing]-    , testCase "getByValue" $ do-        result <- runTestApp backendType $ do-          let alice = person "Alice"-          insert_ alice-          mapM getByValue [alice, person "Bob"]-        map (fmap getName) result @?= [Just "Alice", Nothing]-    , testCase "checkUnique" $ do-        result <- runTestApp backendType $ do-          let alice = person "Alice"-          insert_ alice-          mapM-            checkUnique-            [ alice-            , person "Bob"-            , (person "Alice"){personAge = 100}-            ]-        result @?= [Just (UniqueName "Alice"), Nothing, Just (UniqueName "Alice")]-    , testCase "checkUniqueUpdateable" $ do-        result <- runTestApp backendType $ do-          let alice = person "Alice"-          insert_ alice-          mapM-            checkUniqueUpdateable-            [ Entity 1 alice-            , Entity 2 $ person "Bob"-            , Entity 3 $ (person "Alice"){personAge = 100}-            ]-        result @?= [Nothing, Nothing, Just (UniqueName "Alice")]-    , testCase "deleteBy" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          deleteBy $ UniqueName "Alice"-          getPeople-        result @?= []-    , testCase "insertUnique" $ do-        (result1, result2, people) <- runTestApp backendType $ do-          result1 <- insertUnique $ person "Alice"-          result2 <- insertUnique $ person "Alice"-          people <- getPeopleNames-          return (result1, result2, people)-        result1 @?= Just 1-        result2 @?= Nothing-        people @?= ["Alice"]-    , testCase "upsert" $ do-        (result1, result2, people) <- runTestApp backendType $ do-          result1 <- upsert (person "Alice") [PersonAge =. 0]-          result2 <- upsert (person "Alice") [PersonAge =. 100]-          people <- getPeople-          return (result1, result2, people)-        entityKey result1 @?= entityKey result2-        nameAndAge (entityVal result1) @?= ("Alice", 0)-        nameAndAge (entityVal result2) @?= ("Alice", 100)-        map nameAndAge people @?= [("Alice", 100)]-    , testCase "upsertBy" $ do-        (result1, result2, people) <- runTestApp backendType $ do-          result1 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 0]-          result2 <- upsertBy (UniqueName "Alice") (person "Alice") [PersonAge =. 100]-          people <- getPeople-          return (result1, result2, people)-        entityKey result1 @?= entityKey result2-        nameAndAge (entityVal result1) @?= ("Alice", 0)-        nameAndAge (entityVal result2) @?= ("Alice", 100)-        map nameAndAge people @?= [("Alice", 100)]-    , testCase "putMany" $ do-        result <- runTestApp backendType $ do-          let alice = person "Alice"-          insert_ alice-          putMany-            [ alice{personAge = 100}-            , person "Bob"-            ]-          getPeople-        map nameAndAge result-          @?= [ ("Alice", 100)-              , ("Bob", 0)-              ]-    , testCase "insertBy" $ do-        (result1, result2, people) <- runTestApp backendType $ do-          let alice = person "Alice"-          result1 <- insertBy alice-          result2 <- insertBy $ alice{personAge = 100}-          people <- getPeople-          return (result1, result2, people)-        result1 @?= Right 1-        first (entityKey &&& getName) result2 @?= Left (1, "Alice")-        map nameAndAge people @?= [("Alice", 0)]-    , testCase "insertUniqueEntity" $ do-        (result1, result2, people) <- runTestApp backendType $ do-          let alice = person "Alice"-          result1 <- insertUniqueEntity alice-          result2 <- insertUniqueEntity $ alice{personAge = 100}-          people <- getPeople-          return (result1, result2, people)-        (entityKey &&& getName) <$> result1 @?= Just (1, "Alice")-        result2 @?= Nothing-        map nameAndAge people @?= [("Alice", 0)]-    , testCase "replaceUnique" $ do-        (result1, result2, people) <- runTestApp backendType $ do-          let alice = person "Alice"-              bob = person "Bob"-          insertMany_ [alice, bob]-          result1 <- replaceUnique 1 $ alice{personName = "Bob"}-          result2 <- replaceUnique 2 $ bob{personAge = 100}-          people <- getPeople-          return (result1, result2, people)-        result1 @?= Just (UniqueName "Bob")-        result2 @?= Nothing-        map nameAndAge people @?= [("Alice", 0), ("Bob", 100)]-    , testCase "onlyUnique" $ do-        result <- runTestApp backendType $ onlyUnique $ person "Alice"-        result @?= UniqueName "Alice"-    , testCase "selectSourceRes" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          acquire <- selectSourceRes [] []-          Acquire.with acquire $ \conduit ->-            runConduit $ conduit .| Conduit.mapC getName .| Conduit.sinkList-        result @?= ["Alice", "Bob"]-    , testCase "selectFirst" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          sequence-            [ selectFirst [PersonName ==. "Alice"] []-            , selectFirst [PersonName ==. "Bob"] []-            ]-        map (fmap getName) result @?= [Just "Alice", Nothing]-    , testCase "selectKeysRes" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          acquire <- selectKeysRes @_ @Person [] []-          Acquire.with acquire $ \conduit ->-            runConduit $ conduit .| Conduit.sinkList-        result @?= [1, 2]-    , testCase "count" $ do-        result <- runTestApp backendType $ do-          insertMany_ $ map (\p -> p{personAge = 100}) [person "Alice", person "Bob"]-          count [PersonAge ==. 100]-        result @?= 2-    , testCase "exists" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          exists [PersonName ==. "Alice"]-        result @?= True-    , testCase "selectSource" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList-        result @?= ["Alice", "Bob"]-    , testCase "selectKeys" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          runConduit $ selectKeys @Person [] [] .| Conduit.sinkList-        result @?= [1, 2]-    , testCase "selectList" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          insert_ $ person "Bob"-          selectList [] []-        map getName result @?= ["Alice", "Bob"]-    , testCase "selectKeysList" $ do-        result <- runTestApp backendType $ do-          insert_ $ person "Alice"-          insert_ $ person "Bob"-          selectKeysList @Person [] []-        result @?= [1, 2]-    , testCase "updateWhere" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          updateWhere [PersonName ==. "Alice"] [PersonAge =. 100]-          getPeople-        map nameAndAge result @?= [("Alice", 100), ("Bob", 0)]-    , testCase "deleteWhere" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          deleteWhere [PersonName ==. "Alice"]-          getPeopleNames-        result @?= ["Bob"]-    , testCase "updateWhereCount" $ do-        (rowsUpdated, people) <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          rowsUpdated <- updateWhereCount [PersonName ==. "Alice"] [PersonAge =. 100]-          people <- getPeople-          return (rowsUpdated, people)-        rowsUpdated @?= 1-        map nameAndAge people @?= [("Alice", 100), ("Bob", 0)]-    , testCase "deleteWhereCount" $ do-        (rowsDeleted, names) <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          rowsDeleted <- deleteWhereCount [PersonName ==. "Alice"]-          names <- getPeopleNames-          return (rowsDeleted, names)-        rowsDeleted @?= 1-        names @?= ["Bob"]-    , testCase "parseMigration" $ do-        result <- runTestApp backendType $ do-          setupUnsafeMigration-          parseMigration migration--        let sql = case backendType of-              Sqlite ->-                [ eq-                    ( False-                    , Text.concat-                        [ "CREATE TEMP TABLE \"person_backup\"("-                        , "\"id\" INTEGER PRIMARY KEY,"-                        , "\"name\" VARCHAR NOT NULL,"-                        , "\"age\" INTEGER NOT NULL,"-                        , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"-                        ]-                    )-                , anything-                , eq (True, "DROP TABLE \"person\"")-                , anything-                , anything-                , eq (False, "DROP TABLE \"person_backup\"")-                ]-              Postgresql ->-                [ eq (True, "ALTER TABLE \"person\" DROP COLUMN \"foo\"")-                ]--        result @?~ right (elemsAre sql)-    , testCase "parseMigration'" $ do-        let action :: (Migration -> TestApp a) -> IO a-            action f = runTestApp backendType $ do-              setupUnsafeMigration-              f migration--        result <- action parseMigration-        result' <- action parseMigration'-        Right result' @?= result-    , testCase "printMigration" $-        runTestApp backendType $ do-          setupUnsafeMigration-          printMigration migration-    , testCase "showMigration" $ do-        result <- runTestApp backendType $ do-          setupUnsafeMigration-          showMigration migration--        let sql = case backendType of-              Sqlite ->-                [ eq $-                    Text.concat-                      [ "CREATE TEMP TABLE \"person_backup\"("-                      , "\"id\" INTEGER PRIMARY KEY,"-                      , "\"name\" VARCHAR NOT NULL,"-                      , "\"age\" INTEGER NOT NULL,"-                      , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"));"-                      ]-                , anything-                , eq "DROP TABLE \"person\";"-                , anything-                , anything-                , eq "DROP TABLE \"person_backup\";"-                ]-              Postgresql ->-                [ eq "ALTER TABLE \"person\" DROP COLUMN \"foo\";"-                ]--        result @?~ elemsAre sql-    , testCase "getMigration" $ do-        result <- runTestApp backendType $ do-          setupUnsafeMigration-          getMigration migration--        let sql = case backendType of-              Sqlite ->-                [ eq $-                    Text.concat-                      [ "CREATE TEMP TABLE \"person_backup\"("-                      , "\"id\" INTEGER PRIMARY KEY,"-                      , "\"name\" VARCHAR NOT NULL,"-                      , "\"age\" INTEGER NOT NULL,"-                      , "CONSTRAINT \"unique_name\" UNIQUE (\"name\"))"-                      ]-                , anything-                , eq "DROP TABLE \"person\""-                , anything-                , anything-                , eq "DROP TABLE \"person_backup\""-                ]-              Postgresql ->-                [ eq "ALTER TABLE \"person\" DROP COLUMN \"foo\""-                ]--        result @?~ elemsAre sql-    , testCase "runMigration" $ do-        result <- runTestApp backendType $ do-          setupSafeMigration-          runMigration migration-          getSchemaColumnNames backendType "person"-        assertNotIn "removed_column" result-    , testCase "runMigrationQuiet" $ do-        (withQuiet, cols) <- runTestApp backendType $ do-          setupSafeMigration-          sql <- runMigrationQuiet migration-          cols <- getSchemaColumnNames backendType "person"-          return (sql, cols)-        withSilent <- runTestApp backendType $ do-          setupSafeMigration-          runMigrationSilent migration-        assertNotIn "removed_column" cols-        withQuiet @?= withSilent-    , testCase "runMigrationSilent" $ do-        (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do-          setupSafeMigration-          sqlPlanned <- getMigration migration-          sqlExecuted <- runMigrationSilent migration-          cols <- getSchemaColumnNames backendType "person"-          return (sqlPlanned, sqlExecuted, cols)-        assertNotIn "removed_column" cols-        sqlExecuted @?= sqlPlanned-    , testCase "runMigrationUnsafe" $ do-        result <- runTestApp backendType $ do-          setupUnsafeMigration-          runMigrationUnsafe migration-          getSchemaColumnNames backendType "person"-        assertNotIn "removed_column" result-    , testCase "runMigrationUnsafeQuiet" $ do-        (sqlPlanned, sqlExecuted, cols) <- runTestApp backendType $ do-          setupUnsafeMigration-          sqlPlanned <- getMigration migration-          sqlExecuted <- runMigrationUnsafeQuiet migration-          cols <- getSchemaColumnNames backendType "person"-          return (sqlPlanned, sqlExecuted, cols)-        assertNotIn "removed_column" cols-        sqlExecuted @?= sqlPlanned-    , testCase "getFieldName" $ do-        result <--          runTestApp backendType $-            getFieldName PersonName-        result @?= "\"name\""-    , testCase "getTableName" $ do-        result <--          runTestApp backendType $-            getTableName $-              person "Alice"-        result @?= "\"person\""-    , testCase "withRawQuery" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          withRawQuery "SELECT name FROM person" [] $-            Conduit.mapC (getFirstPersistValue @Text) .| Conduit.sinkList--        result @?= ["Alice", "Bob"]-    , testCase "rawQueryRes" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          acquire <- rawQueryRes "SELECT name FROM person" []-          Acquire.with acquire $ \conduit ->-            runConduit $ conduit .| Conduit.mapC (getFirstPersistValue @Text) .| Conduit.sinkList-        result @?= ["Alice", "Bob"]-    , testCase "rawQuery" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          runConduit $ rawQuery "SELECT name FROM person" [] .| Conduit.mapC (getFirstPersistValue @Text) .| Conduit.sinkList-        result @?= ["Alice", "Bob"]-    , testCase "rawExecute" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          rawExecute "UPDATE person SET age = 100 WHERE name = 'Alice'" []-          getPeople-        map nameAndAge result @?= [("Alice", 100), ("Bob", 0)]-    , testCase "rawExecuteCount" $ do-        (rowsUpdated, people) <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          rowsUpdated <- rawExecuteCount "UPDATE person SET age = 100 WHERE name = 'Alice'" []-          people <- getPeople-          return (rowsUpdated, people)-        rowsUpdated @?= 1-        map nameAndAge people @?= [("Alice", 100), ("Bob", 0)]-    , testCase "rawSql" $ do-        result <- runTestApp backendType $ do-          insertMany_ [person "Alice", person "Bob"]-          rawSql @(Single String) "SELECT name FROM person" []-        map unSingle result @?= ["Alice", "Bob"]-    , testCase "transactionSave" $ do-        result1 <- runTestApp backendType $ do-          catchTestError $ withTransaction $ do-            insert_ $ person "Alice"-            insertAndFail $ person "Bob"-          getPeopleNames-        result1 @?= []--        result2 <- runTestApp backendType $ do-          catchTestError $ withTransaction $ do-            insert_ $ person "Alice"-            transactionSave-            insertAndFail $ person "Bob"-          getPeopleNames-        result2 @?= ["Alice"]-    , testCase "transactionSaveWithIsolation" $ do-        result1 <- runTestApp backendType $ do-          catchTestError $ withTransaction $ do-            insert_ $ person "Alice"-            insertAndFail $ person "Bob"-          getPeopleNames-        result1 @?= []--        result2 <- runTestApp backendType $ do-          catchTestError $ withTransaction $ do-            insert_ $ person "Alice"-            transactionSaveWithIsolation Serializable-            insertAndFail $ person "Bob"-          getPeopleNames-        result2 @?= ["Alice"]-    , testCase "transactionUndo" $ do-        result <- runTestApp backendType $ withTransaction $ do-          insert_ $ person "Alice"-          transactionUndo-          getPeopleNames-        result @?= []-    , testCase "transactionUndoWithIsolation" $ do-        result <- runTestApp backendType $ withTransaction $ do-          insert_ $ person "Alice"-          transactionUndoWithIsolation Serializable-          getPeopleNames-        result @?= []-    ]--testInterop :: BackendType -> TestTree-testInterop backendType =-  testGroup-    "Interop with third-party Persistent libraries"-    [ testCase "unsafeLiftSql" $ do-        let alice = person "Alice"-        result <- runTestApp backendType $ do-          insert_ alice-          esqueletoSelect $-            E.from $-              E.table @Person-        result @?= [Entity 1 alice]-    ]--{- Persistent helpers -}--getFirstPersistValue :: (PersistField a) => [PersistValue] -> a-getFirstPersistValue = \case-  [] -> error "Unexpectedly got no values"-  v : _ -> fromPersistValueOrFail v--fromPersistValueOrFail :: (PersistField a) => PersistValue -> a-fromPersistValueOrFail = either (error . Text.unpack) id . fromPersistValue--{- Meta SQL helpers -}---- | Put the database in a state where running a migration is safe.-setupSafeMigration :: (MonadSqlQuery m) => m ()-setupSafeMigration = rawExecute "ALTER TABLE person ADD COLUMN removed_column VARCHAR" []---- | Put the database in a state where running a migration is unsafe.-setupUnsafeMigration :: (MonadSqlQuery m) => m ()-setupUnsafeMigration = rawExecute "ALTER TABLE person ADD COLUMN foo VARCHAR" []---- | Get the names of all columns in the given table.-getSchemaColumnNames :: (MonadSqlQuery m) => BackendType -> String -> m [String]-getSchemaColumnNames backendType tableName = map unSingle <$> rawSql sql []-  where-    sql = Text.pack $ case backendType of-      Sqlite -> "SELECT name FROM pragma_table_info('" ++ tableName ++ "')"-      Postgresql ->-        unlines-          [ "SELECT column_name FROM information_schema.columns"-          , "WHERE table_schema = 'public' AND table_name = '" ++ tableName ++ "'"-          ]--{- Test helpers -}--data TestError = TestError-  deriving (Show, Eq)--instance Exception TestError--catchTestError :: (MonadUnliftIO m, Eq a, Show a) => m a -> m ()-catchTestError m = do-  result <- try m-  liftIO $ result @?= Left TestError--insertAndFail ::-  ( MonadRerunnableIO m-  , MonadSqlQuery m-  , PersistRecordBackend record SqlBackend-  , Typeable record-  , SafeToInsert record-  ) =>-  record-  -> m ()-insertAndFail record = do-  insert_ record-  rerunnableIO $ throwIO TestError--assertNotIn :: (Eq a, Show a) => a -> [a] -> Assertion-assertNotIn a as = as @?= filter (/= a) as

@@ -1,4 +1,1 @@-{- AUTOCOLLECT.MAIN-suite_name = persistent-mtl-strip_suffix = Test--}+import Skeletest.Main

@@ -0,0 +1,663 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module MockedSpec (spec) where++import Conduit (runConduit, runResourceT, (.|))+import qualified Conduit+import qualified Data.Acquire as Acquire+import qualified Data.Map.Strict as Map+import Data.Maybe (listToMaybe)+import Database.Persist.Sql (+  Entity (..),+  Single (..),+  toPersistValue,+  toSqlKey,+  (=.),+  (==.),+ )+import Skeletest+import qualified Skeletest.Predicate as P+import UnliftIO (SomeException)++import Database.Persist.Monad+import Database.Persist.Monad.TestUtils+import Example++spec :: Spec+spec = do+  describe "withTransaction" $ do+    it "doesn't error with MockSqlQueryT" $+      runMockSqlQueryT+        (withTransaction $ insert_ $ person "Alice")+        [ withRecord @Person $ \case+            Insert_ _ -> Just ()+            _ -> Nothing+        ]++  describe "MockSqlQueryT" $ do+    it "errors if it could not find a mock" $ do+      let errMsg e = (listToMaybe . lines . show) (e :: SomeException)+      runMockSqlQueryT getPeopleNames [] `shouldSatisfy` P.throws (errMsg P.>>> P.just (P.eq "Could not find mock for query: SelectList{..}<Person>"))++    it "continues after a mock doesn't match" $ do+      result <-+        runMockSqlQueryT+          getPeopleNames+          [ withRecord @Post $ \_ -> error "getPeopleNames matched Post record"+          , mockQuery $ \_ -> Nothing+          , withRecord @Person $ \case+              SelectList _ _ ->+                Just+                  [ Entity (toSqlKey 1) (Person "Alice" 10)+                  , Entity (toSqlKey 2) (Person "Bob" 20)+                  ]+              _ -> Nothing+          ]++      result `shouldBe` ["Alice", "Bob"]++  describe "Persistent API" $ do+    it "get" $ do+      result <-+        runMockSqlQueryT+          (mapM get [1, 2])+          [ withRecord @Person $ \case+              Get n+                | n == 1 -> Just $ Just $ person "Alice"+                | n == 2 -> Just Nothing+              _ -> Nothing+          ]+      map (fmap personName) result `shouldBe` [Just "Alice", Nothing]++    it "getMany" $ do+      result <-+        runMockSqlQueryT+          (getMany [1])+          [ withRecord @Person $ \case+              GetMany _ -> Just $ Map.fromList [(1, person "Alice")]+              _ -> Nothing+          ]+      personName <$> Map.lookup 1 result `shouldBe` Just "Alice"++    it "getJust" $ do+      result <-+        runMockSqlQueryT+          (getJust 1)+          [ withRecord @Person $ \case+              GetJust _ -> Just $ person "Alice"+              _ -> Nothing+          ]+      personName result `shouldBe` "Alice"++    it "getJustEntity" $ do+      result <-+        runMockSqlQueryT+          (getJustEntity 1)+          [ withRecord @Person $ \case+              GetJustEntity _ -> Just $ Entity 1 $ person "Alice"+              _ -> Nothing+          ]+      getName result `shouldBe` "Alice"++    it "getEntity" $ do+      result <-+        runMockSqlQueryT+          (mapM getEntity [1, 2])+          [ withRecord @Person $ \case+              GetEntity n+                | n == 1 -> Just $ Just $ Entity 1 $ person "Alice"+                | n == 2 -> Just Nothing+              _ -> Nothing+          ]+      map (fmap getName) result `shouldBe` [Just "Alice", Nothing]++    it "belongsTo" $ do+      let post1 = Post "Post #1" 1 (Just 1)+          post2 = Post "Post #2" 1 Nothing+      result <-+        runMockSqlQueryT+          (mapM (belongsTo postEditor) [post1, post2])+          [ withRecord @(Post, Person) $ \case+              BelongsTo _ Post{postEditor = Just 1} -> Just $ Just $ person "Alice"+              BelongsTo _ Post{postEditor = Nothing} -> Just Nothing+              _ -> Nothing+          ]+      map (fmap personName) result `shouldBe` [Just "Alice", Nothing]++    it "belongsToJust" $ do+      let post1 = Post "Post #1" 1 Nothing+      result <-+        runMockSqlQueryT+          (belongsToJust postAuthor post1)+          [ withRecord @(Post, Person) $ \case+              BelongsToJust _ _ -> Just $ person "Alice"+              _ -> Nothing+          ]+      personName result `shouldBe` "Alice"++    it "insert" $ do+      result <-+        runMockSqlQueryT+          (insert $ person "Alice")+          [ withRecord @Person $ \case+              Insert _ -> Just 1+              _ -> Nothing+          ]+      result `shouldBe` 1++    it "insert_" $ do+      result <-+        runMockSqlQueryT+          (insert_ $ person "Alice")+          [ withRecord @Person $ \case+              Insert_ _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "insertMany" $ do+      result <-+        runMockSqlQueryT+          (insertMany [person "Alice", person "Bob"])+          [ withRecord @Person $ \case+              InsertMany records -> Just $ map fromIntegral [1 .. length records]+              _ -> Nothing+          ]+      result `shouldBe` [1, 2]++    it "insertMany_" $ do+      result <-+        runMockSqlQueryT+          (insertMany_ [person "Alice", person "Bob"])+          [ withRecord @Person $ \case+              InsertMany_ _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "insertEntityMany" $ do+      result <-+        runMockSqlQueryT+          (insertEntityMany [Entity 1 $ person "Alice"])+          [ withRecord @Person $ \case+              InsertEntityMany _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "insertKey" $ do+      result <-+        runMockSqlQueryT+          (insertKey 1 $ person "Alice")+          [ withRecord @Person $ \case+              InsertKey _ _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "repsert" $ do+      result <-+        runMockSqlQueryT+          (repsert 1 $ person "Alice")+          [ withRecord @Person $ \case+              Repsert _ _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "repsertMany" $ do+      result <-+        runMockSqlQueryT+          (repsertMany [(1, person "Alice")])+          [ withRecord @Person $ \case+              RepsertMany _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "replace" $ do+      result <-+        runMockSqlQueryT+          (replace 1 $ person "Alice")+          [ withRecord @Person $ \case+              Replace _ _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "delete" $ do+      result <-+        runMockSqlQueryT+          (delete @Person 1)+          [ withRecord @Person $ \case+              Delete _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "update" $ do+      result <-+        runMockSqlQueryT+          (update 1 [PersonName =. "Alicia"])+          [ withRecord @Person $ \case+              Update _ _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "updateGet" $ do+      result <-+        runMockSqlQueryT+          (updateGet 1 [PersonName =. "Alicia"])+          [ withRecord @Person $ \case+              UpdateGet _ _ -> Just $ person "Alicia"+              _ -> Nothing+          ]+      personName result `shouldBe` "Alicia"++    it "insertEntity" $ do+      let alice = person "Alice"+      result <-+        runMockSqlQueryT+          (insertEntity alice)+          [ withRecord @Person $ \case+              InsertEntity _ -> Just $ Entity 1 alice+              _ -> Nothing+          ]+      entityVal result `shouldBe` alice++    it "insertRecord" $ do+      let alice = person "Alice"+      result <-+        runMockSqlQueryT+          (insertRecord alice)+          [ withRecord @Person $ \case+              InsertRecord _ -> Just alice+              _ -> Nothing+          ]+      result `shouldBe` alice++    it "getBy" $ do+      result <-+        runMockSqlQueryT+          (mapM getBy [UniqueName "Alice", UniqueName "Bob"])+          [ withRecord @Person $ \case+              GetBy (UniqueName "Alice") -> Just $ Just $ Entity 1 $ person "Alice"+              GetBy (UniqueName "Bob") -> Just Nothing+              _ -> Nothing+          ]+      map (fmap getName) result `shouldBe` [Just "Alice", Nothing]++    it "getByValue" $ do+      result <-+        runMockSqlQueryT+          (mapM getByValue [person "Alice", person "Bob"])+          [ withRecord @Person $ \case+              GetByValue Person{personName = "Alice"} -> Just $ Just $ Entity 1 $ person "Alice"+              GetByValue Person{personName = "Bob"} -> Just Nothing+              _ -> Nothing+          ]+      map (fmap getName) result `shouldBe` [Just "Alice", Nothing]++    it "checkUnique" $ do+      result <-+        runMockSqlQueryT+          (mapM checkUnique [person "Alice", person "Bob"])+          [ withRecord @Person $ \case+              CheckUnique Person{personName = "Alice"} -> Just $ Just $ UniqueName "Alice"+              CheckUnique Person{personName = "Bob"} -> Just Nothing+              _ -> Nothing+          ]+      result `shouldBe` [Just $ UniqueName "Alice", Nothing]++    it "checkUniqueUpdateable" $ do+      result <-+        runMockSqlQueryT+          (mapM checkUniqueUpdateable [Entity 1 $ person "Alice", Entity 2 $ person "Bob"])+          [ withRecord @Person $ \case+              CheckUniqueUpdateable (Entity _ Person{personName = "Alice"}) -> Just $ Just $ UniqueName "Alice"+              CheckUniqueUpdateable (Entity _ Person{personName = "Bob"}) -> Just Nothing+              _ -> Nothing+          ]+      result `shouldBe` [Just $ UniqueName "Alice", Nothing]++    it "deleteBy" $ do+      result <-+        runMockSqlQueryT+          (deleteBy $ UniqueName "Alice")+          [ withRecord @Person $ \case+              DeleteBy _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "insertUnique" $ do+      result <-+        runMockSqlQueryT+          (mapM insertUnique [person "Alice", person "Bob"])+          [ withRecord @Person $ \case+              InsertUnique Person{personName = "Alice"} -> Just $ Just 1+              InsertUnique Person{personName = "Bob"} -> Just Nothing+              _ -> Nothing+          ]+      result `shouldBe` [Just 1, Nothing]++    it "upsert" $ do+      let alice = person "Alice"+      result <-+        runMockSqlQueryT+          (upsert alice [PersonAge =. 100])+          [ withRecord @Person $ \case+              Upsert _ _ -> Just $ Entity 1 alice+              _ -> Nothing+          ]+      result `shouldBe` Entity 1 alice++    it "upsertBy" $ do+      let alice = person "Alice"+      result <-+        runMockSqlQueryT+          (upsertBy (UniqueName "Alice") alice [PersonAge =. 100])+          [ withRecord @Person $ \case+              UpsertBy _ _ _ -> Just $ Entity 1 alice+              _ -> Nothing+          ]+      result `shouldBe` Entity 1 alice++    it "putMany" $ do+      result <-+        runMockSqlQueryT+          (putMany [person "Alice"])+          [ withRecord @Person $ \case+              PutMany _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "insertBy" $ do+      let alice = person "Alice"+      result <-+        runMockSqlQueryT+          (mapM insertBy [alice, person "Bob"])+          [ withRecord @Person $ \case+              InsertBy Person{personName = "Alice"} -> Just $ Left $ Entity 1 alice+              InsertBy Person{personName = "Bob"} -> Just $ Right 2+              _ -> Nothing+          ]+      result `shouldBe` [Left $ Entity 1 alice, Right 2]++    it "insertUniqueEntity" $ do+      let bob = person "Bob"+      result <-+        runMockSqlQueryT+          (mapM insertUniqueEntity [person "Alice", bob])+          [ withRecord @Person $ \case+              InsertUniqueEntity Person{personName = "Alice"} -> Just Nothing+              InsertUniqueEntity Person{personName = "Bob"} -> Just $ Just $ Entity 1 bob+              _ -> Nothing+          ]+      result `shouldBe` [Nothing, Just $ Entity 1 bob]++    it "replaceUnique" $ do+      result <-+        runMockSqlQueryT+          (mapM (uncurry replaceUnique) [(1, person "Alice"), (2, person "Bob")])+          [ withRecord @Person $ \case+              ReplaceUnique _ Person{personName = "Alice"} -> Just Nothing+              ReplaceUnique _ Person{personName = "Bob"} -> Just $ Just $ UniqueName "Bob"+              _ -> Nothing+          ]+      result `shouldBe` [Nothing, Just $ UniqueName "Bob"]++    it "onlyUnique" $ do+      result <-+        runMockSqlQueryT+          (onlyUnique $ person "Alice")+          [ withRecord @Person $ \case+              OnlyUnique _ -> Just $ UniqueName "Alice"+              _ -> Nothing+          ]+      result `shouldBe` UniqueName "Alice"++    it "selectSourceRes" $ do+      acquire <-+        runMockSqlQueryT+          (selectSourceRes [] [])+          [ mockSelectSource $ \_ _ ->+              Just+                [ Entity 1 $ person "Alice"+                , Entity 2 $ person "Bob"+                ]+          ]+      result <- Acquire.with acquire $ \conduit ->+        runConduit $ conduit .| Conduit.mapC getName .| Conduit.sinkList+      result `shouldBe` ["Alice", "Bob"]++    it "selectFirst" $ do+      result1 <-+        runMockSqlQueryT+          (selectFirst [PersonName ==. "Alice"] [])+          [ withRecord @Person $ \case+              SelectFirst _ _ -> Just $ Just $ Entity 1 $ person "Alice"+              _ -> Nothing+          ]+      getName <$> result1 `shouldBe` Just "Alice"+      result2 <-+        runMockSqlQueryT+          (selectFirst [PersonName ==. "Alice"] [])+          [ withRecord @Person $ \case+              SelectFirst _ _ -> Just Nothing+              _ -> Nothing+          ]+      result2 `shouldBe` Nothing++    it "selectKeysRes" $ do+      let keys = [1, 2, 3]+      acquire <-+        runMockSqlQueryT+          (selectKeysRes @_ @Person [] [])+          [ mockSelectKeys $ \_ _ -> Just keys+          ]+      result <- Acquire.with acquire $ \conduit ->+        runConduit $ conduit .| Conduit.sinkList+      result `shouldBe` keys++    it "count" $ do+      result <-+        runMockSqlQueryT+          (count @Person [])+          [ withRecord @Person $ \case+              Count _ -> Just 10+              _ -> Nothing+          ]+      result `shouldBe` 10++    it "exists" $ do+      result <-+        runMockSqlQueryT+          (exists @Person [])+          [ withRecord @Person $ \case+              Exists _ -> Just True+              _ -> Nothing+          ]+      result `shouldBe` True++    it "selectSource" $ do+      result <-+        runResourceT $+          runMockSqlQueryT+            (runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList)+            [ mockSelectSource $ \_ _ ->+                Just+                  [ Entity 1 $ person "Alice"+                  , Entity 2 $ person "Bob"+                  ]+            ]+      result `shouldBe` ["Alice", "Bob"]++    it "selectKeys" $ do+      let keys = [1, 2, 3]+      result <-+        runResourceT $+          runMockSqlQueryT+            (runConduit $ selectKeys @Person [] [] .| Conduit.sinkList)+            [ mockSelectKeys $ \_ _ -> Just keys+            ]+      result `shouldBe` keys++    it "selectList" $ do+      result <-+        runMockSqlQueryT+          (selectList [] [])+          [ withRecord @Person $ \case+              SelectList _ _ ->+                Just+                  [ Entity 1 (person "Alice")+                  , Entity 2 (person "Bob")+                  ]+              _ -> Nothing+          ]+      map getName result `shouldBe` ["Alice", "Bob"]++    it "selectKeysList" $ do+      let keys = [1, 2, 3]+      result <-+        runMockSqlQueryT+          (selectKeysList @Person [] [])+          [ withRecord @Person $ \case+              SelectKeysList _ _ -> Just keys+              _ -> Nothing+          ]+      result `shouldBe` keys++    it "updateWhere" $ do+      result <-+        runMockSqlQueryT+          (updateWhere [] [PersonAge =. 100])+          [ withRecord @Person $ \case+              UpdateWhere _ _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "deleteWhere" $ do+      result <-+        runMockSqlQueryT+          (deleteWhere [PersonName ==. "Alice"])+          [ withRecord @Person $ \case+              DeleteWhere _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "updateWhereCount" $ do+      result <-+        runMockSqlQueryT+          (updateWhereCount [] [PersonAge =. 100])+          [ withRecord @Person $ \case+              UpdateWhereCount _ _ -> Just 10+              _ -> Nothing+          ]+      result `shouldBe` 10++    it "deleteWhereCount" $ do+      result <-+        runMockSqlQueryT+          (deleteWhereCount [PersonName ==. "Alice"])+          [ withRecord @Person $ \case+              DeleteWhereCount _ -> Just 10+              _ -> Nothing+          ]+      result `shouldBe` 10++    it "getFieldName" $ do+      result <-+        runMockSqlQueryT+          (getFieldName PersonName)+          [ withRecord @Person $ \case+              GetFieldName PersonName -> Just "\"name\""+              _ -> Nothing+          ]+      result `shouldBe` "\"name\""++    it "getTableName" $ do+      result <-+        runMockSqlQueryT+          (getTableName $ person "Alice")+          [ withRecord @Person $ \case+              GetTableName _ -> Just "\"person\""+              _ -> Nothing+          ]+      result `shouldBe` "\"person\""++    it "withRawQuery" $ do+      let query = "SELECT name FROM person"+          row1 = [toPersistValue @String "Alice"]+          row2 = [toPersistValue @String "Bob"]+          rows = [row1, row2]+      result <-+        runMockSqlQueryT+          (withRawQuery query [] Conduit.sinkList)+          [ mockWithRawQuery $ \sql _ ->+              if sql == query+                then Just rows+                else Nothing+          ]+      result `shouldBe` rows++    it "rawQueryRes" $ do+      let row1 = [toPersistValue @String "Alice"]+          row2 = [toPersistValue @String "Bob"]+          rows = [row1, row2]+      acquire <-+        runMockSqlQueryT+          (rawQueryRes "SELECT name FROM person" [])+          [ mockRawQuery $ \_ _ -> Just rows+          ]+      result <- Acquire.with acquire $ \conduit ->+        runConduit $ conduit .| Conduit.sinkList+      result `shouldBe` rows++    it "rawQuery" $ do+      let row1 = [toPersistValue @String "Alice"]+          row2 = [toPersistValue @String "Bob"]+          rows = [row1, row2]+      result <-+        runResourceT $+          runMockSqlQueryT+            (runConduit $ rawQuery "SELECT name FROM person" [] .| Conduit.sinkList)+            [ mockRawQuery $ \_ _ -> Just rows+            ]+      result `shouldBe` rows++    it "rawExecute" $ do+      result <-+        runMockSqlQueryT+          (rawExecute "DELETE FROM person" [])+          [ mockQuery $ \case+              RawExecute _ _ -> Just ()+              _ -> Nothing+          ]+      result `shouldBe` ()++    it "rawExecuteCount" $ do+      result <-+        runMockSqlQueryT+          (rawExecuteCount "DELETE FROM person" [])+          [ mockQuery $ \case+              RawExecuteCount _ _ -> Just 10+              _ -> Nothing+          ]+      result `shouldBe` 10++    it "rawSql" $ do+      let names = ["Alice", "Bob"] :: [String]+      result <-+        runMockSqlQueryT+          (rawSql "SELECT name FROM person" [])+          [ mockRawSql $ \_ _ -> Just $ map ((: []) . toPersistValue) names+          ]+      map unSingle result `shouldBe` names

@@ -1,622 +0,0 @@-{- AUTOCOLLECT.TEST -}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module MockedTest (-  -- $AUTOCOLLECT.TEST.export$-) where--import Conduit (runConduit, runResourceT, (.|))-import qualified Conduit-import qualified Data.Acquire as Acquire-import qualified Data.Map.Strict as Map-import Data.Maybe (listToMaybe)-import Database.Persist.Sql (-  Entity (..),-  Single (..),-  toPersistValue,-  toSqlKey,-  (=.),-  (==.),- )-import Test.Tasty-import Test.Tasty.HUnit-import UnliftIO (SomeException, try)--import Database.Persist.Monad-import Database.Persist.Monad.TestUtils-import Example--test =-  testGroup-    "withTransaction"-    [ testCase "it doesn't error with MockSqlQueryT" $-        runMockSqlQueryT-          (withTransaction $ insert_ $ person "Alice")-          [ withRecord @Person $ \case-              Insert_ _ -> Just ()-              _ -> Nothing-          ]-    ]--test =-  testGroup-    "MockSqlQueryT"-    [ testCase "it errors if it could not find a mock" $ do-        result <- try $ runMockSqlQueryT getPeopleNames []-        case result of-          Right _ -> assertFailure "runMockSqlQueryT did not fail"-          Left e -> do-            let msg = listToMaybe $ lines $ show (e :: SomeException)-            msg @?= Just "Could not find mock for query: SelectList{..}<Person>"-    , testCase "it continues after a mock doesn't match" $ do-        result <--          runMockSqlQueryT-            getPeopleNames-            [ withRecord @Post $ \_ -> error "getPeopleNames matched Post record"-            , mockQuery $ \_ -> Nothing-            , withRecord @Person $ \case-                SelectList _ _ ->-                  Just-                    [ Entity (toSqlKey 1) (Person "Alice" 10)-                    , Entity (toSqlKey 2) (Person "Bob" 20)-                    ]-                _ -> Nothing-            ]--        result @?= ["Alice", "Bob"]-    ]--test =-  testGroup-    "Persistent API"-    [ testCase "get" $ do-        result <--          runMockSqlQueryT-            (mapM get [1, 2])-            [ withRecord @Person $ \case-                Get n-                  | n == 1 -> Just $ Just $ person "Alice"-                  | n == 2 -> Just Nothing-                _ -> Nothing-            ]-        map (fmap personName) result @?= [Just "Alice", Nothing]-    , testCase "getMany" $ do-        result <--          runMockSqlQueryT-            (getMany [1])-            [ withRecord @Person $ \case-                GetMany _ -> Just $ Map.fromList [(1, person "Alice")]-                _ -> Nothing-            ]-        personName <$> Map.lookup 1 result @?= Just "Alice"-    , testCase "getJust" $ do-        result <--          runMockSqlQueryT-            (getJust 1)-            [ withRecord @Person $ \case-                GetJust _ -> Just $ person "Alice"-                _ -> Nothing-            ]-        personName result @?= "Alice"-    , testCase "getJustEntity" $ do-        result <--          runMockSqlQueryT-            (getJustEntity 1)-            [ withRecord @Person $ \case-                GetJustEntity _ -> Just $ Entity 1 $ person "Alice"-                _ -> Nothing-            ]-        getName result @?= "Alice"-    , testCase "getEntity" $ do-        result <--          runMockSqlQueryT-            (mapM getEntity [1, 2])-            [ withRecord @Person $ \case-                GetEntity n-                  | n == 1 -> Just $ Just $ Entity 1 $ person "Alice"-                  | n == 2 -> Just Nothing-                _ -> Nothing-            ]-        map (fmap getName) result @?= [Just "Alice", Nothing]-    , testCase "belongsTo" $ do-        let post1 = Post "Post #1" 1 (Just 1)-            post2 = Post "Post #2" 1 Nothing-        result <--          runMockSqlQueryT-            (mapM (belongsTo postEditor) [post1, post2])-            [ withRecord @(Post, Person) $ \case-                BelongsTo _ Post{postEditor = Just 1} -> Just $ Just $ person "Alice"-                BelongsTo _ Post{postEditor = Nothing} -> Just Nothing-                _ -> Nothing-            ]-        map (fmap personName) result @?= [Just "Alice", Nothing]-    , testCase "belongsToJust" $ do-        let post1 = Post "Post #1" 1 Nothing-        result <--          runMockSqlQueryT-            (belongsToJust postAuthor post1)-            [ withRecord @(Post, Person) $ \case-                BelongsToJust _ _ -> Just $ person "Alice"-                _ -> Nothing-            ]-        personName result @?= "Alice"-    , testCase "insert" $ do-        result <--          runMockSqlQueryT-            (insert $ person "Alice")-            [ withRecord @Person $ \case-                Insert _ -> Just 1-                _ -> Nothing-            ]-        result @?= 1-    , testCase "insert_" $ do-        result <--          runMockSqlQueryT-            (insert_ $ person "Alice")-            [ withRecord @Person $ \case-                Insert_ _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "insertMany" $ do-        result <--          runMockSqlQueryT-            (insertMany [person "Alice", person "Bob"])-            [ withRecord @Person $ \case-                InsertMany records -> Just $ map fromIntegral [1 .. length records]-                _ -> Nothing-            ]-        result @?= [1, 2]-    , testCase "insertMany_" $ do-        result <--          runMockSqlQueryT-            (insertMany_ [person "Alice", person "Bob"])-            [ withRecord @Person $ \case-                InsertMany_ _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "insertEntityMany" $ do-        result <--          runMockSqlQueryT-            (insertEntityMany [Entity 1 $ person "Alice"])-            [ withRecord @Person $ \case-                InsertEntityMany _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "insertKey" $ do-        result <--          runMockSqlQueryT-            (insertKey 1 $ person "Alice")-            [ withRecord @Person $ \case-                InsertKey _ _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "repsert" $ do-        result <--          runMockSqlQueryT-            (repsert 1 $ person "Alice")-            [ withRecord @Person $ \case-                Repsert _ _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "repsertMany" $ do-        result <--          runMockSqlQueryT-            (repsertMany [(1, person "Alice")])-            [ withRecord @Person $ \case-                RepsertMany _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "replace" $ do-        result <--          runMockSqlQueryT-            (replace 1 $ person "Alice")-            [ withRecord @Person $ \case-                Replace _ _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "delete" $ do-        result <--          runMockSqlQueryT-            (delete @Person 1)-            [ withRecord @Person $ \case-                Delete _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "update" $ do-        result <--          runMockSqlQueryT-            (update 1 [PersonName =. "Alicia"])-            [ withRecord @Person $ \case-                Update _ _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "updateGet" $ do-        result <--          runMockSqlQueryT-            (updateGet 1 [PersonName =. "Alicia"])-            [ withRecord @Person $ \case-                UpdateGet _ _ -> Just $ person "Alicia"-                _ -> Nothing-            ]-        personName result @?= "Alicia"-    , testCase "insertEntity" $ do-        let alice = person "Alice"-        result <--          runMockSqlQueryT-            (insertEntity alice)-            [ withRecord @Person $ \case-                InsertEntity _ -> Just $ Entity 1 alice-                _ -> Nothing-            ]-        entityVal result @?= alice-    , testCase "insertRecord" $ do-        let alice = person "Alice"-        result <--          runMockSqlQueryT-            (insertRecord alice)-            [ withRecord @Person $ \case-                InsertRecord _ -> Just alice-                _ -> Nothing-            ]-        result @?= alice-    , testCase "getBy" $ do-        result <--          runMockSqlQueryT-            (mapM getBy [UniqueName "Alice", UniqueName "Bob"])-            [ withRecord @Person $ \case-                GetBy (UniqueName "Alice") -> Just $ Just $ Entity 1 $ person "Alice"-                GetBy (UniqueName "Bob") -> Just Nothing-                _ -> Nothing-            ]-        map (fmap getName) result @?= [Just "Alice", Nothing]-    , testCase "getByValue" $ do-        result <--          runMockSqlQueryT-            (mapM getByValue [person "Alice", person "Bob"])-            [ withRecord @Person $ \case-                GetByValue Person{personName = "Alice"} -> Just $ Just $ Entity 1 $ person "Alice"-                GetByValue Person{personName = "Bob"} -> Just Nothing-                _ -> Nothing-            ]-        map (fmap getName) result @?= [Just "Alice", Nothing]-    , testCase "checkUnique" $ do-        result <--          runMockSqlQueryT-            (mapM checkUnique [person "Alice", person "Bob"])-            [ withRecord @Person $ \case-                CheckUnique Person{personName = "Alice"} -> Just $ Just $ UniqueName "Alice"-                CheckUnique Person{personName = "Bob"} -> Just Nothing-                _ -> Nothing-            ]-        result @?= [Just $ UniqueName "Alice", Nothing]-    , testCase "checkUniqueUpdateable" $ do-        result <--          runMockSqlQueryT-            (mapM checkUniqueUpdateable [Entity 1 $ person "Alice", Entity 2 $ person "Bob"])-            [ withRecord @Person $ \case-                CheckUniqueUpdateable (Entity _ Person{personName = "Alice"}) -> Just $ Just $ UniqueName "Alice"-                CheckUniqueUpdateable (Entity _ Person{personName = "Bob"}) -> Just Nothing-                _ -> Nothing-            ]-        result @?= [Just $ UniqueName "Alice", Nothing]-    , testCase "deleteBy" $ do-        result <--          runMockSqlQueryT-            (deleteBy $ UniqueName "Alice")-            [ withRecord @Person $ \case-                DeleteBy _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "insertUnique" $ do-        result <--          runMockSqlQueryT-            (mapM insertUnique [person "Alice", person "Bob"])-            [ withRecord @Person $ \case-                InsertUnique Person{personName = "Alice"} -> Just $ Just 1-                InsertUnique Person{personName = "Bob"} -> Just Nothing-                _ -> Nothing-            ]-        result @?= [Just 1, Nothing]-    , testCase "upsert" $ do-        let alice = person "Alice"-        result <--          runMockSqlQueryT-            (upsert alice [PersonAge =. 100])-            [ withRecord @Person $ \case-                Upsert _ _ -> Just $ Entity 1 alice-                _ -> Nothing-            ]-        result @?= Entity 1 alice-    , testCase "upsertBy" $ do-        let alice = person "Alice"-        result <--          runMockSqlQueryT-            (upsertBy (UniqueName "Alice") alice [PersonAge =. 100])-            [ withRecord @Person $ \case-                UpsertBy _ _ _ -> Just $ Entity 1 alice-                _ -> Nothing-            ]-        result @?= Entity 1 alice-    , testCase "putMany" $ do-        result <--          runMockSqlQueryT-            (putMany [person "Alice"])-            [ withRecord @Person $ \case-                PutMany _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "insertBy" $ do-        let alice = person "Alice"-        result <--          runMockSqlQueryT-            (mapM insertBy [alice, person "Bob"])-            [ withRecord @Person $ \case-                InsertBy Person{personName = "Alice"} -> Just $ Left $ Entity 1 alice-                InsertBy Person{personName = "Bob"} -> Just $ Right 2-                _ -> Nothing-            ]-        result @?= [Left $ Entity 1 alice, Right 2]-    , testCase "insertUniqueEntity" $ do-        let bob = person "Bob"-        result <--          runMockSqlQueryT-            (mapM insertUniqueEntity [person "Alice", bob])-            [ withRecord @Person $ \case-                InsertUniqueEntity Person{personName = "Alice"} -> Just Nothing-                InsertUniqueEntity Person{personName = "Bob"} -> Just $ Just $ Entity 1 bob-                _ -> Nothing-            ]-        result @?= [Nothing, Just $ Entity 1 bob]-    , testCase "replaceUnique" $ do-        result <--          runMockSqlQueryT-            (mapM (uncurry replaceUnique) [(1, person "Alice"), (2, person "Bob")])-            [ withRecord @Person $ \case-                ReplaceUnique _ Person{personName = "Alice"} -> Just Nothing-                ReplaceUnique _ Person{personName = "Bob"} -> Just $ Just $ UniqueName "Bob"-                _ -> Nothing-            ]-        result @?= [Nothing, Just $ UniqueName "Bob"]-    , testCase "onlyUnique" $ do-        result <--          runMockSqlQueryT-            (onlyUnique $ person "Alice")-            [ withRecord @Person $ \case-                OnlyUnique _ -> Just $ UniqueName "Alice"-                _ -> Nothing-            ]-        result @?= UniqueName "Alice"-    , testCase "selectSourceRes" $ do-        acquire <--          runMockSqlQueryT-            (selectSourceRes [] [])-            [ mockSelectSource $ \_ _ ->-                Just-                  [ Entity 1 $ person "Alice"-                  , Entity 2 $ person "Bob"-                  ]-            ]-        result <- Acquire.with acquire $ \conduit ->-          runConduit $ conduit .| Conduit.mapC getName .| Conduit.sinkList-        result @?= ["Alice", "Bob"]-    , testCase "selectFirst" $ do-        result1 <--          runMockSqlQueryT-            (selectFirst [PersonName ==. "Alice"] [])-            [ withRecord @Person $ \case-                SelectFirst _ _ -> Just $ Just $ Entity 1 $ person "Alice"-                _ -> Nothing-            ]-        getName <$> result1 @?= Just "Alice"-        result2 <--          runMockSqlQueryT-            (selectFirst [PersonName ==. "Alice"] [])-            [ withRecord @Person $ \case-                SelectFirst _ _ -> Just Nothing-                _ -> Nothing-            ]-        result2 @?= Nothing-    , testCase "selectKeysRes" $ do-        let keys = [1, 2, 3]-        acquire <--          runMockSqlQueryT-            (selectKeysRes @_ @Person [] [])-            [ mockSelectKeys $ \_ _ -> Just keys-            ]-        result <- Acquire.with acquire $ \conduit ->-          runConduit $ conduit .| Conduit.sinkList-        result @?= keys-    , testCase "count" $ do-        result <--          runMockSqlQueryT-            (count @Person [])-            [ withRecord @Person $ \case-                Count _ -> Just 10-                _ -> Nothing-            ]-        result @?= 10-    , testCase "exists" $ do-        result <--          runMockSqlQueryT-            (exists @Person [])-            [ withRecord @Person $ \case-                Exists _ -> Just True-                _ -> Nothing-            ]-        result @?= True-    , testCase "selectSource" $ do-        result <--          runResourceT $-            runMockSqlQueryT-              (runConduit $ selectSource [] [] .| Conduit.mapC getName .| Conduit.sinkList)-              [ mockSelectSource $ \_ _ ->-                  Just-                    [ Entity 1 $ person "Alice"-                    , Entity 2 $ person "Bob"-                    ]-              ]-        result @?= ["Alice", "Bob"]-    , testCase "selectKeys" $ do-        let keys = [1, 2, 3]-        result <--          runResourceT $-            runMockSqlQueryT-              (runConduit $ selectKeys @Person [] [] .| Conduit.sinkList)-              [ mockSelectKeys $ \_ _ -> Just keys-              ]-        result @?= keys-    , testCase "selectList" $ do-        result <--          runMockSqlQueryT-            (selectList [] [])-            [ withRecord @Person $ \case-                SelectList _ _ ->-                  Just-                    [ Entity 1 (person "Alice")-                    , Entity 2 (person "Bob")-                    ]-                _ -> Nothing-            ]-        map getName result @?= ["Alice", "Bob"]-    , testCase "selectKeysList" $ do-        let keys = [1, 2, 3]-        result <--          runMockSqlQueryT-            (selectKeysList @Person [] [])-            [ withRecord @Person $ \case-                SelectKeysList _ _ -> Just keys-                _ -> Nothing-            ]-        result @?= keys-    , testCase "updateWhere" $ do-        result <--          runMockSqlQueryT-            (updateWhere [] [PersonAge =. 100])-            [ withRecord @Person $ \case-                UpdateWhere _ _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "deleteWhere" $ do-        result <--          runMockSqlQueryT-            (deleteWhere [PersonName ==. "Alice"])-            [ withRecord @Person $ \case-                DeleteWhere _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "updateWhereCount" $ do-        result <--          runMockSqlQueryT-            (updateWhereCount [] [PersonAge =. 100])-            [ withRecord @Person $ \case-                UpdateWhereCount _ _ -> Just 10-                _ -> Nothing-            ]-        result @?= 10-    , testCase "deleteWhereCount" $ do-        result <--          runMockSqlQueryT-            (deleteWhereCount [PersonName ==. "Alice"])-            [ withRecord @Person $ \case-                DeleteWhereCount _ -> Just 10-                _ -> Nothing-            ]-        result @?= 10-    , testCase "getFieldName" $ do-        result <--          runMockSqlQueryT-            (getFieldName PersonName)-            [ withRecord @Person $ \case-                GetFieldName PersonName -> Just "\"name\""-                _ -> Nothing-            ]-        result @?= "\"name\""-    , testCase "getTableName" $ do-        result <--          runMockSqlQueryT-            (getTableName $ person "Alice")-            [ withRecord @Person $ \case-                GetTableName _ -> Just "\"person\""-                _ -> Nothing-            ]-        result @?= "\"person\""-    , testCase "withRawQuery" $ do-        let query = "SELECT name FROM person"-            row1 = [toPersistValue @String "Alice"]-            row2 = [toPersistValue @String "Bob"]-            rows = [row1, row2]-        result <--          runMockSqlQueryT-            (withRawQuery query [] Conduit.sinkList)-            [ mockWithRawQuery $ \sql _ ->-                if sql == query-                  then Just rows-                  else Nothing-            ]-        result @?= rows-    , testCase "rawQueryRes" $ do-        let row1 = [toPersistValue @String "Alice"]-            row2 = [toPersistValue @String "Bob"]-            rows = [row1, row2]-        acquire <--          runMockSqlQueryT-            (rawQueryRes "SELECT name FROM person" [])-            [ mockRawQuery $ \_ _ -> Just rows-            ]-        result <- Acquire.with acquire $ \conduit ->-          runConduit $ conduit .| Conduit.sinkList-        result @?= rows-    , testCase "rawQuery" $ do-        let row1 = [toPersistValue @String "Alice"]-            row2 = [toPersistValue @String "Bob"]-            rows = [row1, row2]-        result <--          runResourceT $-            runMockSqlQueryT-              (runConduit $ rawQuery "SELECT name FROM person" [] .| Conduit.sinkList)-              [ mockRawQuery $ \_ _ -> Just rows-              ]-        result @?= rows-    , testCase "rawExecute" $ do-        result <--          runMockSqlQueryT-            (rawExecute "DELETE FROM person" [])-            [ mockQuery $ \case-                RawExecute _ _ -> Just ()-                _ -> Nothing-            ]-        result @?= ()-    , testCase "rawExecuteCount" $ do-        result <--          runMockSqlQueryT-            (rawExecuteCount "DELETE FROM person" [])-            [ mockQuery $ \case-                RawExecuteCount _ _ -> Just 10-                _ -> Nothing-            ]-        result @?= 10-    , testCase "rawSql" $ do-        let names = ["Alice", "Bob"] :: [String]-        result <--          runMockSqlQueryT-            (rawSql "SELECT name FROM person" [])-            [ mockRawSql $ \_ _ -> Just $ map ((: []) . toPersistValue) names-            ]-        map unSingle result @?= names-    ]

@@ -0,0 +1,30 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}++module READMESpec (spec) where++import Skeletest++import Database.Persist.Monad+import Database.Persist.Monad.TestUtils+import Example++spec :: Spec+spec = do+  it "withTransaction example works" $ do+    let foo :: (MonadSqlQuery m) => m ()+        foo = insert_ $ person "Alice"+        bar :: (MonadSqlQuery m) => m ()+        bar = insert_ $ person "Bob"+        fooAndBar :: (MonadSqlQuery m) => m ()+        fooAndBar = withTransaction $ foo >> bar+    runMockSqlQueryT+      fooAndBar+      [ withRecord @Person $ \case+          Insert_ _ -> Just ()+          _ -> Nothing+      , withRecord @Person $ \case+          Insert_ _ -> Just ()+          _ -> Nothing+      ]

@@ -1,32 +0,0 @@-{- AUTOCOLLECT.TEST -}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TypeApplications #-}--module READMETest (-  -- $AUTOCOLLECT.TEST.export$-) where--import Test.Tasty.HUnit--import Database.Persist.Monad-import Database.Persist.Monad.TestUtils-import Example--test =-  testCase "withTransaction example works" $ do-    let foo :: (MonadSqlQuery m) => m ()-        foo = insert_ $ person "Alice"-        bar :: (MonadSqlQuery m) => m ()-        bar = insert_ $ person "Bob"-        fooAndBar :: (MonadSqlQuery m) => m ()-        fooAndBar = withTransaction $ foo >> bar-    runMockSqlQueryT-      fooAndBar-      [ withRecord @Person $ \case-          Insert_ _ -> Just ()-          _ -> Nothing-      , withRecord @Person $ \case-          Insert_ _ -> Just ()-          _ -> Nothing-      ]

@@ -0,0 +1,23 @@+{-# LANGUAGE CPP #-}++module SqlQueryRepSpec (spec) where++import Skeletest+import qualified Skeletest.Predicate as P++import Generated++persistentVersion :: String+#if MIN_VERSION_persistent(2,15,0)+persistentVersion = error "Running tests against persistent > 2.14 is not supported"+#elif MIN_VERSION_persistent(2,14,0)+persistentVersion = "2.14"+#else+persistentVersion = error "Running tests against persistent < 2.14 is not supported"+#endif++spec :: Spec+spec = do+  describe "SqlQueryRep" $ do+    it ("renders with Show (persistent-" <> persistentVersion <> ")") $ do+      unlines allSqlQueryRepShowRepresentations `shouldSatisfy` P.matchesSnapshot

@@ -1,33 +0,0 @@-{- AUTOCOLLECT.TEST -}-{-# LANGUAGE CPP #-}--module SqlQueryRepTest (-  -- $AUTOCOLLECT.TEST.export$-) where--import qualified Data.ByteString.Lazy.Char8 as Char8-import Test.Tasty-import Test.Tasty.Golden--import Generated--persistentVersionDir :: FilePath-#if MIN_VERSION_persistent(2,15,0)-persistentVersionDir = error "Running tests against persistent > 2.14 is not supported"-#elif MIN_VERSION_persistent(2,14,0)-persistentVersionDir = "persistent-2.14/"-#elif MIN_VERSION_persistent(2,13,0)-persistentVersionDir = "persistent-2.13/"-#else-persistentVersionDir = error "Running tests against persistent < 2.13 is not supported"-#endif--test =-  golden "Show representation" (persistentVersionDir ++ "sqlqueryrep_show_representation.golden") $-    pure $-      unlines allSqlQueryRepShowRepresentations--golden :: String -> FilePath -> IO String -> TestTree-golden name fp action = goldenVsStringDiff name diffCmd ("test/goldens/" ++ fp) $ Char8.pack <$> action-  where-    diffCmd expected actual = ["diff", "-u", expected, actual]

@@ -5,7 +5,6 @@ ) where  import qualified Database.Esqueleto.Experimental as E-import qualified Database.Esqueleto.Internal.Internal as E  import Database.Persist.Monad (MonadSqlQuery, unsafeLiftSql) 

@@ -0,0 +1,72 @@+# SqlQueryRep++## SqlQueryRep / renders with Show (persistent-2.14)++```+Get{..}<Person>+GetMany{..}<Person>+GetJust{..}<Person>+GetJustEntity{..}<Person>+GetEntity{..}<Person>+BelongsTo{..}<(Person,Post)>+BelongsToJust{..}<(Person,Post)>+Insert{..}<Person>+Insert_{..}<Person>+InsertMany{..}<Person>+InsertMany_{..}<Person>+InsertEntityMany{..}<Person>+InsertKey{..}<Person>+Repsert{..}<Person>+RepsertMany{..}<Person>+Replace{..}<Person>+Delete{..}<Person>+Update{..}<Person>+UpdateGet{..}<Person>+InsertEntity{..}<Person>+InsertRecord{..}<Person>+GetBy{..}<Person>+GetByValue{..}<Person>+CheckUnique{..}<Person>+CheckUniqueUpdateable{..}<Person>+DeleteBy{..}<Person>+InsertUnique{..}<Person>+Upsert{..}<Person>+UpsertBy{..}<Person>+PutMany{..}<Person>+InsertBy{..}<Person>+InsertUniqueEntity{..}<Person>+ReplaceUnique{..}<Person>+OnlyUnique{..}<Person>+SelectSourceRes{..}<Person>+SelectFirst{..}<Person>+SelectKeysRes{..}<Person>+Count{..}<Person>+Exists{..}<Person>+SelectList{..}<Person>+SelectKeysList{..}<Person>+UpdateWhere{..}<Person>+DeleteWhere{..}<Person>+DeleteWhereCount{..}<Person>+UpdateWhereCount{..}<Person>+ParseMigration{..}+ParseMigration'{..}+PrintMigration{..}+ShowMigration{..}+GetMigration{..}+RunMigration{..}+RunMigrationQuiet{..}+RunMigrationSilent{..}+RunMigrationUnsafe{..}+RunMigrationUnsafeQuiet{..}+GetFieldName{..}<Person>+GetTableName{..}<Person>+WithRawQuery{..}+RawQueryRes{..}+RawExecute{..}+RawExecuteCount{..}+RawSql{..}+TransactionSave{..}+TransactionSaveWithIsolation{..}+TransactionUndo{..}+TransactionUndoWithIsolation{..}+```

@@ -1,66 +0,0 @@-Get{..}<Person>-GetMany{..}<Person>-GetJust{..}<Person>-GetJustEntity{..}<Person>-GetEntity{..}<Person>-BelongsTo{..}<(Person,Post)>-BelongsToJust{..}<(Person,Post)>-Insert{..}<Person>-Insert_{..}<Person>-InsertMany{..}<Person>-InsertMany_{..}<Person>-InsertEntityMany{..}<Person>-InsertKey{..}<Person>-Repsert{..}<Person>-RepsertMany{..}<Person>-Replace{..}<Person>-Delete{..}<Person>-Update{..}<Person>-UpdateGet{..}<Person>-InsertEntity{..}<Person>-InsertRecord{..}<Person>-GetBy{..}<Person>-GetByValue{..}<Person>-CheckUnique{..}<Person>-CheckUniqueUpdateable{..}<Person>-DeleteBy{..}<Person>-InsertUnique{..}<Person>-Upsert{..}<Person>-UpsertBy{..}<Person>-PutMany{..}<Person>-InsertBy{..}<Person>-InsertUniqueEntity{..}<Person>-ReplaceUnique{..}<Person>-OnlyUnique{..}<Person>-SelectSourceRes{..}<Person>-SelectFirst{..}<Person>-SelectKeysRes{..}<Person>-Count{..}<Person>-Exists{..}<Person>-SelectList{..}<Person>-SelectKeysList{..}<Person>-UpdateWhere{..}<Person>-DeleteWhere{..}<Person>-DeleteWhereCount{..}<Person>-UpdateWhereCount{..}<Person>-ParseMigration{..}-ParseMigration'{..}-PrintMigration{..}-ShowMigration{..}-GetMigration{..}-RunMigration{..}-RunMigrationQuiet{..}-RunMigrationSilent{..}-RunMigrationUnsafe{..}-RunMigrationUnsafeQuiet{..}-GetFieldName{..}<Person>-GetTableName{..}<Person>-WithRawQuery{..}-RawQueryRes{..}-RawExecute{..}-RawExecuteCount{..}-RawSql{..}-TransactionSave{..}-TransactionSaveWithIsolation{..}-TransactionUndo{..}-TransactionUndoWithIsolation{..}

@@ -1,66 +0,0 @@-Get{..}<Person>-GetMany{..}<Person>-GetJust{..}<Person>-GetJustEntity{..}<Person>-GetEntity{..}<Person>-BelongsTo{..}<(Person,Post)>-BelongsToJust{..}<(Person,Post)>-Insert{..}<Person>-Insert_{..}<Person>-InsertMany{..}<Person>-InsertMany_{..}<Person>-InsertEntityMany{..}<Person>-InsertKey{..}<Person>-Repsert{..}<Person>-RepsertMany{..}<Person>-Replace{..}<Person>-Delete{..}<Person>-Update{..}<Person>-UpdateGet{..}<Person>-InsertEntity{..}<Person>-InsertRecord{..}<Person>-GetBy{..}<Person>-GetByValue{..}<Person>-CheckUnique{..}<Person>-CheckUniqueUpdateable{..}<Person>-DeleteBy{..}<Person>-InsertUnique{..}<Person>-Upsert{..}<Person>-UpsertBy{..}<Person>-PutMany{..}<Person>-InsertBy{..}<Person>-InsertUniqueEntity{..}<Person>-ReplaceUnique{..}<Person>-OnlyUnique{..}<Person>-SelectSourceRes{..}<Person>-SelectFirst{..}<Person>-SelectKeysRes{..}<Person>-Count{..}<Person>-Exists{..}<Person>-SelectList{..}<Person>-SelectKeysList{..}<Person>-UpdateWhere{..}<Person>-DeleteWhere{..}<Person>-DeleteWhereCount{..}<Person>-UpdateWhereCount{..}<Person>-ParseMigration{..}-ParseMigration'{..}-PrintMigration{..}-ShowMigration{..}-GetMigration{..}-RunMigration{..}-RunMigrationQuiet{..}-RunMigrationSilent{..}-RunMigrationUnsafe{..}-RunMigrationUnsafeQuiet{..}-GetFieldName{..}<Person>-GetTableName{..}<Person>-WithRawQuery{..}-RawQueryRes{..}-RawExecute{..}-RawExecuteCount{..}-RawSql{..}-TransactionSave{..}-TransactionSaveWithIsolation{..}-TransactionUndo{..}-TransactionUndoWithIsolation{..}