Split into multiple testing stanzas and modules for backends

Common/Test.hs holds all common tests and functionality for the backends

esqueleto.cabal

@@ -82,11 +82,45 @@ library
   else
     ghc-options: -Wall
 
-test-suite test
+-- test-suite test-common
+--   type: detailed-0.9
+--   ghc-options:    -Wall
+--   hs-source-dirs: test
+--   test-module:    Common.Test
+--   build-depends:
+--       -- Library dependencies used on the tests.  No need to
+--       -- specify versions since they'll use the same as above.
+--       base, persistent, transformers, resourcet, text
+--
+--       -- Test-only dependencies
+--     , conduit             >= 1.1
+--     , containers
+--     , HUnit
+--     , QuickCheck
+--     , hspec               >= 1.8
+--     , persistent-sqlite   >= 2.1.3
+--     , persistent-template >= 2.1
+--     , monad-control
+--     , monad-logger        >= 0.3
+--     , time                >= 1.5.0.1 && <= 1.8.0.2
+--
+--       -- This library
+--     , esqueleto
+--
+--     , postgresql-simple     >= 0.2
+--     , postgresql-libpq      >= 0.6
+--     , persistent-postgresql >= 2.0
+--
+--     , mysql-simple          >= 0.2.2.3
+--     , mysql                 >= 0.1.1.3
+--     , persistent-mysql      >= 2.0
+
+test-suite postgresql
   type: exitcode-stdio-1.0
   ghc-options:    -Wall
   hs-source-dirs: test
-  main-is:        Test.hs
+  other-modules: Common.Test
+  main-is:        PostgreSQL/Test.hs
   build-depends:
       -- Library dependencies used on the tests.  No need to
       -- specify versions since they'll use the same as above.
@@ -98,10 +132,7 @@ test-suite test
     , HUnit
     , QuickCheck
     , hspec               >= 1.8
-    , persistent-sqlite   >= 2.1.3
-    , persistent-template >= 2.1
     , monad-control
-    , monad-logger        >= 0.3
     , time                >= 1.5.0.1 && <= 1.8.0.2
 
       -- This library
@@ -110,13 +141,65 @@ test-suite test
     , postgresql-simple     >= 0.2
     , postgresql-libpq      >= 0.6
     , persistent-postgresql >= 2.0
+    , persistent-template >= 2.1
+    , monad-control
+    , monad-logger        >= 0.3
+
+
+test-suite mysql
+  type: exitcode-stdio-1.0
+  ghc-options:    -Wall
+  hs-source-dirs: test
+  other-modules:  Common.Test
+  main-is:        MySQL/Test.hs
+  build-depends:
+      -- Library dependencies used on the tests.  No need to
+      -- specify versions since they'll use the same as above.
+      base, persistent, transformers, resourcet, text
+
+      -- Test-only dependencies
+    , conduit             >= 1.1
+    , containers
+    , HUnit
+    , QuickCheck
+    , hspec               >= 1.8
+    , monad-control
+    , time                >= 1.5.0.1 && <= 1.8.0.2
+
+      -- This library
+    , esqueleto
 
     , mysql-simple          >= 0.2.2.3
     , mysql                 >= 0.1.1.3
     , persistent-mysql      >= 2.0
+    , persistent-template >= 2.1
+    , monad-control
+    , monad-logger        >= 0.3
 
-  if flag(postgresql)
-    cpp-options: -DWITH_POSTGRESQL
 
-  if flag(mysql)
+test-suite sqlite
-    cpp-options: -DWITH_MYSQL
+  type: exitcode-stdio-1.0
+  ghc-options:    -Wall
+  hs-source-dirs: test
+  other-modules:  Common.Test
+  main-is:        SQLite/Test.hs
+  build-depends:
+      -- Library dependencies used on the tests.  No need to
+      -- specify versions since they'll use the same as above.
+      base, persistent, transformers, resourcet, text
+
+      -- Test-only dependencies
+    , conduit             >= 1.1
+    , containers
+    , HUnit
+    , QuickCheck
+    , hspec               >= 1.8
+    , monad-control
+    , time                >= 1.5.0.1 && <= 1.8.0.2
+
+      -- This library
+    , esqueleto
+
+    , persistent-sqlite   >= 2.1.3
+    , persistent-template >= 2.1
+    , monad-logger        >= 0.3

test/Common/Test.hs

@@ -16,39 +16,55 @@
            , CPP
            , TypeSynonymInstances
  #-}
-module Main (main) where
+
+module Common.Test
+    ( tests
+    , testLocking
+    , migrateAll
+    , cleanDB
+    , RunDbMonad
+    , Run
+    , p1, p2, p3, p4, p5
+    , l1, l2, l3
+    , insert'
+    , EntityField (..)
+    , Foo (..)
+    , Bar (..)
+    , Person (..)
+    , BlogPost (..)
+    , Lord (..)
+    , Deed (..)
+    , Follow (..)
+    , CcList (..)
+    , Frontcover (..)
+    , Article (..)
+    , Tag (..)
+    , ArticleTag (..)
+    , Article2 (..)
+    , Point (..)
+    , Circle (..)
+    , Numbers (..)
+    ) where
 
 import Control.Monad (forM_, replicateM, replicateM_, void)
 import Control.Monad.IO.Class (MonadIO(liftIO))
-import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT)
+import Control.Monad.Logger (MonadLogger (..), NoLoggingT, runNoLoggingT)
 import Control.Monad.Trans.Control (MonadBaseControl(..))
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Char (toLower, toUpper)
 import Data.Monoid ((<>))
 import Database.Esqueleto
-import Database.Persist.Postgresql (withPostgresqlConn)
-import Data.Ord (comparing)
-import Control.Arrow ((&&&))
-import qualified Database.Esqueleto.PostgreSQL as EP
-import Database.Persist.MySQL ( withMySQLConn
-                              , connectHost
-                              , connectDatabase
-                              , connectUser
-                              , connectPassword
-                              , defaultConnectInfo)
-import Database.Persist.Sqlite (withSqliteConn)
-import Database.Sqlite (SqliteException)
 import Database.Persist.TH
 import Test.Hspec
 
-import Data.Conduit (($$), Source, (=$=))
+import Data.Conduit (($$), (=$=), Source)
 import qualified Data.Conduit.List as CL
 import qualified Control.Monad.Trans.Resource as R
 import qualified Data.List as L
 import qualified Data.Set as S
 import qualified Data.Text.Lazy.Builder as TLB
+import qualified Data.Text.Internal.Lazy as TL
 import qualified Database.Esqueleto.Internal.Sql as EI
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
 
 
 -------------------------------------------------------------------------------
