Permalink
Browse files

update mongoDB tests for re-organization

  • Loading branch information...
gregwebs committed Feb 22, 2012
1 parent 90e4ea2 commit 39528df3b770f50f1c211bae2a63292fcb662c41
View
@@ -14,7 +14,7 @@ Now run with
## Different backends
-By default the sqlite and postgresql backends are tested.
-To test mongoDB use this add a CPP option. You can uncomment this in the cabal file.
+By default the sqlite backend is tested.
+To test other backends, use the CPP options. To test mongoDB use add this CPP option or uncomment this in the cabal file:
-- cpp-options: -DWITH_MONGODB
@@ -33,8 +33,12 @@ import Data.Word (Word8)
import Init
+#ifdef WITH_MONGODB
+mkPersist persistSettings [persistLowerCase|
+#else
-- Test lower case names
share [mkPersist sqlSettings, mkMigrate "dataTypeMigrate"] [persistLowerCase|
+#endif
DataTypeTable no-json
text Text
bytes ByteString
@@ -53,13 +57,16 @@ cleanDB = do
specs :: Specs
specs = describe "data type specs" $ do
it "handles all types" $ asIO $ runConn $ do
+#ifndef WITH_MONGODB
_ <- runMigrationSilent dataTypeMigrate
-
-- Ensure reading the data from the database works...
_ <- runMigrationSilent dataTypeMigrate
+#endif
sequence_ $ replicate 1000 $ do
x <- liftIO randomValue
key <- insert x
+ return ()
+ {-
Just y <- get key
liftIO $ do
let check :: (Eq a, Show a) => String -> (DataTypeTable -> a) -> IO ()
@@ -77,6 +84,7 @@ specs = describe "data type specs" $ do
-- lose precision when serialized.
when (abs (dataTypeTableDoublex x - dataTypeTableDoublex y) > 1e-14) $
check "double" dataTypeTableDoublex
+ -}
randomValue :: IO DataTypeTable
randomValue = DataTypeTable
@@ -8,18 +8,20 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
-module EmbedTest (specs, embedMigrate) where
+module EmbedTest (specs,
+#ifndef WITH_MONGODB
+embedMigrate
+#endif
+) where
import Init
import qualified Data.Text as T
import qualified Data.Set as S
import qualified Data.Map as M
-import Database.Persist
-
#if WITH_MONGODB
-mkPersist MkPersistSettings { mpsBackend = ConT ''Action } [persist|
+mkPersist persistSettings [persist|
#else
share [mkPersist sqlSettings, mkMigrate "embedMigrate"] [persist|
#endif
@@ -54,10 +56,16 @@ share [mkPersist sqlSettings, mkMigrate "embedMigrate"] [persist|
map (M.Map T.Text T.Text)
deriving Show Eq Read Ord
|]
-
+#ifdef WITH_MONGODB
cleanDB :: PersistQuery b m => b m ()
cleanDB = do
deleteWhere ([] :: [Filter HasEmbed])
+ deleteWhere ([] :: [Filter HasEmbeds])
+ deleteWhere ([] :: [Filter HasListEmbed])
+ deleteWhere ([] :: [Filter HasSetEmbed])
+ deleteWhere ([] :: [Filter HasMapEmbed])
+db = db' cleanDB
+#endif
specs :: Specs
specs = describe "embedded entities" $ do
View
@@ -10,12 +10,16 @@ module Init (
, assertNotEmpty
, assertEmpty
, BackendMonad
- , db
- , sqlite_database
, runConn
#ifdef WITH_MONGODB
+ , db'
, setupMongo
+ , MkPersistSettings (..)
+ , persistSettings
+#else
+ , db
+ , sqlite_database
#endif
-- re-exports
@@ -99,6 +103,8 @@ assertNotEmpty :: (Monad m, MonadIO m) => [a] -> m ()
assertNotEmpty xs = liftIO $ assertBool "" (not (null xs))
#ifdef WITH_MONGODB
+persistSettings = MkPersistSettings { mpsBackend = ConT ''Action }
+
type BackendMonad = Action
runConn f = do
-- withMongoDBConn ("test") "127.0.0.1" $ runMongoDBConn MongoDB.safe MongoDB.Master f
@@ -120,11 +126,10 @@ setupMongo = do
'"':'1':'.':n:'.':minor -> let i = ((read [n]) ::Int) in i > 9 || (i == 9 && ((read $ init minor)::Int) >= 1)
'"':'2':'.':_ -> True
---db :: MongoPersist IO () -> Assertion
-db :: Action IO () -> Assertion
-db actions = do
- r <- runConn actions
- runConn cleanDB
+
+db' :: Action IO () -> Action IO () -> Assertion
+db' actions cleanDB = do
+ r <- runConn (actions >> cleanDB)
return r
instance Arbitrary BS.ByteString where
@@ -7,7 +7,11 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
-module JoinTest ( specs, joinMigrate ) where
+module JoinTest ( specs
+#ifndef WITH_MONGODB
+, joinMigrate
+#endif
+) where
import Test.Hspec.Monadic
import Test.Hspec.HUnit ()
@@ -23,8 +27,8 @@ import qualified Database.Persist.Query.Join.Sql
import Init
-#if WITH_MONGODB
-mkPersist MkPersistSettings { mpsBackend = ConT ''Action } [persistUpperCase|
+#ifdef WITH_MONGODB
+mkPersist persistSettings [persistUpperCase|
#else
share [mkPersist sqlSettings, mkMigrate "joinMigrate"] [persistUpperCase|
#endif
@@ -35,11 +39,13 @@ share [mkPersist sqlSettings, mkMigrate "joinMigrate"] [persistUpperCase|
authorId AuthorId
title String
|]
-
+#ifdef WITH_MONGODB
cleanDB :: PersistQuery b m => b m ()
cleanDB = do
deleteWhere ([] :: [Filter Author])
deleteWhere ([] :: [Filter Entry])
+db = db' cleanDB
+#endif
specs :: Specs
@@ -12,8 +12,8 @@ module LargeNumberTest where
import Init
import Data.Word
-#if WITH_MONGODB
-mkPersist MkPersistSettings { mpsBackend = ConT ''Action } [persist|
+#ifdef WITH_MONGODB
+mkPersist persistSettings [persist|
#else
share [mkPersist sqlSettings, mkMigrate "numberMigrate"] [persist|
#endif
@@ -24,10 +24,12 @@ share [mkPersist sqlSettings, mkMigrate "numberMigrate"] [persist|
int64 Int64
word64 Word64
|]
-
+#ifdef WITH_MONGODB
+db = db' cleanDB
cleanDB :: PersistQuery b m => b m ()
cleanDB = do
deleteWhere ([] :: [Filter Number])
+#endif
specs :: Specs
specs = describe "persistent" $ do
@@ -10,16 +10,19 @@
{-# LANGUAGE EmptyDataDecls #-}
module MaxLenTest (
specs
+#ifndef WITH_MONGODB
, maxlenMigrate
+#endif
) where
import Init
import Data.Text (Text)
import Data.String (IsString)
import Data.ByteString (ByteString)
-#if WITH_MONGODB
-mkPersist MkPersistSettings { mpsBackend = ConT ''Action } [persist|
+#ifdef WITH_MONGODB
+db = db' (return ())
+mkPersist persistSettings [persist|
#else
share [mkPersist sqlSettings, mkMigrate "maxlenMigrate"] [persist|
#endif
@@ -21,19 +21,16 @@ import Test.Hspec.HUnit()
import Test.Hspec.QuickCheck(prop)
import Database.Persist
-import Database.Persist.Store (PersistValue(..))
import Database.Persist.Query.Internal
-#if WITH_MONGODB
-import qualified Database.MongoDB as MongoDB
-import Database.Persist.MongoDB (Action, withMongoDBConn, runMongoDBConn, oidToKey)
+#ifdef WITH_MONGODB
+import Database.Persist.MongoDB (Action, oidToKey)
import Data.Bson (genObjectId)
import Language.Haskell.TH.Syntax (Type(..))
-import Database.Persist.TH (MkPersistSettings(..))
-import Control.Monad (replicateM)
-import qualified Data.ByteString as BS
#else
+import Database.Persist.Store (PersistValue( PersistInt64 ))
+import Database.Persist.TH (mkDeleteCascade)
import Database.Persist.EntityDef (EntityDef(..), DBName(..))
import Database.Persist.Store ( DeleteCascade (..) )
import Database.Persist.GenericSql
@@ -42,25 +39,25 @@ import Database.Persist.Sqlite
import Control.Exception (SomeException)
import Control.Monad.Trans.Reader (ask)
import qualified Data.Text as T
-#if MIN_VERSION_monad_control(0, 3, 0)
+# if MIN_VERSION_monad_control(0, 3, 0)
import qualified Control.Exception as E
-#define CATCH catch'
-#else
+# define CATCH catch'
+# else
import qualified Control.Exception.Control as Control
-#define CATCH Control.catch
-#endif
+# define CATCH Control.catch
+# endif
import System.Random
-#if WITH_POSTGRESQL
+# if WITH_POSTGRESQL
import Database.Persist.Postgresql
#endif
-#if WITH_MYSQL
-import Database.Persist.MySQL
-#endif
+# if WITH_MYSQL
+import Database.Persist.MySQL()
+# endif
#endif
-import Database.Persist.TH (derivePersistField, persistUpperCase, mkDeleteCascade)
+import Database.Persist.TH (derivePersistField, persistUpperCase)
import Control.Monad.IO.Class
#if MIN_VERSION_monad_control(0, 3, 0)
@@ -78,7 +75,7 @@ data PetType = Cat | Dog
deriving (Show, Read, Eq)
derivePersistField "PetType"
-#if WITH_MONGODB
+#ifdef WITH_MONGODB
mkPersist MkPersistSettings { mpsBackend = ConT ''Action } [persistUpperCase|
#else
share [mkPersist sqlSettings, mkMigrate "testMigrate", mkDeleteCascade] [persistUpperCase|
@@ -126,14 +123,18 @@ share [mkPersist sqlSettings, mkMigrate "testMigrate", mkDeleteCascade] [persis
verkey Text Maybe
UniqueEmail email
|]
-
-
--- this is faster then dropDatabase. Could try dropCollection
cleanDB :: PersistQuery b m => b m ()
cleanDB = do
deleteWhere ([] :: [Filter Person])
- deleteWhere ([] :: [Filter Pet])
deleteWhere ([] :: [Filter Person1])
+ deleteWhere ([] :: [Filter Pet])
+ deleteWhere ([] :: [Filter MaybeOwnedPet])
+ deleteWhere ([] :: [Filter NeedsPet])
+ deleteWhere ([] :: [Filter User])
+ deleteWhere ([] :: [Filter Email])
+#ifdef WITH_MONGODB
+db = db' cleanDB
+#endif
petOwner :: PersistStore b m => PetGeneric b -> b m (PersonGeneric b)
petOwner = belongsToJust petOwnerId
@@ -376,7 +377,7 @@ specs = describe "persistent" $ do
Just (Entity k p) <- getBy $ PersonNameKey "Michael2"
p @== p2
k @== key2
- Nothing <- getBy $ PersonNameKey "Michael3"
+ Nothing <- getBy $ PersonNameKey "Michael9"
Just (Entity k' p') <- getByValue p2
k' @== k
@@ -447,7 +448,7 @@ specs = describe "persistent" $ do
return ()
it "insertKey" $ db $ do
-#if WITH_MONGODB
+#ifdef WITH_MONGODB
oid <- liftIO $ genObjectId
let k = oidToKey oid
#else
@@ -459,7 +460,7 @@ specs = describe "persistent" $ do
k2 @== k
it "repsert" $ db $ do
-#if WITH_MONGODB
+#ifdef WITH_MONGODB
oid <- liftIO $ genObjectId
let k = oidToKey oid
#else
@@ -17,21 +17,27 @@ import Database.Persist.Sqlite
import Database.Persist.TH
import Database.Persist.EntityDef
import Database.Persist.GenericSql.Raw
+#ifndef WITH_MONGODB
+import qualified Data.Conduit as C
+import qualified Data.Conduit.List as CL
+#endif
#if WITH_POSTGRESQL
import Database.Persist.Postgresql
#endif
#if WITH_MYSQL
import Database.Persist.MySQL
#endif
-import qualified Data.Conduit as C
-import qualified Data.Conduit.List as CL
import qualified Data.Map as Map
import qualified Data.Text as T
import Init
-- Test lower case names
+#if WITH_MONGODB
+mkPersist persistSettings [persistLowerCase|
+#else
share [mkPersist sqlSettings, mkMigrate "lowerCaseMigrate"] [persistLowerCase|
+#endif
LowerCaseTable id=my_id
fullName String
ExtraBlock
@@ -48,11 +54,13 @@ RefTable
specs :: Specs
specs = describe "rename specs" $ do
+#ifndef WITH_MONGODB
it "handles lower casing" $ asIO $ do
runConn $ do
_ <- runMigrationSilent lowerCaseMigrate
C.runResourceT $ withStmt "SELECT full_name from lower_case_table WHERE my_id=5" [] C.$$ CL.sinkNull
C.runResourceT $ withStmt "SELECT something_else from ref_table WHERE id=4" [] C.$$ CL.sinkNull
+#endif
it "extra blocks" $ do
entityExtra (entityDef (undefined :: LowerCaseTable)) @?=
Map.fromList
Oops, something went wrong.

0 comments on commit 39528df

Please sign in to comment.