JSON から BSON に変換する関数を作ってみた

Haskell には Text.JSON という JSON パッケージと、Data.Bson という BSON パッケージがあるのだけど、Text.JSON から Data.Bson へ変換する方法は探しても見つからなかったので作ってみた。

module JtoB (
    J.Result(J.Ok, J.Error),
    jsonStringToBson,
    jsonValueToBson,
    jsonObjectToBson
) where

import Control.Arrow ((***))
import qualified Text.JSON as J
import qualified Data.Bson as B

jsonStringToBson :: String -> (J.Result B.Document)
jsonStringToBson = j2b . J.decode
  where
    j2b (J.Ok    a) = jsonValueToBson a
    j2b (J.Error a) = J.Error a

jsonValueToBson :: J.JSValue -> (J.Result B.Document)
jsonValueToBson (J.JSObject obj) = J.Ok $ jsonObjectToBson obj
jsonValueToBson _                = J.Error "The first arg type isn't JSObject"

jsonObjectToBson :: (J.JSObject J.JSValue) -> B.Document
jsonObjectToBson = map toField . J.fromJSObject
  where
    toField :: (String, J.JSValue) -> B.Field
    toField = uncurry (B.:=) . (B.u *** toValue)
      where
        toValue :: J.JSValue -> B.Value
        toValue J.JSNull               = B.Null
        toValue (J.JSBool b)           = B.Bool b
        toValue (J.JSRational _ ratio) = (B.Float . fromRational) ratio
        toValue (J.JSString str)       = (B.String . B.u . J.fromJSString) str
        toValue (J.JSArray array)      = (B.Array . map toValue) array
        toValue (J.JSObject obj)       = (B.Doc . jsonObjectToBson) obj

Rational は分母が 1 だったら BSON の int32 か int64 に変換してやろうかなーとか思ったんだけど、場合によって double だったり int32 だったりとかしたら絶対やりにくいので、全部 double に統一することにしてみた。