@@ -168,8 +184,8 @@ l3 = Lord "Chester" (Just 17)
 -------------------------------------------------------------------------------
 
 
-testSelect :: SpecWith (Arg (IO ()))
+testSelect :: Run -> Spec
-testSelect = do
+testSelect run = do
   describe "select" $ do
     it "works for a single value" $
       run $ do
@@ -195,8 +211,8 @@ testSelect = do
 -------------------------------------------------------------------------------
 
 
-testSelectSource :: SpecWith (Arg (IO ()))
+testSelectSource :: Run -> Spec
-testSelectSource = do
+testSelectSource run = do
   describe "selectSource" $ do
     it "works for a simple example" $
       run $ do
@@ -238,8 +254,8 @@ testSelectSource = do
 -------------------------------------------------------------------------------
 
 
-testSelectFrom :: SpecWith (Arg (IO ()))
+testSelectFrom :: Run -> Spec
-testSelectFrom = do
+testSelectFrom run = do
   describe "select/from" $ do
     it "works for a simple example" $
       run $ do
@@ -399,8 +415,8 @@ testSelectFrom = do
 -------------------------------------------------------------------------------
 
 
-testSelectJoin :: SpecWith (Arg (IO ()))
+testSelectJoin :: Run -> Spec
-testSelectJoin = do
+testSelectJoin run = do
   describe "select/JOIN" $ do
     it "works with a LEFT OUTER JOIN" $
       run $ do
@@ -561,68 +577,9 @@ testSelectJoin = do
 
 -------------------------------------------------------------------------------
 
-testPostgresqlRandom :: SpecWith (Arg (IO ()))
-testPostgresqlRandom = do
-  it "works with random_" $
-    run $ do
-      _ <- select $ return (random_ :: SqlExpr (Value Double))
-      return ()
 
-testMysqlRandom :: SpecWith (Arg (IO ()))
+testSelectWhere :: Run -> Spec
-testMysqlRandom = do
+testSelectWhere run = do
-  it "works with random_" $
-    run $ do
-      _ <- select $ return (random_ :: SqlExpr (Value Double))
-      return ()
-
-testSqliteRandom :: SpecWith (Arg (IO ()))
-testSqliteRandom = do
-  it "works with random_" $
-    run $ do
-      _ <- select $ return (random_ :: SqlExpr (Value Int))
-      return ()
-
-testPostgresqlSum :: SpecWith (Arg (IO ()))
-testPostgresqlSum = do
-  it "works with sum_" $
-    run $ do
-      _ <- insert' p1
-      _ <- insert' p2
-      _ <- insert' p3
-      _ <- insert' p4
-      ret <- select $
-             from $ \p->
-             return $ joinV $ sum_ (p ^. PersonAge)
-      liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ]
-
-testMysqlSum :: SpecWith (Arg (IO ()))
-testMysqlSum = do
-  it "works with sum_" $
-    run $ do
-      _ <- insert' p1
-      _ <- insert' p2
-      _ <- insert' p3
-      _ <- insert' p4
-      ret <- select $
-             from $ \p->
-             return $ joinV $ sum_ (p ^. PersonAge)
-      liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Double ) ]
-
-testSqliteSum :: SpecWith (Arg (IO ()))
-testSqliteSum = do
-  it "works with sum_" $
-    run $ do
-      _ <- insert' p1
-      _ <- insert' p2
-      _ <- insert' p3
-      _ <- insert' p4
-      ret <- select $
-             from $ \p->
-             return $ joinV $ sum_ (p ^. PersonAge)
-      liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Int) ]
-
-testSelectWhere :: SpecWith (Arg (IO ()))
-testSelectWhere = do
   describe "select/where_" $ do
     it "works for a simple example with (==.)" $
       run $ do
@@ -668,14 +625,6 @@ testSelectWhere = do
                return p
         liftIO $ ret `shouldBe` [ p3e ]
 
-#if   defined(WITH_POSTGRESQL)
-    testPostgresqlSum
-#elif defined(WITH_MYSQL)
-    testMysqlSum
-#else
-    testSqliteSum
-#endif
-
     it "works with avg_" $
       run $ do
         _ <- insert' p1
@@ -728,12 +677,6 @@ testSelectWhere = do
                 return p
         liftIO $ ret2 `shouldBe` [ p2e ]
 
-#if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL)
-    testPostgresqlRandom >> testMysqlRandom
-#else
-    testSqliteRandom
-#endif
-
     it "works with round_" $
       run $ do
         ret <- select $ return $ round_ (val (16.2 :: Double))
@@ -844,98 +787,9 @@ testSelectWhere = do
 
 -------------------------------------------------------------------------------
 
-testPostgresqlTwoAscFields :: SpecWith (Arg (IO ()))
-testPostgresqlTwoAscFields = do
-  it "works with two ASC fields (one call)" $
-    run $ do
-      p1e <- insert' p1
-      p2e <- insert' p2
-      p3e <- insert' p3
-      p4e <- insert' p4
-      ret <- select $
-             from $ \p -> do
-             orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
-             return p
-      -- in PostgreSQL nulls are bigger than everything
-      liftIO $ ret `shouldBe` [ p4e, p3e, p1e , p2e ]
 
-testMysqlTwoAscFields :: SpecWith (Arg (IO ()))
+testSelectOrderBy :: Run -> Spec
-testMysqlTwoAscFields = do
+testSelectOrderBy run = do
-  it "works with two ASC fields (one call)" $
-    run $ do
-      p1e <- insert' p1
-      p2e <- insert' p2
-      p3e <- insert' p3
-      p4e <- insert' p4
-      ret <- select $
-             from $ \p -> do
-             orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
-             return p
-      -- in SQLite and MySQL, its the reverse
-      liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ]
-
-testSqliteTwoAscFields :: SpecWith (Arg (IO ()))
-testSqliteTwoAscFields = do
-  it "works with two ASC fields (one call)" $
-    run $ do
-      p1e <- insert' p1
-      p2e <- insert' p2
-      p3e <- insert' p3
-      p4e <- insert' p4
-      ret <- select $
-             from $ \p -> do
-             orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
-             return p
-      -- in SQLite and MySQL, its the reverse
-      liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ]
-
-testPostgresqlOneAscOneDesc :: SpecWith (Arg (IO ()))
-testPostgresqlOneAscOneDesc = do
-  it "works with one ASC and one DESC field (two calls)" $
-    run $ do
-      p1e <- insert' p1
-      p2e <- insert' p2
-      p3e <- insert' p3
-      p4e <- insert' p4
-      ret <- select $
-             from $ \p -> do
-             orderBy [desc (p ^. PersonAge)]
-             orderBy [asc (p ^. PersonName)]
-             return p
-      liftIO $ ret `shouldBe` [ p2e, p1e, p4e, p3e ]
-
-testMysqlOneAscOneDesc :: SpecWith (Arg (IO ()))
-testMysqlOneAscOneDesc = do
-  it "works with one ASC and one DESC field (two calls)" $
-    run $ do
-      p1e <- insert' p1
-      p2e <- insert' p2
-      p3e <- insert' p3
-      p4e <- insert' p4
-      ret <- select $
-             from $ \p -> do
-             orderBy [desc (p ^. PersonAge)]
-             orderBy [asc (p ^. PersonName)]
-             return p
-      liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
-
-testSqliteOneAscOneDesc :: SpecWith (Arg (IO ()))
-testSqliteOneAscOneDesc = do
-  it "works with one ASC and one DESC field (two calls)" $
-    run $ do
-      p1e <- insert' p1
-      p2e <- insert' p2
-      p3e <- insert' p3
-      p4e <- insert' p4
-      ret <- select $
-             from $ \p -> do
-             orderBy [desc (p ^. PersonAge)]
-             orderBy [asc (p ^. PersonName)]
-             return p
-      liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
-
-testSelectOrderBy :: SpecWith (Arg (IO ()))
-testSelectOrderBy = do
   describe "select/orderBy" $ do
     it "works with a single ASC field" $
       run $ do
