Undo some inessential changes
This commit is contained in:
parent
9f41f36d02
commit
55ca81a474
6 changed files with 25 additions and 27 deletions
|
@ -1,4 +1,4 @@
|
|||
-- | Database administrative functions.
|
||||
-- | Database administrative functions
|
||||
|
||||
{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, RecordWildCards #-}
|
||||
|
||||
|
@ -72,7 +72,7 @@ createCollection :: (MonadIO m) => [CollectionOption] -> Collection -> Action m
|
|||
createCollection opts col = runCommand $ ["create" =: col] ++ map coptElem opts
|
||||
|
||||
renameCollection :: (MonadIO m) => Collection -> Collection -> Action m Document
|
||||
-- ^ Rename first collection to second collection.
|
||||
-- ^ Rename first collection to second collection
|
||||
renameCollection from to = do
|
||||
db <- thisDatabase
|
||||
useDb admin $ runCommand ["renameCollection" =: db <.> from, "to" =: db <.> to, "dropTarget" =: True]
|
||||
|
@ -139,13 +139,13 @@ dropIndex coll idxName = do
|
|||
runCommand ["deleteIndexes" =: coll, "index" =: idxName]
|
||||
|
||||
getIndexes :: MonadIO m => Collection -> Action m [Document]
|
||||
-- ^ Get all indexes on this collection.
|
||||
-- ^ Get all indexes on this collection
|
||||
getIndexes coll = do
|
||||
db <- thisDatabase
|
||||
rest =<< find (select ["ns" =: db <.> coll] "system.indexes")
|
||||
|
||||
dropIndexes :: (MonadIO m) => Collection -> Action m Document
|
||||
-- ^ Drop all indexes on this collection.
|
||||
-- ^ Drop all indexes on this collection
|
||||
dropIndexes coll = do
|
||||
resetIndexCache
|
||||
runCommand ["deleteIndexes" =: coll, "index" =: ("*" :: Text)]
|
||||
|
@ -192,7 +192,7 @@ resetIndexCache = do
|
|||
-- ** User
|
||||
|
||||
allUsers :: MonadIO m => Action m [Document]
|
||||
-- ^ Fetch all users of this database.
|
||||
-- ^ Fetch all users of this database
|
||||
allUsers = map (exclude ["_id"]) `liftM` (rest =<< find
|
||||
(select [] "system.users") {sort = ["user" =: (1 :: Int)], project = ["user" =: (1 :: Int), "readOnly" =: (1 :: Int)]})
|
||||
|
||||
|
@ -301,7 +301,7 @@ dbStats :: (MonadIO m) => Action m Document
|
|||
dbStats = runCommand ["dbstats" =: (1 :: Int)]
|
||||
|
||||
currentOp :: (MonadIO m) => Action m (Maybe Document)
|
||||
-- ^ See currently running operation on the database, if any.
|
||||
-- ^ See currently running operation on the database, if any
|
||||
currentOp = findOne (select [] "$cmd.sys.inprog")
|
||||
|
||||
-- | An operation indentifier.
|
||||
|
|
|
@ -75,8 +75,7 @@ host :: HostName -> Host
|
|||
host hostname = Host hostname defaultPort
|
||||
|
||||
showHostPort :: Host -> String
|
||||
-- ^ Display host as \"host:port\".
|
||||
|
||||
-- ^ Display host as \"host:port\"
|
||||
-- TODO: Distinguish Service port
|
||||
showHostPort (Host hostname (PortNumber port)) = hostname ++ ":" ++ show port
|
||||
#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
|
||||
|
|
|
@ -53,7 +53,7 @@ md5BlockSizeInBytes = 64
|
|||
|
||||
|
||||
data Bucket = Bucket {files :: Text, chunks :: Text}
|
||||
-- ^ Files are stored in /buckets/. You open a bucket with 'openDefaultBucket' or 'openBucket'.
|
||||
-- ^ Files are stored in "buckets". You open a bucket with openDefaultBucket or openBucket
|
||||
|
||||
openDefaultBucket :: (Monad m, MonadIO m) => Action m Bucket
|
||||
-- ^ Open the default 'Bucket' (named "fs")
|
||||
|
|
|
@ -28,7 +28,7 @@ import Network.DNS.Resolver (defaultResolvConf, makeResolvSeed, withResolver)
|
|||
import Network.HTTP.Types.URI (parseQueryText)
|
||||
|
||||
|
||||
-- | Wraps network's 'PortNumber'.
|
||||
-- | Wraps network's 'PortNumber'
|
||||
-- Used to ease compatibility between older and newer network versions.
|
||||
data PortID = PortNumber N.PortNumber
|
||||
#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
|
||||
|
|
|
@ -113,7 +113,7 @@ import Data.Maybe (fromMaybe)
|
|||
-- * Monad
|
||||
|
||||
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'.
|
||||
-- ^ A monad on top of m (which must be a MonadIO) that may access the database and may fail with a DB 'Failure'
|
||||
|
||||
access :: (MonadIO m) => Pipe -> AccessMode -> Database -> Action m a -> m a
|
||||
-- ^ Run action against database on server at other end of pipe. Use access mode for any reads and writes.
|
||||
|
@ -198,12 +198,9 @@ writeMode (ConfirmWrites z) = Confirm z
|
|||
|
||||
-- | Values needed when executing a db operation
|
||||
data MongoContext = MongoContext {
|
||||
-- | operations read/write to this pipelined TCP connection to a MongoDB server
|
||||
mongoPipe :: Pipe,
|
||||
-- | read/write operation will use this access mode
|
||||
mongoAccessMode :: AccessMode,
|
||||
-- | operations query/update this database
|
||||
mongoDatabase :: Database
|
||||
mongoPipe :: Pipe, -- ^ operations read/write to this pipelined TCP connection to a MongoDB server
|
||||
mongoAccessMode :: AccessMode, -- ^ read/write operation will use this access mode
|
||||
mongoDatabase :: Database -- ^ operations query/update this database
|
||||
}
|
||||
|
||||
mongoReadMode :: MongoContext -> ReadMode
|
||||
|
@ -418,7 +415,7 @@ write notice = asks mongoWriteMode >>= \mode -> case mode of
|
|||
-- ** Insert
|
||||
|
||||
insert :: (MonadIO m) => Collection -> Document -> Action m Value
|
||||
-- ^ Insert document into collection and return its @_id@ value, which is created automatically if not supplied
|
||||
-- ^ Insert document into collection and return its \"_id\" value, which is created automatically if not supplied
|
||||
insert col doc = do
|
||||
doc' <- liftIO $ assignId doc
|
||||
res <- insertBlock [] col (0, [doc'])
|
||||
|
@ -427,11 +424,11 @@ insert col doc = do
|
|||
Right r -> return $ head r
|
||||
|
||||
insert_ :: (MonadIO m) => Collection -> Document -> Action m ()
|
||||
-- ^ Same as 'insert' except don't return @_id@
|
||||
-- ^ Same as 'insert' except don't return _id
|
||||
insert_ col doc = insert col doc >> return ()
|
||||
|
||||
insertMany :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
|
||||
-- ^ Insert documents into collection and return their @_id@ values,
|
||||
-- ^ Insert documents into collection and return their \"_id\" values,
|
||||
-- which are created automatically if not supplied.
|
||||
-- If a document fails to be inserted (eg. due to duplicate key)
|
||||
-- then remaining docs are aborted, and @LastError@ is set.
|
||||
|
@ -439,18 +436,18 @@ insertMany :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
|
|||
insertMany = insert' []
|
||||
|
||||
insertMany_ :: (MonadIO m) => Collection -> [Document] -> Action m ()
|
||||
-- ^ Same as 'insertMany' except don't return @_id@ values
|
||||
-- ^ Same as 'insertMany' except don't return _ids
|
||||
insertMany_ col docs = insertMany col docs >> return ()
|
||||
|
||||
insertAll :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
|
||||
-- ^ Insert documents into collection and return their @_id@ values,
|
||||
-- ^ Insert documents into collection and return their \"_id\" values,
|
||||
-- which are created automatically if not supplied. If a document fails
|
||||
-- to be inserted (eg. due to duplicate key) then remaining docs
|
||||
-- are still inserted.
|
||||
insertAll = insert' [KeepGoing]
|
||||
|
||||
insertAll_ :: (MonadIO m) => Collection -> [Document] -> Action m ()
|
||||
-- ^ Same as 'insertAll' except don't return @_id@ values.
|
||||
-- ^ Same as 'insertAll' except don't return _ids
|
||||
insertAll_ col docs = insertAll col docs >> return ()
|
||||
|
||||
insertCommandDocument :: [InsertOption] -> Collection -> [Document] -> Document -> Document
|
||||
|
@ -466,7 +463,7 @@ takeRightsUpToLeft l = E.rights $ takeWhile E.isRight l
|
|||
|
||||
insert' :: (MonadIO m)
|
||||
=> [InsertOption] -> Collection -> [Document] -> Action m [Value]
|
||||
-- ^ Insert documents into collection and return their @_id@ values, which are created automatically if not supplied
|
||||
-- ^ Insert documents into collection and return their \"_id\" values, which are created automatically if not supplied
|
||||
insert' opts col docs = do
|
||||
p <- asks mongoPipe
|
||||
let sd = P.serverData p
|
||||
|
@ -581,7 +578,7 @@ sizeOfDocument :: Document -> Int
|
|||
sizeOfDocument d = fromIntegral $ LBS.length $ runPut $ putDocument d
|
||||
|
||||
assignId :: Document -> IO Document
|
||||
-- ^ Assign a unique value to @_id@ field if missing
|
||||
-- ^ Assign a unique value to _id field if missing
|
||||
assignId doc = if any (("_id" ==) . label) doc
|
||||
then return doc
|
||||
else (\oid -> ("_id" =: oid) : doc) `liftM` genObjectId
|
||||
|
@ -590,7 +587,7 @@ assignId doc = if any (("_id" ==) . label) doc
|
|||
|
||||
save :: (MonadIO m)
|
||||
=> Collection -> Document -> Action m ()
|
||||
-- ^ Save document to collection, meaning insert it if its new (has no @_id@ field) or upsert it if its not new (has @_id@ field)
|
||||
-- ^ Save document to collection, meaning insert it if its new (has no \"_id\" field) or upsert it if its not new (has \"_id\" field)
|
||||
save col doc = case look "_id" doc of
|
||||
Nothing -> insert_ col doc
|
||||
Just i -> upsert (Select ["_id" := i] col) doc
|
||||
|
|
|
@ -21,8 +21,10 @@ import qualified Data.ByteString as ByteString
|
|||
import System.IO
|
||||
|
||||
-- | Abstract transport interface
|
||||
--
|
||||
-- `read` should return `ByteString.null` on EOF
|
||||
data Transport = Transport {
|
||||
read :: Int -> IO ByteString, -- ^ should return `ByteString.null` on @EOF@
|
||||
read :: Int -> IO ByteString,
|
||||
write :: ByteString -> IO (),
|
||||
flush :: IO (),
|
||||
close :: IO ()}
|
||||
|
|
Loading…
Reference in a new issue