persistent-mongoDB 2.8.0 → 2.9.0

raw patch · 8 files changed

+869/−127 lines, 8 filesdep +HUnitdep +QuickCheckdep +blaze-htmldep −attoparsecdep ~aesondep ~basedep ~bsonnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, QuickCheck, blaze-html, hspec, persistent-mongoDB, persistent-qq, persistent-template, persistent-test, process, semigroups, template-haskell

Dependencies removed: attoparsec

Dependency ranges changed: aeson, base, bson, bytestring, cereal, conduit, containers, http-api-data, mongoDB, network, path-pieces, persistent, resource-pool, resourcet, text, transformers

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• Database/Persist/MongoDB.hs +67/−109
• persistent-mongoDB.cabal +50/−18
• test/EmbedTestMongo.hs +432/−0
• test/EntityEmbedTestMongo.hs +21/−0
• test/MongoInit.hs +107/−0
• test/RawMongoHelpers.hs +33/−0
• test/main.hs +151/−0

@@ -1,3 +1,11 @@+# Changelog for persistent-mongoDB++## 2.9.0++* Removed deprecated `entityToDocument`. Please use `recordToDocument` instead. [#894](https://github.com/yesodweb/persistent/pull/894)+* Removed deprecated `multiBsonEq`. Please use `anyBsonEq` instead. [#894](https://github.com/yesodweb/persistent/pull/894)+* Use `portID` from `mongoDB` instead of `network`. [#946](https://github.com/yesodweb/persistent/pull/946)+ ## 2.8.0  * Switch from `MonadBaseControl` to `MonadUnliftIO`