@@ -948,18 +802,6 @@ testSelectOrderBy = do
                return p
         liftIO $ ret `shouldBe` [ p1e, p3e, p2e ]
 
-#ifdef WITH_POSTGRESQL
-    testPostgresqlTwoAscFields
-#else
-    testMysqlTwoAscFields >> testSqliteTwoAscFields
-#endif
-
-#ifdef WITH_POSTGRESQL
-    testPostgresqlOneAscOneDesc
-#else
-    testMysqlOneAscOneDesc >> testSqliteOneAscOneDesc
-#endif
-
     it "works with a sub_select" $
       run $ do
         [p1k, p2k, p3k, p4k] <- mapM insert [p1, p2, p3, p4]
@@ -1006,8 +848,8 @@ testSelectOrderBy = do
 -------------------------------------------------------------------------------
 
 
-testSelectDistinct :: SpecWith (Arg (IO ()))
+testSelectDistinct :: Run -> Spec
-testSelectDistinct = do
+testSelectDistinct run = do
   describe "SELECT DISTINCT" $ do
     let selDistTest
           :: (   forall m. RunDbMonad m
@@ -1038,59 +880,8 @@ testSelectDistinct = do
 -------------------------------------------------------------------------------
 
 
-testSelectDistinctOn :: SpecWith (Arg (IO ()))
+testCoasleceDefault :: Run -> Spec
-testSelectDistinctOn = do
+testCoasleceDefault run = do
-  describe "SELECT DISTINCT ON" $ do
-    it "works on a simple example" $ do
-      run $ do
-        [p1k, p2k, _] <- mapM insert [p1, p2, p3]
-        [_, bpB, bpC] <- mapM insert'
-          [ BlogPost "A" p1k
-          , BlogPost "B" p1k
-          , BlogPost "C" p2k ]
-        ret <- select $
-               from $ \bp ->
-               distinctOn [don (bp ^. BlogPostAuthorId)] $ do
-               orderBy [asc (bp ^. BlogPostAuthorId), desc (bp ^. BlogPostTitle)]
-               return bp
-        liftIO $ ret `shouldBe` L.sortBy (comparing (blogPostAuthorId . entityVal)) [bpB, bpC]
-
-    let slightlyLessSimpleTest q =
-          run $ do
-            [p1k, p2k, _] <- mapM insert [p1, p2, p3]
-            [bpA, bpB, bpC] <- mapM insert'
-              [ BlogPost "A" p1k
-              , BlogPost "B" p1k
-              , BlogPost "C" p2k ]
-            ret <- select $
-                   from $ \bp ->
-                   q bp $ return bp
-            let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal
-            liftIO $ ret `shouldBe` L.sortBy (comparing cmp) [bpA, bpB, bpC]
-
-    it "works on a slightly less simple example (two distinctOn calls, orderBy)" $
-      slightlyLessSimpleTest $ \bp act ->
-        distinctOn [don (bp ^. BlogPostAuthorId)] $
-        distinctOn [don (bp ^. BlogPostTitle)] $ do
-          orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
-          act
-
-    it "works on a slightly less simple example (one distinctOn call, orderBy)" $ do
-      slightlyLessSimpleTest $ \bp act ->
-        distinctOn [don (bp ^. BlogPostAuthorId), don (bp ^. BlogPostTitle)] $ do
-          orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
-          act
-
-    it "works on a slightly less simple example (distinctOnOrderBy)" $ do
-      slightlyLessSimpleTest $ \bp ->
-        distinctOnOrderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
-
-
--------------------------------------------------------------------------------
-
-
-testCoasleceDefault :: SpecWith (Arg (IO ()))
-testCoasleceDefault = do
   describe "coalesce/coalesceDefault" $ do
     it "works on a simple example" $
       run $ do
@@ -1139,45 +930,12 @@ testCoasleceDefault = do
                                 , Value 17
                                 ]
 
-#if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL)
-    testPostgresqlCoalesce >> testMysqlCoalesce
-#else
-    testSqliteCoalesce
-#endif
-
-testPostgresqlCoalesce :: SpecWith (Arg (IO ()))
-testPostgresqlCoalesce = do
-  it "works on PostgreSQL and MySQL with <2 arguments" $
-    run $ do
-      _ :: [Value (Maybe Int)] <-
-        select $
-        from $ \p -> do
-        return (coalesce [p ^. PersonAge])
-      return ()
-
-testMysqlCoalesce :: SpecWith (Arg (IO ()))
-testMysqlCoalesce = do
-  it "works on PostgreSQL and MySQL with <2 arguments" $
-    run $ do
-      _ :: [Value (Maybe Int)] <-
-        select $
-        from $ \p -> do
-        return (coalesce [p ^. PersonAge])
-      return ()
-
-testSqliteCoalesce :: SpecWith (Arg (IO ()))
-testSqliteCoalesce = do
-  it "throws an exception on SQLite with <2 arguments" $
-    run (select $
-         from $ \p -> do
-         return (coalesce [p ^. PersonAge]) :: SqlQuery (SqlExpr (Value (Maybe Int))))
-    `shouldThrow` (\(_ :: SqliteException) -> True)
 
 -------------------------------------------------------------------------------
 
 
-testTextFunctions :: SpecWith (Arg (IO ()))
+testTextFunctions :: Run -> Spec
-testTextFunctions = do
+testTextFunctions run = do
   describe "text functions" $ do
     it "like, (%) and (++.) work on a simple example" $
        run $ do
