packages feed

persistent-mongoDB 1.2.1 → 1.2.1.1

raw patch · 2 files changed

+49/−29 lines, 2 files

Files

Database/Persist/MongoDB.hs view
@@ -116,25 +116,40 @@     parseJSON (Number (D x)) = (return . NoOrphanNominalDiffTime . fromRational . toRational) x     parseJSON _ = fail "couldn't parse diff time" -instance FromJSON PortID where-    parseJSON (Number (I x)) = (return . PortNumber . fromInteger) x+newtype NoOrphanPortID = NoOrphanPortID PortID deriving (Show, Eq)++instance FromJSON NoOrphanPortID where+    parseJSON (Number (I x)) = (return . NoOrphanPortID . PortNumber . fromInteger) x     parseJSON _ = fail "couldn't parse port number" + data Connection = Connection DB.Pipe DB.Database type ConnectionPool = Pool.Pool Connection +-- | ToPathPiece is used to convert a key to/from text instance PathPiece (KeyBackend MongoBackend entity) where-    toPathPiece (Key pOid@(PersistObjectId _)) = -- T.pack $ show $ Serialize.encode bsonId-        let oid = persistObjectIdToDbOid pOid-        in  T.pack $ show oid-    toPathPiece k = throw $ PersistInvalidField $ T.pack $ "Invalid Key (expected PersistObjectId): " ++ show k+    toPathPiece = keyToText+    fromPathPiece keyText = readMayKey $+        -- handle a JSON type prefix+        -- 'o' is a non-hex character, so no confusion here+        case T.uncons keyText of+            Just ('o', prefixed) -> prefixed+            _ -> keyText -    fromPathPiece str =-      case (reads $ (T.unpack str))::[(DB.ObjectId,String)] of-        (parsed,_):[] -> Just $ Key $ PersistObjectId $ Serialize.encode parsed-        _ -> Nothing+keyToText :: KeyBackend MongoBackend entity -> Text+keyToText (Key pOid@(PersistObjectId _)) = -- T.pack $ show $ Serialize.encode bsonId+    let oid = persistObjectIdToDbOid pOid+    in  T.pack $ show oid+keyToText k = throw $ PersistInvalidField $ T.pack $ "Invalid Key (expected PersistObjectId): " ++ show k +-- | Convert a Text to a Key+readMayKey :: Text -> Maybe (KeyBackend MongoBackend entity)+readMayKey str =+  case (reads $ (T.unpack str)) :: [(DB.ObjectId,String)] of+    (parsed,_):[] -> Just $ Key $ PersistObjectId $ Serialize.encode parsed+    _ -> Nothing + withMongoDBConn :: (Trans.MonadIO m, Applicative m)                 => Database -> HostName -> PortID                 -> Maybe MongoAuth -> NominalDiffTime@@ -209,19 +224,22 @@ runMongoDBPoolDef :: (Trans.MonadIO m, MonadBaseControl IO m) => DB.Action m a -> ConnectionPool -> m a runMongoDBPoolDef = runMongoDBPool (DB.ConfirmWrites ["j" DB.=: True]) -filterByKey :: (PersistEntity record) => KeyBackend MongoBackend record -> DB.Document-filterByKey key = [_id DB.=: keyToOid key]+filterByKey :: (PersistEntity record, PersistEntityBackend record ~ MongoBackend)+            => Key record -> DB.Document+filterByKey k = [_id DB.=: keyToOid k] -queryByKey :: (PersistEntity record) => KeyBackend MongoBackend record -> EntityDef a -> DB.Query -queryByKey key entDef = (DB.select (filterByKey key) (unDBName $ entityDB entDef)) +queryByKey :: (PersistEntity record, PersistEntityBackend record ~ MongoBackend)+           => Key record -> EntityDef a -> DB.Query+queryByKey k record = (DB.select (filterByKey k) (unDBName $ entityDB record)) -selectByKey :: (PersistEntity record) => KeyBackend MongoBackend record -> EntityDef a -> DB.Selection -selectByKey k entDef = (DB.select (filterByKey k) (unDBName $ entityDB entDef))+selectByKey :: (PersistEntity record, PersistEntityBackend record ~ MongoBackend)+            => Key record -> EntityDef a -> DB.Selection+selectByKey k record = (DB.select (filterByKey k) (unDBName $ entityDB record)) -updateFields :: (PersistEntity val) => [Update val] -> [DB.Field]+updateFields :: (PersistEntity entity) => [Update entity] -> [DB.Field] updateFields upds = map updateToMongoField upds  -updateToMongoField :: (PersistEntity val) => Update val -> DB.Field+updateToMongoField :: (PersistEntity entity) => Update entity -> DB.Field updateToMongoField (Update field v up) =     opName DB.:= DB.Doc [( (unDBName $ fieldDB $ persistFieldDef field) DB.:= opValue)]     where @@ -277,12 +295,12 @@ fieldToLabel :: FieldDef a -> Text fieldToLabel = unDBName . fieldDB -saveWithKey :: forall m record keyEntity. -- (Applicative m, Functor m, MonadBaseControl IO m,-                                    (PersistEntity keyEntity, PersistEntity record)-            => (record -> [DB.Field])-            -> (DB.Collection -> DB.Document -> DB.Action m () )-            -> KeyBackend MongoBackend keyEntity-            -> record+saveWithKey :: forall m entity keyEntity.+            (PersistEntity entity, PersistEntity keyEntity, PersistEntityBackend keyEntity ~ MongoBackend)+            => (entity -> [DB.Field])+            -> (Text -> [DB.Field] -> DB.Action m ())+            -> Key keyEntity+            -> entity             -> DB.Action m () saveWithKey entToFields dbSave key record =       dbSave (collectionName record) ((keyToMongoIdField key):(entToFields record))@@ -348,7 +366,8 @@ _id :: T.Text _id = "_id" -keyToMongoIdField :: PersistEntity val => KeyBackend MongoBackend val -> DB.Field+keyToMongoIdField :: (PersistEntity entity, PersistEntityBackend entity ~ MongoBackend)+                  => Key entity -> DB.Field keyToMongoIdField k = _id DB.:= (DB.ObjId $ keyToOid k)  @@ -622,7 +641,7 @@ oidToPersistValue :: DB.ObjectId -> PersistValue oidToPersistValue =  PersistObjectId . Serialize.encode -oidToKey :: (PersistEntity val) => DB.ObjectId -> KeyBackend MongoBackend val+oidToKey :: (PersistEntity entity) => DB.ObjectId -> Key entity oidToKey = Key . oidToPersistValue  persistObjectIdToDbOid :: PersistValue -> DB.ObjectId@@ -631,7 +650,8 @@                   Right o -> o persistObjectIdToDbOid _ = throw $ PersistInvalidField "expected PersistObjectId" -keyToOid :: (PersistEntity val) => KeyBackend MongoBackend val -> DB.ObjectId+keyToOid :: (PersistEntity entity, PersistEntityBackend entity ~ MongoBackend)+         => Key entity -> DB.ObjectId keyToOid (Key k) = persistObjectIdToDbOid k  instance DB.Val PersistValue where@@ -718,7 +738,7 @@     loadConfig (Object o) = do         db                 <- o .:  "database"         host               <- o .:? "host" .!= "127.0.0.1"-        port               <- o .:? "port" .!= DB.defaultPort+        (NoOrphanPortID port) <- o .:? "port" .!= (NoOrphanPortID DB.defaultPort)         poolStripes        <- o .:? "poolstripes" .!= 1         stripeConnections  <- o .:  "connections"         (NoOrphanNominalDiffTime connectionIdleTime) <- o .:? "connectionIdleTime" .!= 20
persistent-mongoDB.cabal view
@@ -1,5 +1,5 @@ name:            persistent-mongoDB-version:         1.2.1+version:         1.2.1.1 license:         MIT license-file:    LICENSE author:          Greg Weber <greg@gregweber.info>