Parsing/exporting arbitrarily nested JSON objects to maps in Haskell

Question

I need to be able to parse a giant nested JSON structure into something more malleable, preferably a map from strings to strings.

Example of the kinds of structures I'm talking about:

{ "foo" : "baz", "bar" : {"qux" : "quux", "baz" : {"abracadabra" : "alakazam", "abc" : "xyz" } } }

What I want to parse the above into:

fromList [("foo", "baz"), ("bar/qux", "quux"), ("bar/baz/abracadabra", "alakazam"), ("bar/baz/abc", "xyz")]

Is it possible to use this with a relatively stock parser from Aeson? Should I just do some monkeying around with the JSON AST that Aeson parses until it works?

Answer 1

I couldn't help myself here, I had to abuse lens...

In the example below Primitive is just a data type of the leaf JSON values.

import Data.Aeson
import Control.Lens
import Data.Aeson.Lens

flatten :: Value -> [(String, Primitive)]
flatten (Object obj) = do
    (k, v) <- obj^@..ifolded
    flatten v <&> _1 <>~ (k^..each ++ "/")
flatten (Array  arr) = arr^..each >>= flatten
flatten prim         = [("", prim^?! _Primitive)]

input = "{ \"foo\" : \"baz\", \"bar\" : {\"qux\" : \"quux\", \"baz\" : {\"abracadabra\" : \"alakazam\", \"abc\" : \"xyz\" } } }"

main = do
    print $ input^? _Value . to flatten
    -- Just [("foo/",StringPrim "baz"),("abc/baz/bar/",StringPrim "xyz"),("abracadabra/baz/bar/",StringPrim "alakazam"),("qux/bar/",StringPrim "quux")]

Answer 2

module AesonFun(collapse) where

import qualified Data.Map as M (empty, Map, insert, lookup)
import qualified Data.HashMap.Strict as HM (toList)
import qualified Data.List as L (foldl')
import qualified Data.Aeson as Ae (decode, )
import qualified Data.Text as T (unpack, Text)
import Data.Aeson.Types as AT
import qualified Data.ByteString.Lazy.Char8 as BS ( pack )

collapse :: String -> StringMap
collapse s = maybe M.empty (collapser0 M.empty) $ toValue s

toValue :: String -> Maybe Value
toValue = Ae.decode . BS.pack

type StringMap = M.Map String String

delim = "/"

type Collapser = StringMap -> Value -> StringMap

collapser0 = collapser Nothing

collapser :: (Maybe String) -> Collapser
collapser s m v = case v of
                    AT.Object ob  -> L.foldl' (\m' (c,v') -> c m' v')  m pairs where
                      pairs :: [(Collapser, Value)]
                      pairs = map toPair $ HM.toList ob
                      toPair :: (T.Text, Value) -> (Collapser, Value)
                      toPair (t, v') = (collapser s', v') where
                        s' = case s of
                               Just p  -> Just $ p ++ delim ++ (T.unpack t)
                               Nothing -> Just $ (T.unpack t)
                    AT.String t  -> maybe m (\str -> M.insert str (T.unpack t) m) s
                    otherwise    -> m

AesonFun> collapse "{ \"foo\" : \"baz\", \"bar\" : {\"qux\" : \"quux\", \"baz\" : {\"abracadabra\" : \"alakazam\", \"abc\" : \"xyz\" } } }"
fromList [("bar/baz/abc","xyz"),("bar/baz/abracadabra","alakazam"),("bar/qux","quux"),("foo","baz")]