Safe Haskell | None |
---|---|
Language | Haskell98 |
Database.Persist.MongoDB
Contents
Description
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.
- 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)
- entityToDocument :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => record -> Document
- toInsertDoc :: forall record. (PersistEntity record, PersistEntityBackend record ~ MongoContext) => record -> Document
- updatesToDoc :: PersistEntity entity => [Update entity] -> Document
- filtersToDoc :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => [Filter record] -> Document
- toUniquesDoc :: forall record. PersistEntity record => Unique record -> [Field]
- 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
- multiEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField 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
- multiBsonEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> Value -> Filter record
- (=~.) :: forall record searchable. (MongoRegexSearchable searchable, PersistEntity record, PersistEntityBackend record ~ MongoContext) => EntityField record searchable -> MongoRegex -> Filter record
- (?=~.) :: forall record. (PersistEntity record, PersistEntityBackend record ~ MongoContext) => EntityField record (Maybe Text) -> MongoRegex -> Filter record
- type MongoRegex = (Text, Text)
- (->.) :: 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
- 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
- data family BackendKey backend
- keyToOid :: BackendKey MongoContext -> ObjectId
- oidToKey :: ObjectId -> BackendKey MongoContext
- recordTypeFromKey :: Key record -> record
- fieldName :: forall record typ. PersistEntity record => EntityField record typ -> Label
- withConnection :: (MonadIO m, Applicative m) => MongoConf -> (ConnectionPool -> m b) -> m b
- withMongoPool :: (MonadIO m, Applicative m) => MongoConf -> (ConnectionPool -> m b) -> m b
- withMongoDBConn :: (MonadIO m, Applicative m) => Database -> HostName -> PortID -> Maybe MongoAuth -> NominalDiffTime -> (ConnectionPool -> m b) -> m b
- withMongoDBPool :: (MonadIO m, Applicative m) => Database -> HostName -> PortID -> Maybe MongoAuth -> Int -> Int -> NominalDiffTime -> (ConnectionPool -> m b) -> m b
- createMongoDBPool :: (MonadIO m, Applicative m) => Database -> HostName -> PortID -> Maybe MongoAuth -> Int -> Int -> NominalDiffTime -> m ConnectionPool
- runMongoDBPool :: (MonadIO m, MonadBaseControl IO m) => AccessMode -> Action m a -> ConnectionPool -> m a
- runMongoDBPoolDef :: (MonadIO m, MonadBaseControl IO 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, Applicative m) => HostName -> PortID -> Int -> Int -> NominalDiffTime -> m PipePool
- runMongoDBPipePool :: (MonadIO m, MonadBaseControl IO m) => AccessMode -> Database -> Action m a -> PipePool -> m a
- type HostName = String
- data PortID :: *
- type Database = Text
- type Action = ReaderT MongoContext
- data AccessMode :: *
- master :: AccessMode
- slaveOk :: AccessMode
- (=:) :: Val v => Label -> v -> Field
- data ObjectId :: *
- data MongoContext :: *
- 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
entityToDocument :: (PersistEntity record, PersistEntityBackend record ~ MongoContext) => record -> Document Source
convert a PersistEntity into document fields.
unlike toInsertDoc
, nulls are included.
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.
entityToDocument
includes nulls
updatesToDoc :: PersistEntity entity => [Update entity] -> 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 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 nestEq, 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})
multiEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> typ -> Filter record infixr 4 Source
Deprecated: Please use anyEq instead
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
multiBsonEq :: forall record typ. (PersistField typ, PersistEntityBackend record ~ MongoContext) => EntityField record [typ] -> Value -> Filter record infixr 4 Source
Deprecated: Please use anyBsonEq instead
(=~.) :: forall record searchable. (MongoRegexSearchable searchable, PersistEntity record, PersistEntityBackend record ~ MongoContext) => EntityField record searchable -> MongoRegex -> Filter record infixr 4 Source
Filter using a Regular expression.
(?=~.) :: forall record. (PersistEntity record, PersistEntityBackend record ~ MongoContext) => EntityField record (Maybe Text) -> MongoRegex -> Filter record infixr 4 Source
Deprecated: Use =~. instead
Filter using a Regular expression against a nullable field.
type MongoRegex = (Text, Text) Source
A MongoRegex represetns 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")
(->.) :: 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.
data NestedField record typ Source
Constructors
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 | |
MongoRegexSearchable rs => MongoRegexSearchable [rs] | |
MongoRegexSearchable rs => MongoRegexSearchable (Maybe rs) |
Key conversion helpers
data family BackendKey backend
Instances
keyToOid :: BackendKey MongoContext -> ObjectId Source
Deprecated: Use unMongoKey
oidToKey :: ObjectId -> BackendKey MongoContext Source
Deprecated: Use MongoKey
recordTypeFromKey :: Key record -> record Source
PersistField conversion
fieldName :: forall record typ. PersistEntity record => EntityField record typ -> Label Source
using connections
withConnection :: (MonadIO m, Applicative m) => MongoConf -> (ConnectionPool -> m b) -> m b Source
withMongoPool :: (MonadIO m, Applicative m) => MongoConf -> (ConnectionPool -> m b) -> m b Source
withMongoDBConn :: (MonadIO m, Applicative m) => Database -> HostName -> PortID -> Maybe MongoAuth -> NominalDiffTime -> (ConnectionPool -> m b) -> m b Source
withMongoDBPool :: (MonadIO m, Applicative m) => Database -> HostName -> PortID -> Maybe MongoAuth -> Int -> Int -> NominalDiffTime -> (ConnectionPool -> m b) -> m b Source
Arguments
:: (MonadIO m, Applicative 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 :: (MonadIO m, MonadBaseControl IO m) => AccessMode -> Action m a -> ConnectionPool -> m a Source
runMongoDBPoolDef :: (MonadIO m, MonadBaseControl IO 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
Constructors
MongoConf | |
Fields
|
Instances
defaultMongoConf :: Text -> MongoConf Source
applyDockerEnv :: MongoConf -> IO MongoConf Source
docker integration: change the host to the mongodb link
using raw MongoDB pipes
Arguments
:: (MonadIO m, Applicative 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 :: (MonadIO m, MonadBaseControl IO 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
Constructors
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
master :: AccessMode
Same as ConfirmWrites
[]
Same as ReadStaleOk
data ObjectId :: *
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
HasMongoContext MongoContext | |
PersistUnique MongoContext | |
PersistQuery MongoContext | |
PersistStore MongoContext | older versions versions of haddock (like that on hackage) do not show that this defines
|
HasPersistBackend MongoContext MongoContext | |
Eq (BackendKey MongoContext) | |
Ord (BackendKey MongoContext) | |
Read (BackendKey MongoContext) | |
Show (BackendKey MongoContext) | |
ToJSON (BackendKey MongoContext) | It would make sense to define the instance for ObjectId and then use newtype deriving however, that would create an orphan instance |
FromJSON (BackendKey MongoContext) | |
PathPiece (BackendKey MongoContext) | ToPathPiece is used to convert a key to/from text |
PersistFieldSql (BackendKey MongoContext) | |
PersistField (BackendKey MongoContext) | |
data BackendKey MongoContext = MongoKey {} | |
type BackendSpecificFilter MongoContext record |
Database.Persist
module Database.Persist