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 +178/−142
- persistent-mongoDB.cabal +20/−19
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