diff --git a/Database/MongoDB/BSON.hs b/Database/MongoDB/BSON.hs index 20bf864..c597f62 100644 --- a/Database/MongoDB/BSON.hs +++ b/Database/MongoDB/BSON.hs @@ -30,7 +30,7 @@ module Database.MongoDB.BSON toBsonDoc, BinarySubType(..), - toBson + fromBson, toBson ) where import Control.Monad @@ -38,7 +38,7 @@ import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 import Data.Binary.Put -import Data.ByteString.Char8 +import Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.UTF8 as L8 import qualified Data.ByteString.UTF8 as S8 @@ -47,6 +47,7 @@ import Data.Int import qualified Data.Map as Map import qualified Data.List as List import Data.Time.Clock.POSIX +import Data.Typeable import Database.MongoDB.Util data BsonValue @@ -68,6 +69,9 @@ data BsonValue | BsonMaxKey deriving (Show, Eq, Ord) +instance Typeable BsonValue where + typeOf _ = mkTypeName "BsonValue" + newtype BsonDoc = BsonDoc { fromBsonDoc :: Map.Map L8.ByteString BsonValue } @@ -257,9 +261,16 @@ putOutterObj bytes = do putDataType :: DataType -> Put putDataType = putI8 . fromDataType +fromBson :: Convertible BsonValue a => BsonValue -> a +fromBson = convert + toBson :: Convertible a BsonValue => a -> BsonValue toBson = convert +unsupportedError :: (Typeable a, Convertible BsonValue a) => + BsonValue -> ConvertResult a +unsupportedError = convError "Unsupported conversion" + instance Convertible Double BsonValue where safeConvert = return . BsonDouble @@ -331,3 +342,87 @@ instance Convertible Int32 BsonValue where instance Convertible Int64 BsonValue where safeConvert i = return $ BsonInt64 i + +instance Convertible BsonValue Double where + safeConvert (BsonDouble d) = return d + safeConvert (BsonInt32 i) = safeConvert i + safeConvert (BsonInt64 i) = safeConvert i + safeConvert v = unsupportedError v + +instance Convertible BsonValue Float where + safeConvert (BsonDouble d) = safeConvert d + safeConvert (BsonInt32 i) = safeConvert i + safeConvert (BsonInt64 i) = safeConvert i + safeConvert v = unsupportedError v + +instance Convertible BsonValue String where + safeConvert (BsonString bs) = return $ L8.toString bs + safeConvert v = unsupportedError v + +instance Convertible BsonValue L8.ByteString where + safeConvert (BsonString bs) = return bs + safeConvert v = unsupportedError v + +instance Convertible BsonValue S8.ByteString where + safeConvert (BsonString bs) = return $ C8.concat $ L.toChunks bs + safeConvert v = unsupportedError v + +instance Convertible BsonValue [Double] where + safeConvert (BsonArray a) = mapM safeConvert a + safeConvert v = unsupportedError v + +instance Convertible BsonValue [Float] where + safeConvert (BsonArray a) = mapM safeConvert a + safeConvert v = unsupportedError v + +instance Convertible BsonValue [String] where + safeConvert (BsonArray a) = mapM safeConvert a + safeConvert v = unsupportedError v + +instance Convertible BsonValue [Bool] where + safeConvert (BsonArray a) = mapM safeConvert a + safeConvert v = unsupportedError v + +instance Convertible BsonValue [POSIXTime] where + safeConvert (BsonArray a) = mapM safeConvert a + safeConvert v = unsupportedError v + +instance Convertible BsonValue [Int32] where + safeConvert (BsonArray a) = mapM safeConvert a + safeConvert v = unsupportedError v + +instance Convertible BsonValue [Int64] where + safeConvert (BsonArray a) = mapM safeConvert a + safeConvert v = unsupportedError v + +instance Convertible BsonValue Bool where + safeConvert (BsonBool b) = return b + safeConvert v = unsupportedError v + +instance Convertible BsonValue POSIXTime where + safeConvert (BsonDate t) = return t + safeConvert v = unsupportedError v + +instance Convertible BsonValue Int where + safeConvert (BsonDouble d) = safeConvert d + safeConvert (BsonInt32 d) = safeConvert d + safeConvert (BsonInt64 d) = safeConvert d + safeConvert v = unsupportedError v + +instance Convertible BsonValue Integer where + safeConvert (BsonDouble d) = safeConvert d + safeConvert (BsonInt32 d) = safeConvert d + safeConvert (BsonInt64 d) = safeConvert d + safeConvert v = unsupportedError v + +instance Convertible BsonValue Int32 where + safeConvert (BsonDouble d) = safeConvert d + safeConvert (BsonInt32 d) = return d + safeConvert (BsonInt64 d) = safeConvert d + safeConvert v = unsupportedError v + +instance Convertible BsonValue Int64 where + safeConvert (BsonDouble d) = safeConvert d + safeConvert (BsonInt32 d) = safeConvert d + safeConvert (BsonInt64 d) = return d + safeConvert v = unsupportedError v