@@ -1,3 +1,12 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-orphans #-} -- | Use persistent-mongodb the same way you would use other persistent -- libraries and refer to the general persistent documentation. -- There are some new MongoDB specific filters under the filters section.@@ -13,21 +22,12 @@ -- The MongoDB Persistent backend does not help perform migrations. -- Unlike SQL backends, uniqueness constraints cannot be created for you. -- You must place a unique index on unique fields.-{-# LANGUAGE CPP, PackageImports, OverloadedStrings, ScopedTypeVariables  #-}-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}-{-# LANGUAGE RankNTypes, TypeFamilies #-}-{-# LANGUAGE EmptyDataDecls #-}--{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE GADTs #-} module Database.Persist.MongoDB     (     -- * Entity conversion       collectionName     , docToEntityEither     , docToEntityThrow-    , entityToDocument     , recordToDocument     , documentFromEntity     , toInsertDoc@@ -42,7 +42,7 @@     -- ** Filters     -- $filters     , nestEq, nestNe, nestGe, nestLe, nestIn, nestNotIn-    , anyEq, nestAnyEq, nestBsonEq, anyBsonEq, multiBsonEq+    , anyEq, nestAnyEq, nestBsonEq, anyBsonEq     , inList, ninList     , (=~.)     -- non-operator forms of filters@@ -95,7 +95,6 @@      -- * network type     , HostName-    , PortID      -- * MongoDB driver types     , Database@@ -106,73 +105,57 @@     , (DB.=:)     , DB.ObjectId     , DB.MongoContext+    , DB.PortID      -- * Database.Persist     , module Database.Persist     ) where -import Database.Persist-import qualified Database.Persist.Sql as Sql--import qualified Control.Monad.IO.Class as Trans import Control.Exception (throw, throwIO)-import Data.Acquire (mkAcquire)-import qualified Data.Traversable as Traversable+import Control.Monad (liftM, (>=>), forM_, unless)+import Control.Monad.IO.Class (liftIO)+import qualified Control.Monad.IO.Class as Trans+import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)+import Control.Monad.Trans.Reader (ask, runReaderT) +import Data.Acquire (mkAcquire)+import Data.Aeson (Value (Number), (.:), (.:?), (.!=), FromJSON(..), ToJSON(..), withText, withObject)+import Data.Aeson.Types (modifyFailure)+import Data.Bits (shiftR) import Data.Bson (ObjectId(..))-import qualified Database.MongoDB as DB-import Database.MongoDB.Query (Database)-import Control.Applicative as A (Applicative, (<$>))-import Network (PortID (PortNumber))-import Network.Socket (HostName)+import qualified Data.ByteString as BS+import Data.Conduit import Data.Maybe (mapMaybe, fromJust)-import qualified Data.Text as T+import Data.Monoid (mappend)+import qualified Data.Serialize as Serialize import Data.Text (Text)-import qualified Data.ByteString as BS+import qualified Data.Text as T import qualified Data.Text.Encoding as E-import qualified Data.Serialize as Serialize-import Web.PathPieces (PathPiece(..))-import Web.HttpApiData (ToHttpApiData(..), FromHttpApiData(..), parseUrlPieceMaybe, parseUrlPieceWithPrefix, readTextData)-import Data.Conduit-import Control.Monad.IO.Class (liftIO)-import Data.Aeson (Value (Number), (.:), (.:?), (.!=), FromJSON(..), ToJSON(..), withText, withObject)-import Data.Aeson.Types (modifyFailure)-import Control.Monad (liftM, (>=>), forM_, unless)+import qualified Data.Traversable as Traversable import qualified Data.Pool as Pool import Data.Time (NominalDiffTime)+import Data.Time.Calendar (Day(..)) #ifdef HIGH_PRECISION_DATE import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) #endif-import Data.Time.Calendar (Day(..))-#if MIN_VERSION_aeson(0, 7, 0)-#else-import Data.Attoparsec.Number-#endif-import Data.Bits (shiftR) import Data.Word (Word16)-import Data.Monoid (mappend)-import Control.Monad.Trans.Reader (ask, runReaderT)-import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)+import Network.Socket (HostName) import Numeric (readHex)-import Unsafe.Coerce (unsafeCoerce)--#if MIN_VERSION_base(4,6,0) import System.Environment (lookupEnv)-#else-import System.Environment (getEnvironment)-#endif+import Unsafe.Coerce (unsafeCoerce)+import Web.PathPieces (PathPiece(..))+import Web.HttpApiData (ToHttpApiData(..), FromHttpApiData(..), parseUrlPieceMaybe, parseUrlPieceWithPrefix, readTextData)  #ifdef DEBUG import FileLocation (debug) #endif -#if !MIN_VERSION_base(4,6,0)-lookupEnv :: String -> IO (Maybe String)-lookupEnv key = do-    env <- getEnvironment-    return $ lookup key env-#endif+import qualified Database.MongoDB as DB+import Database.MongoDB.Query (Database) +import Database.Persist+import qualified Database.Persist.Sql as Sql+ instance HasPersistBackend DB.MongoContext where     type BaseBackend DB.MongoContext = DB.MongoContext     persistBackend = id@@ -184,30 +167,16 @@                                 deriving (Show, Eq, Num)  instance FromJSON NoOrphanNominalDiffTime where-#if MIN_VERSION_aeson(0, 7, 0)     parseJSON (Number x) = (return . NoOrphanNominalDiffTime . fromRational . toRational) x---#else-    parseJSON (Number (I x)) = (return . NoOrphanNominalDiffTime . fromInteger) x-    parseJSON (Number (D x)) = (return . NoOrphanNominalDiffTime . fromRational . toRational) x--#endif     parseJSON _ = fail "couldn't parse diff time" -newtype NoOrphanPortID = NoOrphanPortID PortID deriving (Show, Eq)+newtype NoOrphanPortID = NoOrphanPortID DB.PortID deriving (Show, Eq)   instance FromJSON NoOrphanPortID where-#if MIN_VERSION_aeson(0, 7, 0)-    parseJSON (Number  x) = (return . NoOrphanPortID . PortNumber . fromIntegral ) cnvX+    parseJSON (Number  x) = (return . NoOrphanPortID . DB.PortNumber . fromIntegral ) cnvX       where cnvX :: Word16             cnvX = round x--#else-    parseJSON (Number (I x)) = (return . NoOrphanPortID . PortNumber . fromInteger) x--#endif     parseJSON _ = fail "couldn't parse port number"  @@ -220,7 +189,7 @@ instance FromHttpApiData (BackendKey DB.MongoContext) where     parseUrlPiece input = do       s <- parseUrlPieceWithPrefix "o" input <!> return input-      MongoKey A.<$> readTextData s+      MongoKey <$> readTextData s       where         infixl 3 <!>         Left _ <!> y = y@@ -257,19 +226,19 @@     sqlType _ = Sql.SqlOther "doesn't make much sense for MongoDB"  -withConnection :: (Trans.MonadIO m, A.Applicative m)+withConnection :: (Trans.MonadIO m)                => MongoConf                -> (ConnectionPool -> m b) -> m b withConnection mc =   withMongoDBPool (mgDatabase mc) (T.unpack $ mgHost mc) (mgPort mc) (mgAuth mc) (mgPoolStripes mc) (mgStripeConnections mc) (mgConnectionIdleTime mc) -withMongoDBConn :: (Trans.MonadIO m, Applicative m)-                => Database -> HostName -> PortID+withMongoDBConn :: (Trans.MonadIO m)+                => Database -> HostName -> DB.PortID                 -> Maybe MongoAuth -> NominalDiffTime                 -> (ConnectionPool -> m b) -> m b withMongoDBConn dbname hostname port mauth connectionIdleTime = withMongoDBPool dbname hostname port mauth 1 1 connectionIdleTime -createPipe :: HostName -> PortID -> IO DB.Pipe+createPipe :: HostName -> DB.PortID -> IO DB.Pipe createPipe hostname port = DB.connect (DB.Host hostname port)  createReplicatSet :: (DB.ReplicaSetName, [DB.Host]) -> Database -> Maybe MongoAuth -> IO Connection@@ -278,7 +247,7 @@     testAccess pipe dbname mAuth     return $ Connection pipe dbname -createRsPool :: (Trans.MonadIO m, Applicative m) => Database -> ReplicaSetConfig+createRsPool :: (Trans.MonadIO m) => Database -> ReplicaSetConfig               -> Maybe MongoAuth               -> Int -- ^ pool size (number of stripes)               -> Int -- ^ stripe size (number of connections per stripe)@@ -299,13 +268,13 @@       Nothing -> return undefined     return () -createConnection :: Database -> HostName -> PortID -> Maybe MongoAuth -> IO Connection+createConnection :: Database -> HostName -> DB.PortID -> Maybe MongoAuth -> IO Connection createConnection dbname hostname port mAuth = do     pipe <- createPipe hostname port     testAccess pipe dbname mAuth     return $ Connection pipe dbname -createMongoDBPool :: (Trans.MonadIO m, Applicative m) => Database -> HostName -> PortID+createMongoDBPool :: (Trans.MonadIO m) => Database -> HostName -> DB.PortID                   -> Maybe MongoAuth                   -> Int -- ^ pool size (number of stripes)                   -> Int -- ^ stripe size (number of connections per stripe)@@ -320,7 +289,7 @@                           stripeSize  -createMongoPool :: (Trans.MonadIO m, Applicative m) => MongoConf -> m ConnectionPool+createMongoPool :: (Trans.MonadIO m) => MongoConf -> m ConnectionPool createMongoPool c@MongoConf{mgReplicaSetConfig = Just (ReplicaSetConfig rsName hosts)} =       createRsPool          (mgDatabase c)@@ -339,7 +308,7 @@ -- The database parameter has not yet been applied yet. -- This is useful for switching between databases (on the same host and port) -- Unlike the normal pool, no authentication is available-createMongoDBPipePool :: (Trans.MonadIO m, Applicative m) => HostName -> PortID+createMongoDBPipePool :: (Trans.MonadIO m) => HostName -> DB.PortID                   -> Int -- ^ pool size (number of stripes)                   -> Int -- ^ stripe size (number of connections per stripe)                   -> NominalDiffTime -- ^ time a connection is left idle before closing@@ -352,11 +321,11 @@                           connectionIdleTime                           stripeSize -withMongoPool :: (Trans.MonadIO m, Applicative m) => MongoConf -> (ConnectionPool -> m b) -> m b+withMongoPool :: (Trans.MonadIO m) => MongoConf -> (ConnectionPool -> m b) -> m b withMongoPool conf connectionReader = createMongoPool conf >>= connectionReader -withMongoDBPool :: (Trans.MonadIO m, Applicative m) =>-  Database -> HostName -> PortID -> Maybe MongoAuth -> Int -> Int -> NominalDiffTime -> (ConnectionPool -> m b) -> m b+withMongoDBPool :: (Trans.MonadIO m) =>+  Database -> HostName -> DB.PortID -> Maybe MongoAuth -> Int -> Int -> NominalDiffTime -> (ConnectionPool -> m b) -> m b withMongoDBPool dbname hostname port mauth poolStripes stripeConnections connectionIdleTime connectionReader = do   pool <- createMongoDBPool dbname hostname port mauth poolStripes stripeConnections connectionIdleTime   connectionReader pool@@ -443,7 +412,7 @@  -- | convert a PersistEntity into document fields. -- for inserts only: nulls are ignored so they will be unset in the document.--- 'entityToDocument' includes nulls+-- 'recordToDocument' includes nulls toInsertDoc :: forall record.  (PersistEntity record, PersistEntityBackend record ~ DB.MongoContext)             => record -> DB.Document toInsertDoc record = zipFilter (embeddedFields $ toEmbedEntityDef entDef)@@ -488,15 +457,10 @@   where     entity = entityDef $ Just record -entityToDocument :: (PersistEntity record, PersistEntityBackend record ~ DB.MongoContext)-                 => record -> DB.Document-entityToDocument = recordToDocument-{-# DEPRECATED entityToDocument "use recordToDocument" #-}- documentFromEntity :: (PersistEntity record, PersistEntityBackend record ~ DB.MongoContext)                    => Entity record -> DB.Document documentFromEntity (Entity key record) =-    keyToMongoDoc key ++ entityToDocument record+    keyToMongoDoc key ++ recordToDocument record  zipToDoc :: PersistField a => [DBName] -> [a] -> [DB.Field] zipToDoc [] _  = []@@ -638,7 +602,7 @@      upsertBy uniq newRecord upds = do         let uniqueDoc = toUniquesDoc uniq :: [DB.Field]-        let uniqKeys = map DB.label uniqueDoc :: [DB.Label]   +        let uniqKeys = map DB.label uniqueDoc :: [DB.Label]         let insDoc = DB.exclude uniqKeys $ toInsertDoc newRecord :: DB.Document         let selection = DB.select uniqueDoc $ collectionName newRecord :: DB.Selection         mdoc <- getBy uniq@@ -844,7 +808,7 @@  filterToBSON :: forall a. ( PersistField a)              => Text-             -> Either a [a]+             -> FilterValue a              -> PersistFilter              -> DB.Field filterToBSON fname v filt = case filt of@@ -918,11 +882,12 @@     nesFldName (nf1 `LastNestFld` nf2)         = [fieldName nf1, fieldName nf2]     nesFldName (nf1 `LastNestFldNullable` nf2) = [fieldName nf1, fieldName nf2] -toValue :: forall a.  PersistField a => Either a [a] -> DB.Value+toValue :: forall a.  PersistField a => FilterValue a -> DB.Value toValue val =     case val of-      Left v   -> DB.val $ toPersistValue v-      Right vs -> DB.val $ map toPersistValue vs+      FilterValue v   -> DB.val $ toPersistValue v+      UnsafeValue v   -> DB.val $ toPersistValue v+      FilterValues vs -> DB.val $ map toPersistValue vs  fieldName ::  forall record typ.  (PersistEntity record) => EntityField record typ -> DB.Label fieldName f | fieldHaskell fd == HaskellName "Id" = id_@@ -1075,6 +1040,7 @@   val x@(PersistObjectId _) = DB.ObjId $ persistObjectIdToDbOid x   val (PersistTimeOfDay _)  = throw $ PersistMongoDBUnsupported "PersistTimeOfDay not implemented for the MongoDB backend. only PersistUTCTime currently implemented"   val (PersistRational _)   = throw $ PersistMongoDBUnsupported "PersistRational not implemented for the MongoDB backend"+  val (PersistArray a)      = DB.val $ PersistList a   val (PersistDbSpecific _)   = throw $ PersistMongoDBUnsupported "PersistDbSpecific not implemented for the MongoDB backend"   cast' (DB.Float x)  = Just (PersistDouble x)   cast' (DB.Int32 x)  = Just $ PersistInt64 $ fromIntegral x@@ -1122,7 +1088,7 @@ data MongoConf = MongoConf     { mgDatabase :: Text     , mgHost     :: Text-    , mgPort     :: PortID+    , mgPort     :: DB.PortID     , mgAuth     :: Maybe MongoAuth     , mgAccessMode :: DB.AccessMode     , mgPoolStripes :: Int@@ -1265,7 +1231,7 @@ (=~.) :: forall record searchable. (MongoRegexSearchable searchable, PersistEntity record, PersistEntityBackend record ~ DB.MongoContext) => EntityField record searchable -> MongoRegex -> Filter record fld =~. val = BackendFilter $ RegExpFilter fld val -data MongoFilterOperator typ = PersistFilterOperator (Either typ [typ]) PersistFilter+data MongoFilterOperator typ = PersistFilterOperator (FilterValue typ) PersistFilter                              | MongoFilterOperator DB.Value  data UpdateValueOp typ =@@ -1366,7 +1332,6 @@ infixr 4 `anyEq` infixr 4 `nestAnyEq` infixr 4 `nestBsonEq`-infixr 4 `multiBsonEq` infixr 4 `anyBsonEq`  infixr 4 `nestSet`@@ -1398,7 +1363,7 @@        , PersistEntityBackend record ~ DB.MongoContext        ) => PersistFilter -> NestedField record typ -> typ -> Filter record nestedFilterOp op nf v = BackendFilter $-   NestedFilter nf $ PersistFilterOperator (Left v) op+   NestedFilter nf $ PersistFilterOperator (FilterValue v) op  -- | same as `nestEq`, but give a BSON Value nestBsonEq :: forall record typ.@@ -1421,7 +1386,7 @@         , PersistEntityBackend record ~ DB.MongoContext         ) => EntityField record [typ] -> typ -> Filter record fld `anyEq` val = BackendFilter $-    ArrayFilter fld $ PersistFilterOperator (Left val) Eq+    ArrayFilter fld $ PersistFilterOperator (FilterValue val) Eq  -- | Like nestEq, but for an embedded list. -- Checks to see if the nested list contains an item.@@ -1430,14 +1395,7 @@         , PersistEntityBackend record ~ DB.MongoContext         ) => NestedField record [typ] -> typ -> Filter record fld `nestAnyEq` val = BackendFilter $-    NestedArrayFilter fld $ PersistFilterOperator (Left val) Eq--multiBsonEq :: forall record typ.-        ( PersistField typ-        , PersistEntityBackend record ~ DB.MongoContext-        ) => EntityField record [typ] -> DB.Value -> Filter record-multiBsonEq = anyBsonEq-{-# DEPRECATED multiBsonEq "Please use anyBsonEq instead" #-}+    NestedArrayFilter fld $ PersistFilterOperator (FilterValue val) Eq  -- | same as `anyEq`, but give a BSON Value anyBsonEq :: forall record typ.@@ -1508,10 +1466,10 @@  -- | Intersection of lists: if any value in the field is found in the list. inList :: PersistField typ => EntityField v [typ] -> [typ] -> Filter v-f `inList` a = Filter (unsafeCoerce f) (Right a) In+f `inList` a = Filter (unsafeCoerce f) (FilterValues a) In infix 4 `inList`  -- | No intersection of lists: if no value in the field is found in the list. ninList :: PersistField typ => EntityField v [typ] -> [typ] -> Filter v-f `ninList` a = Filter (unsafeCoerce f) (Right a) In+f `ninList` a = Filter (unsafeCoerce f) (FilterValues a) In infix 4 `ninList`

