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 #-}
|
{-# 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
|
createCollection opts col = runCommand $ ["create" =: col] ++ map coptElem opts
|
||||||
|
|
||||||
renameCollection :: (MonadIO m) => Collection -> Collection -> Action m Document
|
renameCollection :: (MonadIO m) => Collection -> Collection -> Action m Document
|
||||||
-- ^ Rename first collection to second collection.
|
-- ^ Rename first collection to second collection
|
||||||
renameCollection from to = do
|
renameCollection from to = do
|
||||||
db <- thisDatabase
|
db <- thisDatabase
|
||||||
useDb admin $ runCommand ["renameCollection" =: db <.> from, "to" =: db <.> to, "dropTarget" =: True]
|
useDb admin $ runCommand ["renameCollection" =: db <.> from, "to" =: db <.> to, "dropTarget" =: True]
|
||||||
|
@ -139,13 +139,13 @@ dropIndex coll idxName = do
|
||||||
runCommand ["deleteIndexes" =: coll, "index" =: idxName]
|
runCommand ["deleteIndexes" =: coll, "index" =: idxName]
|
||||||
|
|
||||||
getIndexes :: MonadIO m => Collection -> Action m [Document]
|
getIndexes :: MonadIO m => Collection -> Action m [Document]
|
||||||
-- ^ Get all indexes on this collection.
|
-- ^ Get all indexes on this collection
|
||||||
getIndexes coll = do
|
getIndexes coll = do
|
||||||
db <- thisDatabase
|
db <- thisDatabase
|
||||||
rest =<< find (select ["ns" =: db <.> coll] "system.indexes")
|
rest =<< find (select ["ns" =: db <.> coll] "system.indexes")
|
||||||
|
|
||||||
dropIndexes :: (MonadIO m) => Collection -> Action m Document
|
dropIndexes :: (MonadIO m) => Collection -> Action m Document
|
||||||
-- ^ Drop all indexes on this collection.
|
-- ^ Drop all indexes on this collection
|
||||||
dropIndexes coll = do
|
dropIndexes coll = do
|
||||||
resetIndexCache
|
resetIndexCache
|
||||||
runCommand ["deleteIndexes" =: coll, "index" =: ("*" :: Text)]
|
runCommand ["deleteIndexes" =: coll, "index" =: ("*" :: Text)]
|
||||||
|
@ -192,7 +192,7 @@ resetIndexCache = do
|
||||||
-- ** User
|
-- ** User
|
||||||
|
|
||||||
allUsers :: MonadIO m => Action m [Document]
|
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
|
allUsers = map (exclude ["_id"]) `liftM` (rest =<< find
|
||||||
(select [] "system.users") {sort = ["user" =: (1 :: Int)], project = ["user" =: (1 :: Int), "readOnly" =: (1 :: Int)]})
|
(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)]
|
dbStats = runCommand ["dbstats" =: (1 :: Int)]
|
||||||
|
|
||||||
currentOp :: (MonadIO m) => Action m (Maybe Document)
|
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")
|
currentOp = findOne (select [] "$cmd.sys.inprog")
|
||||||
|
|
||||||
-- | An operation indentifier.
|
-- | An operation indentifier.
|
||||||
|
|
|
@ -75,8 +75,7 @@ host :: HostName -> Host
|
||||||
host hostname = Host hostname defaultPort
|
host hostname = Host hostname defaultPort
|
||||||
|
|
||||||
showHostPort :: Host -> String
|
showHostPort :: Host -> String
|
||||||
-- ^ Display host as \"host:port\".
|
-- ^ Display host as \"host:port\"
|
||||||
|
|
||||||
-- TODO: Distinguish Service port
|
-- TODO: Distinguish Service port
|
||||||
showHostPort (Host hostname (PortNumber port)) = hostname ++ ":" ++ show port
|
showHostPort (Host hostname (PortNumber port)) = hostname ++ ":" ++ show port
|
||||||
#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
|
#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
|
||||||
|
|
|
@ -53,7 +53,7 @@ md5BlockSizeInBytes = 64
|
||||||
|
|
||||||
|
|
||||||
data Bucket = Bucket {files :: Text, chunks :: Text}
|
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
|
openDefaultBucket :: (Monad m, MonadIO m) => Action m Bucket
|
||||||
-- ^ Open the default 'Bucket' (named "fs")
|
-- ^ Open the default 'Bucket' (named "fs")
|
||||||
|
|
|
@ -28,7 +28,7 @@ import Network.DNS.Resolver (defaultResolvConf, makeResolvSeed, withResolver)
|
||||||
import Network.HTTP.Types.URI (parseQueryText)
|
import Network.HTTP.Types.URI (parseQueryText)
|
||||||
|
|
||||||
|
|
||||||
-- | Wraps network's 'PortNumber'.
|
-- | Wraps network's 'PortNumber'
|
||||||
-- Used to ease compatibility between older and newer network versions.
|
-- Used to ease compatibility between older and newer network versions.
|
||||||
data PortID = PortNumber N.PortNumber
|
data PortID = PortNumber N.PortNumber
|
||||||
#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
|
#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)
|
||||||
|
|
|
@ -113,7 +113,7 @@ import Data.Maybe (fromMaybe)
|
||||||
-- * Monad
|
-- * Monad
|
||||||
|
|
||||||
type Action = ReaderT MongoContext
|
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
|
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.
|
-- ^ 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
|
-- | Values needed when executing a db operation
|
||||||
data MongoContext = MongoContext {
|
data MongoContext = MongoContext {
|
||||||
-- | operations read/write to this pipelined TCP connection to a MongoDB server
|
mongoPipe :: Pipe, -- ^ operations read/write to this pipelined TCP connection to a MongoDB server
|
||||||
mongoPipe :: Pipe,
|
mongoAccessMode :: AccessMode, -- ^ read/write operation will use this access mode
|
||||||
-- | read/write operation will use this access mode
|
mongoDatabase :: Database -- ^ operations query/update this database
|
||||||
mongoAccessMode :: AccessMode,
|
|
||||||
-- | operations query/update this database
|
|
||||||
mongoDatabase :: Database
|
|
||||||
}
|
}
|
||||||
|
|
||||||
mongoReadMode :: MongoContext -> ReadMode
|
mongoReadMode :: MongoContext -> ReadMode
|
||||||
|
@ -418,7 +415,7 @@ write notice = asks mongoWriteMode >>= \mode -> case mode of
|
||||||
-- ** Insert
|
-- ** Insert
|
||||||
|
|
||||||
insert :: (MonadIO m) => Collection -> Document -> Action m Value
|
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
|
insert col doc = do
|
||||||
doc' <- liftIO $ assignId doc
|
doc' <- liftIO $ assignId doc
|
||||||
res <- insertBlock [] col (0, [doc'])
|
res <- insertBlock [] col (0, [doc'])
|
||||||
|
@ -427,11 +424,11 @@ insert col doc = do
|
||||||
Right r -> return $ head r
|
Right r -> return $ head r
|
||||||
|
|
||||||
insert_ :: (MonadIO m) => Collection -> Document -> Action m ()
|
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 ()
|
insert_ col doc = insert col doc >> return ()
|
||||||
|
|
||||||
insertMany :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
|
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.
|
-- which are created automatically if not supplied.
|
||||||
-- If a document fails to be inserted (eg. due to duplicate key)
|
-- If a document fails to be inserted (eg. due to duplicate key)
|
||||||
-- then remaining docs are aborted, and @LastError@ is set.
|
-- then remaining docs are aborted, and @LastError@ is set.
|
||||||
|
@ -439,18 +436,18 @@ insertMany :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
|
||||||
insertMany = insert' []
|
insertMany = insert' []
|
||||||
|
|
||||||
insertMany_ :: (MonadIO m) => Collection -> [Document] -> Action m ()
|
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 ()
|
insertMany_ col docs = insertMany col docs >> return ()
|
||||||
|
|
||||||
insertAll :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
|
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
|
-- which are created automatically if not supplied. If a document fails
|
||||||
-- to be inserted (eg. due to duplicate key) then remaining docs
|
-- to be inserted (eg. due to duplicate key) then remaining docs
|
||||||
-- are still inserted.
|
-- are still inserted.
|
||||||
insertAll = insert' [KeepGoing]
|
insertAll = insert' [KeepGoing]
|
||||||
|
|
||||||
insertAll_ :: (MonadIO m) => Collection -> [Document] -> Action m ()
|
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 ()
|
insertAll_ col docs = insertAll col docs >> return ()
|
||||||
|
|
||||||
insertCommandDocument :: [InsertOption] -> Collection -> [Document] -> Document -> Document
|
insertCommandDocument :: [InsertOption] -> Collection -> [Document] -> Document -> Document
|
||||||
|
@ -466,7 +463,7 @@ takeRightsUpToLeft l = E.rights $ takeWhile E.isRight l
|
||||||
|
|
||||||
insert' :: (MonadIO m)
|
insert' :: (MonadIO m)
|
||||||
=> [InsertOption] -> Collection -> [Document] -> Action m [Value]
|
=> [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
|
insert' opts col docs = do
|
||||||
p <- asks mongoPipe
|
p <- asks mongoPipe
|
||||||
let sd = P.serverData p
|
let sd = P.serverData p
|
||||||
|
@ -581,7 +578,7 @@ sizeOfDocument :: Document -> Int
|
||||||
sizeOfDocument d = fromIntegral $ LBS.length $ runPut $ putDocument d
|
sizeOfDocument d = fromIntegral $ LBS.length $ runPut $ putDocument d
|
||||||
|
|
||||||
assignId :: Document -> IO Document
|
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
|
assignId doc = if any (("_id" ==) . label) doc
|
||||||
then return doc
|
then return doc
|
||||||
else (\oid -> ("_id" =: oid) : doc) `liftM` genObjectId
|
else (\oid -> ("_id" =: oid) : doc) `liftM` genObjectId
|
||||||
|
@ -590,7 +587,7 @@ assignId doc = if any (("_id" ==) . label) doc
|
||||||
|
|
||||||
save :: (MonadIO m)
|
save :: (MonadIO m)
|
||||||
=> Collection -> Document -> Action 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
|
save col doc = case look "_id" doc of
|
||||||
Nothing -> insert_ col doc
|
Nothing -> insert_ col doc
|
||||||
Just i -> upsert (Select ["_id" := i] col) doc
|
Just i -> upsert (Select ["_id" := i] col) doc
|
||||||
|
|
|
@ -21,8 +21,10 @@ import qualified Data.ByteString as ByteString
|
||||||
import System.IO
|
import System.IO
|
||||||
|
|
||||||
-- | Abstract transport interface
|
-- | Abstract transport interface
|
||||||
|
--
|
||||||
|
-- `read` should return `ByteString.null` on EOF
|
||||||
data Transport = Transport {
|
data Transport = Transport {
|
||||||
read :: Int -> IO ByteString, -- ^ should return `ByteString.null` on @EOF@
|
read :: Int -> IO ByteString,
|
||||||
write :: ByteString -> IO (),
|
write :: ByteString -> IO (),
|
||||||
flush :: IO (),
|
flush :: IO (),
|
||||||
close :: IO ()}
|
close :: IO ()}
|
||||||
|
|
Loading…
Reference in a new issue