{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.AesonBson (
aesonify, aesonifyValue,
bsonify, bsonifyValue,
bsonifyError, bsonifyBound,
errorRange, bound,
) where
import Data.Bson as BSON
import Data.Aeson.Types as AESON
import Data.Int
import qualified Data.Scientific as S
import qualified Data.Text as Text
import qualified Data.Text.Encoding as T
import qualified Data.Vector as Vector (fromList, toList)
# if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as HashMap (fromList, toList)
textToKey :: Text.Text -> AESON.Key
textToKey :: Text -> Key
textToKey = Text -> Key
Key.fromText
keyToText :: AESON.Key -> Text.Text
keyToText :: Key -> Text
keyToText = Key -> Text
Key.toText
# else
import qualified Data.HashMap.Strict as HashMap (fromList, toList)
textToKey :: Text.Text -> Text.Text
textToKey = id
keyToText :: Text.Text -> Text.Text
keyToText = id
# endif
bsonifyError :: AESON.Object -> BSON.Document
bsonifyError :: Object -> Document
bsonifyError = (Scientific -> Value) -> Object -> Document
bsonify Scientific -> Value
errorRange
bsonifyBound :: AESON.Object -> BSON.Document
bsonifyBound :: Object -> Document
bsonifyBound = (Scientific -> Value) -> Object -> Document
bsonify Scientific -> Value
bound
bsonify :: (S.Scientific -> BSON.Value) -> AESON.Object -> BSON.Document
bsonify :: (Scientific -> Value) -> Object -> Document
bsonify Scientific -> Value
f Object
o = ((Key, Value) -> Field) -> [(Key, Value)] -> Document
forall a b. (a -> b) -> [a] -> [b]
map (\(Key
t, Value
v) -> Key -> Text
keyToText Key
t Text -> Value -> Field
:= (Scientific -> Value) -> Value -> Value
bsonifyValue Scientific -> Value
f Value
v) ([(Key, Value)] -> Document) -> [(Key, Value)] -> Document
forall a b. (a -> b) -> a -> b
$ Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
HashMap.toList Object
o
aesonify :: BSON.Document -> AESON.Object
aesonify :: Document -> Object
aesonify = [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
HashMap.fromList ([(Key, Value)] -> Object)
-> (Document -> [(Key, Value)]) -> Document -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Field -> (Key, Value)) -> Document -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
l := Value
v) -> (Text -> Key
textToKey Text
l, Value -> Value
aesonifyValue Value
v))
bsonifyValue :: (S.Scientific -> BSON.Value) -> AESON.Value -> BSON.Value
bsonifyValue :: (Scientific -> Value) -> Value -> Value
bsonifyValue Scientific -> Value
f (Object Object
obj) = Document -> Value
Doc (Document -> Value) -> Document -> Value
forall a b. (a -> b) -> a -> b
$ (Scientific -> Value) -> Object -> Document
bsonify Scientific -> Value
f Object
obj
bsonifyValue Scientific -> Value
f (AESON.Array Array
array) = [Value] -> Value
BSON.Array ([Value] -> Value) -> (Array -> [Value]) -> Array -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value) -> [Value] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Scientific -> Value) -> Value -> Value
bsonifyValue Scientific -> Value
f) ([Value] -> [Value]) -> (Array -> [Value]) -> Array -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall a. Vector a -> [a]
Vector.toList (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ Array
array
bsonifyValue Scientific -> Value
_ (AESON.String Text
str) = Text -> Value
BSON.String Text
str
bsonifyValue Scientific -> Value
_ (AESON.Bool Bool
b) = Bool -> Value
BSON.Bool Bool
b
bsonifyValue Scientific -> Value
_ (Value
AESON.Null) = Value
BSON.Null
bsonifyValue Scientific -> Value
f (AESON.Number Scientific
n) = Scientific -> Value
f Scientific
n
aesonifyValue :: BSON.Value -> AESON.Value
aesonifyValue :: Value -> Value
aesonifyValue (Float Double
f) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
f
aesonifyValue (BSON.String Text
s) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
s
aesonifyValue (Doc Document
doc) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Document -> Object
aesonify Document
doc
aesonifyValue (BSON.Array [Value]
list) = Array -> Value
AESON.Array (Array -> Value) -> ([Value] -> Array) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value) -> [Value] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Value
aesonifyValue [Value]
list
aesonifyValue (Bin (Binary ByteString
binary)) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
binary
aesonifyValue (Fun (Function ByteString
function)) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
function
aesonifyValue (Uuid (UUID ByteString
uuid)) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
uuid
aesonifyValue (Md5 (MD5 ByteString
md5)) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
md5
aesonifyValue (UserDef (UserDefined ByteString
userdef)) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
userdef
aesonifyValue (ObjId ObjectId
oid) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ ObjectId -> String
forall a. Show a => a -> String
show ObjectId
oid
aesonifyValue (BSON.Bool Bool
bool) = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
bool
aesonifyValue (UTC UTCTime
utc) = UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON UTCTime
utc
aesonifyValue (Value
BSON.Null) = Value
AESON.Null
aesonifyValue (RegEx (Regex Text
pattern Text
mods)) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"/", Text
pattern, Text
"/", Text
mods]
aesonifyValue (JavaScr (Javascript Document
env Text
code)) = [(Key, Value)] -> Value
object [ Key
"environment" Key -> Object -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Document -> Object
aesonify Document
env, Key
"code" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
code ]
aesonifyValue (Sym (Symbol Text
sym)) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
sym
aesonifyValue (Int32 Int32
int32) = Int32 -> Value
forall a. ToJSON a => a -> Value
toJSON Int32
int32
aesonifyValue (Int64 Int64
int64) = Int64 -> Value
forall a. ToJSON a => a -> Value
toJSON Int64
int64
aesonifyValue (Stamp (MongoStamp Int64
int64)) = Int64 -> Value
forall a. ToJSON a => a -> Value
toJSON Int64
int64
aesonifyValue (MinMax MinMaxKey
mm) = case MinMaxKey
mm of { MinMaxKey
MinKey -> Int -> Value
forall a. ToJSON a => a -> Value
toJSON (-Int
1 :: Int)
; MinMaxKey
MaxKey -> Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int
1 :: Int)}
int64MaxBound, int32MaxBound, int64MinBound, int32MinBound :: S.Scientific
int64MaxBound :: Scientific
int64MaxBound = Int64 -> Scientific
forall i. Integral i => i -> Scientific
toScientific (Int64
forall a. Bounded a => a
maxBound :: Int64)
int32MaxBound :: Scientific
int32MaxBound = Int32 -> Scientific
forall i. Integral i => i -> Scientific
toScientific (Int32
forall a. Bounded a => a
maxBound :: Int32)
int64MinBound :: Scientific
int64MinBound = Int64 -> Scientific
forall i. Integral i => i -> Scientific
toScientific (Int64
forall a. Bounded a => a
minBound :: Int64)
int32MinBound :: Scientific
int32MinBound = Int32 -> Scientific
forall i. Integral i => i -> Scientific
toScientific (Int32
forall a. Bounded a => a
minBound :: Int32)
toScientific :: Integral i => i -> S.Scientific
toScientific :: i -> Scientific
toScientific i
i = Integer -> Int -> Scientific
S.scientific (i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i :: Integer ) Int
0
expo :: S.Scientific -> Int
expo :: Scientific -> Int
expo Scientific
n = Scientific -> Int
S.base10Exponent Scientific
n
coef :: S.Scientific -> Integer
coef :: Scientific -> Integer
coef Scientific
n = Scientific -> Integer
S.coefficient Scientific
n
errorRange :: S.Scientific -> BSON.Value
errorRange :: Scientific -> Value
errorRange Scientific
n | Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
int64MinBound = String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"Number out of min range: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Scientific -> String
forall a. Show a => a -> String
show Scientific
n)
errorRange Scientific
n | Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
> Scientific
int64MaxBound = String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"Number out of max range: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Scientific -> String
forall a. Show a => a -> String
show Scientific
n)
errorRange Scientific
n = Scientific -> Value
bsonifyNumberInRange Scientific
n
bound :: S.Scientific -> BSON.Value
bound :: Scientific -> Value
bound Scientific
n | Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
int64MinBound = Int64 -> Value
Int64 Int64
forall a. Bounded a => a
minBound
bound Scientific
n | Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
> Scientific
int64MaxBound = Int64 -> Value
Int64 Int64
forall a. Bounded a => a
maxBound
bound Scientific
n = Scientific -> Value
bsonifyNumberInRange Scientific
n
bsonifyNumberInRange :: S.Scientific -> BSON.Value
bsonifyNumberInRange :: Scientific -> Value
bsonifyNumberInRange Scientific
n | (Scientific -> Int
expo Scientific
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Double -> Value
Float (Scientific -> Double
forall a. RealFloat a => Scientific -> a
S.toRealFloat Scientific
n :: Double)
bsonifyNumberInRange Scientific
n | Scientific
int64MinBound Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
<= Scientific
n Bool -> Bool -> Bool
&& Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
int32MinBound = Int64 -> Value
Int64 (Int64 -> Value) -> Int64 -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Scientific -> Integer
coef Scientific
n) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10 Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Scientific -> Int
expo Scientific
n)
bsonifyNumberInRange Scientific
n | Scientific
int32MinBound Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
<= Scientific
n Bool -> Bool -> Bool
&& Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
<= Scientific
int32MaxBound = Int32 -> Value
Int32 (Int32 -> Value) -> Int32 -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Scientific -> Integer
coef Scientific
n) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
10 Int32 -> Int -> Int32
forall a b. (Num a, Integral b) => a -> b -> a
^ (Scientific -> Int
expo Scientific
n)
bsonifyNumberInRange Scientific
n | Scientific
int32MaxBound Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
n Bool -> Bool -> Bool
&& Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
<= Scientific
int64MaxBound = Int64 -> Value
Int64 (Int64 -> Value) -> Int64 -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Scientific -> Integer
coef Scientific
n) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10 Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Scientific -> Int
expo Scientific
n)
bsonifyNumberInRange Scientific
_ = String -> Value
forall a. HasCallStack => String -> a
error String
"bsonifyiNumberInRange should be invoked only with n | int64MinBound < n < int64MaxBound"