Rename Connection to ConnPool. Edit tutorial and some comments
This commit is contained in:
parent
ad13914862
commit
36cc86fd70
9 changed files with 118 additions and 124 deletions
|
@ -20,9 +20,6 @@ instance (Monad m, Error e) => Applicative (ErrorT e m) where
|
||||||
class (MonadIO m, Applicative m, Functor m) => MonadIO' m
|
class (MonadIO m, Applicative m, Functor m) => MonadIO' m
|
||||||
instance (MonadIO m, Applicative m, Functor m) => MonadIO' m
|
instance (MonadIO m, Applicative m, Functor m) => MonadIO' m
|
||||||
|
|
||||||
ignore :: (Monad m) => a -> m ()
|
|
||||||
ignore _ = return ()
|
|
||||||
|
|
||||||
loop :: (Functor m, Monad m) => m (Maybe a) -> m [a]
|
loop :: (Functor m, Monad m) => m (Maybe a) -> m [a]
|
||||||
-- ^ Repeatedy execute action, collecting results, until it returns Nothing
|
-- ^ Repeatedy execute action, collecting results, until it returns Nothing
|
||||||
loop act = act >>= maybe (return []) (\a -> (a :) <$> loop act)
|
loop act = act >>= maybe (return []) (\a -> (a :) <$> loop act)
|
||||||
|
|
|
@ -10,8 +10,8 @@ Simple example below. Use with language extension /OvererloadedStrings/.
|
||||||
> import Control.Monad.Trans (liftIO)
|
> import Control.Monad.Trans (liftIO)
|
||||||
>
|
>
|
||||||
> main = do
|
> main = do
|
||||||
> conn <- connect 1 (host "127.0.0.1")
|
> pool <- newConnPool 1 (host "127.0.0.1")
|
||||||
> e <- access safe Master conn run
|
> e <- access safe Master pool run
|
||||||
> print e
|
> print e
|
||||||
>
|
>
|
||||||
> run = use (Database "baseball") $ do
|
> run = use (Database "baseball") $ do
|
||||||
|
|
|
@ -1,16 +1,16 @@
|
||||||
{- | A Mongo connection is a pool of TCP connections to a single server or a replica set of servers. -}
|
{- | A pool of TCP connections to a single server or a replica set of servers. -}
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, RecordWildCards, MultiParamTypeClasses, FlexibleContexts, TypeFamilies, DoRec, RankNTypes #-}
|
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, RecordWildCards, NamedFieldPuns, MultiParamTypeClasses, FlexibleContexts, TypeFamilies, DoRec, RankNTypes, FlexibleInstances #-}
|
||||||
|
|
||||||
module Database.MongoDB.Connection (
|
module Database.MongoDB.Connection (
|
||||||
-- * Host
|
-- * Host
|
||||||
Host(..), PortID(..), host, showHostPort, readHostPort, readHostPortM,
|
Host(..), PortID(..), host, showHostPort, readHostPort, readHostPortM,
|
||||||
-- * ReplicaSet
|
-- * ReplicaSet
|
||||||
ReplicaSet(..),
|
ReplicaSet(..), Name,
|
||||||
-- * MasterOrSlaveOk
|
-- * MasterOrSlaveOk
|
||||||
MasterOrSlaveOk(..),
|
MasterOrSlaveOk(..),
|
||||||
-- * Connection
|
-- * Connection Pool
|
||||||
Server(..), replicaSet
|
Server(..), connHost, replicaSet
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Database.MongoDB.Internal.Protocol
|
import Database.MongoDB.Internal.Protocol
|
||||||
|
@ -30,6 +30,7 @@ import Database.MongoDB.Internal.Util () -- PortID instances
|
||||||
import Var.Pool
|
import Var.Pool
|
||||||
import System.Random (newStdGen, randomRs)
|
import System.Random (newStdGen, randomRs)
|
||||||
import Data.List (delete, find, nub)
|
import Data.List (delete, find, nub)
|
||||||
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
|
||||||
type Name = UString
|
type Name = UString
|
||||||
|
|
||||||
|
@ -103,7 +104,7 @@ getReplicaInfo pipe = do
|
||||||
return info
|
return info
|
||||||
|
|
||||||
type ReplicaInfo = Document
|
type ReplicaInfo = Document
|
||||||
-- ^ Configuration info of a host in a replica set. Contains all the hosts in the replica set plus its role in that set (master, slave, or arbiter)
|
-- ^ Configuration info of a host in a replica set (result of /ismaster/ command). Contains all the hosts in the replica set plus its role in that set (master, slave, or arbiter)
|
||||||
|
|
||||||
{- isPrimary :: ReplicaInfo -> Bool
|
{- isPrimary :: ReplicaInfo -> Bool
|
||||||
-- ^ Is the replica described by this info a master/primary (not slave or arbiter)?
|
-- ^ Is the replica described by this info a master/primary (not slave or arbiter)?
|
||||||
|
@ -139,42 +140,45 @@ data MasterOrSlaveOk =
|
||||||
isMS Master i = isPrimary i
|
isMS Master i = isPrimary i
|
||||||
isMS SlaveOk i = isSecondary i || isPrimary i -}
|
isMS SlaveOk i = isSecondary i || isPrimary i -}
|
||||||
|
|
||||||
-- * Connection
|
-- * Connection Pool
|
||||||
|
|
||||||
type Pool' = Pool IOError
|
type Pool' = Pool IOError
|
||||||
|
|
||||||
-- | A Server is a single server ('Host') or a replica set of servers ('ReplicaSet')
|
-- | A Server is a single server ('Host') or a replica set of servers ('ReplicaSet')
|
||||||
class Server t where
|
class Server t where
|
||||||
data Connection t
|
data ConnPool t
|
||||||
-- ^ A Mongo connection is a pool of TCP connections to a host or a replica set of hosts
|
-- ^ A pool of TCP connections ('Pipe's) to a host or a replica set of hosts
|
||||||
connect :: (MonadIO' m) => Int -> t -> m (Connection t)
|
newConnPool :: (MonadIO' m) => Int -> t -> m (ConnPool t)
|
||||||
-- ^ Create a Mongo Connection to a host or a replica set of hosts. Actual TCP connection is not attempted until 'getPipe' request, so no IOError can be raised here. Up to N TCP connections will be established to each host.
|
-- ^ Create a ConnectionPool to a host or a replica set of hosts. Actual TCP connection is not attempted until 'getPipe' request, so no IOError can be raised here. Up to N TCP connections will be established to each host.
|
||||||
getPipe :: MasterOrSlaveOk -> Connection t -> ErrorT IOError IO Pipe
|
getPipe :: MasterOrSlaveOk -> ConnPool t -> ErrorT IOError IO Pipe
|
||||||
-- ^ Return a TCP connection (Pipe) to the master or a slave in the server. Master must connect to the master, SlaveOk may connect to a slave or master. To spread the load, SlaveOk requests are distributed amongst all hosts in the server. Throw IOError if failed to connect to right type of host (Master/SlaveOk).
|
-- ^ Return a TCP connection (Pipe) to the master or a slave in the server. Master must connect to the master, SlaveOk may connect to a slave or master. To spread the load, SlaveOk requests are distributed amongst all hosts in the server. Throw IOError if failed to connect to right type of host (Master/SlaveOk).
|
||||||
killPipes :: Connection t -> IO ()
|
killPipes :: ConnPool t -> IO ()
|
||||||
-- ^ Kill all open pipes (TCP Connections). Will cause any users of them to fail. Alternatively you can let them die on their own when this Connection is garbage collected.
|
-- ^ Kill all open pipes (TCP Connections). Will cause any users of them to fail. Alternatively you can let them die on their own when they are garbage collected.
|
||||||
|
|
||||||
-- ** Connection Host
|
-- ** ConnectionPool Host
|
||||||
|
|
||||||
instance Server Host where
|
instance Server Host where
|
||||||
data Connection Host = HostConnection {connHost :: Host, connPool :: Pool' Pipe}
|
data ConnPool Host = HostConnPool {connHost :: Host, connPool :: Pool' Pipe}
|
||||||
-- ^ A pool of TCP connections ('Pipe's) to a server, handed out in round-robin style.
|
-- ^ A pool of TCP connections ('Pipe's) to a server, handed out in round-robin style.
|
||||||
connect poolSize' host' = liftIO (connectHost poolSize' host')
|
newConnPool poolSize' host' = liftIO (newHostConnPool poolSize' host')
|
||||||
-- ^ Create a Connection (pool of TCP connections) to server (host or replica set)
|
-- ^ Create a connection pool to server (host or replica set)
|
||||||
getPipe _ = getHostPipe
|
getPipe _ = getHostPipe
|
||||||
-- ^ Return a TCP connection (Pipe). If SlaveOk, connect to a slave if available. Round-robin if multiple slaves are available. Throw IOError if failed to connect.
|
-- ^ Return a TCP connection (Pipe). If SlaveOk, connect to a slave if available. Round-robin if multiple slaves are available. Throw IOError if failed to connect.
|
||||||
killPipes (HostConnection _ pool) = killAll pool
|
killPipes (HostConnPool _ pool) = killAll pool
|
||||||
|
|
||||||
connectHost :: Int -> Host -> IO (Connection Host)
|
instance Show (ConnPool Host) where
|
||||||
|
show HostConnPool{connHost} = "ConnPool " ++ show connHost
|
||||||
|
|
||||||
|
newHostConnPool :: Int -> Host -> IO (ConnPool Host)
|
||||||
-- ^ Create a pool of N 'Pipe's (TCP connections) to server. 'getHostPipe' will return one of those pipes, round-robin style.
|
-- ^ Create a pool of N 'Pipe's (TCP connections) to server. 'getHostPipe' will return one of those pipes, round-robin style.
|
||||||
connectHost poolSize' host' = HostConnection host' <$> newPool Factory{..} poolSize' where
|
newHostConnPool poolSize' host' = HostConnPool host' <$> newPool Factory{..} poolSize' where
|
||||||
newResource = tcpConnect host'
|
newResource = tcpConnect host'
|
||||||
killResource = close
|
killResource = close
|
||||||
isExpired = isClosed
|
isExpired = isClosed
|
||||||
|
|
||||||
getHostPipe :: Connection Host -> ErrorT IOError IO Pipe
|
getHostPipe :: ConnPool Host -> ErrorT IOError IO Pipe
|
||||||
-- ^ Return next pipe (TCP connection) in connection pool, round-robin style. Throw IOError if can't connect to host.
|
-- ^ Return next pipe (TCP connection) in connection pool, round-robin style. Throw IOError if can't connect to host.
|
||||||
getHostPipe (HostConnection _ pool) = aResource pool
|
getHostPipe (HostConnPool _ pool) = aResource pool
|
||||||
|
|
||||||
tcpConnect :: Host -> ErrorT IOError IO Pipe
|
tcpConnect :: Host -> ErrorT IOError IO Pipe
|
||||||
-- ^ Create a TCP connection (Pipe) to the given host. Throw IOError if can't connect.
|
-- ^ Create a TCP connection (Pipe) to the given host. Throw IOError if can't connect.
|
||||||
|
@ -183,39 +187,42 @@ tcpConnect (Host hostname port) = ErrorT . E.try $ mkPipe =<< connectTo hostname
|
||||||
-- ** Connection ReplicaSet
|
-- ** Connection ReplicaSet
|
||||||
|
|
||||||
instance Server ReplicaSet where
|
instance Server ReplicaSet where
|
||||||
data Connection ReplicaSet = ReplicaSetConnection {
|
data ConnPool ReplicaSet = ReplicaSetConnPool {
|
||||||
repsetName :: Name,
|
repsetName :: Name,
|
||||||
currentMembers :: MVar [Connection Host] } -- master at head after a refresh
|
currentMembers :: MVar [ConnPool Host] } -- master at head after a refresh
|
||||||
connect poolSize' repset = liftIO (connectSet poolSize' repset)
|
newConnPool poolSize' repset = liftIO (newSetConnPool poolSize' repset)
|
||||||
getPipe = getSetPipe
|
getPipe = getSetPipe
|
||||||
killPipes ReplicaSetConnection{..} = withMVar currentMembers (mapM_ killPipes)
|
killPipes ReplicaSetConnPool{..} = withMVar currentMembers (mapM_ killPipes)
|
||||||
|
|
||||||
replicaSet :: (MonadIO' m) => Connection ReplicaSet -> m ReplicaSet
|
instance Show (ConnPool ReplicaSet) where
|
||||||
-- ^ Set name with current members as seed list
|
show r = "ConnPool " ++ show (unsafePerformIO $ replicaSet r)
|
||||||
replicaSet ReplicaSetConnection{..} = ReplicaSet repsetName . map connHost <$> readMVar currentMembers
|
|
||||||
|
|
||||||
connectSet :: Int -> ReplicaSet -> IO (Connection ReplicaSet)
|
replicaSet :: (MonadIO' m) => ConnPool ReplicaSet -> m ReplicaSet
|
||||||
-- ^ Create a connection to each member of the replica set.
|
-- ^ Return replicas set name with current members as seed list
|
||||||
connectSet poolSize' repset = assert (not . null $ seedHosts repset) $ do
|
replicaSet ReplicaSetConnPool{..} = ReplicaSet repsetName . map connHost <$> readMVar currentMembers
|
||||||
currentMembers <- newMVar =<< mapM (connect poolSize') (seedHosts repset)
|
|
||||||
return $ ReplicaSetConnection (setName repset) currentMembers
|
|
||||||
|
|
||||||
getMembers :: Name -> [Connection Host] -> ErrorT IOError IO [Host]
|
newSetConnPool :: Int -> ReplicaSet -> IO (ConnPool ReplicaSet)
|
||||||
|
-- ^ Create a connection pool to each member of the replica set.
|
||||||
|
newSetConnPool poolSize' repset = assert (not . null $ seedHosts repset) $ do
|
||||||
|
currentMembers <- newMVar =<< mapM (newConnPool poolSize') (seedHosts repset)
|
||||||
|
return $ ReplicaSetConnPool (setName repset) currentMembers
|
||||||
|
|
||||||
|
getMembers :: Name -> [ConnPool Host] -> ErrorT IOError IO [Host]
|
||||||
-- ^ Get members of replica set, master first. Query supplied connections until config found.
|
-- ^ Get members of replica set, master first. Query supplied connections until config found.
|
||||||
-- TODO: Verify config for request replica set name and not some other replica set. ismaster config should include replica set name in result but currently does not.
|
-- TODO: Verify config for request replica set name and not some other replica set. ismaster config should include replica set name in result but currently does not.
|
||||||
getMembers _repsetName connections = hosts <$> untilSuccess (getReplicaInfo <=< getHostPipe) connections
|
getMembers _repsetName connections = hosts <$> untilSuccess (getReplicaInfo <=< getHostPipe) connections
|
||||||
|
|
||||||
refreshMembers :: Name -> [Connection Host] -> ErrorT IOError IO [Connection Host]
|
refreshMembers :: Name -> [ConnPool Host] -> ErrorT IOError IO [ConnPool Host]
|
||||||
-- ^ Update current members with master at head. Reuse unchanged members. Throw IOError if can't connect to any and fetch config. Dropped connections are not closed in case they still have users; they will be closed when garbage collected.
|
-- ^ Update current members with master at head. Reuse unchanged members. Throw IOError if can't connect to any and fetch config. Dropped connections are not closed in case they still have users; they will be closed when garbage collected.
|
||||||
refreshMembers repsetName connections = do
|
refreshMembers repsetName connections = do
|
||||||
n <- liftIO . poolSize . connPool $ head connections
|
n <- liftIO . poolSize . connPool $ head connections
|
||||||
mapM (connection n) =<< getMembers repsetName connections
|
mapM (connection n) =<< getMembers repsetName connections
|
||||||
where
|
where
|
||||||
connection n host' = maybe (connect n host') return $ find ((host' ==) . connHost) connections
|
connection n host' = maybe (newConnPool n host') return $ find ((host' ==) . connHost) connections
|
||||||
|
|
||||||
getSetPipe :: MasterOrSlaveOk -> Connection ReplicaSet -> ErrorT IOError IO Pipe
|
getSetPipe :: MasterOrSlaveOk -> ConnPool ReplicaSet -> ErrorT IOError IO Pipe
|
||||||
-- ^ Return a pipe to primary or a random secondary in replica set. Use primary for SlaveOk if and only if no secondaries. Note, refreshes members each time (makes ismaster call to primary).
|
-- ^ Return a pipe to primary or a random secondary in replica set. Use primary for SlaveOk if and only if no secondaries. Note, refreshes members each time (makes ismaster call to primary).
|
||||||
getSetPipe mos ReplicaSetConnection{..} = modifyMVar currentMembers $ \conns -> do
|
getSetPipe mos ReplicaSetConnPool{..} = modifyMVar currentMembers $ \conns -> do
|
||||||
connections <- refreshMembers repsetName conns -- master at head after refresh
|
connections <- refreshMembers repsetName conns -- master at head after refresh
|
||||||
pipe <- case mos of
|
pipe <- case mos of
|
||||||
Master -> getHostPipe (head connections)
|
Master -> getHostPipe (head connections)
|
||||||
|
|
|
@ -42,7 +42,7 @@ import Control.Monad.Error
|
||||||
-- * Pipe
|
-- * Pipe
|
||||||
|
|
||||||
type Pipe = P.Pipeline Handle ByteString
|
type Pipe = P.Pipeline Handle ByteString
|
||||||
-- ^ Thread-safe TCP connection to server with pipelined requests
|
-- ^ Thread-safe TCP connection with pipelined requests
|
||||||
|
|
||||||
mkPipe :: Handle -> IO Pipe
|
mkPipe :: Handle -> IO Pipe
|
||||||
-- ^ New thread-safe pipelined connection over handle
|
-- ^ New thread-safe pipelined connection over handle
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
-- | Miscellaneous general functions
|
-- | Miscellaneous general functions and Show, Eq, and Ord instances for PortID
|
||||||
|
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
|
||||||
|
@ -14,12 +14,6 @@ deriving instance Show PortID
|
||||||
deriving instance Eq PortID
|
deriving instance Eq PortID
|
||||||
deriving instance Ord PortID
|
deriving instance Ord PortID
|
||||||
|
|
||||||
snoc :: [a] -> a -> [a]
|
|
||||||
-- ^ add element to end of list (/snoc/ is reverse of /cons/, which adds to front of list)
|
|
||||||
snoc list a = list ++ [a]
|
|
||||||
|
|
||||||
type Secs = Float
|
|
||||||
|
|
||||||
bitOr :: (Bits a) => [a] -> a
|
bitOr :: (Bits a) => [a] -> a
|
||||||
-- ^ bit-or all numbers together
|
-- ^ bit-or all numbers together
|
||||||
bitOr = foldl (.|.) 0
|
bitOr = foldl (.|.) 0
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
-- | Query and update documents residing on a MongoDB server(s)
|
-- | Query and update documents
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings, RecordWildCards, NamedFieldPuns, TupleSections, FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeSynonymInstances, RankNTypes, ImpredicativeTypes #-}
|
{-# LANGUAGE OverloadedStrings, RecordWildCards, NamedFieldPuns, TupleSections, FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeSynonymInstances, RankNTypes, ImpredicativeTypes #-}
|
||||||
|
|
||||||
|
@ -24,7 +24,7 @@ module Database.MongoDB.Query (
|
||||||
-- ** Delete
|
-- ** Delete
|
||||||
delete, deleteOne,
|
delete, deleteOne,
|
||||||
-- * Read
|
-- * Read
|
||||||
slaveOk,
|
readMode,
|
||||||
-- ** Query
|
-- ** Query
|
||||||
Query(..), QueryOption(..), Projector, Limit, Order, BatchSize,
|
Query(..), QueryOption(..), Projector, Limit, Order, BatchSize,
|
||||||
explain, find, findOne, count, distinct,
|
explain, find, findOne, count, distinct,
|
||||||
|
@ -62,23 +62,12 @@ import Database.MongoDB.Internal.Util ((<.>), true1)
|
||||||
mapErrorIO :: (Throw e m, MonadIO m) => (e' -> e) -> ErrorT e' IO a -> m a
|
mapErrorIO :: (Throw e m, MonadIO m) => (e' -> e) -> ErrorT e' IO a -> m a
|
||||||
mapErrorIO f = throwLeft' f . liftIO . runErrorT
|
mapErrorIO f = throwLeft' f . liftIO . runErrorT
|
||||||
|
|
||||||
send :: (Context Pipe m, Throw Failure m, MonadIO m) => [Notice] -> m ()
|
|
||||||
-- ^ Send notices as a contiguous batch to server with no reply. Throw 'ConnectionFailure' if pipe fails.
|
|
||||||
send ns = mapErrorIO ConnectionFailure . flip P.send ns =<< context
|
|
||||||
|
|
||||||
call :: (Context Pipe m, Throw Failure m, MonadIO m) => [Notice] -> Request -> m (forall n. (Throw Failure n, MonadIO n) => n Reply)
|
|
||||||
-- ^ Send notices and request as a contiguous batch to server and return reply promise, which will block when invoked until reply arrives. This call will throw 'ConnectionFailure' if pipe fails on send, and promise will throw 'ConnectionFailure' if pipe fails on receive.
|
|
||||||
call ns r = do
|
|
||||||
pipe <- context
|
|
||||||
promise <- mapErrorIO ConnectionFailure (P.call pipe ns r)
|
|
||||||
return (mapErrorIO ConnectionFailure promise)
|
|
||||||
|
|
||||||
-- * Mongo Monad
|
-- * Mongo Monad
|
||||||
|
|
||||||
access :: (Server s, MonadIO m) => WriteMode -> MasterOrSlaveOk -> Connection s -> Action m a -> m (Either Failure a)
|
access :: (Server s, MonadIO m) => WriteMode -> MasterOrSlaveOk -> ConnPool s -> Action m a -> m (Either Failure a)
|
||||||
-- ^ Run action with access to server or replica set via one of the 'Pipe's (TCP connections) in given 'Connection' pool
|
-- ^ Run action under given write and read mode against the server or replicaSet behind given connection pool. Return Left Failure if there is a connection failure or read/write error.
|
||||||
access w mos conn act = do
|
access w mos pool act = do
|
||||||
ePipe <- liftIO . runErrorT $ getPipe mos conn
|
ePipe <- liftIO . runErrorT $ getPipe mos pool
|
||||||
either (return . Left . ConnectionFailure) (runAction act w mos) ePipe
|
either (return . Left . ConnectionFailure) (runAction act w mos) ePipe
|
||||||
|
|
||||||
-- | A monad with access to a 'Pipe', 'MasterOrSlaveOk', and 'WriteMode', and throws 'Failure' on read, write, or pipe failure
|
-- | A monad with access to a 'Pipe', 'MasterOrSlaveOk', and 'WriteMode', and throws 'Failure' on read, write, or pipe failure
|
||||||
|
@ -93,10 +82,11 @@ instance MonadTrans Action where
|
||||||
lift = Action . lift . lift . lift . lift
|
lift = Action . lift . lift . lift . lift
|
||||||
|
|
||||||
runAction :: Action m a -> WriteMode -> MasterOrSlaveOk -> Pipe -> m (Either Failure a)
|
runAction :: Action m a -> WriteMode -> MasterOrSlaveOk -> Pipe -> m (Either Failure a)
|
||||||
-- ^ Run action with access to pipe. It starts out assuming it is master (invoke 'slaveOk' inside it to change that) and that writes don't need to be check (invoke 'writeMode' to change that). Return Left Failure if error in execution. Throws IOError if pipe fails during execution.
|
-- ^ Run action with given write mode and read mode (master or slave-ok) against given pipe (TCP connection). Return Left Failure if read/write error or connection failure.
|
||||||
|
-- 'access' calls runAction. Use this directly if you want to use the same connection and not take from the pool again. However, the connection may still be used by other threads at the same time. For instance, the pool will still hand this connection out.
|
||||||
runAction (Action action) w mos = runReaderT (runReaderT (runReaderT (runErrorT action) w) mos)
|
runAction (Action action) w mos = runReaderT (runReaderT (runReaderT (runErrorT action) w) mos)
|
||||||
|
|
||||||
-- | Read or write exception like cursor expired or inserting a duplicate key.
|
-- | A connection failure, or a read or write exception like cursor expired or inserting a duplicate key.
|
||||||
-- Note, unexpected data from the server is not a Failure, rather it is a programming error (you should call 'error' in this case) because the client and server are incompatible and requires a programming change.
|
-- Note, unexpected data from the server is not a Failure, rather it is a programming error (you should call 'error' in this case) because the client and server are incompatible and requires a programming change.
|
||||||
data Failure =
|
data Failure =
|
||||||
ConnectionFailure IOError -- ^ TCP connection ('Pipe') failed. Make work if you try again on the same Mongo 'Connection' which will create a new Pipe.
|
ConnectionFailure IOError -- ^ TCP connection ('Pipe') failed. Make work if you try again on the same Mongo 'Connection' which will create a new Pipe.
|
||||||
|
@ -115,7 +105,7 @@ newtype Database = Database {databaseName :: UString} deriving (Eq, Ord)
|
||||||
|
|
||||||
instance Show Database where show (Database x) = unpack x
|
instance Show Database where show (Database x) = unpack x
|
||||||
|
|
||||||
-- | As 'Access' monad with access to a particular 'Database'
|
-- | 'Access' monad with a particular 'Database' in context
|
||||||
class (Context Database m, Access m) => DbAccess m
|
class (Context Database m, Access m) => DbAccess m
|
||||||
instance (Context Database m, Access m) => DbAccess m
|
instance (Context Database m, Access m) => DbAccess m
|
||||||
|
|
||||||
|
@ -124,7 +114,7 @@ allDatabases :: (Access m) => m [Database]
|
||||||
allDatabases = map (Database . at "name") . at "databases" <$> use (Database "admin") (runCommand1 "listDatabases")
|
allDatabases = map (Database . at "name") . at "databases" <$> use (Database "admin") (runCommand1 "listDatabases")
|
||||||
|
|
||||||
use :: Database -> ReaderT Database m a -> m a
|
use :: Database -> ReaderT Database m a -> m a
|
||||||
-- ^ Run Db action against given database
|
-- ^ Run action against given database
|
||||||
use = flip runReaderT
|
use = flip runReaderT
|
||||||
|
|
||||||
thisDatabase :: (DbAccess m) => m Database
|
thisDatabase :: (DbAccess m) => m Database
|
||||||
|
@ -297,9 +287,9 @@ delete' opts (Select sel col) = do
|
||||||
|
|
||||||
-- ** MasterOrSlaveOk
|
-- ** MasterOrSlaveOk
|
||||||
|
|
||||||
slaveOk :: (Access m) => m a -> m a
|
readMode :: (Access m) => MasterOrSlaveOk -> m a -> m a
|
||||||
-- ^ Ok to execute given action against slave, ie. eventually consistent reads
|
-- ^ Execute action using given read mode. Master = consistent reads, SlaveOk = eventually consistent reads.
|
||||||
slaveOk = push (const SlaveOk)
|
readMode = push . const
|
||||||
|
|
||||||
msOption :: MasterOrSlaveOk -> [P.QueryOption]
|
msOption :: MasterOrSlaveOk -> [P.QueryOption]
|
||||||
msOption Master = []
|
msOption Master = []
|
||||||
|
@ -619,6 +609,19 @@ eval :: (DbAccess m) => Javascript -> m Document
|
||||||
-- ^ Run code on server
|
-- ^ Run code on server
|
||||||
eval code = at "retval" <$> runCommand ["$eval" =: code]
|
eval code = at "retval" <$> runCommand ["$eval" =: code]
|
||||||
|
|
||||||
|
-- * Primitives
|
||||||
|
|
||||||
|
send :: (Context Pipe m, Throw Failure m, MonadIO m) => [Notice] -> m ()
|
||||||
|
-- ^ Send notices as a contiguous batch to server with no reply. Throw 'ConnectionFailure' if pipe fails.
|
||||||
|
send ns = mapErrorIO ConnectionFailure . flip P.send ns =<< context
|
||||||
|
|
||||||
|
call :: (Context Pipe m, Throw Failure m, MonadIO m) => [Notice] -> Request -> m (forall n. (Throw Failure n, MonadIO n) => n Reply)
|
||||||
|
-- ^ Send notices and request as a contiguous batch to server and return reply promise, which will block when invoked until reply arrives. This call will throw 'ConnectionFailure' if pipe fails on send, and promise will throw 'ConnectionFailure' if pipe fails on receive.
|
||||||
|
call ns r = do
|
||||||
|
pipe <- context
|
||||||
|
promise <- mapErrorIO ConnectionFailure (P.call pipe ns r)
|
||||||
|
return (mapErrorIO ConnectionFailure promise)
|
||||||
|
|
||||||
|
|
||||||
{- Authors: Tony Hannan <tony@10gen.com>
|
{- Authors: Tony Hannan <tony@10gen.com>
|
||||||
Copyright 2010 10gen Inc.
|
Copyright 2010 10gen Inc.
|
||||||
|
|
|
@ -10,6 +10,7 @@ import Data.Array.IO
|
||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
import Control.Monad.Error
|
import Control.Monad.Error
|
||||||
import System.Random (randomRIO)
|
import System.Random (randomRIO)
|
||||||
|
import Control.Exception (assert)
|
||||||
|
|
||||||
-- | Creator, destroyer, and checker of resources of type r. Creator may throw error or type e.
|
-- | Creator, destroyer, and checker of resources of type r. Creator may throw error or type e.
|
||||||
data Factory e r = Factory {
|
data Factory e r = Factory {
|
||||||
|
@ -18,8 +19,8 @@ data Factory e r = Factory {
|
||||||
isExpired :: r -> IO Bool }
|
isExpired :: r -> IO Bool }
|
||||||
|
|
||||||
newPool :: Factory e r -> Int -> IO (Pool e r)
|
newPool :: Factory e r -> Int -> IO (Pool e r)
|
||||||
-- ^ Create new pool of initial max size
|
-- ^ Create new pool of initial max size, which must be >= 1
|
||||||
newPool f n = do
|
newPool f n = assert (n > 0) $ do
|
||||||
arr <- newArray (0, n-1) Nothing
|
arr <- newArray (0, n-1) Nothing
|
||||||
var <- newMVar arr
|
var <- newMVar arr
|
||||||
return (Pool f var)
|
return (Pool f var)
|
||||||
|
|
|
@ -23,7 +23,7 @@ homepage: http://github.com/TonyGen/mongoDB-haskell
|
||||||
package-url:
|
package-url:
|
||||||
bug-reports:
|
bug-reports:
|
||||||
synopsis: A driver for MongoDB
|
synopsis: A driver for MongoDB
|
||||||
description: This module lets you connect to MongoDB, do inserts, queries, updates, etc.
|
description: This module lets you connect to MongoDB (www.mongodb.org) and do inserts, queries, updates, etc.
|
||||||
category: Database
|
category: Database
|
||||||
author: Scott Parish <srp@srparish.net> & Tony Hannan <tony@10gen.com>
|
author: Scott Parish <srp@srparish.net> & Tony Hannan <tony@10gen.com>
|
||||||
tested-with:
|
tested-with:
|
||||||
|
|
80
tutorial.md
80
tutorial.md
|
@ -1,15 +1,11 @@
|
||||||
MongoDB Haskell Mini Tutorial
|
MongoDB Haskell Mini Tutorial
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
||||||
__Author:__ Brian Gianforcaro (b.gianfo@gmail.com)
|
__Updated:__ Oct 2010
|
||||||
|
|
||||||
__Updated:__ 2/28/2010
|
|
||||||
|
|
||||||
This is a mini tutorial to get you up and going with the basics
|
This is a mini tutorial to get you up and going with the basics
|
||||||
of the Haskell mongoDB drivers. It is modeled after the
|
of the Haskell mongoDB drivers. You will need the mongoDB driver
|
||||||
[pymongo tutorial](http://api.mongodb.org/python/1.4%2B/tutorial.html).
|
installed as well as mongo itself. Prompts used in this tutorial are:
|
||||||
|
|
||||||
You will need the mongoDB driver installed as well as mongo itself installed.
|
|
||||||
|
|
||||||
$ = command line prompt
|
$ = command line prompt
|
||||||
> = ghci repl prompt
|
> = ghci repl prompt
|
||||||
|
@ -18,22 +14,22 @@ You will need the mongoDB driver installed as well as mongo itself installed.
|
||||||
Installing Haskell Bindings
|
Installing Haskell Bindings
|
||||||
---------------------------
|
---------------------------
|
||||||
|
|
||||||
|
From Hackage using cabal:
|
||||||
|
|
||||||
|
$ cabal install mongoDB
|
||||||
|
|
||||||
From Source:
|
From Source:
|
||||||
|
|
||||||
$ git clone git://github.com/srp/mongoDB.git
|
$ git clone git://github.com/TonyGen/mongoDB-haskell.git mongoDB
|
||||||
$ cd mongoDB
|
$ cd mongoDB
|
||||||
$ runhaskell Setup.hs configure
|
$ runhaskell Setup.hs configure
|
||||||
$ runhaskell Setup.hs build
|
$ runhaskell Setup.hs build
|
||||||
$ runhaskell Setup.hs install
|
$ runhaskell Setup.hs install
|
||||||
|
|
||||||
From Hackage using cabal:
|
|
||||||
|
|
||||||
$ cabal install mongoDB
|
|
||||||
|
|
||||||
Getting Ready
|
Getting Ready
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
Start a MongoDB instance for us to play with:
|
Start a MongoDB instance for us to play with in a separate terminal window:
|
||||||
|
|
||||||
$ mongod --dbpath <directory where Mongo will store the data>
|
$ mongod --dbpath <directory where Mongo will store the data>
|
||||||
|
|
||||||
|
@ -41,7 +37,7 @@ Start up a haskell repl:
|
||||||
|
|
||||||
$ ghci
|
$ ghci
|
||||||
|
|
||||||
Now we'll need to bring in the MongoDB/Bson bindings and set
|
Import the MongoDB driver library, and set
|
||||||
OverloadedStrings so literal strings are converted to UTF-8 automatically.
|
OverloadedStrings so literal strings are converted to UTF-8 automatically.
|
||||||
|
|
||||||
> import Database.MongoDB
|
> import Database.MongoDB
|
||||||
|
@ -49,43 +45,43 @@ OverloadedStrings so literal strings are converted to UTF-8 automatically.
|
||||||
|
|
||||||
Making A Connection
|
Making A Connection
|
||||||
-------------------
|
-------------------
|
||||||
Open up a connection to your mongo server, using the standard port (27017):
|
Create a connection pool for your mongo server, using the standard port (27017):
|
||||||
|
|
||||||
> conn <- connect 1 $ host "127.0.0.1"
|
> pool <- newConnPool 1 $ host "127.0.0.1"
|
||||||
|
|
||||||
or for a non-standard port
|
or for a non-standard port
|
||||||
|
|
||||||
> conn <- connect 1 $ Host "127.0.0.1" (PortNumber 30000)
|
> pool <- newConnPool 1 $ Host "127.0.0.1" (PortNumber 30000)
|
||||||
|
|
||||||
*connect* takes the connection pool size and the host to connect to. It returns
|
*newConnPool* takes the connection pool size and the host to connect to. It returns
|
||||||
a *Connection*, which is really a pool of TCP connections, initially created on demand.
|
a *ConnPool*, which is a potential pool of TCP connections. They are not created until first
|
||||||
So it is not possible to get a connection error until you try to use it.
|
access, so it is not possible to get a connection error here.
|
||||||
|
|
||||||
Plain IO code in this driver never raises an exception unless it invokes third party IO
|
Note, plain IO code in this driver never raises an exception unless it invokes third party IO
|
||||||
code that does. Driver code that may throw an exception says so in its Monad type,
|
code that does. Driver code that may throw an exception says so in its Monad type,
|
||||||
for example, *ErrorT IOError IO a*.
|
for example, *ErrorT IOError IO a*.
|
||||||
|
|
||||||
Access monad
|
Access monad
|
||||||
-------------------
|
-------------------
|
||||||
|
|
||||||
A mongo query/update executes in an *Access* monad, which has access to a
|
A query/update executes in an *Access* monad, which has access to a
|
||||||
*Pipe*, *WriteMode*, and *MasterSlaveOk* mode, and may throw a *Failure*. A Pipe
|
*Pipe*, *WriteMode*, and read-mode (*MasterSlaveOk*), and may throw a *Failure*.
|
||||||
is a single TCP connection, while a Connection is a pool of Pipes.
|
A Pipe is a single TCP connection.
|
||||||
|
|
||||||
To run an Access action (monad), supply WriteMode, MasterOrSlaveOk, Connection,
|
To run an Access action (monad), supply WriteMode, MasterOrSlaveOk, Connection,
|
||||||
and action to *access*. For example, to get a list of all the database on the server:
|
and action to *access*. For example, to get a list of all the database on the server:
|
||||||
|
|
||||||
> access safe Master conn allDatabases
|
> access safe Master conn allDatabases
|
||||||
|
|
||||||
|
*access* return either Left Failure or Right result. Failure means there was a connection failure
|
||||||
|
or a read or write exception like cursor expired or duplicate key insert.
|
||||||
|
|
||||||
Since we are working in ghci, which requires us to start from the
|
Since we are working in ghci, which requires us to start from the
|
||||||
IO monad every time, we'll define a convenient *run* function that takes an
|
IO monad every time, we'll define a convenient *run* function that takes an
|
||||||
action and executes it against our "test" database on the server we
|
action and executes it against our "test" database on the server we
|
||||||
just connected to:
|
just connected to, with typical write and read mode:
|
||||||
|
|
||||||
> let run action = access safe Master conn $ use (Database "test") action
|
> let run action = access safe Master pool $ use (Database "test") action
|
||||||
|
|
||||||
*access* return either Left Failure or Right result. Failure means there was a connection failure,
|
|
||||||
or a read or write exception like cursor expired or duplicate key insert.
|
|
||||||
|
|
||||||
*use* adds a *Database* to the action context, so query/update operations know which
|
*use* adds a *Database* to the action context, so query/update operations know which
|
||||||
database to operate on.
|
database to operate on.
|
||||||
|
@ -96,7 +92,7 @@ Databases and Collections
|
||||||
MongoDB can store multiple databases -- separate namespaces
|
MongoDB can store multiple databases -- separate namespaces
|
||||||
under which collections reside.
|
under which collections reside.
|
||||||
|
|
||||||
You can obtain the list of databases available on a connection:
|
As before, you can obtain the list of databases available on a connection:
|
||||||
|
|
||||||
> run allDatabases
|
> run allDatabases
|
||||||
|
|
||||||
|
@ -104,12 +100,10 @@ The "test" database in context is ignored in this case because *allDatabases*
|
||||||
is not a query on a specific database but on the server as a whole.
|
is not a query on a specific database but on the server as a whole.
|
||||||
|
|
||||||
Databases and collections do not need to be created, just start using
|
Databases and collections do not need to be created, just start using
|
||||||
them and MongoDB will automatically create them for you.
|
them and MongoDB will automatically create them for you. In the below examples
|
||||||
|
we'll be using the database "test" (captured in *run* above) and the colllection "posts".
|
||||||
|
|
||||||
In the below examples we'll be using the database "test" (captured in *run*
|
You can obtain a list of all collections in the "test" database:
|
||||||
above) and the colllection "posts":
|
|
||||||
|
|
||||||
You can obtain a list of collections available in the "test" database:
|
|
||||||
|
|
||||||
> run allCollections
|
> run allCollections
|
||||||
|
|
||||||
|
@ -117,9 +111,8 @@ Documents
|
||||||
---------
|
---------
|
||||||
|
|
||||||
Data in MongoDB is represented (and stored) using JSON-style
|
Data in MongoDB is represented (and stored) using JSON-style
|
||||||
documents. In mongoDB we use the BSON *Document* type to represent
|
documents, called BSON documents. A *Document" is simply a list of *Field*s,
|
||||||
these documents. A document is simply a list of *Field*s, where each field is
|
where each field is a named value. A *Value" is a basic type like Bool, Int, Float, String, Time;
|
||||||
a named value. A value is a basic type like Bool, Int, Float, String, Time;
|
|
||||||
a special BSON value like Binary, Javascript, ObjectId; a (embedded)
|
a special BSON value like Binary, Javascript, ObjectId; a (embedded)
|
||||||
Document; or a list of values. Here's an example document which could
|
Document; or a list of values. Here's an example document which could
|
||||||
represent a blog post:
|
represent a blog post:
|
||||||
|
@ -152,7 +145,7 @@ collections in our database:
|
||||||
|
|
||||||
> run allCollections
|
> run allCollections
|
||||||
|
|
||||||
* Note The system.indexes collection is a special internal collection
|
Note, the system.indexes collection is a special internal collection
|
||||||
that was created automatically.
|
that was created automatically.
|
||||||
|
|
||||||
Getting a single document with findOne
|
Getting a single document with findOne
|
||||||
|
@ -168,8 +161,7 @@ collection:
|
||||||
> run $ findOne (select [] "posts")
|
> run $ findOne (select [] "posts")
|
||||||
|
|
||||||
The result is a document matching the one that we inserted previously.
|
The result is a document matching the one that we inserted previously.
|
||||||
|
Note, the returned document contains the *_id* field, which was automatically
|
||||||
* Note: The returned document contains an *_id*, which was automatically
|
|
||||||
added on insert.
|
added on insert.
|
||||||
|
|
||||||
*findOne* also supports querying on specific elements that the
|
*findOne* also supports querying on specific elements that the
|
||||||
|
@ -214,7 +206,7 @@ Querying for More Than One Document
|
||||||
------------------------------------
|
------------------------------------
|
||||||
|
|
||||||
To get more than a single document as the result of a query we use the
|
To get more than a single document as the result of a query we use the
|
||||||
*find* method. *find* returns a cursor instance, which allows us to
|
*find* method. *find* returns a *Cursor*, which allows us to
|
||||||
iterate over all matching documents. There are several ways in which
|
iterate over all matching documents. There are several ways in which
|
||||||
we can iterate: we can call *next* to get documents one at a time
|
we can iterate: we can call *next* to get documents one at a time
|
||||||
or we can get all the results by applying the cursor to *rest*:
|
or we can get all the results by applying the cursor to *rest*:
|
||||||
|
@ -226,7 +218,7 @@ Of course you can use bind (*>>=*) to combine these into one line:
|
||||||
|
|
||||||
> run $ find (select ["author" =: "Mike"] "posts") >>= rest
|
> run $ find (select ["author" =: "Mike"] "posts") >>= rest
|
||||||
|
|
||||||
* Note: *next* automatically closes the cursor when the last
|
Note, *next* automatically closes the cursor when the last
|
||||||
document has been read out of it. Similarly, *rest* automatically
|
document has been read out of it. Similarly, *rest* automatically
|
||||||
closes the cursor after returning all the results.
|
closes the cursor after returning all the results.
|
||||||
|
|
||||||
|
@ -241,7 +233,7 @@ Or count how many documents match a query:
|
||||||
|
|
||||||
> run $ count (select ["author" =: "Mike"] "posts")
|
> run $ count (select ["author" =: "Mike"] "posts")
|
||||||
|
|
||||||
Range Queries
|
Advanced Queries
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
To do
|
To do
|
||||||
|
|
Loading…
Reference in a new issue