Haskell, Aeson & JSON parsing into custom type

Question

Following on from a previous post, I've found I'm totally stuck. I'm trying to parse a JSON structure into my own type, and not only am I stuck on how to parse the Array, I'm not even sure if I'm using the Aeson library as intended. Any help would be greatly appreciated.

The code:

data Exif = Exif [(T.Text, ExifValue)] deriving (Show)
data ExifValue = 
    ExifText T.Text | 
    ExifInt Integer | 
    ExifDouble Double | 
    ExifBool Bool | 
    ExifArray [ExifValue] 
    deriving (Show)

instance FromJSON ExifValue where
    parseJSON (Number (I n)) = return $ ExifInt n
    parseJSON (Number (D n)) = return $ ExifDouble n
    parseJSON (String s)     = return $ ExifText s
    parseJSON (Bool b)       = return $ ExifBool b
    -- parseJSON (Array a)      = ?????

instance FromJSON Exif where
    parseJSON (Object o) = do
        x <- sequence $ map f (M.assocs o)
        return $ Exif x
        where 
        f (t, x) = do
            y <- parseJSON x 
            return ((t, y) :: (T.Text, ExifValue))

parseExifFile = fmap parseExifData . B.readFile

parseExifData :: B.ByteString -> Data.Attoparsec.Result (Data.Aeson.Result [Exif])
parseExifData content = parse (fmap fromJSON json) content

The test file:

[{
  "SourceFile": "test.jpg",
  "ExifTool:ExifToolVersion": 8.61,
  "File:FileName": "test.jpg",
  "File:FileSize": 2174179,
  "File:FileModifyDate": "2011:07:27 16:53:49-07:00",
  "File:FilePermissions": 644,
  "File:FileType": "JPEG",
  "File:MIMEType": "image/jpeg",
  "File:ExifByteOrder": "MM",
  "File:CurrentIPTCDigest": "32d6a77098a73aa816f2570c9472735a",
  "File:ImageWidth": 2592,
  "File:ImageHeight": 1936,
  "File:EncodingProcess": 0,
  "File:BitsPerSample": 8,
  "File:ColorComponents": 3,
  "File:YCbCrSubSampling": "2 2",
  "XMP:Subject": ["alpha","beta","gamma"]
}]

Answer 1

You have to follow the type of parseJSON a little bit down a rabbit trail, but once you recognize what (Array a) represents, it should be straightforward.

parseJSON has type Value -> Parser a, so (Array a) has type Value. One of the variants in the Value type is Array Array, so the a in (Array a) must be of the type Array, which is defined as Vector Value. The Values inside that Vector are what you want to call parseJSON on to return your list, so check out what you can do with a Vector.

The easiest approach would probably to convert a to a list with Vector.toList, and then use mapM to parse the Values.

Alternately, you could avoid the Vector to list conversion by changing your ExifArray variant to hold Vector ExifValue, and then using Vector.mapM.

Answer 2

I'm not native english speaker, so i may not understand you very well. I guess you want to know how to parse json into recursive data type like ExifValue you presented. So i made a simple example to show how to parse json into recursive data type.

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString as B
import Data.Maybe
import Control.Monad
import Control.Applicative
import Data.Attoparsec
import Data.Attoparsec.Number
import Data.Aeson
import qualified Data.Vector as V

data Data = D1 Int | D2 [Data]
    deriving (Show)

instance FromJSON Data where
    parseJSON (Number (I n)) = return $ D1 $ fromInteger n
    parseJSON (Array a)    = D2 <$> mapM parseJSON (V.toList a)

main = do
    let v = fromJust $ maybeResult $ parse json "[1,2,3,[5,3,[6,3,5]]]"
    let v1 :: Data
        v1 = case fromJSON v of
                 Success a -> a
                 Error s   -> error s
    print v1

Answer 3

A slightly newer build of the aeson library (0.3.2.12) supports autogenerating JSON instances.

{-# LANGUAGE TemplateHaskell #-}

import Data.Aeson
import Data.Aeson.TH (deriveJSON)
import Data.Attoparsec
import qualified Data.ByteString as B
import qualified Data.Text as T

data Exif = Exif [(T.Text, ExifValue)] deriving (Show)
data ExifValue = 
    ExifText T.Text | 
    ExifInt Integer | 
    ExifDouble Double | 
    ExifBool Bool | 
    ExifArray [ExifValue] 
    deriving (Show)

deriveJSON id ''Exif
deriveJSON id ''ExifValue

parseExifFile = fmap parseExifData . B.readFile

parseExifData :: B.ByteString -> Data.Attoparsec.Result (Data.Aeson.Result [Exif])
parseExifData content = parse (fmap fromJSON json) content

Produces:

instance ToJSON Exif where
  { toJSON
      = \ value_a1Va
          -> case value_a1Va of { Exif arg1_a1Vb -> toJSON arg1_a1Vb } }
instance FromJSON Exif where
  { parseJSON
      = \ value_a1Vc
          -> case value_a1Vc of {
               arg_a1Vd -> (Exif Data.Functor.<$> parseJSON arg_a1Vd) } }

instance ToJSON ExifValue where
  { toJSON
      = \ value_a1Wd
          -> case value_a1Wd of {
               ExifText arg1_a1We
                 -> object [(T.pack "ExifText" .= toJSON arg1_a1We)]
               ExifInt arg1_a1Wf
                 -> object [(T.pack "ExifInt" .= toJSON arg1_a1Wf)]
               ExifDouble arg1_a1Wg
                 -> object [(T.pack "ExifDouble" .= toJSON arg1_a1Wg)]
               ExifBool arg1_a1Wh
                 -> object [(T.pack "ExifBool" .= toJSON arg1_a1Wh)]
               ExifArray arg1_a1Wi
                 -> object [(T.pack "ExifArray" .= toJSON arg1_a1Wi)] } }
instance FromJSON ExifValue where
  { parseJSON
      = \ value_a1Wj
          -> case value_a1Wj of {
               Object obj_a1Wk
                 -> case Data.Map.toList obj_a1Wk of {
                      [(conKey_a1Wl, conVal_a1Wm)]
                        -> case conKey_a1Wl of {
                             _ | (conKey_a1Wl == T.pack "ExifText")
                               -> case conVal_a1Wm of {
                                    arg_a1Wn
                                      -> (ExifText Data.Functor.<$> parseJSON arg_a1Wn) }
                               | (conKey_a1Wl == T.pack "ExifInt")
                               -> case conVal_a1Wm of {
                                    arg_a1Wo
                                      -> (ExifInt Data.Functor.<$> parseJSON arg_a1Wo) }
                               | (conKey_a1Wl == T.pack "ExifDouble")
                               -> case conVal_a1Wm of {
                                    arg_a1Wp
                                      -> (ExifDouble Data.Functor.<$> parseJSON arg_a1Wp) }
                               | (conKey_a1Wl == T.pack "ExifBool")
                               -> case conVal_a1Wm of {
                                    arg_a1Wq
                                      -> (ExifBool Data.Functor.<$> parseJSON arg_a1Wq) }
                               | (conKey_a1Wl == T.pack "ExifArray")
                               -> case conVal_a1Wm of {
                                    arg_a1Wr
                                      -> (ExifArray Data.Functor.<$> parseJSON arg_a1Wr) }
                               | otherwise -> Control.Monad.mzero }
                      _ -> Control.Monad.mzero }
               _ -> Control.Monad.mzero } }