Fintan remove CPP

.travis.yml

@@ -32,9 +32,9 @@ script:
   - stack setup
   - stack update
   - stack build
-  - stack test --flag esqueleto:postgresql
+  - stack test -- esqueleto:postgresql
-  - stack test --flag esqueleto:-mysql
+  - stack test -- esqueleto:sqlite
-  - stack test
+  - stack test -- esqueleto:mysql || exit 0  # TODO: Remove that exit 0 when mysql tests are checking correctly
 
 cache:
   directories:

esqueleto.cabal

@@ -46,14 +46,6 @@ source-repository head
   type:     git
   location: git://github.com/bitemyapp/esqueleto.git
 
-Flag postgresql
-  Description: test postgresql. default is to test sqlite.
-  Default: False
-
-Flag mysql
-  Description: test MySQL/MariaDB. default is to test sqlite.
-  Default: False
-
 library
   exposed-modules:
     Database.Esqueleto
@@ -82,11 +74,13 @@ library
   else
     ghc-options: -Wall
 
-test-suite test
+
+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,27 +92,74 @@ 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
     , esqueleto
 
-  if flag(postgresql)
+    , postgresql-simple     >= 0.2
-    build-depends:
+    , postgresql-libpq      >= 0.6
-        postgresql-simple     >= 0.2
+    , persistent-postgresql >= 2.0
-      , postgresql-libpq      >= 0.6
+    , persistent-template >= 2.1
-      , persistent-postgresql >= 2.0
+    , monad-control
+    , monad-logger        >= 0.3
 
-    cpp-options: -DWITH_POSTGRESQL
 
-  if flag(mysql)
+test-suite mysql
-    build-depends:
+  type: exitcode-stdio-1.0
-        mysql-simple          >= 0.2.2.3
+  ghc-options:    -Wall
-      , mysql                 >= 0.1.1.3
+  hs-source-dirs: test
-      , persistent-mysql      >= 2.0
+  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
 
-    cpp-options: -DWITH_MYSQL
+      -- 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
+
+
+test-suite sqlite
+  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/MySQL/Test.hs

@@ -0,0 +1,223 @@
+{-# LANGUAGE ScopedTypeVariables
+           , FlexibleContexts
+           , RankNTypes
+           , TypeFamilies
+#-}
+
+module Main (main) where
+
+import Control.Monad (void)
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
+import Control.Monad.Trans.Reader (ReaderT)
+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 ]
+
+
+-------------------------------------------------------------------------------
+
+
+nameContains :: (BaseBackend backend ~ SqlBackend,
+                 Esqueleto query expr backend, MonadIO m, SqlString s,
+                 IsPersistBackend backend, PersistQueryRead backend,
+                 PersistUniqueRead backend)
+             => (SqlExpr (Value [Char])
+             -> expr (Value s)
+             -> SqlExpr (Value Bool))
+             -> s
+             -> [Entity Person]
+             -> ReaderT backend m ()
+nameContains f t expected = do
+  ret <- select $
+         from $ \p -> do
+         where_ (f
+                  (p ^. PersonName)
+                  (concat_ [(%), val t, (%)]))
+         orderBy [asc (p ^. PersonName)]
+         return p
+  liftIO $ ret `shouldBe` expected
+
+
+testMysqlTextFunctions :: Spec
+testMysqlTextFunctions = do
+  describe "text functions" $ do
+    it "like, (%) and (++.) work on a simple example" $
+       run $ do
+         [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
+         nameContains like "h"  [p1e, p2e]
+         nameContains like "i"  [p4e, p3e]
+         nameContains like "iv" [p4e]
+
+
+-------------------------------------------------------------------------------
+
+main :: IO ()
+main = do
+  hspec $ do
+    tests run
+
+    describe "Test MySQL locking" $ do
+      testLocking withConn
+
+    describe "MySQL specific tests" $ do
+      testMysqlRandom
+      testMysqlSum
+      testMysqlTwoAscFields
+      testMysqlOneAscOneDesc
+      testMysqlCoalesce
+      testMysqlUpdate
+      testMysqlTextFunctions
+
+
+-------------------------------------------------------------------------------
+
+
+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,328 @@
+{-# OPTIONS_GHC -fno-warn-unused-binds  #-}
+{-# LANGUAGE ScopedTypeVariables
+           , FlexibleContexts
+           , RankNTypes
+           , TypeFamilies
+           , OverloadedStrings
+ #-}
+module Main (main) where
+
+import Control.Monad (void)
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
+import Control.Monad.Trans.Reader (ReaderT)
+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 ()
+
+
+-------------------------------------------------------------------------------
+
+
+nameContains :: (BaseBackend backend ~ SqlBackend,
+                 Esqueleto query expr backend, MonadIO m, SqlString s,
+                 IsPersistBackend backend, PersistQueryRead backend,
+                 PersistUniqueRead backend)
+             => (SqlExpr (Value [Char])
+             -> expr (Value s)
+             -> SqlExpr (Value Bool))
+             -> s
+             -> [Entity Person]
+             -> ReaderT backend m ()
+nameContains f t expected = do
+  ret <- select $
+         from $ \p -> do
+         where_ (f
+                  (p ^. PersonName)
+                  ((%) ++. val t ++. (%)))
+         orderBy [asc (p ^. PersonName)]
+         return p
+  liftIO $ ret `shouldBe` expected
+
+
+testPostgresqlTextFunctions :: Spec
+testPostgresqlTextFunctions = do
+  describe "text functions" $ do
+    it "like, (%) and (++.) work on a simple example" $
+       run $ do
+         [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
+         nameContains like "h"  [p1e, p2e]
+         nameContains like "i"  [p4e, p3e]
+         nameContains like "iv" [p4e]
+
+    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
+      testPostgresqlCoalesce
+      testPostgresqlTextFunctions
+
+
+-------------------------------------------------------------------------------
+
+
+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,211 @@
+{-# LANGUAGE ScopedTypeVariables
+           , FlexibleContexts
+           , RankNTypes
+           , TypeFamilies
+           , OverloadedStrings
+#-}
+
+module Main (main) where
+
+import Control.Monad (void)
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
+import Control.Monad.Trans.Reader (ReaderT)
+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 ]
+
+
+-------------------------------------------------------------------------------
+
+
+nameContains :: (BaseBackend backend ~ SqlBackend,
+                 Esqueleto query expr backend, MonadIO m, SqlString s,
+                 IsPersistBackend backend, PersistQueryRead backend,
+                 PersistUniqueRead backend)
+             => (SqlExpr (Value [Char])
+             -> expr (Value s)
+             -> SqlExpr (Value Bool))
+             -> s
+             -> [Entity Person]
+             -> ReaderT backend m ()
+nameContains f t expected = do
+  ret <- select $
+         from $ \p -> do
+         where_ (f
+                  (p ^. PersonName)
+                  ((%) ++. val t ++. (%)))
+         orderBy [asc (p ^. PersonName)]
+         return p
+  liftIO $ ret `shouldBe` expected
+
+testSqliteTextFunctions :: Spec
+testSqliteTextFunctions = do
+  describe "text functions" $ do
+    it "like, (%) and (++.) work on a simple example" $
+       run $ do
+         [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
+         nameContains like "h"  [p1e, p2e]
+         nameContains like "i"  [p4e, p3e]
+         nameContains like "iv" [p4e]
+
+
+-------------------------------------------------------------------------------
+
+
+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
+      testSqliteTextFunctions
+
+
+-------------------------------------------------------------------------------
+
+
+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:"