From 55ca81a474ad8702cc4adb94fdf999dc21676798 Mon Sep 17 00:00:00 2001 From: Andrea Condoluci Date: Wed, 1 Apr 2020 16:53:37 +0200 Subject: [PATCH] Undo some inessential changes --- Database/MongoDB/Admin.hs | 12 ++++++------ Database/MongoDB/Connection.hs | 3 +-- Database/MongoDB/GridFS.hs | 2 +- Database/MongoDB/Internal/Network.hs | 2 +- Database/MongoDB/Query.hs | 29 +++++++++++++--------------- Database/MongoDB/Transport.hs | 4 +++- 6 files changed, 25 insertions(+), 27 deletions(-) diff --git a/Database/MongoDB/Admin.hs b/Database/MongoDB/Admin.hs index 09186f7..afa5ff6 100644 --- a/Database/MongoDB/Admin.hs +++ b/Database/MongoDB/Admin.hs @@ -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. diff --git a/Database/MongoDB/Connection.hs b/Database/MongoDB/Connection.hs index 5631244..f6bfb6b 100644 --- a/Database/MongoDB/Connection.hs +++ b/Database/MongoDB/Connection.hs @@ -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) diff --git a/Database/MongoDB/GridFS.hs b/Database/MongoDB/GridFS.hs index 0c1ce15..5515ace 100644 --- a/Database/MongoDB/GridFS.hs +++ b/Database/MongoDB/GridFS.hs @@ -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") diff --git a/Database/MongoDB/Internal/Network.hs b/Database/MongoDB/Internal/Network.hs index 74f1659..11190b1 100644 --- a/Database/MongoDB/Internal/Network.hs +++ b/Database/MongoDB/Internal/Network.hs @@ -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) diff --git a/Database/MongoDB/Query.hs b/Database/MongoDB/Query.hs index 80a28d2..e682a19 100644 --- a/Database/MongoDB/Query.hs +++ b/Database/MongoDB/Query.hs @@ -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 diff --git a/Database/MongoDB/Transport.hs b/Database/MongoDB/Transport.hs index e253cee..a7d5d98 100644 --- a/Database/MongoDB/Transport.hs +++ b/Database/MongoDB/Transport.hs @@ -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 ()}