@@ -1,5 +1,5 @@ name:            persistent-mongoDB-version:         2.8.0+version:         2.9.0 license:         MIT license-file:    LICENSE author:          Greg Weber <greg@gregweber.info>@@ -7,7 +7,7 @@ synopsis:        Backend for the persistent library using mongoDB. category:        Database stability:       Experimental-cabal-version:   >= 1.8+cabal-version:   >= 1.10 build-type:      Simple homepage:        http://www.yesodweb.com/book/persistent bug-reports:     https://github.com/yesodweb/persistent/issues@@ -21,30 +21,62 @@ library     build-depends:   base               >= 4.8 && < 5                    , persistent         >= 2.8   && < 3-                   , text               >= 0.8-                   , transformers       >= 0.2.1-                   , containers         >= 0.2-                   , bytestring         >= 0.9-                   , conduit            >= 0.5.3-                   , resourcet          >= 0.3-                   , mongoDB            >= 2.0.3   && (< 2.1 || >= 2.1.1)-                   , bson               >= 0.3.1   && < 0.4-                   , network            >= 2.2.1.7-                   , cereal             >= 0.3.0.0-                   , path-pieces        >= 0.1-                   , http-api-data      >= 0.2       && < 0.4-                   , aeson              >= 0.6.2-                   , attoparsec-                   , time+                   , aeson              >= 1.0+                   , bson               >= 0.3.2   && < 0.4                    , bytestring-                   , resource-pool      < 0.3+                   , cereal             >= 0.5+                   , conduit            >= 1.2+                   , http-api-data      >= 0.3.7     && < 0.5+                   , mongoDB            >= 2.3+                   , network            >= 2.6+                   , path-pieces        >= 0.2+                   , resource-pool      >= 0.2       && < 0.3+                   , resourcet          >= 1.1+                   , text               >= 1.2+                   , time+                   , transformers       >= 0.5                    , unliftio-core      exposed-modules: Database.Persist.MongoDB     ghc-options:     -Wall+    default-language: Haskell2010     if flag(high_precision_date)      cpp-options: -DHIGH_PRECISION_DATE++test-suite test+    type:            exitcode-stdio-1.0+    main-is:         main.hs+    hs-source-dirs:  test+    other-modules:   MongoInit+                     EmbedTestMongo+                     EntityEmbedTestMongo+                     RawMongoHelpers+    ghc-options:     -Wall++    build-depends:   base >= 4.6 && < 5+                   , persistent+                   , persistent-mongoDB+                   , persistent-qq+                   , persistent-template+                   , persistent-test+                   , blaze-html+                   , bytestring+                   , containers+                   , hspec           >= 2.4.0+                   , HUnit+                   , mongoDB+                   , process+                   , QuickCheck+                   , template-haskell+                   , text+                   , time+                   , transformers+                   , unliftio-core+   if impl(ghc < 8)+     build-depends:+       semigroups+    default-language: Haskell2010  source-repository head   type:     git

