Vergara_Tech/mongodb
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

make changes suggested by hlint

Browse source
This commit is contained in:
Scott R. Parish 2010-02-06 15:52:23 -06:00
parent 613fc8ff6d
commit 92f37cc946
2 changed files with 11 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
Database/MongoDB.hs
View file

@ -107,7 +107,7 @@ connectAll c [] = return c
connectAll c ((host, port) : xs) = do connectAll c ((host, port) : xs) = do
h <- Network.connectTo host port h <- Network.connectTo host port
hSetBuffering h NoBuffering hSetBuffering h NoBuffering
connectAll (c {cHandles = h:(cHandles c)}) xs connectAll (c {cHandles = h : cHandles c}) xs
-- | Establish a connection to a MongoDB server on a non-standard port -- | Establish a connection to a MongoDB server on a non-standard port
connectOnPort :: HostName -> Network.PortID -> IO Connection connectOnPort :: HostName -> Network.PortID -> IO Connection
@ -127,14 +127,14 @@ newConnection = do
getHandle :: Connection -> IO Handle getHandle :: Connection -> IO Handle
getHandle c = do getHandle c = do
i <- readIORef $ cIndex c i <- readIORef $ cIndex c
return $ (cHandles c) !! i return $ cHandles c !! i
cPut :: Connection -> L.ByteString -> IO () cPut :: Connection -> L.ByteString -> IO ()
cPut c msg = getHandle c >>= flip L.hPut msg cPut c msg = getHandle c >>= flip L.hPut msg
-- | Close database connection -- | Close database connection
conClose :: Connection -> IO () conClose :: Connection -> IO ()
conClose c = sequence_ $ map hClose $ cHandles c conClose c = mapM_ hClose $ cHandles c
setTarget :: Connection -> Int -> IO () setTarget :: Connection -> Int -> IO ()
setTarget c i = setTarget c i =
@ -557,7 +557,7 @@ login c db user pass = do
doc <- runCommand c db (toBsonDoc [("getnonce", toBson (1 :: Int))]) doc <- runCommand c db (toBsonDoc [("getnonce", toBson (1 :: Int))])
let nonce = fromBson $ fromLookup $ BSON.lookup "nonce" doc :: String let nonce = fromBson $ fromLookup $ BSON.lookup "nonce" doc :: String
digest = md5sum $ pack $ nonce ++ user ++ digest = md5sum $ pack $ nonce ++ user ++
( md5sum $ pack (user ++ ":mongo:" ++ pass)) md5sum (pack (user ++ ":mongo:" ++ pass))
request = toBsonDoc [("authenticate", toBson (1 :: Int)), request = toBsonDoc [("authenticate", toBson (1 :: Int)),
("user", toBson user), ("user", toBson user),
("nonce", toBson nonce), ("nonce", toBson nonce),
@ -567,11 +567,11 @@ login c db user pass = do
-- | create a new user in the current /Database/ -- | create a new user in the current /Database/
addUser :: Connection -> Database -> Username -> Password -> IO BsonDoc addUser :: Connection -> Database -> Username -> Password -> IO BsonDoc
addUser c db user pass = do addUser c db user pass = do
let userDoc = toBsonDoc [(s2L"user", toBson user)] let userDoc = toBsonDoc [(s2L "user", toBson user)]
fdb = L.append db (s2L ".system.users") fdb = L.append db (s2L ".system.users")
doc <- liftM (maybe userDoc id) (findOne c fdb userDoc) doc <- findOne c fdb userDoc
let doc' = Map.insert (s2L "pwd") let pwd = md5sum $ pack (user ++ ":mongo:" ++ pass)
(toBson ( md5sum $ pack (user ++ ":mongo:" ++ pass))) doc doc' = Map.insert (s2L "pwd") (toBson pwd) (fromMaybe userDoc doc)
_ <- save c fdb doc' _ <- save c fdb doc'
return doc' return doc'
@ -594,7 +594,7 @@ save c fc doc =
-- > findOne conn mycoll $ whereClause "this.name == (name1 + name2)" -- > findOne conn mycoll $ whereClause "this.name == (name1 + name2)"
-- > (toBsonDoc [("name1", toBson "mar"), ("name2", toBson "tha")]) -- > (toBsonDoc [("name1", toBson "mar"), ("name2", toBson "tha")])
whereClause :: String -> BsonDoc -> BsonDoc whereClause :: String -> BsonDoc -> BsonDoc
whereClause qry scope = toBsonDoc [("$where", (BsonCodeWScope (s2L qry) scope))] whereClause qry scope = toBsonDoc [("$where", BsonCodeWScope (s2L qry) scope)]
data Hdr = Hdr { data Hdr = Hdr {
hMsgLen :: Int32, hMsgLen :: Int32,
@ -836,7 +836,6 @@ validateCollectionName col = do
throwColInvalid $ "Collection can't start or end with '.': " ++ show col throwColInvalid $ "Collection can't start or end with '.': " ++ show col
return (db, col') return (db, col')
fromLookup :: (Maybe a) -> a fromLookup :: Maybe a -> a
fromLookup (Just m) = m fromLookup (Just m) = m
fromLookup Nothing = throwColInvalid "cannot find key" fromLookup Nothing = throwColInvalid "cannot find key"

2
Database/MongoDB/BSON.hs
View file

@ -277,7 +277,7 @@ putVal (BsonInt32 i) = putI32 i
putVal (BsonInt64 i) = putI64 i putVal (BsonInt64 i) = putI64 i
putVal (BsonCodeWScope q s) = putVal (BsonCodeWScope q s) =
let bytes = runPut (putStrSz q >> putObj s) let bytes = runPut (putStrSz q >> putObj s)
in (putI32 $ (+4) $ fromIntegral $ L.length bytes) >> putLazyByteString bytes in putI32 ((+4) $ fromIntegral $ L.length bytes) >> putLazyByteString bytes
putVal BsonMinKey = putNothing putVal BsonMinKey = putNothing
putVal BsonMaxKey = putNothing putVal BsonMaxKey = putNothing