packages feed

persistent-mongoDB 0.3.0 → 0.6.1

raw patch · 2 files changed

+198/−161 lines, 2 filesdep +monad-controldep +path-piecesdep −neitherdep ~bsondep ~mongoDBdep ~persistentPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-control, path-pieces

Dependencies removed: neither

Dependency ranges changed: bson, mongoDB, persistent, template-haskell

API changes (from Hackage documentation)

- Database.Persist.MongoDB: PersistBool :: Bool -> PersistValue
- Database.Persist.MongoDB: PersistByteString :: ByteString -> PersistValue
- Database.Persist.MongoDB: PersistDay :: Day -> PersistValue
- Database.Persist.MongoDB: PersistDouble :: Double -> PersistValue
- Database.Persist.MongoDB: PersistForeignKey :: ByteString -> PersistValue
- Database.Persist.MongoDB: PersistInt64 :: Int64 -> PersistValue
- Database.Persist.MongoDB: PersistList :: [PersistValue] -> PersistValue
- Database.Persist.MongoDB: PersistMap :: [(Text, PersistValue)] -> PersistValue
- Database.Persist.MongoDB: PersistNull :: PersistValue
- Database.Persist.MongoDB: PersistText :: Text -> PersistValue
- Database.Persist.MongoDB: PersistTimeOfDay :: TimeOfDay -> PersistValue
- Database.Persist.MongoDB: PersistUTCTime :: UTCTime -> PersistValue
- Database.Persist.MongoDB: data MongoDBReader m a
- Database.Persist.MongoDB: data PersistValue :: *
- Database.Persist.MongoDB: instance (Monad m, Functor m) => Applicative (MongoDBReader m)
- Database.Persist.MongoDB: instance (MonadIO m, Functor m) => PersistBackend (MongoDBReader m)
- Database.Persist.MongoDB: instance Exception MongoDBException
- Database.Persist.MongoDB: instance Functor m => Functor (MongoDBReader m)
- Database.Persist.MongoDB: instance Monad m => Context Database (MongoDBReader m)
- Database.Persist.MongoDB: instance Monad m => Context MasterOrSlaveOk (MongoDBReader m)
- Database.Persist.MongoDB: instance Monad m => Context Pipe (MongoDBReader m)
- Database.Persist.MongoDB: instance Monad m => Context WriteMode (MongoDBReader m)
- Database.Persist.MongoDB: instance Monad m => Monad (MongoDBReader m)
- Database.Persist.MongoDB: instance Monad m => Throw Failure (MongoDBReader m)
- Database.Persist.MongoDB: instance MonadIO m => MonadIO (MongoDBReader m)
- Database.Persist.MongoDB: instance Show MongoDBException
- Database.Persist.MongoDB: instance Typeable MongoDBException
+ Database.Persist.MongoDB: (=:) :: Val v => Label -> v -> Field
+ Database.Persist.MongoDB: ConfirmWrites :: GetLastError -> AccessMode
+ Database.Persist.MongoDB: ReadStaleOk :: AccessMode
+ Database.Persist.MongoDB: UnconfirmedWrites :: AccessMode
+ Database.Persist.MongoDB: data AccessMode :: *
+ Database.Persist.MongoDB: data Action m :: (* -> *) a :: (* -> *) -> * -> *
+ Database.Persist.MongoDB: instance (Applicative m, Functor m, MonadControlIO m) => PersistBackend Action m
+ Database.Persist.MongoDB: instance SinglePiece (Key Action entity)
+ Database.Persist.MongoDB: master :: AccessMode
+ Database.Persist.MongoDB: slaveOk :: AccessMode
+ Database.Persist.MongoDB: type ConnectionPool = (Pool IOError Pipe, Database)
+ Database.Persist.MongoDB: u :: String -> UString
+ Database.Persist.MongoDB: withMongoDBPool :: (MonadIO m, Applicative m) => Database -> HostName -> Int -> (ConnectionPool -> m b) -> m b
- Database.Persist.MongoDB: runMongoDBConn :: (Service s, MonadIO m) => MongoDBReader m b -> WriteMode -> MasterOrSlaveOk -> ConnPool s -> Database -> m b
+ Database.Persist.MongoDB: runMongoDBConn :: MonadIO m => AccessMode -> Action m b -> ConnectionPool -> m b
- Database.Persist.MongoDB: withMongoDBConn :: (MonadIO m, Applicative m) => t -> HostName -> (ConnPool Host -> t -> m b) -> m b
+ Database.Persist.MongoDB: withMongoDBConn :: (MonadIO m, Applicative m) => Database -> HostName -> (ConnectionPool -> m b) -> m b