@@ -1193,31 +951,12 @@ testTextFunctions = do
          nameContains "i"  [p4e, p3e]
          nameContains "iv" [p4e]
 
-#if defined(WITH_POSTGRESQL)
-    testPostgresqlTextFunction
-#endif
-
-testPostgresqlTextFunction :: SpecWith (Arg (IO ()))
-testPostgresqlTextFunction = do
-  it "ilike, (%) and (++.) work on a simple example on PostgreSQL" $
-    run $ do
-      [p1e, _, p3e, _, p5e] <- mapM insert' [p1, p2, p3, p4, p5]
-      let nameContains t expected = do
-            ret <- select $
-                   from $ \p -> do
-                   where_ (p ^. PersonName `ilike` (%) ++. val t ++. (%))
-                   orderBy [asc (p ^. PersonName)]
-                   return p
-            liftIO $ ret `shouldBe` expected
-      nameContains "mi" [p3e, p5e]
-      nameContains "JOHN" [p1e]
-
 
 -------------------------------------------------------------------------------
 
 
-testDelete :: SpecWith (Arg (IO ()))
+testDelete :: Run -> Spec
-testDelete = do
+testDelete run = do
   describe "delete" $
     it "works on a simple example" $
       run $ do
@@ -1244,93 +983,10 @@ testDelete = do
 
 -------------------------------------------------------------------------------
 
-testPostgresqlUpdate :: SpecWith (Arg (IO ()))
-testPostgresqlUpdate = do
-  it "works on a simple example" $
-    run $ do
-      p1k <- insert p1
-      p2k <- insert p2
-      p3k <- insert p3
-      let anon = "Anonymous"
-      ()  <- update $ \p -> do
-             set p [ PersonName =. val anon
-                   , PersonAge *=. just (val 2) ]
-             where_ (p ^. PersonName !=. val "Mike")
-      n   <- updateCount $ \p -> do
-             set p [ PersonAge +=. just (val 1) ]
-             where_ (p ^. PersonName !=. val "Mike")
-      ret <- select $
-             from $ \p -> do
-             orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
-             return p
-      -- PostgreSQL: nulls are bigger than data, and update returns
-      --             matched rows, not actually changed rows.
-      liftIO $ n `shouldBe` 2
-      liftIO $ ret `shouldBe` [ Entity p1k (Person anon (Just 73) Nothing 1)
-                              , Entity p2k (Person anon Nothing (Just 37) 2)
-                              , Entity p3k p3 ]
 
-testMysqlUpdate :: SpecWith (Arg (IO ()))
+testUpdate :: Run -> Spec
-testMysqlUpdate = do
+testUpdate run = do
-  it "works on a simple example" $
-    run $ do
-      p1k <- insert p1
-      p2k <- insert p2
-      p3k <- insert p3
-      let anon = "Anonymous"
-      ()  <- update $ \p -> do
-             set p [ PersonName =. val anon
-                   , PersonAge *=. just (val 2) ]
-             where_ (p ^. PersonName !=. val "Mike")
-      n   <- updateCount $ \p -> do
-             set p [ PersonAge +=. just (val 1) ]
-             where_ (p ^. PersonName !=. val "Mike")
-      ret <- select $
-             from $ \p -> do
-             orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
-             return p
-      -- MySQL: nulls appear first, and update returns actual number
-      --        of changed rows
-      liftIO $ n `shouldBe` 1
-      liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing (Just 37) 2)
-                              , Entity p1k (Person anon (Just 73) Nothing 1)
-                              , Entity p3k p3 ]
-
-testSqliteUpdate :: SpecWith (Arg (IO ()))
-testSqliteUpdate = do
-  it "works on a simple example" $
-    run $ do
-      p1k <- insert p1
-      p2k <- insert p2
-      p3k <- insert p3
-      let anon = "Anonymous"
-      ()  <- update $ \p -> do
-             set p [ PersonName =. val anon
-                   , PersonAge *=. just (val 2) ]
-             where_ (p ^. PersonName !=. val "Mike")
-      n   <- updateCount $ \p -> do
-             set p [ PersonAge +=. just (val 1) ]
-             where_ (p ^. PersonName !=. val "Mike")
-      ret <- select $
-             from $ \p -> do
-             orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
-             return p
-      -- SQLite: nulls appear first, update returns matched rows.
-      liftIO $ n `shouldBe` 2
-      liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing (Just 37) 2)
-                              , Entity p1k (Person anon (Just 73) Nothing 1)
-                              , Entity p3k p3 ]
-
-testUpdate :: SpecWith (Arg (IO ()))
-testUpdate = do
   describe "update" $ do
-#if   defined(WITH_POSTGRESQL)
-    testPostgresqlUpdate
-#elif defined(WITH_MYSQL)
-    testMysqlUpdate
-#else
-    testSqliteUpdate
-#endif
 
     it "works with a subexpression having COUNT(*)" $
       run $ do
@@ -1405,6 +1061,7 @@ testUpdate = do
           return (lord ^. LordId, count $ deed ^. DeedId)
         liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7)
                                        , (Value l1k, Value 3) ]
+
     it "GROUP BY works with HAVING" $
       run $ do
         p1k <- insert p1
@@ -1427,8 +1084,8 @@ testUpdate = do
 -------------------------------------------------------------------------------
 
 
-testListOfValues :: SpecWith (Arg (IO ()))
+testListOfValues :: Run -> Spec
-testListOfValues = do
+testListOfValues run = do
   describe "lists of values" $ do
     it "IN works for valList" $
       run $ do
@@ -1523,8 +1180,8 @@ testListOfValues = do
 -------------------------------------------------------------------------------
 
 
-testListFields :: SpecWith (Arg (IO ()))
+testListFields :: Run -> Spec
-testListFields = do
+testListFields run = do
   describe "list fields" $ do
     -- <https://github.com/prowdsponsor/esqueleto/issues/100>
     it "can update list fields" $
@@ -1538,8 +1195,8 @@ testListFields = do
 -------------------------------------------------------------------------------
 
 
-testInsertsBySelect :: SpecWith (Arg (IO ()))
+testInsertsBySelect :: Run -> Spec
-testInsertsBySelect = do
+testInsertsBySelect run = do
   describe "inserts by select" $ do
     it "IN works for insertSelect" $
       run $ do
@@ -1555,8 +1212,8 @@ testInsertsBySelect = do
 -------------------------------------------------------------------------------
 
 
-testInsertsBySelectReturnsCount :: SpecWith (Arg (IO ()))
+testInsertsBySelectReturnsCount :: Run -> Spec
-testInsertsBySelectReturnsCount = do
+testInsertsBySelectReturnsCount run = do
   describe "inserts by select, returns count" $ do
     it "IN works for insertSelectCount" $
       run $ do
