diff --git a/Database/Persist/MongoDB.hs b/Database/Persist/MongoDB.hs --- a/Database/Persist/MongoDB.hs +++ b/Database/Persist/MongoDB.hs @@ -39,7 +39,8 @@ -- * MongoDB specific Filters -- $filters - , nestEq, anyEq, multiEq, nestBsonEq, anyBsonEq, multiBsonEq + , nestEq, nestNe, nestGe, nestLe, nestIn, nestNotIn + , anyEq, multiEq, nestBsonEq, anyBsonEq, multiBsonEq , (=~.), (?=~.), MongoRegex , (->.), (~>.), (?&->.), (?&~>.), (&->.), (&~>.) -- non-operator forms of filters @@ -410,14 +411,23 @@ -- for inserts only: nulls are ignored so they will be unset in the document. -- 'entityToDocument' includes nulls toInsertDoc :: forall record. (PersistEntity record) => record -> DB.Document -toInsertDoc record = zipFilter (entityFields entity) (toPersistFields record) +toInsertDoc record = zipFilter (entityFields entDef) (map toPersistValue $ toPersistFields record) where + entDef = entityDef $ Just record + zipFilter :: [FieldDef a] -> [PersistValue] -> DB.Document zipFilter [] _ = [] zipFilter _ [] = [] - zipFilter (e:efields) (p:pfields) = let pv = toPersistValue p in - if pv == PersistNull then zipFilter efields pfields - else (fieldToLabel e DB.:= DB.val pv):zipFilter efields pfields - entity = entityDef $ Just record + zipFilter (fd:efields) (pv:pvs) = + if pv == PersistNull then recur else + (fieldToLabel fd DB.:= embeddedVal (fieldEmbedded fd) pv):recur + where + recur = zipFilter efields pvs + -- make sure to removed nulls from an embedded value also + embeddedVal :: Maybe (EntityDef a) -> PersistValue -> DB.Value + embeddedVal (Just emDef) (PersistMap m) = DB.Doc $ + zipFilter (entityFields emDef) $ map snd m + embeddedVal je@(Just _) (PersistList l) = DB.Array $ map (embeddedVal je) l + embeddedVal _ _ = DB.val pv collectionName :: (PersistEntity record) => record -> Text collectionName = unDBName . entityDB . entityDef . Just @@ -623,25 +633,43 @@ #ifdef DEBUG debug $ #endif - if null filts then [] else multiFilter andDollar filts + if null filts then [] else multiFilter AndDollar filts filterToDocument :: (PersistEntity val, PersistEntityBackend val ~ MongoBackend) => Filter val -> DB.Document filterToDocument f = case f of - Filter field v filt -> return $ filterToBSON (fieldName field) v filt - FilterOr [] -> -- Michael decided to follow Haskell's semantics, which seems reasonable to me. - -- in Haskell an empty or is a False - -- Perhaps there is a less hacky way of creating a query that always returns false? - ["$not" DB.=: [existsDollar DB.=: _id]] - FilterOr fs -> multiFilter orDollar fs - -- usually $and is unecessary, but it makes query construction easier in special cases - FilterAnd [] -> [] - FilterAnd fs -> multiFilter andDollar fs + Filter field v filt -> [filterToBSON (fieldName field) v filt] BackendFilter mf -> mongoFilterToDoc mf + -- The empty filter case should never occur when the user uses ||. + -- An empty filter list will throw an exception in multiFilter + -- + -- The alternative would be to create a query which always returns true + -- However, I don't think an end user ever wants that. + FilterOr fs -> multiFilter OrDollar fs + -- Ignore an empty filter list instead of throwing an exception. + -- $and is necessary in only a few cases, but it makes query construction easier + FilterAnd [] -> [] + FilterAnd fs -> multiFilter AndDollar fs -multiFilter :: forall record. (PersistEntity record, PersistEntityBackend record ~ MongoBackend) => Text -> [Filter record] -> [DB.Field] -multiFilter multi fs = [multi DB.:= DB.Array (map (DB.Doc . filterToDocument) fs)] +data MultiFilter = OrDollar | AndDollar deriving Show +toMultiOp :: MultiFilter -> Text +toMultiOp OrDollar = orDollar +toMultiOp AndDollar = andDollar +multiFilter :: forall record. (PersistEntity record, PersistEntityBackend record ~ MongoBackend) => MultiFilter -> [Filter record] -> [DB.Field] +multiFilter _ [] = throw $ PersistMongoDBError "An empty list of filters was given" +multiFilter multi filters = + case (multi, filter (not . null) (map filterToDocument filters)) of + -- a $or must have at least 2 items + (OrDollar, []) -> orError + (AndDollar, []) -> [] + (OrDollar, _:[]) -> orError + (AndDollar, doc:[]) -> doc + (_, doc) -> [toMultiOp multi DB.:= DB.Array (map DB.Doc doc)] + where + orError = throw $ PersistMongoDBError $ + "An empty list of filters was given to one side of ||." + existsDollar, orDollar, andDollar :: Text existsDollar = "$exists" orDollar = "$or" @@ -1118,6 +1146,12 @@ infixr 6 ->. infixr 4 `nestEq` +infixr 4 `nestNe` +infixr 4 `nestGe` +infixr 4 `nestLe` +infixr 4 `nestIn` +infixr 4 `nestNotIn` + infixr 4 `anyEq` infixr 4 `multiEq` infixr 4 `nestBsonEq` @@ -1130,13 +1164,25 @@ -- using this as the only query filter is similar to the following in the mongoDB shell -- -- > db.Collection.find({"object.field": item}) -nestEq :: forall record typ. +nestEq, nestNe, nestGe, nestLe, nestIn, nestNotIn :: forall record typ. + ( PersistField typ , PersistEntityBackend record ~ MongoBackend) + => NestedField record typ + -> typ + -> Filter record +nestEq = nestedOp Eq +nestNe = nestedOp Ne +nestGe = nestedOp Ge +nestLe = nestedOp Le +nestIn = nestedOp In +nestNotIn = nestedOp NotIn + +nestedOp :: forall record typ. ( PersistField typ , PersistEntityBackend record ~ MongoBackend - ) => NestedField record typ -> typ -> Filter record -nf `nestEq` v = BackendFilter $ NestedFilter + ) => PersistFilter -> NestedField record typ -> typ -> Filter record +nestedOp op nf v = BackendFilter $ NestedFilter { nestedField = nf - , nestedValue = PersistOperator (Left v) Eq + , nestedValue = PersistOperator (Left v) op } -- | same as `nestEq`, but give a BSON Value diff --git a/persistent-mongoDB.cabal b/persistent-mongoDB.cabal --- a/persistent-mongoDB.cabal +++ b/persistent-mongoDB.cabal @@ -1,5 +1,5 @@ name: persistent-mongoDB -version: 1.4.3 +version: 1.4.4 license: MIT license-file: LICENSE author: Greg Weber