Files

Database/Persist/MongoDB.hs view
@@ -1,89 +1,92 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE PackageImports, RankNTypes #-}--- | A redis backend for persistent.+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Persist.MongoDB-    ( MongoDBReader-    , withMongoDBConn+    ( withMongoDBConn+    , withMongoDBPool     , runMongoDBConn      , HostName-    , PersistValue(..)+    , u+    , DB.Action+    -- , DB.MasterOrSlaveOk(..)+    , DB.AccessMode(..)+    , DB.master+    , DB.slaveOk+    , (DB.=:)+    , ConnectionPool     , module Database.Persist     ) where  import Database.Persist import Database.Persist.Base-import Control.Monad.Trans.Reader+ import qualified Control.Monad.IO.Class as Trans+import Control.Exception (throw, toException, throwIO)+ import qualified Database.MongoDB as DB-import Database.MongoDB.Query (Action, Failure)+import Database.MongoDB.Query (Database) import Control.Applicative (Applicative)-import Control.Exception (toException) import Data.UString (u) import qualified Data.CompactString.UTF8 as CS-import Data.Enumerator hiding (map, length)+import Data.Enumerator hiding (map, length, concatMap, head, replicate) import Network.Socket (HostName)-import qualified Network.Abstract(NetworkIO) import Data.Maybe (mapMaybe, fromJust) import qualified Data.Text as T import qualified Data.Text.Encoding as E-import qualified Data.Serialize as S-import Control.Exception (Exception, throwIO)-import Data.Typeable (Typeable)-import Control.Monad.Context (Context (..))-import Control.Monad.Throw (Throw (..))-import Prelude hiding (catch)-import Network.Abstract (Internet (..), ANetwork (..))+import qualified Data.Serialize as Serialize+import qualified System.IO.Pool as Pool+import Web.PathPieces (SinglePiece (..))+import Control.Monad.IO.Control (MonadControlIO) -newtype MongoDBReader m a = MongoDBReader { unMongoDBReader :: ReaderT DB.Database (Action m) a }-    deriving (Monad, Trans.MonadIO, Functor, Applicative)+#ifdef DEBUG+import FileLocation (debug)+#else+{-+debug :: forall a. a -> a+debug = id+debugMsg :: forall t a. t -> a -> a+debugMsg _ = id+-}+#endif -instance Monad m => Context DB.Database (MongoDBReader m) where-    context = MongoDBReader ask-    push f (MongoDBReader x) = MongoDBReader $ local f x+type ConnectionPool = (Pool.Pool IOError DB.Pipe, Database) -instance Monad m => Context DB.MasterOrSlaveOk (MongoDBReader m) where-    context = MongoDBReader context-    push f (MongoDBReader x) = MongoDBReader $ push f x+instance SinglePiece (Key DB.Action entity) where+    toSinglePiece (Key pOid@(PersistObjectId _)) = -- T.pack $ show $ Serialize.encode bsonId+        let oid@(DB.Oid _ _) = persistObjectIdToDbOid pOid+        in  T.pack $ show oid+    toSinglePiece k = throw $ PersistInvalidField $ "Invalid Key (expected PersistObjectId): " ++ show k -instance Monad m => Context DB.Pipe (MongoDBReader m) where-    context = MongoDBReader context-    push f (MongoDBReader x) = MongoDBReader $ push f x+    fromSinglePiece str =+      case (reads $ (T.unpack str))::[(DB.ObjectId,String)] of+        (parsed,_):[] -> Just $ Key $ PersistObjectId $ Serialize.encode parsed+        _ -> Nothing -instance Monad m => Context DB.WriteMode (MongoDBReader m) where-    context = MongoDBReader context-    push f (MongoDBReader x) = MongoDBReader $ push f x -instance Monad m => Throw Failure (MongoDBReader m) where-    throw = MongoDBReader . throw-    catch (MongoDBReader x) f =-        MongoDBReader $ ReaderT $ \db -> catch (runReaderT x db) (f' db)-      where-        f' db e = runReaderT (unMongoDBReader (f e)) db--withMongoDBConn :: (Trans.MonadIO m, Applicative m) => t -> HostName -> (DB.ConnPool DB.Host -> t -> m b) -> m b-withMongoDBConn dbname hostname connectionReader = do-  pool <- runReaderT (DB.newConnPool 1 $ DB.host hostname) $ ANetwork Internet-  connectionReader pool dbname-+withMongoDBConn :: (Trans.MonadIO m, Applicative m) =>+  Database -> HostName -> (ConnectionPool -> m b) -> m b+withMongoDBConn dbname hostname = withMongoDBPool dbname hostname 1 -runMongoDBConn :: (DB.Service s, Trans.MonadIO m) =>-                                    MongoDBReader m b-                                 -> DB.WriteMode-                                 -> DB.MasterOrSlaveOk-                                 -> DB.ConnPool s-                                 -> DB.Database-                                 -> m b-runMongoDBConn (MongoDBReader a) wm ms cp db = do-    res <- DB.access wm ms cp (runReaderT a db)-    either (Trans.liftIO . throwIO . MongoDBException) return res+withMongoDBPool :: (Trans.MonadIO m, Applicative m) =>+  Database -> HostName -> Int -> (ConnectionPool -> m b) -> m b+withMongoDBPool dbname hostname connectionPoolSize connectionReader = do+  --pool <- runReaderT (DB.newConnPool connectionPoolSize $ DB.host hostname) $ ANetwork Internet+  pool <- Trans.liftIO $ Pool.newPool Pool.Factory { Pool.newResource  = DB.connect (DB.host hostname)+                                                  , Pool.killResource = DB.close+                                                  , Pool.isExpired    = DB.isClosed+                                                  }+                                     connectionPoolSize+  connectionReader (pool, dbname) -newtype MongoDBException = MongoDBException Failure-    deriving (Show, Typeable)-instance Exception MongoDBException+runMongoDBConn :: (Trans.MonadIO m) => DB.AccessMode  ->  DB.Action m b -> ConnectionPool -> m b+runMongoDBConn accessMode action (pool, databaseName) = do+  pipe <- Trans.liftIO $ DB.runIOE $ Pool.aResource pool+  res  <- DB.access pipe accessMode databaseName action+  either (Trans.liftIO . throwIO . PersistMongoDBError . show) return res  value :: DB.Field -> DB.Value value (_ DB.:= val) = val@@ -93,62 +96,57 @@       Left e -> error e       Right v -> v -fst3 :: forall t t1 t2. (t, t1, t2) -> t-fst3 (x, _, _) = x--filterByKey :: (PersistEntity val) => Key val -> DB.Document+filterByKey :: (PersistEntity val) => Key DB.Action val -> DB.Document filterByKey k = [u"_id" DB.=: keyToDbOid k] -queryByKey :: (PersistEntity val) => Key val -> EntityDef -> DB.Query +queryByKey :: (PersistEntity val) => Key DB.Action val -> EntityDef -> DB.Query  queryByKey k entity = (DB.select (filterByKey k) (u $ entityName entity))  -selectByKey :: (PersistEntity val) => Key val -> EntityDef -> DB.Selection +selectByKey :: (PersistEntity val) => Key DB.Action val -> EntityDef -> DB.Selection  selectByKey k entity = (DB.select (filterByKey k) (u $ entityName entity))  updateFields :: (PersistEntity val) => [Update val] -> [DB.Field]-updateFields upds = map updateField upds +updateFields upds = map updateToMongoField upds  -updateField :: (PersistEntity val) => Update val -> DB.Field-updateField upd = opName DB.:= DB.Doc [( (u $ persistUpdateToFieldName upd) DB.:= opValue)]+updateToMongoField :: (PersistEntity val) => Update val -> DB.Field+updateToMongoField upd@(Update _ v up) = opName DB.:= DB.Doc [( (u $ updateFieldName upd) DB.:= opValue)]     where -      opValue = (DB.val $ transform $ persistUpdateToValue upd)-      transform (PersistInt64 i) = PersistInt64 $-        case persistUpdateToUpdate upd of-          Subtract -> -i-          _        ->  i-      transform x = x-      opName = case persistUpdateToUpdate upd of-                    Update   -> u "$set"-                    Add      -> u "$inc"-                    Subtract -> u "$inc"-                    Multiply -> error "multiply not supported yet"-                    Divide   -> error "divide not supported yet"+      opValue = DB.val . snd $ opNameValue+      opName = fst opNameValue+      opNameValue =+        case (up, toPersistValue v) of+                  (Assign,a)    -> (u "$set", a)+                  (Add, a)      -> (u "$inc", a)+                  (Subtract, PersistInt64 i) -> (u "$inc", PersistInt64 (-i))+                  (Subtract, _) -> error "expected PersistInt64 for a subtraction"+                  (Multiply, _) -> throw $ PersistMongoDBUnsupported "multiply not supported"+                  (Divide, _)   -> throw $ PersistMongoDBUnsupported "divide not supported"  -uniqSelector :: forall val.  (PersistEntity val) => Unique val -> [DB.Field]+uniqSelector :: forall val.  (PersistEntity val) => Unique val DB.Action -> [DB.Field] uniqSelector uniq = zipWith (DB.:=)   (map u (persistUniqueToFieldNames uniq))   (map DB.val (persistUniqueToValues uniq)) -pairFromDocument :: forall val val1.  (PersistEntity val, PersistEntity val1) => EntityDef -> [DB.Field] -> Either String (Key val, val1)+pairFromDocument :: forall val val1.  (PersistEntity val, PersistEntity val1) => EntityDef -> [DB.Field] -> Either String (Key DB.Action val, val1) pairFromDocument ent document = pairFromPersistValues document   where     pairFromPersistValues (x:xs) =         case wrapFromPersistValues ent xs of             Left e -> Left e-            Right xs' -> Right ((toPersistKey . fromJust . DB.cast' . value) x, xs')+            Right xs' -> Right ((Key . dbOidToKey . fromJust . DB.cast' . value) x, xs')     pairFromPersistValues _ = Left "error in fromPersistValues'"  insertFields :: forall val.  (PersistEntity val) => EntityDef -> val -> [DB.Field] insertFields t record = zipWith (DB.:=) (toLabels) (toValues)   where-    toLabels = map (u . fst3) $ entityColumns t+    toLabels = map (u . columnName) $ entityColumns t     toValues = map (DB.val . toPersistValue) (toPersistFields record) -instance (Trans.MonadIO m, Functor m) => PersistBackend (MongoDBReader m) where+instance (Applicative m, Functor m, MonadControlIO m) => PersistBackend DB.Action m where     insert record = do         (DB.ObjId oid) <- DB.insert (u $ entityName t) (insertFields t record)-        return $ toPersistKey $ dbOidToKey oid +        return $ Key $ dbOidToKey oid        where         t = entityDef record @@ -170,7 +168,7 @@     updateWhere filts upds =         DB.modify DB.Select {           DB.coll = (u $ entityName t)-        , DB.selector = filterToSelector filts+        , DB.selector = filtersToSelector filts         } $ updateFields upds       where         t = entityDef $ dummyFromFilts filts@@ -186,7 +184,7 @@     deleteWhere filts = do         DB.delete DB.Select {           DB.coll = (u $ entityName t)-        , DB.selector = filterToSelector filts+        , DB.selector = filtersToSelector filts         }       where         t = entityDef $ dummyFromFilts filts@@ -214,7 +212,7 @@         case mdocument of           Nothing -> return Nothing           Just document -> case pairFromDocument t document of-              Left s -> error s+              Left s -> Trans.liftIO . throwIO $ PersistMarshalError s               Right (k, x) -> return $ Just (k, x)       where         t = entityDef $ dummyFromUnique uniq@@ -223,26 +221,16 @@         i <- DB.count query         return $ fromIntegral i       where-        query = DB.select (filterToSelector filts) (u $ entityName t)+        query = DB.select (filtersToSelector filts) (u $ entityName t)         t = entityDef $ dummyFromFilts filts -    selectEnum filts ords limit offset = Iteratee . start+    selectEnum filts opts = Iteratee . start       where         start x = do-            cursor <- DB.find query+            cursor <- DB.find $ makeQuery filts opts             loop x cursor -        query = (DB.select (filterToSelector filts) (u $ entityName t)) {-          DB.limit = fromIntegral limit-        , DB.skip  = fromIntegral offset-        , DB.sort  = if null ords then [] else map orderClause ords-        }-         t = entityDef $ dummyFromFilts filts-        orderClause o = (u(persistOrderToFieldName o))-                        DB.=: (case persistOrderToOrder o of-                                Asc -> 1 :: Int-                                Desc -> -1 )          loop (Continue k) curs = do             doc <- DB.next curs@@ -250,12 +238,22 @@                 Nothing -> return $ Continue k                 Just document -> case pairFromDocument t document of                         Left s -> return $ Error $ toException-                                $ PersistMarshalException s+                                    $ PersistMarshalError s                         Right row -> do                             step <- runIteratee $ k $ Chunks [row]                             loop step curs         loop step _ = return step +    selectFirst filts opts = do+        doc <- DB.findOne $ makeQuery filts opts+        case doc of+            Nothing -> return Nothing+            Just document -> case pairFromDocument t document of+                Left s -> Trans.liftIO . throwIO $ PersistMarshalError s+                Right row -> return $ Just row+      where+        t = entityDef $ dummyFromFilts filts+     selectKeys filts =         Iteratee . start       where@@ -268,33 +266,65 @@             case doc of                 Nothing -> return $ Continue k                 Just [_ DB.:= (DB.ObjId oid)] -> do-                    step <- runIteratee $ k $ Chunks [toPersistKey $ dbOidToKey oid]+                    step <- runIteratee $ k $ Chunks [Key $ dbOidToKey oid]                     loop step curs-                Just y -> return $ Error $ toException $ PersistMarshalException+                Just y -> return $ Error $ toException $ PersistMarshalError                         $ "Unexpected in selectKeys: " ++ show y         loop step _ = return step -        query = (DB.select (filterToSelector filts) (u $ entityName t)) {+        query = (DB.select (filtersToSelector filts) (u $ entityName t)) {           DB.project = [u"_id" DB.=: (1 :: Int)]         }         t = entityDef $ dummyFromFilts filts -filterToSelector :: PersistEntity val => [Filter val] -> DB.Document-filterToSelector filts = map filterField filts+orderClause :: PersistEntity val => SelectOpt val -> DB.Field+orderClause o = case o of+                  Asc f  -> fieldName f DB.=: ( 1 :: Int)+                  Desc f -> fieldName f DB.=: (-1 :: Int)+                  _      -> error "orderClause: expected Asc or Desc" -filterField :: PersistEntity val => Filter val -> DB.Field-filterField f = case filt of-    Eq -> name DB.:= filterValue-    _  -> name DB.=: [u(showFilter filt) DB.:= filterValue]++makeQuery :: PersistEntity val => [Filter val] -> [SelectOpt val] -> DB.Query+makeQuery filts opts =+    (DB.select (filtersToSelector filts) (u $ entityName t)) {+      DB.limit = fromIntegral limit+    , DB.skip  = fromIntegral offset+    , DB.sort  = orders+    }   where-    name = case (persistFilterToFieldName f) of-            "id"  -> u "_id"-            other -> u other-    filt = persistFilterToFilter f-    filterValue = case persistFilterToValue f of-      Left v -> DB.val v-      Right vs -> DB.Array (map DB.val vs)+    t = entityDef $ dummyFromFilts filts+    limit  = fst3 $ limitOffsetOrder opts+    offset = snd3 $ limitOffsetOrder opts+    orders = map orderClause $ third3 $ limitOffsetOrder opts +filtersToSelector :: PersistEntity val => [Filter val] -> DB.Document+filtersToSelector filts = +#ifdef DEBUG+  debug $+#endif+    if null filts then [] else concatMap filterToDocument filts++multiFilter :: forall val.  PersistEntity val => String -> [Filter val] -> [DB.Field]+multiFilter multi fs = [u multi  DB.:= DB.Array (map (DB.Doc . filterToDocument) fs)]++filterToDocument :: PersistEntity val => Filter val -> DB.Document+filterToDocument f =+    case f of+      Filter field v filt -> return $ case filt of+          Eq -> fieldName field DB.:= toValue v+          _  -> fieldName field DB.=: [u(showFilter filt) DB.:= toValue v]+      FilterOr fs  -> multiFilter "$or" fs+      -- I didn't even know about the $and operator.+      -- It is unecessary in 99% of cases.+      -- However it makes query construction easier in special cases+      FilterAnd fs -> multiFilter "$and" fs+  where+    toValue :: forall a.  PersistField a => Either a [a] -> DB.Value+    toValue val =+      case val of+        Left v   -> DB.val $ toPersistValue v+        Right vs -> DB.val $ map toPersistValue vs+     showFilter Ne = "$ne"     showFilter Gt = "$gt"     showFilter Lt = "$lt"@@ -302,13 +332,19 @@     showFilter Le = "$lte"     showFilter In = "$in"     showFilter NotIn = "$nin"-    showFilter Eq = error ""+    showFilter Eq = error "EQ filter not expected"+    showFilter (BackendSpecificFilter bsf) = throw $ PersistMongoDBError $ "did not expect BackendSpecificFilter " ++ bsf +fieldName ::  forall v typ.  (PersistEntity v) => EntityField v typ -> CS.CompactString+fieldName = u . idfix . columnName . persistColumnDef+  where idfix f = if f == "id" then "_id" else f++ wrapFromPersistValues :: (PersistEntity val) => EntityDef -> [DB.Field] -> Either String val wrapFromPersistValues e doc = fromPersistValues reorder   where     castDoc = mapFromDoc doc-    castColumns = map (T.pack . fst3) $ (entityColumns e) +    castColumns = map (T.pack . columnName) $ (entityColumns e)     -- we have an alist of fields that need to be the same order as entityColumns     --     -- this naive lookup is O(n^2)@@ -332,8 +368,8 @@           where             matchOne (f:fs) tried =               if c == fst f then (f, tried ++ fs) else matchOne fs (f:tried)-            matchOne fs tried = error $ "field doesn't match" ++ (show c) ++ (show fs) ++ (show tried)-        match cs fs values = error $ "fields don't match" ++ (show cs) ++ (show fs) ++ (show values)+            matchOne fs tried = throw $ PersistError $ "reorder error: field doesn't match" ++ (show c) ++ (show fs) ++ (show tried)+        match cs fs values = throw $ PersistError $ "reorder error: fields don't match" ++ (show cs) ++ (show fs) ++ (show values)  mapFromDoc :: DB.Document -> [(T.Text, PersistValue)] mapFromDoc = Prelude.map (\f -> ( ( csToT (DB.label f)), (fromJust . DB.cast') (DB.value f) ) )@@ -345,16 +381,16 @@ tToCS = CS.fromByteString_ . E.encodeUtf8  dbOidToKey :: DB.ObjectId -> PersistValue-dbOidToKey =  PersistForeignKey . S.encode+dbOidToKey =  PersistObjectId . Serialize.encode -foreignKeyToDbOid :: PersistValue -> DB.ObjectId-foreignKeyToDbOid (PersistForeignKey k) = case S.decode k of-                  Left s -> error s+persistObjectIdToDbOid :: PersistValue -> DB.ObjectId+persistObjectIdToDbOid (PersistObjectId k) = case Serialize.decode k of+                  Left msg -> throw $ PersistError $ "error decoding " ++ (show k) ++ ": " ++ msg                   Right o -> o-foreignKeyToDbOid _ = error "expected PersistForeignKey"+persistObjectIdToDbOid _ = throw $ PersistInvalidField "expected PersistObjectId" -keyToDbOid :: (PersistEntity val) => Key val -> DB.ObjectId-keyToDbOid = foreignKeyToDbOid . fromPersistKey+keyToDbOid :: (PersistEntity val) => Key DB.Action val -> DB.ObjectId+keyToDbOid (Key k) = persistObjectIdToDbOid k  instance DB.Val PersistValue where   val (PersistInt64 x)   = DB.Int64 x@@ -366,9 +402,9 @@   val (PersistList l)    = DB.Array $ map DB.val l   val (PersistMap  m)    = DB.Doc $ map (\(k, v)-> (DB.=:) (tToCS k) v) m   val (PersistByteString x) = DB.String $ CS.fromByteString_ x -  val x@(PersistForeignKey _) = DB.ObjId $ foreignKeyToDbOid x-  val (PersistDay _)        = error "only PersistUTCTime currently implemented"-  val (PersistTimeOfDay _)  = error "only PersistUTCTime currently implemented"+  val x@(PersistObjectId _) = DB.ObjId $ persistObjectIdToDbOid x+  val (PersistDay _)        = throw $ PersistMongoDBUnsupported "only PersistUTCTime currently implemented"+  val (PersistTimeOfDay _)  = throw $ PersistMongoDBUnsupported "only PersistUTCTime currently implemented"   cast' (DB.Float x)  = Just (PersistDouble x)   cast' (DB.Int32 x)  = Just $ PersistInt64 $ fromIntegral x   cast' (DB.Int64 x)  = Just $ PersistInt64 x@@ -384,23 +420,23 @@   cast' (DB.RegEx (DB.Regex us1 us2))    = Just $ PersistByteString $ CS.toByteString $ CS.append us1 us2   cast' (DB.Doc doc)  = Just $ PersistMap $ mapFromDoc doc   cast' (DB.Array xs) = Just $ PersistList $ mapMaybe DB.cast' xs-  cast' (DB.ObjId x) = Just $ dbOidToKey x -  cast' (DB.JavaScr _) = error "cast operation not supported for javascript"-  cast' (DB.Sym _) = error "cast operation not supported for sym"-  cast' (DB.Stamp _) = error "cast operation not supported for stamp"-  cast' (DB.MinMax _) = error "cast operation not supported for minmax"+  cast' (DB.ObjId x)  = Just $ dbOidToKey x +  cast' (DB.JavaScr _) = throw $ PersistMongoDBUnsupported "cast operation not supported for javascript"+  cast' (DB.Sym _)     = throw $ PersistMongoDBUnsupported "cast operation not supported for sym"+  cast' (DB.Stamp _)   = throw $ PersistMongoDBUnsupported "cast operation not supported for stamp"+  cast' (DB.MinMax _)  = throw $ PersistMongoDBUnsupported "cast operation not supported for minmax" -instance S.Serialize DB.ObjectId where-  put (DB.Oid w1 w2) = do S.put w1-                          S.put w2+instance Serialize.Serialize DB.ObjectId where+  put (DB.Oid w1 w2) = do Serialize.put w1+                          Serialize.put w2 -  get = do w1 <- S.get-           w2 <- S.get+  get = do w1 <- Serialize.get+           w2 <- Serialize.get            return (DB.Oid w1 w2)  -dummyFromKey :: Key v -> v+dummyFromKey :: Key DB.Action v -> v dummyFromKey _ = error "dummyFromKey"-dummyFromUnique :: Unique v -> v+dummyFromUnique :: Unique v DB.Action -> v dummyFromUnique _ = error "dummyFromUnique" dummyFromFilts :: [Filter v] -> v dummyFromFilts _ = error "dummyFromFilts"
persistent-mongoDB.cabal view
@@ -1,36 +1,37 @@ name:            persistent-mongoDB-version:         0.3.0+version:         0.6.1 license:         BSD3 license-file:    LICENSE author:          Greg Weber <greg@gregweber.info>-maintainer:      Greg Weber <greg@gregweber.info>, Rick Richardson <rick.richardson@gmail.com>+maintainer:      Greg Weber <greg@gregweber.info> synopsis:        Backend for the persistent library using mongoDB.-description:     Backend for the persistent library using mongoDB. category:        Database stability:       Experimental cabal-version:   >= 1.6 build-type:      Simple-homepage:        http://docs.yesodweb.com/persistent/+homepage:        http://www.yesodweb.com/book/persistent+description:     Backend for the persistent library using mongoDB.  library-    build-depends:   base >= 4 && < 5-                   , persistent >= 0.5.0-                   , neither-                   , template-haskell >= 2.4 && < 2.6-                   , text                     >= 0.8       && < 0.12-                   , transformers >= 0.2.1 && < 0.3-                   , containers >= 0.2 && < 0.5-                   , bytestring >= 0.9 && < 0.10-                   , enumerator >= 0.4 && < 0.5-                   , mongoDB >= 0.9.2.1 && < 1.0-                   , network >= 2.2.1.7-                   , bson >= 0.1.2-                   , compact-string-fix >= 0.3.1 && < 0.4-                   , cereal >= 0.3.0.0+    build-depends:   base               >= 4 && < 5+                   , persistent         >= 0.6.0 && < 0.7.0+                   , template-haskell   >= 2.4     && < 2.7+                   , text               >= 0.8     && < 0.12+                   , transformers       >= 0.2.1   && < 0.3+                   , containers         >= 0.2     && < 0.5+                   , bytestring         >= 0.9     && < 0.10+                   , enumerator         >= 0.4     && < 0.5+                   , mongoDB            >= 1.1     && < 1.2+                   , bson               >= 0.1.5+                   , network            >= 2.2.1.7+                   , compact-string-fix >= 0.3.1   && < 0.4+                   , cereal             >= 0.3.0.0+                   , path-pieces        >= 0.0     && < 0.1+                   , monad-control      >= 0.2     && < 0.3      exposed-modules: Database.Persist.MongoDB     ghc-options:     -Wall  source-repository head   type:     git-  location: git://github.com/snoyberg/persistent.git+  location: git://github.com/yesodweb/persistent.git