Use MonadFail instead of Monad
This commit is contained in:
commit
e2e8288b32
5 changed files with 22 additions and 15 deletions
|
@ -33,6 +33,7 @@ import Control.Applicative ((<$>))
|
|||
#endif
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Monad (forever, unless, liftM)
|
||||
import Control.Monad.Fail(MonadFail)
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Data.Maybe (maybeToList)
|
||||
import Data.Set (Set)
|
||||
|
@ -76,7 +77,7 @@ 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, MonadFail 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
|
||||
|
|
|
@ -24,12 +24,14 @@ module Database.MongoDB.Connection (
|
|||
import Prelude hiding (lookup)
|
||||
import Data.IORef (IORef, newIORef, readIORef)
|
||||
import Data.List (intersect, partition, (\\), delete)
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
|
||||
import Control.Monad (forM_, guard)
|
||||
import Control.Monad.Fail(MonadFail)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import System.Timeout (timeout)
|
||||
import Text.ParserCombinators.Parsec (parse, many1, letter, digit, char, anyChar, eof,
|
||||
|
@ -82,7 +84,7 @@ showHostPort (Host hostname (PortNumber port)) = hostname ++ ":" ++ show port
|
|||
showHostPort (Host _ (UnixSocket path)) = "unix:" ++ path
|
||||
#endif
|
||||
|
||||
readHostPortM :: (Monad m) => String -> m Host
|
||||
readHostPortM :: (MonadFail m) => String -> m Host
|
||||
-- ^ Read string \"hostname:port\" as @Host hosthame (PortNumber port)@ or \"hostname\" as @host hostname@ (default port). Fail if string does not match either syntax.
|
||||
-- TODO: handle Service port
|
||||
readHostPortM = either (fail . show) return . parse parser "readHostPort" where
|
||||
|
@ -104,7 +106,7 @@ readHostPortM = either (fail . show) return . parse parser "readHostPort" where
|
|||
|
||||
readHostPort :: String -> Host
|
||||
-- ^ Read string \"hostname:port\" as @Host hostname (PortNumber port)@ or \"hostname\" as @host hostname@ (default port). Error if string does not match either syntax.
|
||||
readHostPort = runIdentity . readHostPortM
|
||||
readHostPort = fromJust . readHostPortM
|
||||
|
||||
type Secs = Double
|
||||
|
||||
|
|
|
@ -26,6 +26,7 @@ module Database.MongoDB.GridFS
|
|||
import Control.Applicative((<$>))
|
||||
|
||||
import Control.Monad(when)
|
||||
import Control.Monad.Fail(MonadFail)
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans(lift)
|
||||
|
||||
|
@ -69,7 +70,7 @@ openBucket name = do
|
|||
|
||||
data File = File {bucket :: Bucket, document :: Document}
|
||||
|
||||
getChunk :: (Monad m, MonadIO m) => File -> Int -> Action m (Maybe S.ByteString)
|
||||
getChunk :: (MonadFail m, MonadIO m) => File -> Int -> Action m (Maybe S.ByteString)
|
||||
-- ^ Get a chunk of a file
|
||||
getChunk (File bucket doc) i = do
|
||||
files_id <- B.look "_id" doc
|
||||
|
@ -98,7 +99,7 @@ fetchFile bucket sel = do
|
|||
doc <- fetch $ select sel $ files bucket
|
||||
return $ File bucket doc
|
||||
|
||||
deleteFile :: (MonadIO m) => File -> Action m ()
|
||||
deleteFile :: (MonadIO m, MonadFail m) => File -> Action m ()
|
||||
-- ^ Delete files in the bucket
|
||||
deleteFile (File bucket doc) = do
|
||||
files_id <- B.look "_id" doc
|
||||
|
@ -110,7 +111,7 @@ putChunk :: (Monad m, MonadIO m) => Bucket -> ObjectId -> Int -> L.ByteString ->
|
|||
putChunk bucket files_id i chunk = do
|
||||
insert_ (chunks bucket) ["files_id" =: files_id, "n" =: i, "data" =: Binary (L.toStrict chunk)]
|
||||
|
||||
sourceFile :: (Monad m, MonadIO m) => File -> Producer (Action m) S.ByteString
|
||||
sourceFile :: (MonadFail m, MonadIO m) => File -> Producer (Action m) S.ByteString
|
||||
-- ^ A producer for the contents of a file
|
||||
sourceFile file = yieldChunk 0 where
|
||||
yieldChunk i = do
|
||||
|
|
|
@ -49,6 +49,7 @@ module Database.MongoDB.Query (
|
|||
import Prelude hiding (lookup)
|
||||
import Control.Exception (Exception, throwIO)
|
||||
import Control.Monad (unless, replicateM, liftM, liftM2)
|
||||
import Control.Monad.Fail(MonadFail)
|
||||
import Data.Default.Class (Default(..))
|
||||
import Data.Int (Int32, Int64)
|
||||
import Data.Either (lefts, rights)
|
||||
|
@ -1065,7 +1066,7 @@ defFamUpdateOpts ups = FamUpdate
|
|||
-- Returns a single updated document (new option is set to true).
|
||||
--
|
||||
-- see 'findAndModifyOpts' if you want to use findAndModify in a differnt way
|
||||
findAndModify :: MonadIO m
|
||||
findAndModify :: (MonadIO m, MonadFail m)
|
||||
=> Query
|
||||
-> Document -- ^ updates
|
||||
-> Action m (Either String Document)
|
||||
|
@ -1080,7 +1081,7 @@ findAndModify q ups = do
|
|||
|
||||
-- | runs the findAndModify command,
|
||||
-- allows more options than 'findAndModify'
|
||||
findAndModifyOpts :: MonadIO m
|
||||
findAndModifyOpts :: (MonadIO m, MonadFail m)
|
||||
=> Query
|
||||
->FindAndModifyOpts
|
||||
-> Action m (Either String (Maybe Document))
|
||||
|
@ -1105,8 +1106,8 @@ findAndModifyOpts (Query {
|
|||
return $ case lookupErr result of
|
||||
Just e -> leftErr e
|
||||
Nothing -> case lookup "value" result of
|
||||
Left err -> leftErr $ "no document found: " `mappend` err
|
||||
Right mdoc -> case mdoc of
|
||||
Nothing -> leftErr "no document found"
|
||||
Just mdoc -> case mdoc of
|
||||
Just doc@(_:_) -> Right (Just doc)
|
||||
Just [] -> case famOpts of
|
||||
FamUpdate { famUpsert = True, famNew = False } -> Right Nothing
|
||||
|
@ -1118,9 +1119,10 @@ findAndModifyOpts (Query {
|
|||
`mappend` "\nerror: " `mappend` err
|
||||
|
||||
-- return Nothing means ok, Just is the error message
|
||||
lookupErr result = case lookup "lastErrorObject" result of
|
||||
Right errObject -> lookup "err" errObject
|
||||
Left err -> Just err
|
||||
lookupErr :: Document -> Maybe String
|
||||
lookupErr result = do
|
||||
errObject <- lookup "lastErrorObject" result
|
||||
lookup "err" errObject
|
||||
|
||||
explain :: (MonadIO m) => Query -> Action m Document
|
||||
-- ^ Return performance stats of query execution
|
||||
|
@ -1301,7 +1303,7 @@ isCursorClosed (Cursor _ _ var) = do
|
|||
type Pipeline = [Document]
|
||||
-- ^ The Aggregate Pipeline
|
||||
|
||||
aggregate :: MonadIO m => Collection -> Pipeline -> Action m [Document]
|
||||
aggregate :: (MonadIO m, MonadFail 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
|
||||
aggregateCursor aColl agg def >>= rest
|
||||
|
@ -1312,7 +1314,7 @@ data AggregateConfig = AggregateConfig {}
|
|||
instance Default AggregateConfig where
|
||||
def = AggregateConfig {}
|
||||
|
||||
aggregateCursor :: MonadIO m => Collection -> Pipeline -> AggregateConfig -> Action m Cursor
|
||||
aggregateCursor :: (MonadIO m, MonadFail m) => Collection -> Pipeline -> AggregateConfig -> Action m Cursor
|
||||
-- ^ Runs an aggregate and unpacks the result. See <http://docs.mongodb.org/manual/core/aggregation/> for details.
|
||||
aggregateCursor aColl agg _ = do
|
||||
response <- runCommand ["aggregate" =: aColl, "pipeline" =: agg, "cursor" =: ([] :: Document)]
|
||||
|
|
|
@ -57,6 +57,7 @@ Library
|
|||
, base16-bytestring >= 0.1.1.6
|
||||
, base64-bytestring >= 1.0.0.1
|
||||
, nonce >= 1.0.5
|
||||
, fail
|
||||
|
||||
if flag(_old-network)
|
||||
-- "Network.BSD" is only available in network < 2.9
|
||||
|
|
Loading…
Reference in a new issue