@@ -1573,8 +1230,8 @@ testInsertsBySelectReturnsCount = do
 -------------------------------------------------------------------------------
 
 
-testMathFunctions :: SpecWith (Arg (IO ()))
+testMathFunctions :: Run -> Spec
-testMathFunctions = do
+testMathFunctions run = do
   describe "Math-related functions" $ do
     it "rand returns result in random order" $
       run $ do
@@ -1613,8 +1270,8 @@ testMathFunctions = do
 -------------------------------------------------------------------------------
 
 
-testCase :: SpecWith (Arg (IO ()))
+testCase :: Run -> Spec
-testCase = do
+testCase run = do
   describe "case" $ do
     it "Works for a simple value based when - False" $
       run $ do
@@ -1665,8 +1322,8 @@ testCase = do
 -------------------------------------------------------------------------------
 
 
-testLocking :: SpecWith (Arg (IO ()))
+testLocking :: WithConn (NoLoggingT IO) [TL.Text] -> Spec
-testLocking = do
+testLocking withConn = do
   describe "locking" $ do
     -- The locking clause is the last one, so try to use many
     -- others to test if it's at the right position.  We don't
@@ -1713,8 +1370,8 @@ testLocking = do
 -------------------------------------------------------------------------------
 
 
-testCountingRows :: SpecWith (Arg (IO ()))
+testCountingRows :: Run -> Spec
-testCountingRows = do
+testCountingRows run = do
   describe "counting rows" $ do
     forM_ [ ("count (test A)",    count . (^. PersonAge),         4)
           , ("count (test B)",    count . (^. PersonWeight),      5)
@@ -1736,77 +1393,26 @@ testCountingRows = do
 -------------------------------------------------------------------------------
 
 
-testPostgresModule :: SpecWith (Arg (IO ()))
+tests :: Run -> Spec
-testPostgresModule = do
+tests run = do
-  describe "PostgreSQL module" $ do
+  describe "Tests that are common to all backends" $ do
-    it "arrayAgg looks sane" $
+    testSelect run
-      run $ do
+    testSelectSource run
-        let people = [p1, p2, p3, p4, p5]
+    testSelectFrom run
-        mapM_ insert people
+    testSelectJoin run
-        [Value ret] <-
+    testSelectWhere run
-          select . from $ \p -> return (EP.arrayAgg (p ^. PersonName))
+    testSelectOrderBy run
-        liftIO $ L.sort ret `shouldBe` L.sort (map personName people)
+    testSelectDistinct run
-
+    testCoasleceDefault run
-    it "stringAgg looks sane" $
+    testTextFunctions run
-      run $ do
+    testDelete run
-        let people = [p1, p2, p3, p4, p5]
+    testUpdate run
-        mapM_ insert people
+    testListOfValues run
-        [Value ret] <-
+    testListFields run
-          select $
+    testInsertsBySelect run
-          from $ \p -> do
+    testMathFunctions run
-          return (EP.stringAgg (p ^. PersonName) (val " "))
+    testCase run
-        liftIO $ L.sort (words ret) `shouldBe` L.sort (map personName people)
+    testCountingRows run
-
-    it "chr looks sane" $
-      run $ do
-        [Value (ret :: String)] <- select $ return (EP.chr (val 65))
-        liftIO $ ret `shouldBe` "A"
-
-    it "works with now" $
-      run $ do
-        nowDb <- select $ return EP.now_
-        nowUtc <- liftIO getCurrentTime
-        let halfSecond = realToFrac (0.5 :: Double)
-
-        -- | Check the result is not null
-        liftIO $ nowDb `shouldSatisfy` (not . null)
-
-        -- | Unpack the now value
-        let (Value now: _) = nowDb
-
-        -- | Get the time diff and check it's less than half a second
-        liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< halfSecond)
-
-
--------------------------------------------------------------------------------
-
-main :: IO ()
-main = do
-  hspec $ do
-    testSelect
-    testSelectSource
-    testSelectFrom
-    testSelectJoin
-    testSelectWhere
-    testSelectOrderBy
-    testSelectDistinct
-
-#if defined(WITH_POSTGRESQL)
-    testSelectDistinctOn
-    testPostgresModule
-#endif
-
-    testCoasleceDefault
-    testTextFunctions
-    testDelete
-    testUpdate
-    testListOfValues
-    testListFields
-    testInsertsBySelect
-    testMathFunctions
-    testCase
-    testLocking
-    testCountingRows
 
 ----------------------------------------------------------------------
 
@@ -1823,6 +1429,10 @@ insert' v = flip Entity v <$> insert v
 type RunDbMonad m = ( MonadBaseControl IO m, MonadIO m, MonadLogger m
                     , R.MonadThrow m )
 
+type Run = forall a. (forall m. RunDbMonad m => SqlPersistT (R.ResourceT m) a) -> IO a
+
+type WithConn m a = RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
+
 -- With SQLite and in-memory databases, a separate connection implies a
 -- separate database. With 'actual databases', the data is persistent and
 -- thus must be cleaned after each test.
@@ -1854,44 +1464,41 @@ cleanDB = do
 
   delete $ from $ \(_ :: SqlExpr (Entity Numbers))    -> return ()
 
-
+-- run, runSilent, runVerbose :: Run a
-run, runSilent, runVerbose :: (forall m. RunDbMonad m => SqlPersistT (R.ResourceT m) a) -> IO a
+-- runSilent  act = runNoLoggingT     $ run_worker act
-runSilent  act = runNoLoggingT     $ run_worker act
+-- runVerbose act = runStderrLoggingT $ run_worker act
-runVerbose act = runStderrLoggingT $ run_worker act
+-- run =
-run =
+--   if verbose
-  if verbose
+--   then runVerbose
-  then runVerbose
+--   else runSilent
-  else runSilent
+--
-
+--
-
+-- verbose :: Bool
-verbose :: Bool
+-- verbose = True
-verbose = True
+--
-
+--
-
+-- run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a
-run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a
+-- run_worker act = withConn $ runSqlConn (migrateIt >> act)
-run_worker act = withConn $ runSqlConn (migrateIt >> act)
+--
-
+--
-
+-- migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) ()
-migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) ()
+-- migrateIt = do
-migrateIt = do
+--   void $ runMigrationSilent migrateAll
-  void $ runMigrationSilent migrateAll
+-- #if defined (WITH_POSTGRESQL) || defined (WITH_MYSQL)
-#if defined (WITH_POSTGRESQL) || defined (WITH_MYSQL)
+--   cleanDB
-  cleanDB
+-- #endif
-#endif
+--
-
+--
-
+-- withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
-withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
+-- withConn =
-withConn =
+--   R.runResourceT .
-  R.runResourceT .
+-- #if defined (WITH_MYSQL)
-#if defined(WITH_POSTGRESQL)
+--   withMySQLConn defaultConnectInfo
-  withPostgresqlConn "host=localhost port=5432 user=esqutest password=esqutest dbname=esqutest"
+--     { connectHost     = "localhost"
-#elif defined (WITH_MYSQL)
+--     , connectUser     = "esqutest"
-  withMySQLConn defaultConnectInfo
+--     , connectPassword = "esqutest"
-    { connectHost     = "localhost"
+--     , connectDatabase = "esqutest"
-    , connectUser     = "esqutest"
+--     }
-    , connectPassword = "esqutest"
+-- #else
-    , connectDatabase = "esqutest"
+--   withSqliteConn ":memory:"
-    }
+-- #endif
-#else
-  withSqliteConn ":memory:"
-#endif

