noob question: BSON pretty printer

[jerng]

Hi,

1. Is there a standard BSON pretty printer for Haskell?
2. If not, is this the correct repository to contribute one? I have already hacked one together while learning how to use Mongo+Haskell.

I'm sorry if this is the wrong place to ask these questions.

[knsd]

Hello, jerng!

I don't know about any pretty printers for BSON.

Maybe you can contribute to bson-haskell repository.

[superbobry]

Why would you want a pretty printer for BSON in the serialisation library? aeson doesn't have one for JSON, for instance.

[jerng]

@knsd Thanks. I will look into pushing it to Data.Bson, when I next have time. @superbobry I guess you're saying that it doesn't belong in Data.Bson? Well do you think it belongs in Database.MongoDB then?

Use case: I'm working in Haskell with MongoDB and I want to read my data ASAP...

I essentially have written a (show') which prints Document types like MongoDB's JavaScript db.collection.find().pretty()

[superbobry]

@jerng, sorry, indeed I was saying 'Data.Bson' is probably not the best place to put a pretty printer, but on second thought, it looks useful for debugging, so why not :)

Is your implementation avail. somewhere?

[jerng]

I did mean to push it to Github at some point. I'm still drowning in learning how Haskell's type system works, so here's the quick and dirty module...

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}

module Jerng (  mdbPrint
             ) where

import Prelude as P
import qualified Database.MongoDB as Mdb
import qualified Data.Text as T
import qualified Data.Text.IO as T

mdbPrint accessed =
  T.putStr $! T.concat [T.replicate 80 "-","\n",mdbAccessedToText accessed]

class MdbAccessed a where 
  mdbAccessedToText :: a -> T.Text
instance MdbAccessed Int where
  mdbAccessedToText b = 
    T.pack $! show b ++ "\n\n(ToText Int)\n\n"
instance MdbAccessed Mdb.Value where
  mdbAccessedToText b = 
    T.concat [showVal 0 b, "\n\n"]
instance MdbAccessed Mdb.Document where
  mdbAccessedToText b = 
    T.concat [showDoc 0 b, "(ToText ([] Field))\n\n"]
instance MdbAccessed ([] Mdb.Document) where
  mdbAccessedToText b = 
    T.concat [showBson b, "\n(ToText ([] Document)\n\n"]
instance MdbAccessed ([] Mdb.Value) where
  mdbAccessedToText b = 
    T.concat [showArr 0 b, "\n(ToText ([] Values)\n\n"]
instance MdbAccessed ([] Mdb.Collection) where
  mdbAccessedToText b = 
    T.concat [showCols b, "\n(ToText ([] Collection)\n\n"]

showBson :: [Mdb.Document] -> T.Text
showBson docList = T.intercalate "\n" (P.map (showDoc 0) docList)

showInd :: Int -> T.Text
showInd ind = T.replicate ind "\t"

showDoc :: Int -> Mdb.Document -> T.Text
showDoc ind doc = T.concat $! "[\n"
  : T.intercalate ",\n" (P.map (showFld (ind+1)) doc)
  : "\n"
  : showInd ind
  : "]\n"
  : ( showInd ind )
  : []  

showArr :: Int -> [Mdb.Value] -> T.Text
showArr ind arr = T.concat $! "[\n"
  : T.intercalate ",\n"
    (P.map (\v -> T.concat [ showInd (ind+1), showVal (ind+1) v ]) arr)
  : "\n"
  : showInd ind
  : "]\n"
  : showInd ind 
  : []

showFld :: Int -> Mdb.Field -> T.Text
showFld ind fld@((Mdb.:=) {Mdb.label=l, Mdb.value=v }) = T.concat $! showInd ind
  : T.pack(show l)
  : " =: "
  : showVal ind v
  : []

showVal :: Int -> Mdb.Value -> T.Text
showVal ind val = case val of 
  Mdb.Float v     -> T.concat [T.pack(show v)," (Float Double)"]
  Mdb.String v    -> T.concat [T.pack(show v)," (String Text)"]
  Mdb.Doc v       -> T.concat [showDoc ind v,"(Doc Document)"]
  Mdb.Array v     -> T.concat [showArr ind v,"(Array [Value])"]
  Mdb.Bin v       -> T.concat [T.pack(show v)," (Bin Binary)"]
  Mdb.Fun v       -> T.concat [T.pack(show v)," (Fun Function)"]
  Mdb.Uuid v      -> T.concat [T.pack(show v)," (Uuid UUID)"]
  Mdb.Md5 v       -> T.concat [T.pack(show v)," (Md5 MD5)"]
  Mdb.UserDef v   -> T.concat [T.pack(show v)," (UserDef UserDefined)"]
  Mdb.ObjId v     -> T.concat [T.pack(show v)," (ObjId ObjectId)"]
  Mdb.UTC v       -> T.concat [T.pack(show v)," (UTC UTCTime)"]
  Mdb.Null        ->                          "Null (Null)"
  Mdb.RegEx v     -> T.concat [T.pack(show v)," (RegEx Regex)"]
  Mdb.JavaScr v   -> T.concat [T.pack(show v)," (JavaScr Javascript)"]
  Mdb.Sym v       -> T.concat [T.pack(show v)," (Sym Symbol)"]
  Mdb.Int32 v     -> T.concat [T.pack(show v)," (Int32 Int32)"]
  Mdb.Int64 v     -> T.concat [T.pack(show v)," (Int64 Int64)"]
  Mdb.Stamp v     -> T.concat [T.pack(show v)," (Stamp MongoStamp)"]
  Mdb.MinMax v    -> T.concat [T.pack(show v)," (MinMax MinMaxKey)"]

showCols :: [Mdb.Collection] -> T.Text
showCols cols = T.concat $! "[\n\t"
  : T.intercalate ",\n\t" cols
  : "\n]"
  : []