Merge pull request #30 from jcristovao/upstream

PostgreSQL and MySQL support

esqueleto.cabal

@@ -47,6 +47,14 @@ source-repository head
   type:     git
   location: git://github.com/meteficha/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
@@ -90,3 +98,20 @@ test-suite test
 
       -- This library
     , esqueleto
+
+  if flag(postgresql)
+    build-depends:
+        postgresql-simple     >= 0.2
+      , postgresql-libpq      >= 0.6
+      , persistent-postgresql >= 1.2.0
+    
+    cpp-options: -DWITH_POSTGRESQL
+
+  if flag(mysql)
+    build-depends:
+        mysql-simple          >= 0.2.2.3
+      , mysql                 >= 0.1.1.3
+      , persistent-mysql      >= 1.2.0
+
+    cpp-options: -DWITH_MYSQL
+

test/Test.hs

@@ -10,6 +10,7 @@
            , TemplateHaskell
            , TypeFamilies
            , ScopedTypeVariables
+           , CPP
  #-}
 module Main (main) where
 
@@ -20,11 +21,22 @@ import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT)
 import Control.Monad.Trans.Control (MonadBaseControl(..))
 import Database.Esqueleto
 import Database.Persist.Sqlite (withSqliteConn)
+#if   defined (WITH_POSTGRESQL)
+import Database.Persist.Postgresql (withPostgresqlConn)
+#elif defined (WITH_MYSQL)
+import Database.Persist.MySQL ( withMySQLConn
+                              , connectHost
+                              , connectDatabase
+                              , connectUser
+                              , connectPassword
+                              , defaultConnectInfo)
+#endif
 import Database.Persist.TH
 import Test.Hspec
 
 import qualified Data.Conduit as C
 import qualified Data.Set as S
+import qualified Data.List as L
 
 
 -- Test schema
@@ -43,6 +55,10 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
     deriving Eq Show
 |]
 
+-- | this could be achieved with S.fromList, but not all lists
+--   have Ord instances
+sameElementsAs :: Eq a => [a] -> [a] -> Bool
+sameElementsAs l1 l2 = null (l1 L.\\ l2)
 
 main :: IO ()
 main = do
@@ -96,10 +112,10 @@ main = do
           ret <- select $
                  from $ \(person1, person2) ->
                  return (person1, person2)
-          liftIO $ ret `shouldBe` [ (p1e, p1e)
+          liftIO $ ret `shouldSatisfy` sameElementsAs [ (p1e, p1e)
-                                  , (p1e, p2e)
+                                                      , (p1e, p2e)
-                                  , (p2e, p1e)
+                                                      , (p2e, p1e)
-                                  , (p2e, p2e) ]
+                                                      , (p2e, p2e) ]
 
       it "works for a self-join via sub_select" $
         run $ do
@@ -149,7 +165,8 @@ main = do
           ret <- select $
                  from $ \(pa, pb) ->
                  return (pa ^. PersonName, pb ^. PersonName)
-          liftIO $ ret `shouldBe` [ (Value (personName p1), Value (personName p1))
+          liftIO $ ret `shouldSatisfy` sameElementsAs
+                                  [ (Value (personName p1), Value (personName p1))
                                   , (Value (personName p1), Value (personName p2))
                                   , (Value (personName p2), Value (personName p1))
                                   , (Value (personName p2), Value (personName p2)) ]
@@ -343,7 +360,11 @@ main = do
 
       it "works with random_" $
         run $ do
+#if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL)
+          ret <- select $ return (random_ :: SqlExpr (Value Double))
+#else
           ret <- select $ return (random_ :: SqlExpr (Value Int))
+#endif
           return ()
 
       it "works with round_" $
@@ -462,7 +483,13 @@ main = do
                  from $ \p -> do
                  orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
                  return p
+          -- in PostgreSQL nulls are bigger than everything
+#ifdef WITH_POSTGRESQL
+          liftIO $ ret `shouldBe` [ p4e, p3e, p1e , p2e ]
+#else
+          -- in SQLite and MySQL, its the reverse
           liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ]
+#endif
 
       it "works with one ASC and one DESC field" $
         run $ do
@@ -474,7 +501,11 @@ main = do
                  from $ \p -> do
                  orderBy [desc (p ^. PersonAge), asc (p ^. PersonName)]
                  return p
+#ifdef WITH_POSTGRESQL
+          liftIO $ ret `shouldBe` [ p2e, p1e, p4e, p3e ]
+#else
           liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
+#endif
 
       it "works with a sub_select" $
         run $ do
@@ -578,10 +609,27 @@ main = do
                  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.
+#if   defined(WITH_POSTGRESQL)
+          liftIO $ n `shouldBe` 2
+          liftIO $ ret `shouldBe` [ Entity p1k (Person anon (Just 73))
+                                  , Entity p2k (Person anon Nothing)
+                                  , Entity p3k p3 ]
+          -- MySQL: nulls appear first, and update returns actual number
+          --        of changed rows
+#elif defined(WITH_MYSQL)
+          liftIO $ n `shouldBe` 1
+          liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing)
+                                  , Entity p1k (Person anon (Just 73))
+                                  , Entity p3k p3 ]
+#else
+          -- SQLite: nulls appear first, update returns matched rows.
           liftIO $ n `shouldBe` 2
           liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing)
                                   , Entity p1k (Person anon (Just 73))
                                   , Entity p3k p3 ]
+#endif
 
       it "works with a subexpression having COUNT(*)" $
         run $ do
@@ -755,6 +803,20 @@ insert' v = flip Entity v <$> insert v
 type RunDbMonad m = ( MonadBaseControl IO m, MonadIO m, MonadLogger m
                     , C.MonadUnsafeIO m, C.MonadThrow m )
 
+#if defined (WITH_POSTGRESQL) || defined (WITH_MYSQL)
+-- 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.
+-- TODO: there is certainly a better way...
+cleanDB
+  :: (forall m. RunDbMonad m
+  => SqlPersistT (C.ResourceT m) ())
+cleanDB = do
+  delete $ from $ \(blogpost :: SqlExpr (Entity BlogPost))-> return ()
+  delete $ from $ \(follow   :: SqlExpr (Entity Follow))  -> return ()
+  delete $ from $ \(person   :: SqlExpr (Entity Person))  -> return ()
+#endif
+
 
 run, runSilent, runVerbose :: (forall m. RunDbMonad m => SqlPersistT (C.ResourceT m) a) -> IO a
 runSilent  act = runNoLoggingT     $ run_worker act
@@ -770,8 +832,23 @@ verbose = True
 
 
 run_worker :: RunDbMonad m => SqlPersistT (C.ResourceT m) a -> m a
-run_worker =
+run_worker act =
   C.runResourceT .
+#if defined(WITH_POSTGRESQL)
+  withPostgresqlConn "host=localhost port=5432 user=joao dbname=esqueleto" .
+#elif defined (WITH_MYSQL)
+  withMySQLConn defaultConnectInfo
+    { connectHost     = "localhost"
+    , connectUser     = "test"
+    , connectPassword = "test"
+    , connectDatabase = "test"
+    } .
+#else
   withSqliteConn ":memory:" .
+#endif
   runSqlConn .
-  (runMigrationSilent migrateAll >>)
+#if defined (WITH_POSTGRESQL) || defined (WITH_MYSQL)
+  (runMigrationSilent migrateAll >>) $ (cleanDB >> act)
+#else
+  (runMigrationSilent migrateAll >>) $ act
+#endif