test/MySQL/Test.hs

@@ -0,0 +1,183 @@
+{-# LANGUAGE ScopedTypeVariables
+           , FlexibleContexts
+           , RankNTypes
+#-}
+
+module Main (main) where
+
+import Control.Monad (void)
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT)
+import Control.Monad.Trans.Control (MonadBaseControl(..))
+import Database.Persist.MySQL ( withMySQLConn
+                              , connectHost
+                              , connectDatabase
+                              , connectUser
+                              , connectPassword
+                              , defaultConnectInfo)
+import Database.Esqueleto
+import qualified Control.Monad.Trans.Resource as R
+import Test.Hspec
+
+import Common.Test
+
+-------------------------------------------------------------------------------
+
+
+testMysqlRandom :: Spec
+testMysqlRandom = do
+  it "works with random_" $
+    run $ do
+      _ <- select $ return (random_ :: SqlExpr (Value Double))
+      return ()
+
+
+-------------------------------------------------------------------------------
+
+
+testMysqlSum :: Spec
+testMysqlSum = do
+  it "works with sum_" $
+    run $ do
+      _ <- insert' p1
+      _ <- insert' p2
+      _ <- insert' p3
+      _ <- insert' p4
+      ret <- select $
+             from $ \p->
+             return $ joinV $ sum_ (p ^. PersonAge)
+      liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Double ) ]
+
+
+-------------------------------------------------------------------------------
+
+
+testMysqlTwoAscFields :: Spec
+testMysqlTwoAscFields = do
+  it "works with two ASC fields (one call)" $
+    run $ do
+      p1e <- insert' p1
+      p2e <- insert' p2
+      p3e <- insert' p3
+      p4e <- insert' p4
+      ret <- select $
+             from $ \p -> do
+             orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
+             return p
+      liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ]
+
+
+-------------------------------------------------------------------------------
+
+
+testMysqlOneAscOneDesc :: Spec
+testMysqlOneAscOneDesc = do
+  it "works with one ASC and one DESC field (two calls)" $
+    run $ do
+      p1e <- insert' p1
+      p2e <- insert' p2
+      p3e <- insert' p3
+      p4e <- insert' p4
+      ret <- select $
+             from $ \p -> do
+             orderBy [desc (p ^. PersonAge)]
+             orderBy [asc (p ^. PersonName)]
+             return p
+      liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
+
+
+-------------------------------------------------------------------------------
+
+
+testMysqlCoalesce :: Spec
+testMysqlCoalesce = do
+  it "works on PostgreSQL and MySQL with <2 arguments" $
+    run $ do
+      _ :: [Value (Maybe Int)] <-
+        select $
+        from $ \p -> do
+        return (coalesce [p ^. PersonAge])
+      return ()
+
+
+-------------------------------------------------------------------------------
+
+
+testMysqlUpdate :: Spec
+testMysqlUpdate = do
+  it "works on a simple example" $
+    run $ do
+      p1k <- insert p1
+      p2k <- insert p2
+      p3k <- insert p3
+      let anon = "Anonymous"
+      ()  <- update $ \p -> do
+             set p [ PersonName =. val anon
+                   , PersonAge *=. just (val 2) ]
+             where_ (p ^. PersonName !=. val "Mike")
+      n   <- updateCount $ \p -> do
+             set p [ PersonAge +=. just (val 1) ]
+             where_ (p ^. PersonName !=. val "Mike")
+      ret <- select $
+             from $ \p -> do
+             orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
+             return p
+      -- MySQL: nulls appear first, and update returns actual number
+      --        of changed rows
+      liftIO $ n `shouldBe` 1
+      liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing (Just 37) 2)
+                              , Entity p1k (Person anon (Just 73) Nothing 1)
+                              , Entity p3k p3 ]
+
+
+-------------------------------------------------------------------------------
+
+
+main :: IO ()
+main = do
+  hspec $ do
+    tests run
+
+    describe "MySQL specific tests" $ do
+      testMysqlRandom
+      testMysqlSum
+      testMysqlTwoAscFields
+      testMysqlOneAscOneDesc
+      testMysqlCoalesce
+      testMysqlUpdate
+
+
+-------------------------------------------------------------------------------
+
+run, runSilent, runVerbose :: Run
+runSilent  act = runNoLoggingT     $ run_worker act
+runVerbose act = runStderrLoggingT $ run_worker act
+run =
+  if verbose
+  then runVerbose
+  else runSilent
+
+
+verbose :: Bool
+verbose = True
+
+
+run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a
+run_worker act = withConn $ runSqlConn (migrateIt >> act)
+
+
+migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) ()
+migrateIt = do
+  void $ runMigrationSilent migrateAll
+  cleanDB
+
+
+withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
+withConn =
+  R.runResourceT .
+  withMySQLConn defaultConnectInfo
+    { connectHost     = "localhost"
+    , connectUser     = "esqutest"
+    , connectPassword = "esqutest"
+    , connectDatabase = "esqutest"
+    }

test/PostgreSQL/Test.hs

