Messing around with converting from JSON (via Data.Aeson) to CSV-y formats.

JsonToCsv.hs

{-# LANGUAGE OverloadedStrings #-}

import Data.Aeson
import Data.List (nub)
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Vector as V

packShow :: Show a => a -> T.Text
packShow = T.pack . show

convertObjectToTextMap :: Object -> HM.HashMap T.Text T.Text
convertObjectToTextMap jsObj =
  HM.fromList $ (HM.toList jsObj) >>= showVal
  where extractVal :: Value -> T.Text
        extractVal (String s) = packShow s
        extractVal (Number n) = packShow n
        extractVal (Bool b) = packShow b
        extractVal _ = ""
        showVal :: (T.Text, Value) -> [(T.Text, T.Text)]
        showVal (l, Array vec) =
            [(l, wrapText $ T.intercalate "," (fmap extractVal vl))]
          where vl = V.toList vec
                wrapText t = T.append "[" $ T.append t "]"
        showVal (l, Object obj) =
            HM.toList $ convertObjectToTextMap relabeledMap
          where relabeledMap = HM.fromList $ map reLabel $ HM.toList obj
                reLabel :: (T.Text, Value) -> (T.Text, Value)
                reLabel (key, val) = (T.intercalate "." [l, key], val)
        showVal (l, v) = [(l, extractVal v)]

csvFromHashMapList :: [HM.HashMap T.Text T.Text] -> [T.Text]
csvFromHashMapList hashMapList =
    fmap (T.intercalate ",") $ fmap packShow hashMapKeys : (fmap hashMapToList hashMapList)
  where hashMapKeys = nub $ concatMap HM.keys hashMapList
        showKeyOrEmpty hashMap key = maybe "" id (HM.lookup key hashMap)
        hashMapToList hashMap = fmap (showKeyOrEmpty hashMap) hashMapKeys

exampleJSON = "[{ \"animal\": \"dog\", \"color\": \"red\", \"type\": \"animal\" },{ \"fruit\": \"apple\", \"color\": \"green\", \"type\": \"fruit\" }]"

main :: IO ()
main = mapM_ T.putStrLn $ csvFromHashMapList $ textMapOrFail exampleJSON
  where textMapOrFail json = maybe [] (fmap convertObjectToTextMap) $ maybeObjectList json
        maybeObjectList json = decode json :: Maybe [Object]