move the get/put* helpers to Util.hs so other modules can use them

Database/MongoDB/BSON.hs

@@ -17,10 +17,10 @@ import Data.ByteString.Char8
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as LC
 import qualified Data.ByteString.Lazy.UTF8 as L8
-import Data.Char          (chr, ord)
 import Data.Int
 import qualified Data.List as List
 import Data.Time.Clock.POSIX
+import Database.MongoDB.Util
 
 data BSValue
     = BSDouble Double
@@ -103,7 +103,7 @@ instance Binary BSONObject where
     get = liftM snd getObj
     put = putObj
 
-getVal :: DataType -> Get (Int, BSValue)
+getVal :: DataType -> Get (Integer, BSValue)
 getVal Data_number = getFloat64le >>= return . (,) 8 . BSDouble
 getVal Data_string = do
   sLen1 <- getI32
@@ -119,7 +119,7 @@ getVal Data_binary = do
   st   <- getI8
   len2 <- getI32
   bs   <- getLazyByteString $ fromIntegral len2
-  return (4 + 1 + 4 + len2, BSBinary (toBinarySubType st) bs)
+  return (4 + 1 + 4 + fromIntegral len2, BSBinary (toBinarySubType st) bs)
 getVal Data_undefined = return (1, BSUndefined)
 getVal Data_oid = getLazyByteString 12 >>= return . (,) 12 . BSObjectId
 getVal Data_boolean = getI8 >>= return . (,) 1 . BSBool . (/= 0)
@@ -134,28 +134,19 @@ getInnerObj bytesLeft obj = do
   typ <- getDataType
   (keySz, key) <- getS
   (valSz, val) <- getVal typ
-  getInnerObj (bytesLeft - 1 - keySz - valSz) $ liftM ((key, val) :) obj
+  getInnerObj (bytesLeft - 1 - fromIntegral keySz - fromIntegral valSz) $
+              liftM ((key, val) :) obj
 
 getRawObj = do
   bytes <- getI32
   obj <- getInnerObj (bytes - 4) $ return []
   getNull
-  return (bytes, obj)
+  return (fromIntegral bytes, obj)
 
 getObj = getRawObj >>= \(len, obj) ->  return (len, toBSONObject obj)
 
-getS :: Get (Int, L8.ByteString)
-getS = getLazyByteStringNul >>= \s -> return (fromIntegral $ L.length s + 1, s)
-
-getNull = do {'\0' <- getC; return ()}
-
-getC = liftM chr getI8
-getI8 = liftM fromIntegral getWord8
-getI32 = liftM fromIntegral getWord32le
-getI64 = liftM fromIntegral getWord64le
 getDataType = liftM toDataType getI8
 
-
 putType BSDouble{}   = putDataType Data_number
 putType BSString{}   = putDataType Data_string
 putType BSObject{}   = putDataType Data_object
@@ -179,14 +170,14 @@ putType BSMaxKey     = putDataType Data_max_key
 
 
 putVal (BSDouble d)   = putFloat64le d
-putVal (BSString s)   = putI32 (1 + L8.length s) >> putS s
+putVal (BSString s)   = putI32 (fromIntegral $ 1 + L8.length s) >> putS s
 putVal (BSObject o)   = putObj o
 putVal (BSArray es)   = putOutterObj bs
     where bs = runPut $ forM_ (List.zip [0..] es) $ \(i, e) ->
                putType e >> (putS $ L8.fromString $ show i) >> putVal e
-putVal (BSBinary t bs)= do putI32 $ 4 + L.length bs
+putVal (BSBinary t bs)= do putI32 $ fromIntegral $ 4 + L.length bs
                            putI8 $ fromBinarySubType t
-                           putI32 $ L.length bs
+                           putI32 $ fromIntegral $ L.length bs
                            putLazyByteString bs
 putVal BSUndefined    = flush
 putVal (BSObjectId o) = putLazyByteString o
@@ -197,7 +188,7 @@ putVal BSNull         = flush
 putVal (BSRegex r opt)= do putS r
                            putByteString $ pack $ List.sort opt
                            putNull
-putVal (BSSymbol s)   = putI32 (1 + L8.length s) >> putS s
+putVal (BSSymbol s)   = putI32 (fromIntegral $ 1 + L8.length s) >> putS s
 putVal (BSInt32 i)    = putI32 i
 putVal (BSInt64 i)    = putI64 i
 putVal BSMinKey       = flush
@@ -209,24 +200,8 @@ putObj obj   = putOutterObj bs
 
 putOutterObj bytes = do
   -- the length prefix and null term are included in the length
-  putI32 $ 4 + 1 + L.length bytes
+  putI32 $ fromIntegral $ 4 + 1 + L.length bytes
   putLazyByteString bytes
   putNull
 
-putNull = putI8 0
-putI8 :: (Integral i) => i -> Put
-putI8 = putWord8 . fromIntegral
-
-putI32 :: (Integral i) => i -> Put
-putI32 = putWord32le . fromIntegral
-
-putI64 :: (Integral i) => i -> Put
-putI64 = putWord64le . fromIntegral
-
-putS :: L8.ByteString -> Put
-putS s = putLazyByteString s >> putNull
-
 putDataType = putI8 . fromDataType
-
-int32_min = -2147483648
-int32_max = -int32_min - 1

Database/MongoDB/Util.hs

@@ -0,0 +1,42 @@
+module Database.MongoDB.Util
+    (
+     putI8, putI32, putI64, putNull, putS,
+     getI8, getI32, getI64, getC, getS, getNull,
+    )
+where
+import Control.Monad
+import Data.Binary
+import Data.Binary.Get
+import Data.Binary.Put
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.UTF8 as L8
+import Data.Char          (chr, ord)
+import Data.Int
+
+getC = liftM chr getI8
+getI8 = liftM fromIntegral getWord8
+
+getI32 :: Get Int32
+getI32 = liftM fromIntegral getWord32le
+
+getI64 :: Get Int64
+getI64 = liftM fromIntegral getWord64le
+
+getS :: Get (Integer, L8.ByteString)
+getS = getLazyByteStringNul >>= \s -> return (fromIntegral $ L.length s + 1, s)
+
+getNull = do {'\0' <- getC; return ()}
+
+putI8 :: (Integral i) => i -> Put
+putI8 = putWord8 . fromIntegral
+
+putI32 :: Int32 -> Put
+putI32 = putWord32le . fromIntegral
+
+putI64 :: Int64 -> Put
+putI64 = putWord64le . fromIntegral
+
+putNull = putI8 0
+
+putS :: L8.ByteString -> Put
+putS s = putLazyByteString s >> putNull

mongoDB.cabal

@@ -9,3 +9,4 @@ Build-Depends:       base,
 		     utf8-string
 Build-Type:          Simple
 Exposed-modules:     Database.MongoDB.BSON
+Other-modules:       Database.MongoDB.Util