Aeson parsing into multiple constructors - haskell

I'm trying to parse JSON to produce a type with multiple constructors. The challenge is that the type is encoded in the name of a key which contains the required data. In theory I could use a bunch of .:? calls and then check if given key returns Just but I think there must be a better way. I looked at asum but this didn't help me much (probably because of my unfamiliarity with it).
import Data.Aeson
import Data.Time.Clock
data Request = Req1 { id :: String, properties :: Value }
| Req2 { id :: String, properties :: Value }
| Req3 { id :: String, time :: UTCTime }
instance FromJSON Request where
parseJSON = withObject "message" $ \o ->
-- ???
Example requests:
{"req1": {"id": "345", "p1": "v1", "p2": "v2"}}
{"req2": {"id": "654", "p3", "v3"}}
{"req3": {"id": "876", "time": 1234567890}}

Here's how to manually inspect an Object:
{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson
import Data.Time.Clock
import qualified Data.HashMap.Strict as H
import Control.Monad
type Val = Int
data Request = Req1 { id :: String, properties :: Val }
| Req2 { id :: String, properties :: Val }
| Req3 { id :: String, time :: UTCTime }
instance FromJSON Request where
parseJSON (Object v) =
case H.lookup "req1" v of
Just (Object h) -> Req1 <$> h .: "id" <*> h .: "properties"
Nothing ->
case H.lookup "req2" v of
Just (Object h) -> Req2 <$> h .: "id" <*> h .: "properies"
Nothing ->
case H.lookup "req3" v of
Just (Object h) -> Req3 <$> h .: "id" <*> h .: "time"
Nothing -> mzero
If the key req1 exists it will assume it is a Req1 value; else if the key req2 exists it will try to parse it as a Req2 value; etc. for req3. If none of those keys exist it will fail.
Instead of mzero you can also use fail "..." to display a custom error message.

Related

How to parse values distributed across an array with Aeson?

I have an json value of:
{
"name": "xyz1",
"extra": [
{
"this_string_A": "Hello"
},
{
"this_string_B": "World"
}
]
}
And a data type of:
data Abc = Abc
{ name :: String
, a :: Maybe String
, b :: Maybe String
} deriving (Generic, Show)
In the above case I would want it to parse with a result of Abc "xyz1" (Just "Hello") (Just "World").
I can't figure out how to conditionally parse the values within extra (which is a JSON array) within the aeson Parser context. How can I get extra[0].this_string_a for example? I
What I tried:
I thought I could create my own Parser (Maybe String) function but ran into confusing errors:
instance FromJSON Abc where
parseJSON = withObject "Abc" $ \v -> Abc
<$> v .: "name"
<*> myParse v
<*> myParse v
myParse :: Object -> Parser (Maybe String)
myParse x = withArray "extra" myParse2 (x)
myParse2 :: Array -> Parser (Maybe String)
myParse2 = undefined
typecheck fails with:
• Couldn't match type ‘unordered-containers-0.2.10.0:Data.HashMap.Base.HashMap
text-1.2.3.1:Data.Text.Internal.Text Value’
with ‘Value’
Expected type: Value
Actual type: Object
• In the third argument of ‘withArray’, namely ‘(x)’
And if I replace x with Object x then I get parse error of:
Left "Error in $: parsing extra failed, expected Array, but encountered Object"
Full example (run test function to test):
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Example where
import GHC.Generics
import Data.Aeson
import Data.Aeson.Types
data Abc = Abc
{ name :: String
, a :: Maybe String
, b :: Maybe String
} deriving (Generic, Show)
instance FromJSON Abc where
parseJSON = withObject "Abc" $ \v -> Abc
<$> v .: "name"
<*> (v.: "extra") -- find where object has key of this_string_a ??
<*> (v.: "extra") -- find where object has key of this_string_b ??
test :: Either String Abc
test = eitherDecode exampleJson
exampleJson = "{ \"name\": \"xyz1\", \"extra\": [ { \"this_string_A\": \"Hello\" }, { \"this_string_B\": \"World\" } ] }"
The withXXX "helpers" make everything kind of awkward, but here goes.
The Aeson Parser type is misnamed, and this causes confusion.
The idea with Aeson Parser objects is that they represent a monadic parse result. (This is different from the Parser objects you find in Parsec, etc., which represent actual monadic parsers.) So, you should think of a Parser a as isomorphic to an Either ParseError a -- a monadic result with the possibility of failure.
These parse results are usually combined applicatively. So if you have a parser like:
data Xyz = Xyz { x :: String, y :: String }
instance FromJSON Xyz where
parseJSON = withObject "Xyz" $ \v ->
Xyz <$> v .: "x" <*> v .: "y"
the parse results v .: "x" and v .: "y" have type Parser String which is really like Either ParseError a, and the last line of that instance is the usual method of combining successful and unsuccessful results in an applicative manner, along the lines of:
Xyz <$> Right "value_x" <*> Left "while parsing Xyz: key y was missing"
Now, the function parseJSON has type Value -> Parser a. This is what should properly be called a parser, but to avoid confusion, let's call it a "parse function". A parse function takes a JSON representation (a Value, or an Object or some other JSON thingy) and returns a parse result. The withXXX family of functions are used to adapt parse functions between JSON thingies. If you have a parse function that expects an Object, like:
\v -> Xyz <$> v .: "x" <*> v .: "y" :: Object -> Parser Xyz
and you want to adapt it to parseJSON :: Value -> Parser Xyz, you use withObject "str" :: (Object -> Parser Xyz) -> (Value -> Parser Xyz) to do it.
Getting back to your problem, if you'd like to write a core parser that looks like:
\v -> Abc <$> v .: "name" <*> extra .:? "this_string_A"
<*> extra .:? "this_string_B"
you want extra to be an Object, and you want to extract it monadically from the overall JSON object v :: Object, using appropriate withXXX helpers to adapt parse functions from one input JSON thingy type to another. So, let's write a monadic function (a parse function, in fact) to do that:
getExtra :: Object -> Parser Object
getExtra v = do
First, we monadically extract the optional "extra" component from v. We use the conditional form here, so mextra :: Maybe Value.
mextra <- v .:? "extra"
Second, let's monadically create our final Object out of "mextra". This will be the JSON Object whose keys are "this_string_A" and "this_string_B" with the array layer removed. Note the type of this case expression will be Parser Object, a parse result of type Object = HashMap key value. For the Just case, we have a Value that we expect to be an array, so let's use the withArray helper to ensure that. Note that the withArray "str" helper function takes our parse function of type \arr -> do ... :: Array -> Parser Object and adapts it to Value -> Parser Object so it can be applied to vv :: Value.
case mextra of
Just vv -> vv & withArray "Abc.extra" (\arr -> do
Now, arr is an Array = Vector Value. We hope it's an array of Objects. Let's pull the Values out as a list:
let vallst = toList arr
and then monadically traverse the list with the help of withObject to ensure they're all Objects as expected. Note the use of pure here, since we want to extract the Objects as-is without any additional processing:
objlst <- traverse (withObject "Abc.extra[..]" pure) vallst
Now, we have an objlst :: [Object]. They're a set of singleton hashmaps with disjoint keys, and the Object / hashmap we want is their union, so let's return that. The parenthesis here ends the withArray expression that's being applied to vv:
return $ HashMap.unions objlst)
For the Nothing case ("extra" not found), we merely return an empty hashmap:
Nothing -> return HashMap.empty
The full function looks like this:
getExtra :: Object -> Parser Object
getExtra v = do
mextra <- v .:? "extra"
case mextra of
Just vv -> vv & withArray "Abc.extra" (\arr -> do
let vallst = toList arr
objlst <- traverse (withObject "Abc.extra[..]" pure) vallst
return $ HashMap.unions objlst)
Nothing -> return HashMap.empty
and you use it in your parser instance like so:
instance FromJSON Abc where
parseJSON =
withObject "Abc" $ \v -> do
extra <- getExtra v
Abc <$> v .: "name" <*> extra .:? "this_string_A" <*> extra .:? "this_string_B"
With a test case:
example :: BL.ByteString
example = "{\"name\": \"xyz1\", \"extra\": [{\"this_string_A\": \"Hello\"}, {\"this_string_B\": \"World\"}]}"
main = print (eitherDecode example :: Either String Abc)
it works like so:
λ> main
Right (Abc {name = "xyz1", a = Just "Hello", b = Just "World"})
The full code:
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson (eitherDecode, FromJSON, Object, parseJSON, withArray, withObject, (.:), (.:?))
import Data.Aeson.Types (Parser)
import GHC.Generics (Generic)
import qualified Data.ByteString.Lazy as BL (ByteString)
import qualified Data.HashMap.Strict as HashMap (empty, unions)
import Data.Function ((&))
import Data.Foldable (toList)
data Abc = Abc
{ name :: String
, a :: Maybe String
, b :: Maybe String
} deriving (Generic, Show)
instance FromJSON Abc where
parseJSON =
withObject "Abc" $ \v -> do
extra <- getExtra v
Abc <$> v .: "name" <*> extra .:? "this_string_A" <*> extra .:? "this_string_B"
getExtra :: Object -> Parser Object
getExtra v = do
mextra <- v .:? "extra"
case mextra of
Just vv -> vv & withArray "Abc.extra" (\arr -> do
let vallst = toList arr
objlst <- traverse (withObject "Abc.extra[..]" pure) vallst
return $ HashMap.unions objlst)
Nothing -> return HashMap.empty
example :: BL.ByteString
example = "{\"name\": \"xyz1\", \"extra\": [{\"this_string_A\": \"Hello\"}, {\"this_string_B\": \"World\"}]}"
main = print (eitherDecode example :: Either String Abc)
Partial answer...
instance FromJSON Abc where
parseJSON = withObject "Abc" $ \v -> Abc
<$> v .: "name"
<*> (v .: "extra" >>= myParse)
<*> (v .: "extra" >>= myParse)
myParse :: Array -> Parser (Maybe String)
myParse x = withArray "extra" (lookupDictArray "this_string_a") (Array x)
lookupDictArray :: Text -> Array -> Parser (Maybe String)
lookupDictArray k a = do
let v = Vector.find (maybe False (HashMap.member k) . parseMaybe parseJSON) a
case v of
Just v' -> withObject "grrrrrrrrrrr" (\v -> v .: k) v'
Nothing -> pure Nothing
Fails to typecheck with:
src/Example.hs:32:69-77: error:
• Ambiguous type variable ‘a0’ arising from a use of
‘parseJSON’
prevents the constraint ‘(FromJSON a0)’ from being
solved.
Probable fix: use a type annotation to specify
what ‘a0’ should be.
These potential instances exist:
instance FromJSON DotNetTime
-- Defined in ‘aeson-1.4.4.0:Data.Aeson.Types.FromJSON’
instance FromJSON Value
-- Defined in ‘aeson-1.4.4.0:Data.Aeson.Types.FromJSON’
instance (FromJSON a, FromJSON b) => FromJSON
(Either a b)
-- Defined in ‘aeson-1.4.4.0:Data.Aeson.Types.FromJSON’
...plus 29 others
...plus 60 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the first argument of ‘parseMaybe’, namely
‘parseJSON’
In the second argument of ‘(.)’, namely
‘parseMaybe parseJSON’
In the first argument of ‘Vector.find’, namely
‘(maybe False (member k) . parseMaybe
parseJSON)’
|
32 | let v = (Vector.find (maybe False (HashMap.member
k) . parseMaybe parseJSON) a)

Aeson decode JSON object that can be either a string or an int

I'm working with some complexly formatted JSON responses from a REST server. To decode them, I have a couple of data types to handle the different nested objects. For example:
... Other types ...
data Profile =
Profile { fields :: [KVPair]
} deriving (Show)
instance FromJSON Profile where
parseJSON (Object v) =
Profile <$> v .: "Fields"
parseJSON _ = mzero
data KVPair =
KVPair { key :: Int
, value :: String
} deriving (Show)
instance FromJSON KVPair where
parseJSON (Object v) =
KVPair <$> v .: "Key"
<*> v .: "Value"
parseJSON _ = mzero
Everything works except for the final KVPair type. My JSON objects all have integer keys; however, the values can be either an integer or a string:
{
"Key": 0,
"Value": "String Value!"
},
{
"Key": 1,
"Value": 42
}
Now I suppose I could add another sum type to my value decode that is composed of String and Int, but I would prefer to avoid adding a whole new type just for that. Does Aeson have a simple way to handle this scenario?
There are two simple fixes. One is to simply write
data KVPair = KVPair { key :: Int, value :: Value }
and leave all other code the same. Consumers will need to check the Value to see whether it is a string-y thing or a number-y thing.
Probably the better way is to simply provide two alternative parsers that both convert to your desired format. For example, keeping your KVPair definition as is, one might write
showInt :: Int -> String
showInt = show
instance FromJSON KVPair where
parseJSON (Object v)
= KVPair
<$> v .: "Key"
<*> (v .: "Value" <|> (showInt <$> v .: "Value"))
The best of both worlds would be to keep the information about whether it's a String or Int around and to reject other kinds of values; e.g.
data KVPair = KVPair { key :: Int, value :: Either String Int }
instance FromJSON KVPair where
parseJSON (Object v)
= KVPair
<$> v .: "Key"
<*> ( (Left <$> v .: "Value")
<|> (Right <$> v .: "Value")
)
You'll just have to use the Aeson Value type to work with an Object with fields that can be any JSON value.

Aeson: how do I parse an object with an element that is a stringified object?

I need to parse an object that has a string element where the string itself is a stringified object:
{
"a" : "apples",
"bar" : "{\"b\":\"bananas\"}"
}
I would like to parse this into Just ( Foo { fooA = "apples", fooBar = Bar { barB = "bananas" } } ) so if parsing of bar returns Nothing then the parsing of the whole object returns Nothing, ie the result is as though the bar element of the object was not stringified.
Here is my attempt in which the parsing of testData returns Nothing:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Aeson
import Data.Aeson.Types
data Foo = Foo { fooA :: String
, fooBar :: Bar
} deriving (Show)
instance FromJSON Foo where
parseJSON (Object o) = do bar <- (o .: "bar")
Foo <$> o .: "a" <*> parseJSON bar
parseJSON x = typeMismatch "Foo" x
data Bar = Bar { barB :: String
} deriving (Show)
instance FromJSON Bar where
parseJSON (Object o) = Bar <$> o .: "b"
parseJSON x = typeMismatch "Bar" x
testData = "{ \"a\":\"apples\", \"bar\":\"{\\\"b\\\":\\\"bananas\\\"}\" }"
main :: IO ()
main = putStrLn $ show d
where d :: Maybe Foo
d = decode testData
How can I modify the above code to perform closer to what I need?
You can get more insight into what's going on by using:
main = print (eitherDecode testData :: Either String Foo)
which displays: Left "Error in $: expected Bar, encountered String"
In this code:
parseJSON (Object o) = do bar <- (o .: "bar")
Foo <$> o .: "a" <*> parseJSON bar
bar is String ... value.
To accomplish what you want to do, you could add a case to the FromJSON instance for Bar to catch this:
instance FromJSON Bar where
...
parseJSON (String text) =
case eitherDecode (textToLBS text) of
Left e -> fail $ "while decoding a Bar: " ++ e
Right b -> return b
...
Or you could put this code in the parseJSON definition for Foo.
Here textToLBS converts strict Text to lazy ByteStrings:
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Encoding as TE
textToLBS :: T.Text -> LBS.ByteString
textToLBS t = LBS.fromStrict (TE.encodeUtf8 t)
Code available at: http://lpaste.net/143183

Aeson: parsing dynamic keys as type field

Let's say there is a JSON like:
{
"bob_id" : {
"name": "bob",
"age" : 20
},
"jack_id" : {
"name": "jack",
"age" : 25
}
}
Is it possible to parse it to [Person] with Person defined like below?
data Person = Person {
id :: Text
,name :: Text
,age :: Int
}
You cannot define an instance for [Person] literally, because aeson already includes an instance for [a], however you can create a newtype, and provide an instance for that.
Aeson also includes the instance FromJSON a => FromJSON (Map Text a), which means if aeson knows how to parse something, it knows how to parse a dict of that something.
You can define a temporary datatype resembling a value in the dict, then use the Map instance to define FromJSON PersonList, where newtype PersonList = PersonList [Person]:
data PersonInfo = PersonInfo { infoName :: Text, infoAge :: Int }
instance FromJSON PersonInfo where
parseJSON (Object v) = PersonInfo <$> v .: "name" <*> v .: "age"
parseJSON _ = mzero
data Person = Person { id :: Text, name :: Text, age :: Int }
newtype PersonList = PersonList [Person]
instance FromJSON PersonList where
parseJSON v = fmap (PersonList . map (\(id, PersonInfo name age) -> Person id name age) . M.toList) $ parseJSON v
If you enable FlexibleInstances, you can make instance for [Person]. You can parse your object to Map Text Value and then parse each element in map:
{-# LANGUAGE UnicodeSyntax, OverloadedStrings, FlexibleInstances #-}
module Person (
) where
import Data.Aeson
import Data.Aeson.Types
import Data.Text.Lazy
import Data.Text.Lazy.Encoding
import Data.Map (Map)
import qualified Data.Map as M
data Person = Person {
id ∷ Text,
name ∷ Text,
age ∷ Int }
deriving (Eq, Ord, Read, Show)
instance FromJSON [Person] where
parseJSON v = do
objs ← parseJSON v ∷ Parser (Map Text Value)
sequence [withObject "person"
(\v' → Person i <$> v' .: "name" <*> v' .: "age") obj |
(i, obj) ← M.toList objs]
test ∷ Text
test = "{\"bob_id\":{\"name\":\"bob\",\"age\":20},\"jack_id\":{\"name\":\"jack\",\"age\":25}}"
res ∷ Maybe [Person]
res = decode (encodeUtf8 test)
mniip's answer converts the JSON Object to a Map, which leads to a result list sorted by ID. If you don't need the results sorted in that fashion, it's probably better to use a more direct approach to speed things up. In particular, an Object is really just a HashMap Text Value, so we can use HashMap operations to work with it.
Note that I renamed the id field to ident, because most Haskell programmers will assume that id refers to the identity function in Prelude or to the more general identity arrow in Control.Category.
module Aes where
import Control.Applicative
import Data.Aeson
import Data.Text (Text)
import qualified Data.HashMap.Strict as HMS
data PersonInfo = PersonInfo { infoName :: Text, infoAge :: Int }
instance FromJSON PersonInfo where
-- Use mniip's definition here
data Person = Person { ident :: Text, name :: Text, age :: Int }
newtype PersonList = PersonList [Person]
instance FromJSON PersonList where
parseJSON (Object v) = PersonList <$> HMS.foldrWithKey go (pure []) v
where
go i x r = (\(PersonInfo nm ag) rest -> Person i nm ag : rest) <$>
parseJSON x <*> r
parseJSON _ = empty
Note that, like Alexander VoidEx Ruchkin's answer, this sequences the conversion from PersonInfo to Person explicitly within the Parser monad. It would therefore be easy to modify it to produce a parse error if the Person fails some sort of high-level validation. Alexander's answer also demonstrates the utility of the withObject combinator, which I'd have used if I'd known it existed.

'Nothing' Result from Decode in Aeson

I'm using this code:
{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson
import Data.Maybe
import Data.ByteString.Lazy
import Control.Applicative
import Debug.Trace
import Control.Monad
import qualified Data.Aeson.Types as T
main = do
res <- liftA show (liftA decodeOriginal (Data.ByteString.Lazy.readFile "./a.json"))
Prelude.putStrLn res
interpretResult :: Maybe String -> String
interpretResult Nothing = "Error."
interpretResult x = fromJust x
data TotalLine1 = TotalLine1 {
timestamp :: Integer,
value :: Integer
} deriving (Eq, Show)
data Original = Original {
totals :: [TotalLine1]
} deriving (Eq, Show)
instance FromJSON Original where
parseJSON (Object v) = traceStack "Original" (Original <$> (parseJSON =<< (v .: "visitors.total")))
parseJSON _ = mzero
instance FromJSON TotalLine1 where
parseJSON (Object v) = TotalLine1 <$>
v .: "timestamp" <*>
v .: "value"
decodeOriginal :: ByteString -> Maybe Original
decodeOriginal b = traceStack "decoding" (do
a <- decode b :: Maybe Original
return a)
to try and parse JSON like this:
{
visitors.total: [
{
timestamp: 1365548400,
value: 1
},
{
timestamp: 1365548700,
value: 2
},
{
timestamp: 1365549000,
value: 5
},
]
}
But main just returns Nothing every time. What have I done wrong? It seems that even parseJSON isn't being called for Original.
Your JSON file is not valid.
On the one hand, the names of the fields have to be quoted,
"timestamp"
etc. and on the other, you have a trailing comma in the list of TotalLine1s, which causes the decoding of the ByteString to a Value to fail. Quote the field names and remove the trailing comma, and it works.

Resources