@@ -0,0 +1,432 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-unused-top-binds -Wno-orphans -O0 #-}+module EmbedTestMongo (specs) where++import MongoInit++import Control.Exception (Exception, throw)+import Data.List.NonEmpty hiding (insert, length)+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Text as T+import Data.Typeable (Typeable)+import Database.MongoDB (genObjectId)+import Database.MongoDB (Value(String))+import System.Process (readProcess)++import EntityEmbedTestMongo+import Database.Persist.MongoDB++data TestException = TestException+    deriving (Show, Typeable, Eq)+instance Exception TestException++instance PersistFieldSql a => PersistFieldSql (NonEmpty a) where+    sqlType _ = SqlString++instance PersistField a => PersistField (NonEmpty a) where+    toPersistValue = toPersistValue . toList+    fromPersistValue pv = do+        list <- fromPersistValue pv+        case list of+            [] -> Left "PersistField: NonEmpty found unexpected Empty List"+            (l:ls) -> Right (l:|ls)+++mkPersist persistSettings [persistUpperCase|+  HasObjectId+    oid  ObjectId+    name Text+    deriving Show Eq Read Ord++  HasArrayWithObjectIds+    name Text+    arrayWithObjectIds [HasObjectId]+    deriving Show Eq Read Ord++  HasArrayWithEntities+    hasEntity (Entity ARecord)+    arrayWithEntities [AnEntity]+    deriving Show Eq Read Ord++  OnlyName+    name Text+    deriving Show Eq Read Ord++  HasEmbed+    name Text+    embed OnlyName+    deriving Show Eq Read Ord++  HasEmbeds+    name Text+    embed OnlyName+    double HasEmbed+    deriving Show Eq Read Ord++  HasListEmbed+    name Text+    list [HasEmbed]+    deriving Show Eq Read Ord++  HasSetEmbed+    name Text+    set (S.Set HasEmbed)+    deriving Show Eq Read Ord++  HasMap+    name Text+    map (M.Map T.Text T.Text)+    deriving Show Eq Read Ord++  HasList+    list [HasListId]+    deriving Show Eq Read Ord++  EmbedsHasMap+    name Text Maybe+    embed HasMap+    deriving Show Eq Read Ord++  InList+    one Int+    two Int+    deriving Show Eq++  ListEmbed+    nested [InList]+    one Int+    two Int+    deriving Show Eq++  User+    ident Text+    password Text Maybe+    profile Profile+    deriving Show Eq Read Ord++  Profile+    firstName Text+    lastName Text+    contact Contact Maybe+    deriving Show Eq Read Ord++  Contact+    phone Int+    email T.Text+    deriving Show Eq Read Ord++  Account+    userIds       (NonEmpty (Key User))+    name          Text Maybe+    customDomains [Text]             -- we may want to allow multiple cust domains.  use [] instead of maybe++    deriving Show Eq Read Ord++  HasNestedList+    list [IntList]+    deriving Show Eq++  IntList+    ints [Int]+    deriving Show Eq++  -- We would like to be able to use OnlyNameId+  -- But (Key OnlyName) works+  MapIdValue+    map (M.Map T.Text (Key OnlyName))+    deriving Show Eq Read Ord+++  -- Self refrences are only allowed as a nullable type:+  -- a Maybe or a List+  SelfList+    reference [SelfList]++  SelfMaybe+    reference SelfMaybe Maybe++  -- This failes+  -- SelfDirect+  --  reference SelfDirect+|]++cleanDB :: (PersistQuery backend, PersistEntityBackend HasMap ~ backend, MonadIO m) => ReaderT backend m ()+cleanDB = do+  deleteWhere ([] :: [Filter HasEmbed])+  deleteWhere ([] :: [Filter HasEmbeds])+  deleteWhere ([] :: [Filter HasListEmbed])+  deleteWhere ([] :: [Filter HasSetEmbed])+  deleteWhere ([] :: [Filter User])+  deleteWhere ([] :: [Filter HasMap])+  deleteWhere ([] :: [Filter HasList])+  deleteWhere ([] :: [Filter EmbedsHasMap])+  deleteWhere ([] :: [Filter ListEmbed])+  deleteWhere ([] :: [Filter ARecord])+  deleteWhere ([] :: [Filter Account])+  deleteWhere ([] :: [Filter HasNestedList])++db :: Action IO () -> Assertion+db = db' cleanDB++unlessM :: MonadIO m => IO Bool -> m () -> m ()+unlessM predicate body = do+    b <- liftIO predicate+    unless b body++specs :: Spec+specs = describe "embedded entities" $ do++  it "simple entities" $ db $ do+      let container = HasEmbeds "container" (OnlyName "2")+            (HasEmbed "embed" (OnlyName "1"))+      contK <- insert container+      Just res <- selectFirst [HasEmbedsName ==. "container"] []+      res @== Entity contK container++  it "query for equality of embeded entity" $ db $ do+      let container = HasEmbed "container" (OnlyName "2")+      contK <- insert container+      Just res <- selectFirst [HasEmbedEmbed ==. OnlyName "2"] []+      res @== Entity contK container++  it "Set" $ db $ do+      let container = HasSetEmbed "set" $ S.fromList+            [ HasEmbed "embed" (OnlyName "1")+            , HasEmbed "embed" (OnlyName "2")+            ]+      contK <- insert container+      Just res <- selectFirst [HasSetEmbedName ==. "set"] []+      res @== Entity contK container++  it "Set empty" $ db $ do+      let container = HasSetEmbed "set empty" $ S.fromList []+      contK <- insert container+      Just res <- selectFirst [HasSetEmbedName ==. "set empty"] []+      res @== Entity contK container++  it "exception" $ flip shouldThrow (== TestException) $ db $ do+      let container = HasSetEmbed "set" $ S.fromList+            [ HasEmbed "embed" (OnlyName "1")+            , HasEmbed "embed" (OnlyName "2")+            ]+      contK <- insert container+      Just res <- selectFirst [HasSetEmbedName ==. throw TestException] []+      res @== Entity contK container++  it "ListEmbed" $ db $ do+      let container = HasListEmbed "list"+            [ HasEmbed "embed" (OnlyName "1")+            , HasEmbed "embed" (OnlyName "2")+            ]+      contK <- insert container+      Just res <- selectFirst [HasListEmbedName ==. "list"] []+      res @== Entity contK container++  it "ListEmbed empty" $ db $ do+      let container = HasListEmbed "list empty" []+      contK <- insert container+      Just res <- selectFirst [HasListEmbedName ==. "list empty"] []+      res @== Entity contK container++  it "List empty" $ db $ do+      let container = HasList []+      contK <- insert container+      Just res <- selectFirst [] []+      res @== Entity contK container++  it "NonEmpty List wrapper" $ db $ do+      let con = Contact 123456 "foo@bar.com"+      let prof = Profile "fstN" "lstN" (Just con)+      uid <- insert $ User "foo" (Just "pswd") prof+      let container = Account (uid:|[]) (Just "Account") []+      contK <- insert container+      Just res <- selectFirst [AccountUserIds ==. (uid:|[])] []+      res @== Entity contK container++  it "Map" $ db $ do+      let container = HasMap "2 items" $ M.fromList [+              ("k1","v1")+            , ("k2","v2")+            ]+      contK <- insert container+      Just res <- selectFirst [HasMapName ==. "2 items"] []+      res @== Entity contK container++  it "Map empty" $ db $ do+      let container = HasMap "empty" $ M.fromList []+      contK <- insert container+      Just res <- selectFirst [HasMapName ==. "empty"] []+      res @== Entity contK container++  it "Embeds a Map" $ db $ do+      let container = EmbedsHasMap (Just "non-empty map") $ HasMap "2 items" $ M.fromList [+              ("k1","v1")+            , ("k2","v2")+            ]+      contK <- insert container+      Just res <- selectFirst [EmbedsHasMapName ==. Just "non-empty map"] []+      res @== Entity contK container++  it "Embeds a Map empty" $ db $ do+      let container = EmbedsHasMap (Just "empty map") $ HasMap "empty" $ M.fromList []+      contK <- insert container+      Just res <- selectFirst [EmbedsHasMapName ==. Just "empty map"] []+      res @== Entity contK container++  it "Embeds a Map with ids as values" $ db $ do+      onId <- insert $ OnlyName "nombre"+      onId2 <- insert $ OnlyName "nombre2"+      let midValue = MapIdValue $ M.fromList [("foo", onId),("bar",onId2)]+      mK <- insert midValue+      Just mv <- get mK+      mv @== midValue++  it "List" $ db $ do+      k1 <- insert $ HasList []+      k2 <- insert $ HasList [k1]+      let container = HasList [k1, k2]+      contK <- insert container+      Just res <- selectFirst [HasListList `anyEq` k2] []+      res @== Entity contK container++  it "can embed an Entity" $ db $ do+    let foo = ARecord "foo"+        bar = ARecord "bar"+    _ <- insertMany [foo, bar]+    arecords <- selectList ([ARecordName ==. "foo"] ||. [ARecordName ==. "bar"]) []+    length arecords @== 2++    kfoo <- insert foo+    let hasEnts = HasArrayWithEntities (Entity kfoo foo) arecords+    kEnts <- insert hasEnts+    Just retrievedHasEnts <- get kEnts+    retrievedHasEnts @== hasEnts++  it "can embed objects with ObjectIds" $ db $ do+    oid <- liftIO $ genObjectId+    let hoid   = HasObjectId oid "oid"+        hasArr = HasArrayWithObjectIds "array" [hoid]++    k <- insert hasArr+    Just v <- get k+    v @== hasArr++  describe "mongoDB filters" $ do+    it "mongo single nesting filters" $ db $ do+        let usr = User "foo" (Just "pswd") prof+            prof = Profile "fstN" "lstN" (Just con)+            con = Contact 123456 "foo@bar.com"+        uId <- insert usr+        Just r1 <- selectFirst [UserProfile &->. ProfileFirstName `nestEq` "fstN"] []+        r1 @== (Entity uId usr)+        Just r2 <- selectFirst [UserProfile &~>. ProfileContact ?&->. ContactEmail `nestEq` "foo@bar.com", UserIdent ==. "foo"] []+        r2 @== (Entity uId usr)++    it "mongo embedded array filters" $ db $ do+        let container = HasListEmbed "list" [+                (HasEmbed "embed" (OnlyName "1"))+              , (HasEmbed "embed" (OnlyName "2"))+              ]+        contK <- insert container+        let contEnt = Entity contK container+        Just meq <- selectFirst [HasListEmbedList `anyEq` HasEmbed "embed" (OnlyName "1")] []+        meq @== contEnt++        Just neq1 <- selectFirst [HasListEmbedList ->. HasEmbedName `nestEq` "embed"] []+        neq1 @== contEnt++        Just nne1 <- selectFirst [HasListEmbedList ->. HasEmbedName `nestNe` "notEmbed"] []+        nne1 @== contEnt++        Just neq2 <- selectFirst [HasListEmbedList ~>. HasEmbedEmbed &->. OnlyNameName `nestEq` "1"] []+        neq2 @== contEnt++        Just nbq1 <- selectFirst [HasListEmbedList ->. HasEmbedName `nestBsonEq` String "embed"] []+        nbq1 @== contEnt++        Just nbq2 <- selectFirst [HasListEmbedList ~>. HasEmbedEmbed &->. OnlyNameName `nestBsonEq` String "1"] []+        nbq2 @== contEnt++    it "regexp match" $ db $ do+        let container = HasListEmbed "list" [+                (HasEmbed "embed" (OnlyName "abcd"))+              , (HasEmbed "embed" (OnlyName "efgh"))+              ]+        contK <- insert container+        let mkReg t = (t, "ims")+        Just res <- selectFirst [HasListEmbedName =~. mkReg "ist"] []+        res @== (Entity contK container)++    it "nested anyEq" $ db $ do+        let top = HasNestedList [IntList [1,2]]+        k <- insert top+        Nothing  <- selectFirst [HasNestedListList ->. IntListInts `nestEq` ([]::[Int])] []+        Nothing  <- selectFirst [HasNestedListList ->. IntListInts `nestAnyEq` 3] []+        Just res <- selectFirst [HasNestedListList ->. IntListInts `nestAnyEq` 2] []+        res @== (Entity k top)++  describe "mongoDB updates" $ do+    it "mongo single nesting updates" $ db $ do+        let usr = User "foo" (Just "pswd") prof+            prof = Profile "fstN" "lstN" (Just con)+            con = Contact 123456 "foo@bar.com"+        uid <- insert usr+        let newName = "fstN2"+        usr1 <- updateGet uid [UserProfile &->. ProfileFirstName `nestSet` newName]+        (profileFirstName $ userProfile usr1) @== newName++        let newEmail = "foo@example.com"+        let newIdent = "bar"+        usr2 <- updateGet uid [UserProfile &~>. ProfileContact ?&->. ContactEmail `nestSet` newEmail, UserIdent =. newIdent]+        (userIdent usr2) @== newIdent+        (fmap contactEmail . profileContact . userProfile $ usr2) @== Just newEmail+++    it "mongo embedded array updates" $ db $ do+        let container = HasListEmbed "list" [+                (HasEmbed "embed" (OnlyName "1"))+              , (HasEmbed "embed" (OnlyName "2"))+              ]+        contk <- insert container+        let _contEnt = Entity contk container++        pushed <- updateGet contk [HasListEmbedList `push` HasEmbed "embed" (OnlyName "3")]+        (Prelude.map (onlyNameName . hasEmbedEmbed) $ hasListEmbedList pushed) @== ["1","2","3"]++        -- same, don't add anything+        addedToSet <- updateGet contk [HasListEmbedList `addToSet` HasEmbed "embed" (OnlyName "3")]+        (Prelude.map (onlyNameName . hasEmbedEmbed) $ hasListEmbedList addedToSet) @== ["1","2","3"]+        pulled <- updateGet contk [HasListEmbedList `pull` HasEmbed "embed" (OnlyName "3")]+        (Prelude.map (onlyNameName . hasEmbedEmbed) $ hasListEmbedList pulled) @== ["1","2"]++        -- now it is new+        addedToSet2 <- updateGet contk [HasListEmbedList `addToSet` HasEmbed "embed" (OnlyName "3")]+        (Prelude.map (onlyNameName . hasEmbedEmbed) $ hasListEmbedList addedToSet2) @== ["1","2","3"]++        allPulled <- updateGet contk [eachOp pull HasListEmbedList+          [ HasEmbed "embed" (OnlyName "3")+          , HasEmbed "embed" (OnlyName "2")+          ] ]+        (Prelude.map (onlyNameName . hasEmbedEmbed) $ hasListEmbedList allPulled) @== ["1"]+        allPushed <- updateGet contk [eachOp push HasListEmbedList+          [ HasEmbed "embed" (OnlyName "4")+          , HasEmbed "embed" (OnlyName "5")+          ] ]+        (Prelude.map (onlyNameName . hasEmbedEmbed) $ hasListEmbedList allPushed) @== ["1","4","5"]+++  it "re-orders json inserted from another source" $ db $ do+    let cname = T.unpack $ collectionName (error "ListEmbed" :: ListEmbed)+    liftIO $ putStrLn =<< readProcess "mongoimport" ["-d", T.unpack dbName, "-c", cname] "{ \"nested\": [{ \"one\": 1, \"two\": 2 }, { \"two\": 2, \"one\": 1}], \"two\": 2, \"one\": 1, \"_id\" : { \"$oid\" : \"50184f5a92d7ae0000001e89\" } }"++    lists <- selectList [] []+    fmap entityVal lists @== [ListEmbed [InList 1 2, InList 1 2] 1 2]

