persistent-mongoDB 1.4.3 → 1.4.4
raw patch · 2 files changed
+69/−23 lines, 2 files
Files
- Database/Persist/MongoDB.hs +68/−22
- persistent-mongoDB.cabal +1/−1
Database/Persist/MongoDB.hs view
@@ -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
persistent-mongoDB.cabal view
@@ -1,5 +1,5 @@ name: persistent-mongoDB-version: 1.4.3+version: 1.4.4 license: MIT license-file: LICENSE author: Greg Weber <greg@gregweber.info>