TokyoCabinetJson2.hs

import System (getArgs)
import Data.Map hiding (map)
import Database.TokyoCabinet
import qualified Data.ByteString.Char8 as B
import Text.JSONb
  
fetch :: String -> Maybe Int -> TCM [(String,B.ByteString)]    
fetch fileName maxElems = do
      tc <- new :: TCM HDB -- alternatively you can use BDB or FDB
      open tc fileName [OREADER]
      iterinit tc
      collect maxElems tc 0 []
    where 
      collect maxElems tc count acc = 
        let (haveMax,theMax) = case maxElems of {Just n -> (True,n); _ -> (False,0)} in 
        do
          k <- iternext tc
          case k of
              Just key | not haveMax || count < theMax -> do
                v <- get tc key
                case v of
                  -- somehow things come back quote-escaped and quoted out of tokyo,
                  -- it's either clojure putting it or haskell getting it;
                  -- for now quickly unescape quotes and remove the enclosing ones
                  Just val -> -- let raw = B.filter (/='\\') . B.init . B.tail $ val in
                    collect maxElems tc (succ count) ((key,val):acc)
                  _ -> error "iternext has a key without a val"
              _ -> return (reverse acc)
   
-- type AdjList = Map String (Map String Int)      
-- type Graph = Map String AdjList

json2graph =
  map step where
    step (key,bval) = 
      let rval = decode bval in
      case rval of
        Left e -> error $ "bad json, error:" ++ e ++ ", " ++ key ++ " => " ++ (B.unpack bval)
        Right val -> case val of {String s -> error $ "String? " ++ (B.unpack s); Object _ -> (key,val)}
    -- step _ = error "fookin prawns!" -- overlapping!

main :: IO ()
main = do
  args  <-  getArgs
  let (fileName,maxElems) = case args of {x:y:_ -> (x,Just (read y :: Int)); x:_ -> (x,Nothing); _ -> error "need a file name for the cabinet"}
  let println = Prelude.putStrLn
  println ("file: " ++ fileName ++ ", maxElems: " ++ (show maxElems))
  -- (pack key) below for ByteString:
  graph' <- runTCM (fetch fileName maxElems)
  println . show $ graph'
  let graph = json2graph graph'
  println . show $ (map snd graph)