-- License: CC0 (see LICENSE_aeson-bson)
-- Author: Niklas Hambuechen <mail@nh2.me>
-- Author: Andras Slemmer <0slemi0@gmail.com>
-- Upstream repository: https://github.com/dino-/aesonbson

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.Aeson.Bson (
  toAeson, aesonifyValue,
  toBson, bsonifyValue
) where

import Data.Bson as BSON
import Data.Aeson.Types as AESON
import Data.Text as T hiding (map)
import Data.Text.Encoding (decodeUtf8)
import Data.ByteString (ByteString)
import Data.HashMap.Strict as Map (fromList, toList)
import Data.Vector as Vector (toList)
import Numeric
import Data.Scientific

instance ToJSON BSON.Value where
  toJSON = aesonifyValue

instance ToJSON BSON.Field where
  toJSON (_ := v) = aesonifyValue v

bsonifyValue :: AESON.Value -> BSON.Value
bsonifyValue (Object obj) = Doc $ toBson obj
bsonifyValue (AESON.Array array) = BSON.Array . map bsonifyValue . Vector.toList $ array
bsonifyValue (AESON.String str) = BSON.String str
bsonifyValue (Number n) = case floatingOrInteger n of 
                                    { Right (int :: Integer)   -> Int64 $ fromIntegral int
                                    ; Left float -> Float float }
bsonifyValue (AESON.Bool b) = BSON.Bool b
bsonifyValue (AESON.Null) = BSON.Null

instance ToJSON ByteString where
    toJSON = toJSON . decodeUtf8

aesonifyValue :: BSON.Value -> AESON.Value
aesonifyValue (Float f) = toJSON f
aesonifyValue (BSON.String s) = toJSON s
aesonifyValue (Doc doc) = Object . toAeson $ doc
aesonifyValue (BSON.Array list) = toJSON 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 w32 w64)) = toJSON $ showHex w32 (showHex w64 "")
aesonifyValue (BSON.Bool bool) = toJSON bool
aesonifyValue (UTC utc) = toJSON utc
aesonifyValue (BSON.Null) = AESON.Null
aesonifyValue (RegEx (Regex pattern mods)) = toJSON $
                                           '/' : T.unpack pattern ++
                                           '/' : T.unpack mods
aesonifyValue (JavaScr (Javascript env code)) = toJSON . Map.fromList $
                                              [ (T.pack "environment", toJSON env)
                                              , (T.pack "code", toJSON 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)}


toBson :: AESON.Object -> BSON.Document
toBson = map (\(t, v) -> (t := bsonifyValue v)) . Map.toList

toAeson :: BSON.Document -> AESON.Object
toAeson = Map.fromList . map (\(l := v) -> (l, aesonifyValue v))