Remove MonadIO'
This commit is contained in:
Michael Snoyman
parent
3a97c2cbdb
commit
a43c94f977
3 changed files with 65 additions and 70 deletions
|
|
@ -30,7 +30,7 @@ module Database.MongoDB.Admin (
|
|||
import Prelude hiding (lookup)
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Monad (forever, unless)
|
||||
import Control.Monad (forever, unless, liftM)
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Data.Set (Set)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
|
@ -47,7 +47,7 @@ import qualified Data.Text as T
|
|||
|
||||
import Database.MongoDB.Connection (Host, showHostPort)
|
||||
import Database.MongoDB.Internal.Protocol (pwHash, pwKey)
|
||||
import Database.MongoDB.Internal.Util (MonadIO', (<.>), true1)
|
||||
import Database.MongoDB.Internal.Util ((<.>), true1)
|
||||
import Database.MongoDB.Query (Action, Database, Collection, Username, Password,
|
||||
Order, Query(..), accessMode, master, runCommand,
|
||||
useDb, thisDatabase, rest, select, find, findOne,
|
||||
|
|
@ -64,17 +64,17 @@ coptElem Capped = "capped" =: True
|
|||
coptElem (MaxByteSize n) = "size" =: n
|
||||
coptElem (MaxItems n) = "max" =: n
|
||||
|
||||
createCollection :: (MonadIO' m) => [CollectionOption] -> Collection -> Action m Document
|
||||
createCollection :: (MonadIO m) => [CollectionOption] -> Collection -> Action m Document
|
||||
-- ^ Create collection with given options. You only need to call this to set options, otherwise a collection is created automatically on first use with no options.
|
||||
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
|
||||
renameCollection from to = do
|
||||
db <- thisDatabase
|
||||
useDb admin $ runCommand ["renameCollection" =: db <.> from, "to" =: db <.> to, "dropTarget" =: True]
|
||||
|
||||
dropCollection :: (MonadIO' m) => Collection -> Action m Bool
|
||||
dropCollection :: (MonadIO m) => Collection -> Action m Bool
|
||||
-- ^ Delete the given collection! Return True if collection existed (and was deleted); return False if collection did not exist (and no action).
|
||||
dropCollection coll = do
|
||||
resetIndexCache
|
||||
|
|
@ -83,7 +83,7 @@ dropCollection coll = do
|
|||
if at "errmsg" r == ("ns not found" :: Text) then return False else
|
||||
fail $ "dropCollection failed: " ++ show r
|
||||
|
||||
validateCollection :: (MonadIO' m) => Collection -> Action m Document
|
||||
validateCollection :: (MonadIO m) => Collection -> Action m Document
|
||||
-- ^ This operation takes a while
|
||||
validateCollection coll = runCommand ["validate" =: coll]
|
||||
|
||||
|
|
@ -115,7 +115,7 @@ genName :: Order -> IndexName
|
|||
genName keys = T.intercalate "_" (map f keys) where
|
||||
f (k := v) = k `T.append` "_" `T.append` T.pack (show v)
|
||||
|
||||
ensureIndex :: (MonadIO' m) => Index -> Action m ()
|
||||
ensureIndex :: (MonadIO m) => Index -> Action m ()
|
||||
-- ^ Create index if we did not already create one. May be called repeatedly with practically no performance hit, because we remember if we already called this for the same index (although this memory gets wiped out every 15 minutes, in case another client drops the index and we want to create it again).
|
||||
ensureIndex idx = let k = (iColl idx, iName idx) in do
|
||||
icache <- fetchIndexCache
|
||||
|
|
@ -124,11 +124,11 @@ ensureIndex idx = let k = (iColl idx, iName idx) in do
|
|||
accessMode master (createIndex idx)
|
||||
liftIO $ writeIORef icache (Set.insert k set)
|
||||
|
||||
createIndex :: (MonadIO' m) => Index -> Action m ()
|
||||
createIndex :: (MonadIO m) => Index -> Action m ()
|
||||
-- ^ Create index on the server. This call goes to the server every time.
|
||||
createIndex idx = insert_ "system.indexes" . idxDocument idx =<< thisDatabase
|
||||
|
||||
dropIndex :: (MonadIO' m) => Collection -> IndexName -> Action m Document
|
||||
dropIndex :: (MonadIO m) => Collection -> IndexName -> Action m Document
|
||||
-- ^ Remove the index
|
||||
dropIndex coll idxName = do
|
||||
resetIndexCache
|
||||
|
|
@ -140,7 +140,7 @@ getIndexes coll = do
|
|||
db <- thisDatabase
|
||||
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
|
||||
dropIndexes coll = do
|
||||
resetIndexCache
|
||||
|
|
@ -192,7 +192,7 @@ allUsers :: (MonadIO m, MonadBaseControl IO m, Functor m) => Action m [Document]
|
|||
allUsers = map (exclude ["_id"]) <$> (rest =<< find
|
||||
(select [] "system.users") {sort = ["user" =: (1 :: Int)], project = ["user" =: (1 :: Int), "readOnly" =: (1 :: Int)]})
|
||||
|
||||
addUser :: (MonadIO' m) => Bool -> Username -> Password -> Action m ()
|
||||
addUser :: (MonadIO m) => Bool -> Username -> Password -> Action m ()
|
||||
-- ^ Add user with password with read-only access if bool is True or read-write access if bool is False
|
||||
addUser readOnly user pass = do
|
||||
mu <- findOne (select ["user" =: user] "system.users")
|
||||
|
|
@ -208,76 +208,76 @@ admin :: Database
|
|||
-- ^ \"admin\" database
|
||||
admin = "admin"
|
||||
|
||||
cloneDatabase :: (MonadIO' m) => Database -> Host -> Action m Document
|
||||
cloneDatabase :: (MonadIO m) => Database -> Host -> Action m Document
|
||||
-- ^ Copy database from given host to the server I am connected to. Fails and returns @"ok" = 0@ if we don't have permission to read from given server (use copyDatabase in this case).
|
||||
cloneDatabase db fromHost = useDb db $ runCommand ["clone" =: showHostPort fromHost]
|
||||
|
||||
copyDatabase :: (MonadIO' m) => Database -> Host -> Maybe (Username, Password) -> Database -> Action m Document
|
||||
copyDatabase :: (MonadIO m) => Database -> Host -> Maybe (Username, Password) -> Database -> Action m Document
|
||||
-- ^ Copy database from given host to the server I am connected to. If username & password is supplied use them to read from given host.
|
||||
copyDatabase fromDb fromHost mup toDb = do
|
||||
let c = ["copydb" =: (1 :: Int), "fromhost" =: showHostPort fromHost, "fromdb" =: fromDb, "todb" =: toDb]
|
||||
useDb admin $ case mup of
|
||||
Nothing -> runCommand c
|
||||
Just (usr, pss) -> do
|
||||
n <- at "nonce" <$> runCommand ["copydbgetnonce" =: (1 :: Int), "fromhost" =: showHostPort fromHost]
|
||||
n <- at "nonce" `liftM` runCommand ["copydbgetnonce" =: (1 :: Int), "fromhost" =: showHostPort fromHost]
|
||||
runCommand $ c ++ ["username" =: usr, "nonce" =: n, "key" =: pwKey n usr pss]
|
||||
|
||||
dropDatabase :: (MonadIO' m) => Database -> Action m Document
|
||||
dropDatabase :: (MonadIO m) => Database -> Action m Document
|
||||
-- ^ Delete the given database!
|
||||
dropDatabase db = useDb db $ runCommand ["dropDatabase" =: (1 :: Int)]
|
||||
|
||||
repairDatabase :: (MonadIO' m) => Database -> Action m Document
|
||||
repairDatabase :: (MonadIO m) => Database -> Action m Document
|
||||
-- ^ Attempt to fix any corrupt records. This operation takes a while.
|
||||
repairDatabase db = useDb db $ runCommand ["repairDatabase" =: (1 :: Int)]
|
||||
|
||||
-- ** Server
|
||||
|
||||
serverBuildInfo :: (MonadIO' m) => Action m Document
|
||||
serverBuildInfo :: (MonadIO m) => Action m Document
|
||||
serverBuildInfo = useDb admin $ runCommand ["buildinfo" =: (1 :: Int)]
|
||||
|
||||
serverVersion :: (MonadIO' m) => Action m Text
|
||||
serverVersion = at "version" <$> serverBuildInfo
|
||||
serverVersion :: (MonadIO m) => Action m Text
|
||||
serverVersion = at "version" `liftM` serverBuildInfo
|
||||
|
||||
-- * Diagnostics
|
||||
|
||||
-- ** Collection
|
||||
|
||||
collectionStats :: (MonadIO' m) => Collection -> Action m Document
|
||||
collectionStats :: (MonadIO m) => Collection -> Action m Document
|
||||
collectionStats coll = runCommand ["collstats" =: coll]
|
||||
|
||||
dataSize :: (MonadIO' m) => Collection -> Action m Int
|
||||
dataSize c = at "size" <$> collectionStats c
|
||||
dataSize :: (MonadIO m) => Collection -> Action m Int
|
||||
dataSize c = at "size" `liftM` collectionStats c
|
||||
|
||||
storageSize :: (MonadIO' m) => Collection -> Action m Int
|
||||
storageSize c = at "storageSize" <$> collectionStats c
|
||||
storageSize :: (MonadIO m) => Collection -> Action m Int
|
||||
storageSize c = at "storageSize" `liftM` collectionStats c
|
||||
|
||||
totalIndexSize :: (MonadIO' m) => Collection -> Action m Int
|
||||
totalIndexSize c = at "totalIndexSize" <$> collectionStats c
|
||||
totalIndexSize :: (MonadIO m) => Collection -> Action m Int
|
||||
totalIndexSize c = at "totalIndexSize" `liftM` collectionStats c
|
||||
|
||||
totalSize :: (MonadIO m, MonadBaseControl IO m, MonadIO' m) => Collection -> Action m Int
|
||||
totalSize :: (MonadIO m, MonadBaseControl IO m) => Collection -> Action m Int
|
||||
totalSize coll = do
|
||||
x <- storageSize coll
|
||||
xs <- mapM isize =<< getIndexes coll
|
||||
return (foldl (+) x xs)
|
||||
where
|
||||
isize idx = at "storageSize" <$> collectionStats (coll `T.append` ".$" `T.append` at "name" idx)
|
||||
isize idx = at "storageSize" `liftM` collectionStats (coll `T.append` ".$" `T.append` at "name" idx)
|
||||
|
||||
-- ** Profiling
|
||||
|
||||
data ProfilingLevel = Off | Slow | All deriving (Show, Enum, Eq)
|
||||
|
||||
getProfilingLevel :: (MonadIO' m) => Action m ProfilingLevel
|
||||
getProfilingLevel = toEnum . at "was" <$> runCommand ["profile" =: (-1 :: Int)]
|
||||
getProfilingLevel :: (MonadIO m) => Action m ProfilingLevel
|
||||
getProfilingLevel = (toEnum . at "was") `liftM` runCommand ["profile" =: (-1 :: Int)]
|
||||
|
||||
type MilliSec = Int
|
||||
|
||||
setProfilingLevel :: (MonadIO' m) => ProfilingLevel -> Maybe MilliSec -> Action m ()
|
||||
setProfilingLevel :: (MonadIO m) => ProfilingLevel -> Maybe MilliSec -> Action m ()
|
||||
setProfilingLevel p mSlowMs =
|
||||
runCommand (["profile" =: fromEnum p] ++ ("slowms" =? mSlowMs)) >> return ()
|
||||
|
||||
-- ** Database
|
||||
|
||||
dbStats :: (MonadIO' m) => Action m Document
|
||||
dbStats :: (MonadIO m) => Action m Document
|
||||
dbStats = runCommand ["dbstats" =: (1 :: Int)]
|
||||
|
||||
currentOp :: (MonadIO m) => Action m (Maybe Document)
|
||||
|
|
@ -291,7 +291,7 @@ killOp op = findOne (select ["op" =: op] "$cmd.sys.killop")
|
|||
|
||||
-- ** Server
|
||||
|
||||
serverStatus :: (MonadIO' m) => Action m Document
|
||||
serverStatus :: (MonadIO m) => Action m Document
|
||||
serverStatus = useDb admin $ runCommand ["serverStatus" =: (1 :: Int)]
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Database.MongoDB.Internal.Util where
|
||||
|
||||
import Control.Applicative (Applicative(..), (<$>))
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Exception (assert, handle, throwIO, Exception)
|
||||
import Control.Monad (liftM, liftM2)
|
||||
import Data.Bits (Bits, (.|.))
|
||||
|
|
@ -35,10 +35,6 @@ deriving instance Eq PortID
|
|||
#endif
|
||||
deriving instance Ord PortID
|
||||
|
||||
-- | MonadIO with extra Applicative and Functor superclasses
|
||||
class (MonadIO m, Applicative m, Functor m) => MonadIO' m
|
||||
instance (MonadIO m, Applicative m, Functor m) => MonadIO' m
|
||||
|
||||
-- | A monadic sort implementation derived from the non-monadic one in ghc's Prelude
|
||||
mergesortM :: Monad m => (a -> a -> m Ordering) -> [a] -> m [a]
|
||||
mergesortM cmp = mergesortM' cmp . map wrap
|
||||
|
|
|
|||
|
|
@ -44,9 +44,8 @@ module Database.MongoDB.Query (
|
|||
) where
|
||||
|
||||
import Prelude hiding (lookup)
|
||||
import Control.Applicative (Applicative, (<$>))
|
||||
import Control.Exception (Exception, throwIO)
|
||||
import Control.Monad (unless, replicateM)
|
||||
import Control.Monad (unless, replicateM, liftM)
|
||||
import Data.Int (Int32)
|
||||
import Data.Maybe (listToMaybe, catMaybes)
|
||||
import Data.Word (Word32)
|
||||
|
|
@ -80,7 +79,7 @@ import Database.MongoDB.Internal.Protocol (Reply(..), QueryOption(..),
|
|||
qFullCollection, qBatchSize,
|
||||
qSelector, qProjector),
|
||||
pwKey)
|
||||
import Database.MongoDB.Internal.Util (MonadIO', loop, liftIOE, true1, (<.>))
|
||||
import Database.MongoDB.Internal.Util (loop, liftIOE, true1, (<.>))
|
||||
import qualified Database.MongoDB.Internal.Protocol as P
|
||||
|
||||
#if !MIN_VERSION_base(4,6,0)
|
||||
|
|
@ -186,9 +185,9 @@ liftDB m = do
|
|||
|
||||
type Database = Text
|
||||
|
||||
allDatabases :: (MonadIO' m) => Action m [Database]
|
||||
allDatabases :: (MonadIO m) => Action m [Database]
|
||||
-- ^ List all databases residing on server
|
||||
allDatabases = map (at "name") . at "databases" <$> useDb "admin" (runCommand1 "listDatabases")
|
||||
allDatabases = (map (at "name") . at "databases") `liftM` useDb "admin" (runCommand1 "listDatabases")
|
||||
|
||||
thisDatabase :: (Monad m) => Action m Database
|
||||
-- ^ Current database in use
|
||||
|
|
@ -200,18 +199,18 @@ useDb db act = local (\ctx -> ctx {myDatabase = db}) act
|
|||
|
||||
-- * Authentication
|
||||
|
||||
auth :: (MonadIO' m) => Username -> Password -> Action m Bool
|
||||
auth :: (MonadIO m) => Username -> Password -> Action m Bool
|
||||
-- ^ Authenticate with the current database (if server is running in secure mode). Return whether authentication was successful or not. Reauthentication is required for every new pipe.
|
||||
auth usr pss = do
|
||||
n <- at "nonce" <$> runCommand ["getnonce" =: (1 :: Int)]
|
||||
true1 "ok" <$> runCommand ["authenticate" =: (1 :: Int), "user" =: usr, "nonce" =: n, "key" =: pwKey n usr pss]
|
||||
n <- at "nonce" `liftM` runCommand ["getnonce" =: (1 :: Int)]
|
||||
true1 "ok" `liftM` runCommand ["authenticate" =: (1 :: Int), "user" =: usr, "nonce" =: n, "key" =: pwKey n usr pss]
|
||||
|
||||
-- * Collection
|
||||
|
||||
type Collection = Text
|
||||
-- ^ Collection name (not prefixed with database)
|
||||
|
||||
allCollections :: (MonadIO m, MonadBaseControl IO m, Functor m) => Action m [Collection]
|
||||
allCollections :: (MonadIO m, MonadBaseControl IO m) => Action m [Collection]
|
||||
-- ^ List all collections in this database
|
||||
allCollections = do
|
||||
db <- thisDatabase
|
||||
|
|
@ -263,11 +262,11 @@ write notice = asks myWriteMode >>= \mode -> case mode of
|
|||
|
||||
-- ** 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 col doc = head <$> insertMany col [doc]
|
||||
insert col doc = head `liftM` insertMany col [doc]
|
||||
|
||||
insert_ :: (MonadIO' m) => Collection -> Document -> Action m ()
|
||||
insert_ :: (MonadIO m) => Collection -> Document -> Action m ()
|
||||
-- ^ Same as 'insert' except don't return _id
|
||||
insert_ col doc = insert col doc >> return ()
|
||||
|
||||
|
|
@ -299,11 +298,11 @@ assignId :: Document -> IO Document
|
|||
-- ^ Assign a unique value to _id field if missing
|
||||
assignId doc = if any (("_id" ==) . label) doc
|
||||
then return doc
|
||||
else (\oid -> ("_id" =: oid) : doc) <$> genObjectId
|
||||
else (\oid -> ("_id" =: oid) : doc) `liftM` genObjectId
|
||||
|
||||
-- ** Update
|
||||
|
||||
save :: (MonadIO' m) => Collection -> Document -> Action m ()
|
||||
save :: (MonadIO m) => Collection -> Document -> Action m ()
|
||||
-- ^ Save document to collection, meaning insert it if its new (has no \"_id\" field) or update it if its not new (has \"_id\" field)
|
||||
save col doc = case look "_id" doc of
|
||||
Nothing -> insert_ col doc
|
||||
|
|
@ -408,7 +407,7 @@ fetch q = findOne q >>= maybe (liftIO $ throwIO $ DocNotFound $ selection q) ret
|
|||
-- | runs the findAndModify command.
|
||||
-- Returns a single updated document (new option is set to true).
|
||||
-- Currently this API does not allow setting the remove option
|
||||
findAndModify :: (Applicative m, MonadIO m)
|
||||
findAndModify :: MonadIO m
|
||||
=> Query
|
||||
-> Document -- ^ updates
|
||||
-> Action m (Either String Document)
|
||||
|
|
@ -450,15 +449,15 @@ explain q = do -- same as findOne but with explain set to true
|
|||
Batch _ _ docs <- fulfill =<< request [] =<< queryRequest True q {limit = 1}
|
||||
return $ if null docs then error ("no explain: " ++ show q) else head docs
|
||||
|
||||
count :: (MonadIO' m) => Query -> Action m Int
|
||||
count :: (MonadIO m) => Query -> Action m Int
|
||||
-- ^ Fetch number of documents satisfying query (including effect of skip and/or limit if present)
|
||||
count Query{selection = Select sel col, skip, limit} = at "n" <$> runCommand
|
||||
count Query{selection = Select sel col, skip, limit} = at "n" `liftM` runCommand
|
||||
(["count" =: col, "query" =: sel, "skip" =: (fromIntegral skip :: Int32)]
|
||||
++ ("limit" =? if limit == 0 then Nothing else Just (fromIntegral limit :: Int32)))
|
||||
|
||||
distinct :: (MonadIO' m) => Label -> Selection -> Action m [Value]
|
||||
distinct :: (MonadIO m) => Label -> Selection -> Action m [Value]
|
||||
-- ^ Fetch distinct values of field in selected documents
|
||||
distinct k (Select sel col) = at "values" <$> runCommand ["distinct" =: col, "key" =: k, "query" =: sel]
|
||||
distinct k (Select sel col) = at "values" `liftM` runCommand ["distinct" =: col, "key" =: k, "query" =: sel]
|
||||
|
||||
queryRequest :: (Monad m) => Bool -> Query -> Action m (Request, Limit)
|
||||
-- ^ Translate Query to Protocol.Query. If first arg is true then add special $explain attribute.
|
||||
|
|
@ -570,11 +569,11 @@ next (Cursor fcol batchSize var) = modifyMVar var nextState where
|
|||
then return (return $ Batch 0 0 [], Nothing) -- finished
|
||||
else fmap (,Nothing) $ nextBatch' fcol batchSize limit cid
|
||||
|
||||
nextN :: (MonadIO m, MonadBaseControl IO m, Functor m) => Int -> Cursor -> Action m [Document]
|
||||
nextN :: (MonadIO m, MonadBaseControl IO m) => Int -> Cursor -> Action m [Document]
|
||||
-- ^ Return next N documents or less if end is reached
|
||||
nextN n c = catMaybes <$> replicateM n (next c)
|
||||
nextN n c = catMaybes `liftM` replicateM n (next c)
|
||||
|
||||
rest :: (MonadIO m, MonadBaseControl IO m, Functor m) => Cursor -> Action m [Document]
|
||||
rest :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m [Document]
|
||||
-- ^ Return remaining documents in query result
|
||||
rest c = loop (next c)
|
||||
|
||||
|
|
@ -594,7 +593,7 @@ isCursorClosed (Cursor _ _ var) = do
|
|||
type Pipeline = [Document]
|
||||
-- ^ The Aggregate Pipeline
|
||||
|
||||
aggregate :: MonadIO' m => Collection -> Pipeline -> Action m [Document]
|
||||
aggregate :: MonadIO m => Collection -> Pipeline -> Action m [Document]
|
||||
-- ^ Runs an aggregate and unpacks the result. See <http://docs.mongodb.org/manual/core/aggregation/> for details.
|
||||
aggregate aColl agg = do
|
||||
response <- runCommand ["aggregate" =: aColl, "pipeline" =: agg]
|
||||
|
|
@ -627,9 +626,9 @@ groupDocument Group{..} =
|
|||
"initial" =: gInitial,
|
||||
"cond" =: gCond ]
|
||||
|
||||
group :: (MonadIO' m) => Group -> Action m [Document]
|
||||
group :: (MonadIO m) => Group -> Action m [Document]
|
||||
-- ^ Execute group query and return resulting aggregate value for each distinct key
|
||||
group g = at "retval" <$> runCommand ["group" =: groupDocument g]
|
||||
group g = at "retval" `liftM` runCommand ["group" =: groupDocument g]
|
||||
|
||||
-- ** MapReduce
|
||||
|
||||
|
|
@ -699,7 +698,7 @@ mapReduce :: Collection -> MapFun -> ReduceFun -> MapReduce
|
|||
-- ^ MapReduce on collection with given map and reduce functions. Remaining attributes are set to their defaults, which are stated in their comments.
|
||||
mapReduce col map' red = MapReduce col map' red [] [] 0 Inline Nothing [] False
|
||||
|
||||
runMR :: (MonadIO m, MonadBaseControl IO m, Applicative m) => MapReduce -> Action m Cursor
|
||||
runMR :: (MonadIO m, MonadBaseControl IO m) => MapReduce -> Action m Cursor
|
||||
-- ^ Run MapReduce and return cursor of results. Error if map/reduce fails (because of bad Javascript)
|
||||
runMR mr = do
|
||||
res <- runMR' mr
|
||||
|
|
@ -709,7 +708,7 @@ runMR mr = do
|
|||
Just x -> error $ "unexpected map-reduce result field: " ++ show x
|
||||
Nothing -> newCursor "" "" 0 $ return $ Batch 0 0 (at "results" res)
|
||||
|
||||
runMR' :: (MonadIO' m) => MapReduce -> Action m MRResult
|
||||
runMR' :: (MonadIO m) => MapReduce -> Action m MRResult
|
||||
-- ^ Run MapReduce and return a MR result document containing stats and the results if Inlined. Error if the map/reduce failed (because of bad Javascript).
|
||||
runMR' mr = do
|
||||
doc <- runCommand (mrDocument mr)
|
||||
|
|
@ -720,18 +719,18 @@ runMR' mr = do
|
|||
type Command = Document
|
||||
-- ^ A command is a special query or action against the database. See <http://www.mongodb.org/display/DOCS/Commands> for details.
|
||||
|
||||
runCommand :: (MonadIO' m) => Command -> Action m Document
|
||||
runCommand :: (MonadIO m) => Command -> Action m Document
|
||||
-- ^ Run command against the database and return its result
|
||||
runCommand c = maybe err id <$> findOne (query c "$cmd") where
|
||||
runCommand c = maybe err id `liftM` findOne (query c "$cmd") where
|
||||
err = error $ "Nothing returned for command: " ++ show c
|
||||
|
||||
runCommand1 :: (MonadIO' m) => Text -> Action m Document
|
||||
runCommand1 :: (MonadIO m) => Text -> Action m Document
|
||||
-- ^ @runCommand1 foo = runCommand [foo =: 1]@
|
||||
runCommand1 c = runCommand [c =: (1 :: Int)]
|
||||
|
||||
eval :: (MonadIO' m, Val v) => Javascript -> Action m v
|
||||
eval :: (MonadIO m, Val v) => Javascript -> Action m v
|
||||
-- ^ Run code on server
|
||||
eval code = at "retval" <$> runCommand ["$eval" =: code]
|
||||
eval code = at "retval" `liftM` runCommand ["$eval" =: code]
|
||||
|
||||
|
||||
{- Authors: Tony Hannan <tony@10gen.com>
|
||||
|
|
|
|||
Loading…
Reference in a new issue