@@ -0,0 +1,284 @@
+{-# OPTIONS_GHC -fno-warn-unused-binds  #-}
+{-# LANGUAGE ConstraintKinds
+           , EmptyDataDecls
+           , FlexibleContexts
+           , FlexibleInstances
+           , DeriveGeneric
+           , GADTs
+           , GeneralizedNewtypeDeriving
+           , MultiParamTypeClasses
+           , OverloadedStrings
+           , QuasiQuotes
+           , Rank2Types
+           , TemplateHaskell
+           , TypeFamilies
+           , ScopedTypeVariables
+           , TypeSynonymInstances
+ #-}
+module Main (main) where
+
+import Control.Monad (void)
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
+import Database.Esqueleto
+import Database.Persist.Postgresql (withPostgresqlConn)
+import Data.Ord (comparing)
+import Control.Arrow ((&&&))
+import qualified Database.Esqueleto.PostgreSQL as EP
+import Test.Hspec
+import qualified Control.Monad.Trans.Resource as R
+import qualified Data.List as L
+import Data.Time.Clock (getCurrentTime, diffUTCTime)
+
+import Common.Test
+
+
+testPostgresqlCoalesce :: Spec
+testPostgresqlCoalesce = do
+  it "works on PostgreSQL and MySQL with <2 arguments" $
+    run $ do
+      _ :: [Value (Maybe Int)] <-
+        select $
+        from $ \p -> do
+        return (coalesce [p ^. PersonAge])
+      return ()
+
+
+testPostgresqlTextFunction :: Spec
+testPostgresqlTextFunction = do
+  it "ilike, (%) and (++.) work on a simple example on PostgreSQL" $
+    run $ do
+      [p1e, _, p3e, _, p5e] <- mapM insert' [p1, p2, p3, p4, p5]
+      let nameContains t expected = do
+            ret <- select $
+                   from $ \p -> do
+                   where_ (p ^. PersonName `ilike` (%) ++. val t ++. (%))
+                   orderBy [asc (p ^. PersonName)]
+                   return p
+            liftIO $ ret `shouldBe` expected
+      nameContains "mi" [p3e, p5e]
+      nameContains "JOHN" [p1e]
+
+
+testPostgresqlUpdate :: Spec
+testPostgresqlUpdate = do
+  it "works on a simple example" $
+    run $ do
+      p1k <- insert p1
+      p2k <- insert p2
+      p3k <- insert p3
+      let anon = "Anonymous"
+      ()  <- update $ \p -> do
+             set p [ PersonName =. val anon
+                   , PersonAge *=. just (val 2) ]
+             where_ (p ^. PersonName !=. val "Mike")
+      n   <- updateCount $ \p -> do
+             set p [ PersonAge +=. just (val 1) ]
+             where_ (p ^. PersonName !=. val "Mike")
+      ret <- select $
+             from $ \p -> do
+             orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
+             return p
+      -- PostgreSQL: nulls are bigger than data, and update returns
+      --             matched rows, not actually changed rows.
+      liftIO $ n `shouldBe` 2
+      liftIO $ ret `shouldBe` [ Entity p1k (Person anon (Just 73) Nothing 1)
+                              , Entity p2k (Person anon Nothing (Just 37) 2)
+                              , Entity p3k p3 ]
+
+
+testPostgresqlRandom :: Spec
+testPostgresqlRandom = do
+  it "works with random_" $
+    run $ do
+      _ <- select $ return (random_ :: SqlExpr (Value Double))
+      return ()
+
+
+testPostgresqlSum :: Spec
+testPostgresqlSum = do
+  it "works with sum_" $
+    run $ do
+      _ <- insert' p1
+      _ <- insert' p2
+      _ <- insert' p3
+      _ <- insert' p4
+      ret <- select $
+             from $ \p->
+             return $ joinV $ sum_ (p ^. PersonAge)
+      liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ]
+
+
+testPostgresqlTwoAscFields :: Spec
+testPostgresqlTwoAscFields = do
+  it "works with two ASC fields (one call)" $
+    run $ do
+      p1e <- insert' p1
+      p2e <- insert' p2
+      p3e <- insert' p3
+      p4e <- insert' p4
+      ret <- select $
+             from $ \p -> do
+             orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
+             return p
+      -- in PostgreSQL nulls are bigger than everything
+      liftIO $ ret `shouldBe` [ p4e, p3e, p1e , p2e ]
+
+
+testPostgresqlOneAscOneDesc :: Spec
+testPostgresqlOneAscOneDesc = do
+  it "works with one ASC and one DESC field (two calls)" $
+    run $ do
+      p1e <- insert' p1
+      p2e <- insert' p2
+      p3e <- insert' p3
+      p4e <- insert' p4
+      ret <- select $
+             from $ \p -> do
+             orderBy [desc (p ^. PersonAge)]
+             orderBy [asc (p ^. PersonName)]
+             return p
+      liftIO $ ret `shouldBe` [ p2e, p1e, p4e, p3e ]
+
+
+----------------------------------------------------------------------
+
+
+testSelectDistinctOn :: Spec
+testSelectDistinctOn = do
+  describe "SELECT DISTINCT ON" $ do
+    it "works on a simple example" $ do
+      run $ do
+        [p1k, p2k, _] <- mapM insert [p1, p2, p3]
+        [_, bpB, bpC] <- mapM insert'
+          [ BlogPost "A" p1k
+          , BlogPost "B" p1k
+          , BlogPost "C" p2k ]
+        ret <- select $
+               from $ \bp ->
+               distinctOn [don (bp ^. BlogPostAuthorId)] $ do
+               orderBy [asc (bp ^. BlogPostAuthorId), desc (bp ^. BlogPostTitle)]
+               return bp
+        liftIO $ ret `shouldBe` L.sortBy (comparing (blogPostAuthorId . entityVal)) [bpB, bpC]
+
+    let slightlyLessSimpleTest q =
+          run $ do
+            [p1k, p2k, _] <- mapM insert [p1, p2, p3]
+            [bpA, bpB, bpC] <- mapM insert'
+              [ BlogPost "A" p1k
+              , BlogPost "B" p1k
+              , BlogPost "C" p2k ]
+            ret <- select $
+                   from $ \bp ->
+                   q bp $ return bp
+            let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal
+            liftIO $ ret `shouldBe` L.sortBy (comparing cmp) [bpA, bpB, bpC]
+
+    it "works on a slightly less simple example (two distinctOn calls, orderBy)" $
+      slightlyLessSimpleTest $ \bp act ->
+        distinctOn [don (bp ^. BlogPostAuthorId)] $
+        distinctOn [don (bp ^. BlogPostTitle)] $ do
+          orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
+          act
+
+    it "works on a slightly less simple example (one distinctOn call, orderBy)" $ do
+      slightlyLessSimpleTest $ \bp act ->
+        distinctOn [don (bp ^. BlogPostAuthorId), don (bp ^. BlogPostTitle)] $ do
+          orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
+          act
+
+    it "works on a slightly less simple example (distinctOnOrderBy)" $ do
+      slightlyLessSimpleTest $ \bp ->
+        distinctOnOrderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
+
+
+----------------------------------------------------------------------
+
+
+testPostgresModule :: Spec
+testPostgresModule = do
+  describe "PostgreSQL module" $ do
+    it "arrayAgg looks sane" $
+      run $ do
+        let people = [p1, p2, p3, p4, p5]
+        mapM_ insert people
+        [Value ret] <-
+          select . from $ \p -> return (EP.arrayAgg (p ^. PersonName))
+        liftIO $ L.sort ret `shouldBe` L.sort (map personName people)
+
+    it "stringAgg looks sane" $
+      run $ do
+        let people = [p1, p2, p3, p4, p5]
+        mapM_ insert people
+        [Value ret] <-
+          select $
+          from $ \p -> do
+          return (EP.stringAgg (p ^. PersonName) (val " "))
+        liftIO $ L.sort (words ret) `shouldBe` L.sort (map personName people)
+
+    it "chr looks sane" $
+      run $ do
+        [Value (ret :: String)] <- select $ return (EP.chr (val 65))
+        liftIO $ ret `shouldBe` "A"
+
+    it "works with now" $
+      run $ do
+        nowDb <- select $ return EP.now_
+        nowUtc <- liftIO getCurrentTime
+        let halfSecond = realToFrac (0.5 :: Double)
+
+        -- | Check the result is not null
+        liftIO $ nowDb `shouldSatisfy` (not . null)
+
+        -- | Unpack the now value
+        let (Value now: _) = nowDb
+
+        -- | Get the time diff and check it's less than half a second
+        liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< halfSecond)
+
+
+----------------------------------------------------------------------
+
+
+main :: IO ()
+main = do
+  hspec $ do
+    tests run
+
+    describe "Test PostgreSQL locking" $ do
+      testLocking withConn
+
+    describe "PostgreSQL specific tests" $ do
+      testSelectDistinctOn
+      testPostgresModule
+      testPostgresqlOneAscOneDesc
+      testPostgresqlTwoAscFields
+      testPostgresqlSum
+      testPostgresqlRandom
+      testPostgresqlUpdate
+      testPostgresqlTextFunction
+      testPostgresqlCoalesce
+
+run, runSilent, runVerbose :: Run
+runSilent  act = runNoLoggingT     $ run_worker act
+runVerbose act = runStderrLoggingT $ run_worker act
+run =
+  if verbose
+  then runVerbose
+  else runSilent
+
+
+verbose :: Bool
+verbose = True
+
+migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) ()
+migrateIt = do
+  void $ runMigrationSilent migrateAll
+  cleanDB
+
+run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a
+run_worker act = withConn $ runSqlConn (migrateIt >> act)
+
+withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
+withConn =
+  R.runResourceT . withPostgresqlConn "host=localhost port=5432 user=esqutest password=esqutest dbname=esqutest"

