Convert Bson to Json

aesonBson.hs

{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}

-- https://github.com/mailrank/aeson/blob/master/examples/Demo.hs
-- cabal install aeson
-- cabal install mongoDb

import Data.Aeson
import qualified Data.Aeson.Types as T

import Data.Attoparsec (parse, Result(..))
import Data.Attoparsec.Number (Number(..))
import qualified Data.Text as Text
import Control.Applicative ((<$>))
import Control.Monad (mzero)
import qualified Data.ByteString.Char8 as BS
-- Aeson's "encode" to JSON generates lazy bytestrings
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.CompactString as CS

import Database.MongoDB
import Data.Bson
import qualified Data.Bson as Bson

import GHC.Int

-- Is there a better way to convert between string representations?
csToTxt :: UString -> Text.Text
csToTxt cs = Text.pack $ CS.unpack cs

bsToTxt :: BS.ByteString -> Text.Text
bsToTxt bs = Text.pack $ BS.unpack bs

instance ToJSON Field where
    toJSON f = object [key .= val]
        where key = csToTxt $ label f
              val = toJSON (value f)

-- So, is this how I have to do it? Go through each type and map it? This seems overly complicated
instance ToJSON Data.Bson.Value where
    toJSON (Float f) = T.Number $ D f
    toJSON (Bson.String s) = T.String $ csToTxt s
    toJSON (Doc d) = T.String "How to do Document?"
    toJSON (Bson.Array xs) = T.String "How to do Array?"
    toJSON (Bin b) = T.Null
    toJSON (Fun f) = T.Null
    toJSON (Uuid (UUID bs)) = T.String $ bsToTxt bs
    toJSON (Md5 m) = T.Null
    toJSON (UserDef u) = T.Null
    toJSON (ObjId (Oid w32 w64)) = T.String "look up GHC.Word.Word32 and GHC.Word.Word64"
    toJSON (Bson.Bool b) = T.Bool b
    toJSON (UTC time) = T.String "look up Data.Time.Clock.UTC.UTCTime"
    toJSON Bson.Null = T.Null
    toJSON (RegEx r) = T.Null
    toJSON (JavaScr j) = T.Null
    toJSON (Sym s) = T.Null
    -- I couldn't figure out how to do the ints because they were of type GHC.Int.Int32, which have a weird # GHC.Prim.Int# in the data constructor
    -- toJSON (Int32 (I32 i)) = T.Number $ I i 
    -- toJSON (Int64 i) = T.Number $ I i 
    toJSON (Stamp s) = T.Null
    toJSON (MinMax mm) = T.Null
    -- sort of a catch-all. Probably not safe (doesn't even work for strings)
    toJSON x = T.String $ Text.pack $ show x 
    -- if I decide not to use the other one
    -- toJSON _ = T.Null

-- Data.Bson.Value and T.Value for reference
-- data Data.Bson.Value
--   = Float Double
--   | Data.Bson.String UString
--   | Doc Document
--   | Data.Bson.Array [Data.Bson.Value]
--   | Bin Binary
--   | Fun Function
--   | Uuid UUID
--   | Md5 MD5
--   | UserDef UserDefined
--   | ObjId ObjectId
--   | Data.Bson.Bool Bool
--   | UTC time-1.2.0.3:Data.Time.Clock.UTC.UTCTime
--   | Data.Bson.Null
--   | RegEx Regex
--   | JavaScr Javascript
--   | Sym Symbol
--   | Int32 GHC.Int.Int32
--   | Int64 GHC.Int.Int64
--   | Stamp MongoStamp
--   | MinMax MinMaxKey

-- data T.Value
--   = Object Object
--   | T.Array Array
--   | T.String Text.Text
--   | Number Data.Attoparsec.Number.Number
--   | T.Bool !Bool
--   | T.Null

main ::IO ()
main = do
    putStrLn $ "testing again: " ++ BSL.unpack (encode ["Hello", "I", "am", "angry"])
    
    let field = "key" =: "value"
    print field
    print $ label field
    putStrLn $ CS.unpack $ label field

    putStrLn $ show "asdf"

    -- Getting close
    putStrLn $ "testing again: " ++ BSL.unpack (encode ["hello" =: "world", "num" =: 10.05, "num2" =: 5, "sub" =: ["doc","charlie"]])
    putStrLn $ "testing again: " ++ BSL.unpack (encode ["hello" =: "world", "sub" =: ["doc" =: "charlie"]])