Safe Haskell | None |
---|---|
Language | Haskell2010 |
Use persistent-mongodb the same way you would use other persistent libraries and refer to the general persistent documentation. There are some new MongoDB specific filters under the filters section. These help extend your query into a nested document.
However, at some point you will find the normal Persistent APIs lacking. and want lower level-level MongoDB access. There are functions available to make working with the raw driver easier: they are under the Entity conversion section. You should still use the same connection pool that you are using for Persistent.
MongoDB is a schema-less database. The MongoDB Persistent backend does not help perform migrations. Unlike SQL backends, uniqueness constraints cannot be created for you. You must place a unique index on unique fields.
Synopsis
- collectionName :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => record -> Text
- docToEntityEither :: forall record. PersistEntity record => Document -> Either Text (Entity record)
- docToEntityThrow :: forall m record. (MonadIO m, PersistEntity record, PersistEntityBackend record ~ MongoContext) => Document -> m (Entity record)
- recordToDocument :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => record -> Document
- documentFromEntity :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => Entity record -> Document
- toInsertDoc :: forall record. (PersistEntity record, PersistEntityBackend record ~ MongoContext) => record -> Document
- entityToInsertDoc :: forall record. (PersistEntity record, PersistEntityBackend record ~ MongoContext) => Entity record -> Document
- updatesToDoc :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => [Update record] -> Document
- filtersToDoc :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => [Filter record] -> Document
- toUniquesDoc :: forall record. PersistEntity record => Unique record -> [Field]
- (->.) :: forall record emb typ. PersistEntity emb => EntityField record [emb] -> EntityField emb typ -> NestedField record typ
- (~>.) :: forall record typ emb. PersistEntity emb => EntityField record [emb] -> NestedField emb typ -> NestedField record typ
- (?&->.) :: forall record typ nest. PersistEntity nest => EntityField record (Maybe nest) -> EntityField nest typ -> NestedField record typ
- (?&~>.) :: forall val nes nes1. PersistEntity nes1 => EntityField val (Maybe nes1) -> NestedField nes1 nes -> NestedField val nes
- (&->.) :: forall record typ nest. PersistEntity nest => EntityField record nest -> EntityField nest typ -> NestedField record typ
- (&~>.) :: forall val nes nes1. PersistEntity nes1 => EntityField val nes1 -> NestedField nes1 nes -> NestedField val nes
- nestEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record
- nestNe :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record
- nestGe :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record
- nestLe :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record
- nestIn :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record
- nestNotIn :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record
- anyEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> typ -> Filter record
- nestAnyEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record [typ] -> typ -> Filter record
- nestBsonEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> Value -> Filter record
- anyBsonEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> Value -> Filter record
- inList :: PersistField typ => EntityField v [typ] -> [typ] -> Filter v
- ninList :: PersistField typ => EntityField v [typ] -> [typ] -> Filter v
- (=~.) :: forall record searchable. (MongoRegexSearchable searchable, PersistEntity record, PersistEntityBackend record ~ MongoContext) => EntityField record searchable -> MongoRegex -> Filter record
- data NestedField record typ
- = forall emb.PersistEntity emb => (EntityField record [emb]) `LastEmbFld` (EntityField emb typ)
- | forall emb.PersistEntity emb => (EntityField record [emb]) `MidEmbFld` (NestedField emb typ)
- | forall nest.PersistEntity nest => (EntityField record nest) `MidNestFlds` (NestedField nest typ)
- | forall nest.PersistEntity nest => (EntityField record (Maybe nest)) `MidNestFldsNullable` (NestedField nest typ)
- | forall nest.PersistEntity nest => (EntityField record nest) `LastNestFld` (EntityField nest typ)
- | forall nest.PersistEntity nest => (EntityField record (Maybe nest)) `LastNestFldNullable` (EntityField nest typ)
- class PersistField typ => MongoRegexSearchable typ
- type MongoRegex = (Text, Text)
- nestSet :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Update record
- nestInc :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Update record
- nestDec :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Update record
- nestMul :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Update record
- push :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> typ -> Update record
- pull :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> typ -> Update record
- pullAll :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> [typ] -> Update record
- addToSet :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> typ -> Update record
- eachOp :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => (EntityField record [typ] -> typ -> Update record) -> EntityField record [typ] -> [typ] -> Update record
- data family BackendKey backend
- keyToOid :: ToBackendKey MongoContext record => Key record -> ObjectId
- oidToKey :: ToBackendKey MongoContext record => ObjectId -> Key record
- recordTypeFromKey :: Key record -> record
- readMayObjectId :: Text -> Maybe ObjectId
- readMayMongoKey :: Text -> Maybe (BackendKey MongoContext)
- keyToText :: BackendKey MongoContext -> Text
- fieldName :: forall record typ. PersistEntity record => EntityField record typ -> Label
- withConnection :: MonadIO m => MongoConf -> (ConnectionPool -> m b) -> m b
- withMongoPool :: MonadIO m => MongoConf -> (ConnectionPool -> m b) -> m b
- withMongoDBConn :: MonadIO m => Database -> HostName -> PortID -> Maybe MongoAuth -> NominalDiffTime -> (ConnectionPool -> m b) -> m b
- withMongoDBPool :: MonadIO m => Database -> HostName -> PortID -> Maybe MongoAuth -> Int -> Int -> NominalDiffTime -> (ConnectionPool -> m b) -> m b
- createMongoDBPool :: MonadIO m => Database -> HostName -> PortID -> Maybe MongoAuth -> Int -> Int -> NominalDiffTime -> m ConnectionPool
- runMongoDBPool :: MonadUnliftIO m => AccessMode -> Action m a -> ConnectionPool -> m a
- runMongoDBPoolDef :: MonadUnliftIO m => Action m a -> ConnectionPool -> m a
- type ConnectionPool = Pool Connection
- data Connection
- data MongoAuth = MongoAuth Username Password
- data MongoConf = MongoConf {
- mgDatabase :: Text
- mgHost :: Text
- mgPort :: PortID
- mgAuth :: Maybe MongoAuth
- mgAccessMode :: AccessMode
- mgPoolStripes :: Int
- mgStripeConnections :: Int
- mgConnectionIdleTime :: NominalDiffTime
- mgReplicaSetConfig :: Maybe ReplicaSetConfig
- defaultMongoConf :: Text -> MongoConf
- defaultHost :: Text
- defaultAccessMode :: AccessMode
- defaultPoolStripes :: Int
- defaultConnectionIdleTime :: NominalDiffTime
- defaultStripeConnections :: Int
- applyDockerEnv :: MongoConf -> IO MongoConf
- type PipePool = Pool Pipe
- createMongoDBPipePool :: MonadIO m => HostName -> PortID -> Int -> Int -> NominalDiffTime -> m PipePool
- runMongoDBPipePool :: MonadUnliftIO m => AccessMode -> Database -> Action m a -> PipePool -> m a
- type HostName = String
- type Database = Text
- type Action = ReaderT MongoContext
- data AccessMode
- master :: AccessMode
- slaveOk :: AccessMode
- (=:) :: Val v => Label -> v -> Field
- data ObjectId
- data MongoContext
- data PortID
- module Database.Persist
Entity conversion
collectionName :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => record -> Text Source #
docToEntityEither :: forall record. PersistEntity record => Document -> Either Text (Entity record) Source #
docToEntityThrow :: forall m record. (MonadIO m, PersistEntity record, PersistEntityBackend record ~ MongoContext) => Document -> m (Entity record) Source #
recordToDocument :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => record -> Document Source #
convert a PersistEntity into document fields.
unlike toInsertDoc
, nulls are included.
documentFromEntity :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => Entity record -> Document Source #
toInsertDoc :: forall record. (PersistEntity record, PersistEntityBackend record ~ MongoContext) => record -> Document Source #
convert a PersistEntity into document fields.
for inserts only: nulls are ignored so they will be unset in the document.
recordToDocument
includes nulls
entityToInsertDoc :: forall record. (PersistEntity record, PersistEntityBackend record ~ MongoContext) => Entity record -> Document Source #
updatesToDoc :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => [Update record] -> Document Source #
filtersToDoc :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => [Filter record] -> Document Source #
toUniquesDoc :: forall record. PersistEntity record => Unique record -> [Field] Source #
convert a unique key into a MongoDB document
MongoDB specific queries
(->.) :: forall record emb typ. PersistEntity emb => EntityField record [emb] -> EntityField emb typ -> NestedField record typ infixr 6 Source #
Point to an array field with an embedded object and give a deeper query into the embedded object.
Use with nestEq
.
(~>.) :: forall record typ emb. PersistEntity emb => EntityField record [emb] -> NestedField emb typ -> NestedField record typ infixr 5 Source #
(?&->.) :: forall record typ nest. PersistEntity nest => EntityField record (Maybe nest) -> EntityField nest typ -> NestedField record typ infixr 6 Source #
Same as &->.
, but Works against a Maybe type
(?&~>.) :: forall val nes nes1. PersistEntity nes1 => EntityField val (Maybe nes1) -> NestedField nes1 nes -> NestedField val nes infixr 5 Source #
Same as &~>.
, but works against a Maybe type
(&->.) :: forall record typ nest. PersistEntity nest => EntityField record nest -> EntityField nest typ -> NestedField record typ infixr 6 Source #
Point to a nested field to query. This field is not an array type.
Use with nestEq
.
(&~>.) :: forall val nes nes1. PersistEntity nes1 => EntityField val nes1 -> NestedField nes1 nes -> NestedField val nes infixr 5 Source #
Point to a nested field to query. This field is not an array type.
This level of nesting is not the final level.
Use ->.
or &>.
to point to the final level.
Filters
You can find example usage for all of Persistent in our test cases: https://github.com/yesodweb/persistent/blob/master/persistent-test/EmbedTest.hs#L144
These filters create a query that reaches deeper into a document with nested fields.
nestEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record infixr 4 Source #
nestNe :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record infixr 4 Source #
nestGe :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record infixr 4 Source #
nestLe :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record infixr 4 Source #
nestIn :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record infixr 4 Source #
nestNotIn :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Filter record infixr 4 Source #
anyEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> typ -> Filter record infixr 4 Source #
Like (==.)
but for an embedded list.
Checks to see if the list contains an item.
In Haskell we need different equality functions for embedded fields that are lists or non-lists to keep things type-safe.
using this as the only query filter is similar to the following in the mongoDB shell
db.Collection.find({arrayField: arrayItem})
nestAnyEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record [typ] -> typ -> Filter record infixr 4 Source #
Like nestEq, but for an embedded list. Checks to see if the nested list contains an item.
nestBsonEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> Value -> Filter record infixr 4 Source #
same as nestEq
, but give a BSON Value
anyBsonEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> Value -> Filter record infixr 4 Source #
same as anyEq
, but give a BSON Value
inList :: PersistField typ => EntityField v [typ] -> [typ] -> Filter v infix 4 Source #
Intersection of lists: if any value in the field is found in the list.
ninList :: PersistField typ => EntityField v [typ] -> [typ] -> Filter v infix 4 Source #
No intersection of lists: if no value in the field is found in the list.
(=~.) :: forall record searchable. (MongoRegexSearchable searchable, PersistEntity record, PersistEntityBackend record ~ MongoContext) => EntityField record searchable -> MongoRegex -> Filter record infixr 4 Source #
Filter using a Regular expression.
data NestedField record typ Source #
forall emb.PersistEntity emb => (EntityField record [emb]) `LastEmbFld` (EntityField emb typ) | |
forall emb.PersistEntity emb => (EntityField record [emb]) `MidEmbFld` (NestedField emb typ) | |
forall nest.PersistEntity nest => (EntityField record nest) `MidNestFlds` (NestedField nest typ) | |
forall nest.PersistEntity nest => (EntityField record (Maybe nest)) `MidNestFldsNullable` (NestedField nest typ) | |
forall nest.PersistEntity nest => (EntityField record nest) `LastNestFld` (EntityField nest typ) | |
forall nest.PersistEntity nest => (EntityField record (Maybe nest)) `LastNestFldNullable` (EntityField nest typ) |
class PersistField typ => MongoRegexSearchable typ Source #
Mark the subset of PersistField
s that can be searched by a mongoDB regex
Anything stored as PersistText or an array of PersistText would be valid
Instances
MongoRegexSearchable Text Source # | |
Defined in Database.Persist.MongoDB | |
MongoRegexSearchable rs => MongoRegexSearchable [rs] Source # | |
Defined in Database.Persist.MongoDB | |
MongoRegexSearchable rs => MongoRegexSearchable (Maybe rs) Source # | |
Defined in Database.Persist.MongoDB |
type MongoRegex = (Text, Text) Source #
A MongoRegex represents a Regular expression.
It is a tuple of the expression and the options for the regular expression, respectively
Options are listed here: http://docs.mongodb.org/manual/reference/operator/query/regex/
If you use the same options you may want to define a helper such as r t = (t, "ims")
Updates
nestSet :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Update record infixr 4 Source #
nestInc :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Update record Source #
nestDec :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Update record Source #
nestMul :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => NestedField record typ -> typ -> Update record Source #
push :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> typ -> Update record infixr 4 Source #
pull :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> typ -> Update record infixr 4 Source #
pullAll :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> [typ] -> Update record infixr 4 Source #
addToSet :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> typ -> Update record infixr 4 Source #
eachOp :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => (EntityField record [typ] -> typ -> Update record) -> EntityField record [typ] -> [typ] -> Update record Source #
equivalent to $each
eachOp push field []
eachOp pull
will get translated to $pullAll
Key conversion helpers
data family BackendKey backend #
Instances
keyToOid :: ToBackendKey MongoContext record => Key record -> ObjectId Source #
oidToKey :: ToBackendKey MongoContext record => ObjectId -> Key record Source #
recordTypeFromKey :: Key record -> record Source #
readMayMongoKey :: Text -> Maybe (BackendKey MongoContext) Source #
Convert a Text to a Key
keyToText :: BackendKey MongoContext -> Text Source #
PersistField conversion
fieldName :: forall record typ. PersistEntity record => EntityField record typ -> Label Source #
using connections
withConnection :: MonadIO m => MongoConf -> (ConnectionPool -> m b) -> m b Source #
withMongoPool :: MonadIO m => MongoConf -> (ConnectionPool -> m b) -> m b Source #
withMongoDBConn :: MonadIO m => Database -> HostName -> PortID -> Maybe MongoAuth -> NominalDiffTime -> (ConnectionPool -> m b) -> m b Source #
withMongoDBPool :: MonadIO m => Database -> HostName -> PortID -> Maybe MongoAuth -> Int -> Int -> NominalDiffTime -> (ConnectionPool -> m b) -> m b Source #
:: MonadIO m | |
=> Database | |
-> HostName | |
-> PortID | |
-> Maybe MongoAuth | |
-> Int | pool size (number of stripes) |
-> Int | stripe size (number of connections per stripe) |
-> NominalDiffTime | time a connection is left idle before closing |
-> m ConnectionPool |
runMongoDBPool :: MonadUnliftIO m => AccessMode -> Action m a -> ConnectionPool -> m a Source #
runMongoDBPoolDef :: MonadUnliftIO m => Action m a -> ConnectionPool -> m a Source #
use default AccessMode
type ConnectionPool = Pool Connection Source #
data Connection Source #
Connection configuration
Information required to connect to a mongo database
MongoConf | |
|
Instances
Show MongoConf Source # | |
FromJSON MongoConf Source # | |
PersistConfig MongoConf Source # | |
Defined in Database.Persist.MongoDB type PersistConfigBackend MongoConf :: (Type -> Type) -> Type -> Type # type PersistConfigPool MongoConf # loadConfig :: Value -> Parser MongoConf # applyEnv :: MongoConf -> IO MongoConf # createPoolConfig :: MongoConf -> IO (PersistConfigPool MongoConf) # runPool :: MonadUnliftIO m => MongoConf -> PersistConfigBackend MongoConf m a -> PersistConfigPool MongoConf -> m a # | |
type PersistConfigPool MongoConf Source # | |
Defined in Database.Persist.MongoDB | |
type PersistConfigBackend MongoConf Source # | |
Defined in Database.Persist.MongoDB |
defaultMongoConf :: Text -> MongoConf Source #
defaultHost :: Text Source #
applyDockerEnv :: MongoConf -> IO MongoConf Source #
docker integration: change the host to the mongodb link
using raw MongoDB pipes
createMongoDBPipePool Source #
:: MonadIO m | |
=> HostName | |
-> PortID | |
-> Int | pool size (number of stripes) |
-> Int | stripe size (number of connections per stripe) |
-> NominalDiffTime | time a connection is left idle before closing |
-> m PipePool |
A pool of plain MongoDB pipes. The database parameter has not yet been applied yet. This is useful for switching between databases (on the same host and port) Unlike the normal pool, no authentication is available
runMongoDBPipePool :: MonadUnliftIO m => AccessMode -> Database -> Action m a -> PipePool -> m a Source #
run a pool created with createMongoDBPipePool
network type
Either a host name e.g., "haskell.org"
or a numeric host
address string consisting of a dotted decimal IPv4 address or an
IPv6 address e.g., "192.168.0.1"
.
MongoDB driver types
type Action = ReaderT MongoContext #
A monad on top of m (which must be a MonadIO) that may access the database and may fail with a DB Failure
data AccessMode #
Type of reads and writes to perform
ReadStaleOk | Read-only action, reading stale data from a slave is OK. |
UnconfirmedWrites | Read-write action, slave not OK, every write is fire & forget. |
ConfirmWrites GetLastError | Read-write action, slave not OK, every write is confirmed with getLastError. |
Instances
Show AccessMode | |
Defined in Database.MongoDB.Query showsPrec :: Int -> AccessMode -> ShowS # show :: AccessMode -> String # showList :: [AccessMode] -> ShowS # |
master :: AccessMode #
Same as ConfirmWrites
[]
slaveOk :: AccessMode #
Same as ReadStaleOk
A BSON ObjectID is a 12-byte value consisting of a 4-byte timestamp (seconds since epoch), a 3-byte machine id, a 2-byte process id, and a 3-byte counter. Note that the timestamp and counter fields must be stored big endian unlike the rest of BSON. This is because they are compared byte-by-byte and we want to ensure a mostly increasing order.
data MongoContext #
Values needed when executing a db operation
Instances
Wraps network's PortNumber
Used to ease compatibility between older and newer network versions.
Database.Persist
module Database.Persist