test/SQLite/Test.hs

@@ -0,0 +1,146 @@
+{-# LANGUAGE ScopedTypeVariables
+           , FlexibleContexts
+           , RankNTypes
+           , OverloadedStrings
+#-}
+
+module Main (main) where
+
+import Control.Monad (void)
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
+import Database.Persist.Sqlite (withSqliteConn)
+import Database.Sqlite (SqliteException)
+import Database.Esqueleto
+import qualified Control.Monad.Trans.Resource as R
+import Test.Hspec
+
+import Common.Test
+
+
+testSqliteRandom :: Spec
+testSqliteRandom = do
+  it "works with random_" $
+    run $ do
+      _ <- select $ return (random_ :: SqlExpr (Value Int))
+      return ()
+
+testSqliteSum :: Spec
+testSqliteSum = do
+  it "works with sum_" $
+    run $ do
+      _ <- insert' p1
+      _ <- insert' p2
+      _ <- insert' p3
+      _ <- insert' p4
+      ret <- select $
+             from $ \p->
+             return $ joinV $ sum_ (p ^. PersonAge)
+      liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Int) ]
+
+testSqliteTwoAscFields :: Spec
+testSqliteTwoAscFields = do
+  it "works with two ASC fields (one call)" $
+    run $ do
+      p1e <- insert' p1
+      p2e <- insert' p2
+      p3e <- insert' p3
+      p4e <- insert' p4
+      ret <- select $
+             from $ \p -> do
+             orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
+             return p
+      -- in SQLite and MySQL, its the reverse
+      liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ]
+
+testSqliteOneAscOneDesc :: Spec
+testSqliteOneAscOneDesc = do
+  it "works with one ASC and one DESC field (two calls)" $
+    run $ do
+      p1e <- insert' p1
+      p2e <- insert' p2
+      p3e <- insert' p3
+      p4e <- insert' p4
+      ret <- select $
+             from $ \p -> do
+             orderBy [desc (p ^. PersonAge)]
+             orderBy [asc (p ^. PersonName)]
+             return p
+      liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
+
+
+testSqliteCoalesce :: Spec
+testSqliteCoalesce = do
+  it "throws an exception on SQLite with <2 arguments" $
+    run (select $
+         from $ \p -> do
+         return (coalesce [p ^. PersonAge]) :: SqlQuery (SqlExpr (Value (Maybe Int))))
+    `shouldThrow` (\(_ :: SqliteException) -> True)
+
+
+testSqliteUpdate :: Spec
+testSqliteUpdate = do
+  it "works on a simple example" $
+    run $ do
+      p1k <- insert p1
+      p2k <- insert p2
+      p3k <- insert p3
+      let anon = "Anonymous"
+      ()  <- update $ \p -> do
+             set p [ PersonName =. val anon
+                   , PersonAge *=. just (val 2) ]
+             where_ (p ^. PersonName !=. val "Mike")
+      n   <- updateCount $ \p -> do
+             set p [ PersonAge +=. just (val 1) ]
+             where_ (p ^. PersonName !=. val "Mike")
+      ret <- select $
+             from $ \p -> do
+             orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
+             return p
+      -- SQLite: nulls appear first, update returns matched rows.
+      liftIO $ n `shouldBe` 2
+      liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing (Just 37) 2)
+                              , Entity p1k (Person anon (Just 73) Nothing 1)
+                              , Entity p3k p3 ]
+
+main :: IO ()
+main = do
+  hspec $ do
+    tests run
+
+    describe "Test SQLite locking" $ do
+      testLocking withConn
+
+    describe "SQLite specific tests" $ do
+      testSqliteRandom
+      testSqliteSum
+      testSqliteTwoAscFields
+      testSqliteOneAscOneDesc
+      testSqliteCoalesce
+      testSqliteUpdate
+
+run, runSilent, runVerbose :: Run
+runSilent  act = runNoLoggingT     $ run_worker act
+runVerbose act = runStderrLoggingT $ run_worker act
+run =
+  if verbose
+  then runVerbose
+  else runSilent
+
+
+verbose :: Bool
+verbose = True
+
+
+run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a
+run_worker act = withConn $ runSqlConn (migrateIt >> act)
+
+
+migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) ()
+migrateIt = do
+  void $ runMigrationSilent migrateAll
+
+
+withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
+withConn =
+  R.runResourceT . withSqliteConn ":memory:"