summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--AesonBson.cabal10
-rw-r--r--CHANGELOG11
-rw-r--r--Data/AesonBson.hs130
-rw-r--r--Data/AesonBson/Instances.hs2
-rw-r--r--test/Main.hs49
5 files changed, 146 insertions, 56 deletions
diff --git a/AesonBson.cabal b/AesonBson.cabal
index 5f99573..5879a7a 100644
--- a/AesonBson.cabal
+++ b/AesonBson.cabal
@@ -1,5 +1,5 @@
name: AesonBson
-version: 0.2.2
+version: 0.4.0
license: OtherLicense
license-file: LICENSE
copyright: CC0
@@ -30,16 +30,16 @@ library
Data.AesonBson.Instances
build-depends:
base < 5,
- aeson >= 0.3 && < 0.7,
+ aeson >= 0.7,
attoparsec >= 0.10,
bson >= 0.2,
+ scientific >= 0.3,
+ text >= 0.11.3.1,
unordered-containers >= 0.1.3.0,
vector >= 0.7.1
hs-source-dirs: .
ghc-options: -Wall
-
-
test-Suite tests
type: exitcode-stdio-1.0
hs-source-dirs:
@@ -53,5 +53,7 @@ test-Suite tests
bson,
hspec >= 1.7.2.1,
HUnit >= 1.2.5.2,
+ scientific >= 0.2,
+ QuickCheck >= 2.6,
text >= 0.11.3.1
ghc-options: -Wall
diff --git a/CHANGELOG b/CHANGELOG
index 2aa5e84..ac6f6c9 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,8 +1,9 @@
-0.2.2
+# 0.4.0
- * Fix compilation by depending on aeson < 0.7
+* Compatibility with current `aeson`
+ (https://github.com/nh2/aesonbson/pull/11)
-0.2.1
+# 0.2.1
- * Fixed BSON ObjIDs being converted incorrectly
- (https://github.com/nh2/aesonbson/pull/2)
+* Fixed BSON ObjIDs being converted incorrectly
+ (https://github.com/nh2/aesonbson/pull/2)
diff --git a/Data/AesonBson.hs b/Data/AesonBson.hs
index 483db80..e16c90b 100644
--- a/Data/AesonBson.hs
+++ b/Data/AesonBson.hs
@@ -13,62 +13,106 @@
-- We tried to choose sensible translations on those cases.
module Data.AesonBson (
aesonify, aesonifyValue,
- bsonify, bsonifyValue
+ bsonify, bsonifyValue,
+ bsonifyError, bsonifyBound,
+ errorRange, bound,
) where
-- TODO Document the arbitrary choices in the Haddock.
import Data.Bson as BSON
import Data.Aeson.Types as AESON
-import qualified Data.Attoparsec.Number as Atto
-import Data.Monoid
+import Data.Int
import qualified Data.HashMap.Strict as HashMap (fromList, toList)
+import qualified Data.Scientific as S
+import qualified Data.Text.Encoding as T
import qualified Data.Vector as Vector (fromList, toList)
+-- | Converts an AESON object to a BSON document. Will yeld an error for JSON numbers that are too big.
+bsonifyError :: AESON.Object -> BSON.Document
+bsonifyError = bsonify errorRange
+
+-- | Converts an AESON object to a BSON document. Will bound JSON numbers that are too big.
+bsonifyBound :: AESON.Object -> BSON.Document
+bsonifyBound = bsonify bound
+
+-- | Converts an AESON object to a BSON document. The user can provide a function to deal with JSON numbers that are too big.
+bsonify :: (S.Scientific -> BSON.Value) -> AESON.Object -> BSON.Document
+bsonify f o = map (\(t, v) -> t := bsonifyValue f v) $ HashMap.toList o
+
+-- | Converts a BSON document to an AESON object.
+aesonify :: BSON.Document -> AESON.Object
+aesonify = HashMap.fromList . map (\(l := v) -> (l, aesonifyValue v))
+
+
+-- | Helpers
-- | Converts a JSON value to BSON.
-bsonifyValue :: AESON.Value -> BSON.Value
-bsonifyValue (Object obj) = Doc $ bsonify obj
-bsonifyValue (AESON.Array array) = BSON.Array . map bsonifyValue . Vector.toList $ array
-bsonifyValue (AESON.String str) = BSON.String str
-bsonifyValue (Number n) = case n of { Atto.I int -> Int64 $ fromIntegral int
- ; Atto.D float -> Float float }
-bsonifyValue (AESON.Bool b) = BSON.Bool b
-bsonifyValue (AESON.Null) = BSON.Null
+bsonifyValue :: (S.Scientific -> BSON.Value) -> AESON.Value -> BSON.Value
+bsonifyValue f (Object obj) = Doc $ bsonify f obj
+bsonifyValue f (AESON.Array array) = BSON.Array . map (bsonifyValue f) . Vector.toList $ array
+bsonifyValue _ (AESON.String str) = BSON.String str
+bsonifyValue _ (AESON.Bool b) = BSON.Bool b
+bsonifyValue _ (AESON.Null) = BSON.Null
+bsonifyValue f (AESON.Number n) = f n
-- | Converts a BSON value to JSON.
aesonifyValue :: BSON.Value -> AESON.Value
-aesonifyValue (Float f) = toJSON f
-aesonifyValue (BSON.String s) = toJSON s
-aesonifyValue (Doc doc) = Object $ aesonify doc
-aesonifyValue (BSON.Array list) = AESON.Array . Vector.fromList $ map aesonifyValue list
-aesonifyValue (Bin (Binary binary)) = toJSON binary
-aesonifyValue (Fun (Function function)) = toJSON function
-aesonifyValue (Uuid (UUID uuid)) = toJSON uuid
-aesonifyValue (Md5 (MD5 md5)) = toJSON md5
-aesonifyValue (UserDef (UserDefined userdef)) = toJSON userdef
-aesonifyValue (ObjId oid) = toJSON $ show oid -- Relies on bson to show the OID as 24 digit hex.
- -- It would be better if BSON exposed a non-show function for this,
- -- preferably a fast one.
-aesonifyValue (BSON.Bool bool) = toJSON bool
-aesonifyValue (UTC utc) = toJSON utc
-aesonifyValue (BSON.Null) = AESON.Null
-aesonifyValue (RegEx (Regex pattern mods)) = toJSON $ mconcat ["/", pattern, "/", mods]
-aesonifyValue (JavaScr (Javascript env code)) = object [ "environment" .= aesonify env
- , "code" .= code ]
-aesonifyValue (Sym (Symbol sym)) = toJSON sym
-aesonifyValue (Int32 int32) = toJSON int32
-aesonifyValue (Int64 int64) = toJSON int64
-aesonifyValue (Stamp (MongoStamp int64)) = toJSON int64
-aesonifyValue (MinMax mm) = case mm of { MinKey -> toJSON (-1 :: Int)
- ; MaxKey -> toJSON (1 :: Int)}
-
-
--- | Converts an AESON object to a BSON document.
-bsonify :: AESON.Object -> BSON.Document
-bsonify = map (\(t, v) -> t := bsonifyValue v) . HashMap.toList
+aesonifyValue (Float f) = toJSON f
+aesonifyValue (BSON.String s) = toJSON s
+aesonifyValue (Doc doc) = Object $ aesonify doc
+aesonifyValue (BSON.Array list) = AESON.Array . Vector.fromList $ map aesonifyValue list
+aesonifyValue (Bin (Binary binary)) = toJSON $ T.decodeUtf8 binary
+aesonifyValue (Fun (Function function)) = toJSON $ T.decodeUtf8 function
+aesonifyValue (Uuid (UUID uuid)) = toJSON $ T.decodeUtf8 uuid
+aesonifyValue (Md5 (MD5 md5)) = toJSON $ T.decodeUtf8 md5
+aesonifyValue (UserDef (UserDefined userdef)) = toJSON $ T.decodeUtf8 userdef
+aesonifyValue (ObjId oid) = toJSON $ show oid -- Relies on bson to show the OID as 24 digit hex. It would be better if BSON exposed a non-show function for this, preferably a fast one.
+aesonifyValue (BSON.Bool bool) = toJSON bool
+aesonifyValue (UTC utc) = toJSON utc
+aesonifyValue (BSON.Null) = AESON.Null
+aesonifyValue (RegEx (Regex pattern mods)) = toJSON $ mconcat ["/", pattern, "/", mods]
+aesonifyValue (JavaScr (Javascript env code)) = object [ "environment" .= aesonify env, "code" .= code ]
+aesonifyValue (Sym (Symbol sym)) = toJSON sym
+aesonifyValue (Int32 int32) = toJSON int32
+aesonifyValue (Int64 int64) = toJSON int64
+aesonifyValue (Stamp (MongoStamp int64)) = toJSON int64
+aesonifyValue (MinMax mm) = case mm of { MinKey -> toJSON (-1 :: Int)
+ ; MaxKey -> toJSON (1 :: Int)}
+
+int64MaxBound, int32MaxBound, int64MinBound, int32MinBound :: S.Scientific
+int64MaxBound = toScientific (maxBound :: Int64)
+int32MaxBound = toScientific (maxBound :: Int32)
+int64MinBound = toScientific (minBound :: Int64)
+int32MinBound = toScientific (minBound :: Int32)
+
+toScientific :: Integral i => i -> S.Scientific
+toScientific i = S.scientific (fromIntegral i :: Integer ) 0
+
+expo :: S.Scientific -> Int
+expo n = S.base10Exponent n
+
+coef :: S.Scientific -> Integer
+coef n = S.coefficient n
+
+-- Error when the number of out of range
+errorRange :: S.Scientific -> BSON.Value
+errorRange n | n < int64MinBound = error $ "Number out of min range: " ++ (show n)
+errorRange n | n > int64MaxBound = error $ "Number out of max range: " ++ (show n)
+errorRange n = bsonifyNumberInRange n
+
+-- Bound the number when out of range.
+bound :: S.Scientific -> BSON.Value
+bound n | n < int64MinBound = Int64 minBound
+bound n | n > int64MaxBound = Int64 maxBound
+bound n = bsonifyNumberInRange n
+
+-- Function for converting numbers within range; int64MinBound < n < int64MaxBound
+bsonifyNumberInRange :: S.Scientific -> BSON.Value
+bsonifyNumberInRange n | (expo n) < 0 = Float (S.toRealFloat n :: Double)
+bsonifyNumberInRange n | int64MinBound <= n && n < int32MinBound = Int64 $ fromIntegral (coef n) * 10 ^ (expo n)
+bsonifyNumberInRange n | int32MinBound <= n && n <= int32MaxBound = Int32 $ fromIntegral (coef n) * 10 ^ (expo n)
+bsonifyNumberInRange n | int32MaxBound < n && n <= int64MaxBound = Int64 $ fromIntegral (coef n) * 10 ^ (expo n)
+bsonifyNumberInRange _ = error "bsonifyiNumberInRange should be invoked only with n | int64MinBound < n < int64MaxBound"
--- | Converts a BSON document to an AESON object.
-aesonify :: BSON.Document -> AESON.Object
-aesonify = HashMap.fromList . map (\(l := v) -> (l, aesonifyValue v))
diff --git a/Data/AesonBson/Instances.hs b/Data/AesonBson/Instances.hs
index 0b4c58c..9e0a693 100644
--- a/Data/AesonBson/Instances.hs
+++ b/Data/AesonBson/Instances.hs
@@ -13,5 +13,3 @@ import Data.AesonBson
instance ToJSON BSON.Value where
toJSON = aesonifyValue
-instance ToJSON BSON.Document where
- toJSON = Object . aesonify
diff --git a/test/Main.hs b/test/Main.hs
index 4aba28b..203db9f 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,13 +1,17 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module Main where
import Test.Hspec
+import Test.QuickCheck
+
import Data.Aeson.Types as AESON
import Data.Bson as BSON
+import Data.Int
import qualified Data.Text as T
+import qualified Data.Scientific as Scientific
-import Data.AesonBson
+import Data.AesonBson
main :: IO ()
main = hspec $ do
@@ -19,3 +23,44 @@ main = hspec $ do
AESON.String str = aesonifyValue objid
str `shouldBe` "000000010000000000000001"
T.length str `shouldBe` 24
+
+ describe "JSON -> BSON" $ do
+ it "converts Int32 max bound + 1 to Int64" $ do
+ let x = succ $ fromIntegral (maxBound :: Int32) :: Integer
+ (bsonifyValue errorRange . AESON.Number $ Scientific.scientific x 0)
+ `shouldBe` BSON.Int64 (fromIntegral x)
+
+ it "converts Int32 max bound to Int32" $ do
+ let x = fromIntegral (maxBound :: Int32) :: Integer
+ (bsonifyValue errorRange . AESON.Number $ Scientific.scientific x 0)
+ `shouldBe` BSON.Int32 (fromIntegral x)
+
+ it "converts Int32 min bound to Int32" $ do
+ let x = fromIntegral (minBound :: Int32) :: Integer
+ (bsonifyValue errorRange . AESON.Number $ Scientific.scientific x 0)
+ `shouldBe` BSON.Int32 (fromIntegral x)
+
+ it "converts Int32 min bound - 1 to Int64" $ do
+ let x = pred $ fromIntegral (minBound :: Int32) :: Integer
+ (bsonifyValue errorRange . AESON.Number $ Scientific.scientific x 0)
+ `shouldBe` BSON.Int64 (fromIntegral x)
+
+ it "converts number smaller than Int32 min bound to Int64" $ do
+ let x = fromIntegral (minBound :: Int32) :: Integer
+ (bsonifyValue errorRange . AESON.Number $ Scientific.scientific (pred x) 0)
+ `shouldBe` BSON.Int64 (fromIntegral $ pred x)
+
+ it "converts Int32 to Int32" $ property $ \(x :: Int32) ->
+ (bsonifyValue errorRange . AESON.Number $ Scientific.scientific (fromIntegral x) 0)
+ `shouldBe` BSON.Int32 x
+
+ it "converts Int64 max bound + 1 to Int64 max bound" $ do
+ let x = succ $ fromIntegral (maxBound :: Int64) :: Integer
+ (bsonifyValue bound . AESON.Number $ Scientific.scientific x 0)
+ `shouldBe` BSON.Int64 maxBound
+
+ it "converts Int64 min bound - 1 to Int64 min bound" $ do
+ let x = pred $ fromIntegral (minBound :: Int64) :: Integer
+ (bsonifyValue bound . AESON.Number $ Scientific.scientific x 0)
+ `shouldBe` BSON.Int64 minBound
+