@@ -0,0 +1,21 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module EntityEmbedTestMongo where++-- because we are using a type alias we need to declare in a separate module+-- this is used in EmbedTest+import MongoInit++mkPersist persistSettings [persistUpperCase|+  ARecord+    name Text+    deriving Show Eq Read Ord+|]++type AnEntity = Entity ARecord

@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- We create an orphan instance for GenerateKey here to avoid a circular+-- dependency between:+--+-- a) persistent-mongoDB:test depends on+-- b) persistent-test:lib depends on+-- c) persistent-mongODB:lib+--+-- This kind of cycle is all kinds of bad news.++module MongoInit (+  BackendMonad+  , runConn+  , MonadIO+  , persistSettings+  , MkPersistSettings (..)+  , dbName+  , db'+  , setup+  , mkPersistSettings+  , Action+  , Context+  , BackendKey(MongoKey)++   -- re-exports+  , module Database.Persist+  , module Database.Persist.Sql.Raw.QQ+  , module Test.Hspec+  , module Test.HUnit+  , liftIO+  , mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase+  , Int32, Int64+  , Text+  , module Control.Monad.Trans.Reader+  , module Control.Monad+  , PersistFieldSql(..)+  , BS.ByteString+  , SomeException+  , module Init+  ) where++-- we have to be careful with this import becuase CPP is still a problem+import Init+    ( TestFn(..), truncateTimeOfDay, truncateUTCTime+    , truncateToMicro, arbText, liftA2, GenerateKey(..)+    , (@/=), (@==), (==@)+    , assertNotEqual, assertNotEmpty, assertEmpty, asIO+    , isTravis+    )++-- re-exports+import Control.Exception (SomeException)+import Control.Monad (void, replicateM, liftM, when, forM_)+import Control.Monad.Trans.Reader+import Database.Persist.TH (mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase, MkPersistSettings(..))+import Database.Persist.Sql.Raw.QQ+import Test.Hspec++-- testing+import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool)++import Control.Monad (unless, (>=>))+import Control.Monad.IO.Class+import Control.Monad.IO.Unlift (MonadUnliftIO)+import qualified Data.ByteString as BS+import Data.Int (Int32, Int64)+import Data.Text (Text)+import qualified Database.MongoDB as MongoDB+import Database.Persist.MongoDB (Action, withMongoPool, runMongoDBPool, defaultMongoConf, applyDockerEnv, BackendKey(..))+import Language.Haskell.TH.Syntax (Type(..))++import Database.Persist+import Database.Persist.Sql (PersistFieldSql(..))+import Database.Persist.TH (mkPersistSettings)++setup :: Action IO ()+setup = setupMongo+type Context = MongoDB.MongoContext++_debugOn :: Bool+_debugOn = True++persistSettings :: MkPersistSettings+persistSettings = (mkPersistSettings $ ConT ''Context) { mpsGeneric = True }++dbName :: Text+dbName = "persistent"++type BackendMonad = Context++runConn :: MonadUnliftIO m => Action m backend -> m ()+runConn f = do+  conf <- liftIO $ applyDockerEnv $ defaultMongoConf dbName -- { mgRsPrimary = Just "replicaset" }+  void $ withMongoPool conf $ runMongoDBPool MongoDB.master f++setupMongo :: Action IO ()+setupMongo = void $ MongoDB.dropDatabase dbName++db' :: Action IO () -> Action IO () -> Assertion+db' actions cleanDB = do+  r <- runConn (actions >> cleanDB)+  return r++instance GenerateKey MongoDB.MongoContext where+    generateKey = MongoKey `liftM` MongoDB.genObjectId

@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+module RawMongoHelpers where++import qualified Database.MongoDB as MongoDB+import Database.Persist.MongoDB (toInsertDoc, docToEntityThrow, collectionName, recordToDocument)++import MongoInit+import PersistentTest (cleanDB)+import PersistentTestModels+++db :: ReaderT MongoDB.MongoContext IO () -> IO ()+db = db' cleanDB++specs :: Spec+specs = do+  describe "raw MongoDB helpers" $ do+    it "collectionName" $ do+        collectionName (Person "Duder" 0 Nothing) @?= "Person"++    it "toInsertFields, entityFields, & docToEntityThrow" $ db $ do+        let p1 = Person "Duder" 0 Nothing+        let doc = toInsertDoc p1+        MongoDB.ObjId _id <- MongoDB.insert "Person" $ doc+        let idSelector = "_id" MongoDB.=: _id+        Entity _ ent1 <- docToEntityThrow $ idSelector:doc+        liftIO $ p1 @?= ent1++        let p2 = p1 {personColor = Just "blue"}+        let doc2 = idSelector:recordToDocument p2+        MongoDB.save "Person" doc2+        Entity _ ent2 <- docToEntityThrow doc2+        liftIO $ p2 @?= ent2

@@ -0,0 +1,151 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}++import qualified Data.ByteString as BS+import Data.IntMap (IntMap)+import qualified Data.Text as T+import Data.Time+import Database.MongoDB (runCommand1)+import Text.Blaze.Html+import Test.QuickCheck++-- FIXME: should this be added? (RawMongoHelpers module wasn't used)+-- import qualified RawMongoHelpers+import MongoInit++-- These tests are noops with the NoSQL flags set.+--+-- import qualified CompositeTest+-- import qualified CustomPrimaryKeyReferenceTest+-- import qualified InsertDuplicateUpdate+-- import qualified PersistUniqueTest+-- import qualified PrimaryTest+-- import qualified UniqueTest+-- import qualified MigrationColumnLengthTest+-- import qualified EquivalentTypeTest++-- These modules were quite complicated. Instead of fully extracting the+-- relevant common functionality, I just copied and de-CPPed manually.+import qualified EmbedTestMongo++-- These are done.+import qualified CustomPersistFieldTest+import qualified DataTypeTest+import qualified EmbedOrderTest+import qualified EmptyEntityTest+import qualified HtmlTest+import qualified LargeNumberTest+import qualified MaxLenTest+import qualified MigrationOnlyTest+import qualified PersistentTest+import qualified Recursive+import qualified RenameTest+import qualified SumTypeTest+import qualified UpsertTest++type Tuple = (,)++dbNoCleanup :: Action IO () -> Assertion+dbNoCleanup = db' (pure ())++-- FIXME: This isn't actually used?+share [mkPersist persistSettings, mkMigrate "htmlMigrate"] [persistLowerCase|+HtmlTable+    html Html+    deriving+|]++mkPersist persistSettings [persistUpperCase|+DataTypeTable no-json+    text Text+    textMaxLen Text maxlen=100+    bytes ByteString+    bytesTextTuple (Tuple ByteString Text)+    bytesMaxLen ByteString maxlen=100+    int Int+    intList [Int]+    intMap (IntMap Int)+    double Double+    bool Bool+    day Day+    utc UTCTime+|]++instance Arbitrary DataTypeTable where+  arbitrary = DataTypeTable+     <$> arbText                -- text+     <*> (T.take 100 <$> arbText)          -- textManLen+     <*> arbitrary              -- bytes+     <*> liftA2 (,) arbitrary arbText      -- bytesTextTuple+     <*> (BS.take 100 <$> arbitrary)       -- bytesMaxLen+     <*> arbitrary              -- int+     <*> arbitrary              -- intList+     <*> arbitrary              -- intMap+     <*> arbitrary              -- double+     <*> arbitrary              -- bool+     <*> arbitrary              -- day+     <*> (truncateUTCTime   =<< arbitrary) -- utc++mkPersist persistSettings [persistUpperCase|+EmptyEntity+|]++main :: IO ()+main = do+  hspec $ afterAll dropDatabase $ do+    xdescribe "This test is failing for Mongo by only embedding the first thing." $ do+        RenameTest.specsWith (db' RenameTest.cleanDB)+    DataTypeTest.specsWith+        dbNoCleanup+        Nothing+        [ TestFn "Text" dataTypeTableText+        , TestFn "Text" dataTypeTableTextMaxLen+        , TestFn "Bytes" dataTypeTableBytes+        , TestFn "Bytes" dataTypeTableBytesTextTuple+        , TestFn "Bytes" dataTypeTableBytesMaxLen+        , TestFn "Int" dataTypeTableInt+        , TestFn "Int" dataTypeTableIntList+        , TestFn "Int" dataTypeTableIntMap+        , TestFn "Double" dataTypeTableDouble+        , TestFn "Bool" dataTypeTableBool+        , TestFn "Day" dataTypeTableDay+        ]+        []+        dataTypeTableDouble+    HtmlTest.specsWith (db' HtmlTest.cleanDB) Nothing+    EmbedTestMongo.specs+    EmbedOrderTest.specsWith (db' EmbedOrderTest.cleanDB)+    LargeNumberTest.specsWith+        (db' (deleteWhere ([] :: [Filter (LargeNumberTest.NumberGeneric backend)])))+    MaxLenTest.specsWith dbNoCleanup+    Recursive.specsWith (db' Recursive.cleanup)++    SumTypeTest.specsWith (dbNoCleanup) Nothing+    MigrationOnlyTest.specsWith+        dbNoCleanup+        Nothing+    PersistentTest.specsWith (db' PersistentTest.cleanDB)+    -- TODO: The upsert tests are currently failing. Find out why and fix+    -- them.+    xdescribe "UpsertTest is currently failing for Mongo due to differing behavior" $ do+        UpsertTest.specsWith+            (db' PersistentTest.cleanDB)+            UpsertTest.AssumeNullIsZero+            UpsertTest.UpsertGenerateNewKey+    EmptyEntityTest.specsWith+        (db' EmptyEntityTest.cleanDB)+        Nothing+    CustomPersistFieldTest.specsWith+        dbNoCleanup+    -- FIXME: should this be added? (RawMongoHelpers module wasn't used)+    -- RawMongoHelpers.specs++  where+    dropDatabase () = dbNoCleanup (void (runCommand1 $ T.pack "dropDatabase()"))