I have a type
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiWayIf #-}
import GHC.Generics
import Data.Aeson.TH
import Data.Aeson.Types
data MyJSONObject = MyJSONObject
{ name :: String
, ptype :: Maybe String
, pid :: Maybe String
, subject :: Maybe String
, message :: Maybe String
} deriving (Show, Generic)
with a great many more Maybe String fields. My FromJSON and ToJSON are provided by the TemplateHaskell function
$(deriveJSON defaultOptions
{
omitNothingFields = True
, fieldLabelModifier = \f -> if
| f == "ptype" -> "type" -- reserved keyword
| f == "pid" -> "id" -- Prelude function name
| otherwise -> f
} ''MyJSONObject)
Ultimately, the output of the program is a JSON document intended to be consumed by an application that does not permit some fields to have null values, even if it does allow these fields to not exist. In other words, it's perfectly fine for subject to not be present in the JSON document, but if it does exist, its value cannot be null. My expectation was that omitNothingFields would handle this requirement, but this does not appear to be the case: the decoded JSON still has Nothing values for fields that are not present, and the encoded JSON has null values for those fields. The former case is fine; the latter case is not, hence the question.
Am I misusing, or misunderstanding the purpose of, omitNothingFields? How can I ignore fields with Nothing/null values?
Works for me. Try using Generics deriving instead of TH. Maybe that's doing it.
*Main Data.Aeson> decode "{\"name\":\"str\"}" :: Maybe MyJSONObject
Just (MyJSONObject {name = "str", ptype = Nothing, pid = Nothing, subject = Nothing, message = Nothing})
*Main Data.Aeson> encode (MyJSONObject "str" Nothing Nothing Nothing Nothing)
"{\"name\":\"str\"}"
The full code is
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
import Data.Aeson
import Data.Aeson.Types
data MyJSONObject = MyJSONObject
{ name :: String
, ptype :: Maybe String
, pid :: Maybe String
, subject :: Maybe String
, message :: Maybe String
} deriving (Show, Generic)
instance ToJSON MyJSONObject where
toJSON = genericToJSON defaultOptions
{ omitNothingFields = True }
instance FromJSON MyJSONObject where
parseJSON = genericParseJSON defaultOptions
{ omitNothingFields = True }
Using GHC 8.2.1, aeson-1.1.2.0.
Related
here is my JSON structure, there are N records that has a name as ID to represent a children
{"Kids":
{"Jack":{"age":10}
,"Jane":{"age":9}
, .......
}
}
in the data type in Haskell
data Kid = Kid { name::String, age::Int}
instance FromJSON Kid where
parseJSON (Object v) =
....
question is ,how to make the key ( name ) as part of the constructor ? the expected output signature is like:
decode "input json string" -> [Kid]
when the expect decode function was called, it will return a list of type Kid. Thanks for reading this & appreciate any help .
By using the withObject function, you get access to an Object which is actually a KeyMap which you can manipulate much like the usual Map from e.g. containers. If you're on an older aeson version, Object will instead be a HashMap, so you can use that as well.
EDIT: I remember that Map itself also has a FromJSON, so you can probably use that instead for a shorter "solution":
{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson (FromJSON(..), withObject, (.:), fromJSON)
import Data.Map (Map)
import qualified Data.Map as Map
data Kid = MkKid {name :: String, age :: Int}
newtype Kids = MkKids {unKids :: [Kid]}
instance FromJSON Kids where
parseJSON = withObject "Kids" $ \o -> do
kvmap <- o .: "Kids"
pure $ MkKids $ map (uncurry MkKid) $ Map.toList kvmap
Old "solution", which manipulates they KeyMap
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson.Key (Key)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Aeson.Types (Parser, Object, Value)
import Data.Aeson (FromJSON(..), withObject, (.:), fromJSON)
data Kid = MkKid {name :: String, age :: Int}
newtype Kids = MkKids {unKids :: [Kid]}
instance FromJSON Kids where
parseJSON = withObject "Kids" $ \o -> do
inner <- o .: "Kids"
withObject "inner" parseKids inner
where
parseKids :: Object -> Parser Kids
parseKids obj =
fmap MkKids $ traverse toKid $ KeyMap.toList obj
toKid :: (Key, Value) -> Parser Kid
toKid (k, v) = do
age <- parseJSON v
let name = Key.toString k
pure $ MkKid {name, age}
If I have a data type that looks like this:
data SumType = ABC | DEF deriving (Generic, ToJSON)
data MyType = MyType {field1 :: String, field2 :: SumType} deriving (Generic, ToJSON)
The above will generate a JSON that looks like: {"field1": "blah", "field2":"ABC"}
In practice, MyType is a fairly complex type and I would like to keep the ToJSON deriving but want to adjust just one field to use the show instance.
instance Show SumType where
show ABC = "abc-blah"
show DEF = "def-xyz"
Unfortunately, the above Show instance does not get picked up by ToJSON (I don't know if it is supposed to). Hand rolling ToJSON for SumType does not seem to work because it expects a key-value pair (Maybe there is another of way doing it?). In other words, the JSON will be like: {"field1": "blah", "field2":{"field3": "ABC"}} -- I just want to change the way the value is stringified and not create a new object there.
Any suggestions on how I can change the output string of SumType without manually creating ToJSON for MyType? So the output is {"field1": "blah", "field2":"abc-blah"}
Thanks!
I do not see what the problem is with defining a ToJSON instance for the SumType. You can do this with:
import Data.Aeson(ToJSON(toJSON), Value(String))
import Data.Text(pack)
instance ToJSON SumType where
toJSON = String . pack . show
Or if you want to use other strings for the ToJSON than Show:
{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson(ToJSON(toJSON), Value(String))
instance ToJSON SumType where
toJSON ABC = String "ABC for JSON"
toJSON DEF = String "DEF for JSON"
Now Haskell will JSON-encode the SumType as a JSON string:
Prelude Data.Aeson> encode ABC
"\"ABC for JSON\""
Prelude Data.Aeson> encode DEF
"\"DEF for JSON\""
You can do the same with FromJSON to parse the JSON string back into a SumType object:
{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson(FromJSON(parseJSON), withText)
instance FromJSON SumType where
parseJSON = withText "SumType" f
where f "ABC for JSON" = return ABC
f "DEF for JSON" = return DEF
f _ = fail "Can not understand what you say!"
If we then parse back the JSON string, we get:
Prelude Data.Aeson> decode "\"ABC for JSON\"" :: Maybe SumType
Just ABC
Prelude Data.Aeson> decode "\"DEF for JSON\"" :: Maybe SumType
Just DEF
Prelude Data.Aeson> decode "\"other JSON string\"" :: Maybe SumType
Nothing
Prelude Data.Aeson> decode "{}" :: Maybe SumType
Nothing
So in case we do not decode a JSON string that follows one of the patterns we have defined, the parsing will fail. The same happens if we do not provide a JSON string, but for instance an empty JSON object.
Additional notes:
Since SumType here has two values, you can also use a JSON boolean to encode the values.
you can also encode on different JSON objects. You can for instance use the JSON string for ABC, and an integer for DEF.
Although I would advice not to do this until there are good reasons
(if for instance ABC carries only a string, and DEF ony an
integer).
usually the more complex you make encoding, the more complex decoding will be.
I am new to Haskell, so maybe I am missing some fundamental concepts here (or maybe failed to find the appropriate extension). I was wondering if there was a way to optimize or further abstract the following scenario. This code seems very redundant.
Let's say I have the following data classes:
data Person = Person
{ personName :: !String
, personAge :: !Int
} deriving Show
data Dog = Dog
{ dogName :: !String
, dogAge :: !Int
} deriving Show
Let's say I have a service and I'm only concerned with outputing records as strings. In reality, the strings will probably be JSON and the records fetched from the DB, but let's take a simpler case. I basically need a URL token to fetch an appropriate object (say, the string "dog" will get me a Dog, or even just the Haskell "show" string, without expressly declaring it as (value)::Dog).
I have attempted to implement this in several ways...the only thing that seems to work is the following:
data Creature = DogC Dog
| PersonC Person
deriving Show
fromString :: String -> Maybe Creature
fromString "dog" = Just $ DogC $ Dog "muffin" 8
fromString "person" = Just $ PersonC $ Person "John" 22
fromString _ = Nothing
main :: IO ()
main = do
putStrLn $ show $ fromString "dog"
I'm not entirely fond of the new type, nor the list of fromString declarations. And to benefit from the original data declarations, I would probably need to write a similarly tedious expression (eg, "fromCreature") to revert Creature back into my original types. This information might change, so I would probably need TH for a few of the declarations...
Is there a way around some of this? I fiddled with GADTs and classes, but both seemed to be dependent on type- rather than value- based polymorphism (A string identifier tends to cause issues with ambiguous instances). It would be nice to map the constructor to a string (Say, with Data.Map), but constructors often have different kinds.
Update
So, I went with an approach that isn't exactly relevant to the question I had asked, but it may be useful to someone. I did want to maintain some record types, but most didn't add much value and were getting in my way. The steps I had followed went something like:
Use a different/lower-level DB driver, that returns workable types (eg, [ColumnDef] and [[SQLValue]] instead of tuples and records...).
Create ToJSON instances for SQLValue -- most of the types were covered, except a few ByteString types, and I had to handle the conversion of SQLNull to Null. To maintain compatibility with some record types, my default handler looked like: toJSON = genericToJSON defaultOptions { sumEncoding = UnTaggedValue} The untagged value should allow one to read the JSON into defined data types (eg, Dog / Person ) if desired....
Given that column name is accessible from ColumnDef, I wrote an expression that zips [ColumnDef] and [SqlValue] to a list of Aeson-compatible key-value pairs, eg: toJsPairs :: [ColumnDef] -> [SqlValue] -> [(Text,Value)]
Then, I wrote an expression to fetch the JSON from a table name, which more or less serves as my "universal dispatcher." It references a list of authorized tables, so it's less crazy than it might sound.
The code looked a bit like this (using mysql-haskell).
{-# LANGUAGE OverloadedStrings #-}
import qualified Control.Applicative as App
import Database.MySQL.Base
import qualified System.IO.Streams as Streams
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Types
import Data.Text.Encoding
import Data.String (fromString)
import Data.ByteString.Internal
import qualified Data.ByteString.Lazy.Internal as BLI
import Data.HashMap.Strict (fromList)
appConnectInfo = defaultConnectInfo {
ciUser = "some_user"
, ciPassword = "some_password"
, ciDatabase = "some_db"
}
instance FromJSON ByteString where
parseJSON (String s) = pure $ encodeUtf8 s
parseJSON _ = App.empty
instance ToJSON ByteString where
toJSON = String . decodeUtf8
instance ToJSON MySQLValue where
toJSON (MySQLNull) = Null
toJSON x = genericToJSON defaultOptions
{ sumEncoding = UntaggedValue } x
-- This expression should fail on dimensional mismatch.
-- It's stupidly lenient, but really dimensional mismatch should
-- never occur...
toJsPairs :: [ColumnDef] -> [MySQLValue] -> [(Text,Value)]
toJsPairs [] _ = []
toJsPairs _ [] = []
toJsPairs (x:xs) (y:ys) = (txt x, toJSON y):toJsPairs xs ys
where
-- Implement any modifications to the key names here
txt = decodeUtf8.columnName
listRecords :: String -> IO BLI.ByteString
listRecords tbl = do
conn <- connect appConnectInfo
-- This is clearly an injection vulnerability.
-- Implemented, however, the values for 'tbl' are intensely
-- vetted. This is just an example.
(defs, is) <- query_ conn $ fromString ( "SELECT * FROM `" ++ tbl ++ "` LIMIT 100")
rcrds <- Streams.toList is
return $ encodePretty $ map (jsnobj defs) rcrds
where
jsnobj :: [ColumnDef] -> [MySQLValue] -> Value
jsnobj defs x = Object $ fromList $ toJsPairs defs x
If what you want to consume at the end is json value - it might make sense to
represent result as json value using aeson library:
{-# LANGUAGE DeriveGeneric #-}
import Data.Aeson
import GHC.Generics
data Dog = Dog Int String deriving (Show, Generic)
data Cat = Cat Int String deriving (Show, Generic)
-- here I'm using instance derived with generics, but you can write one by
-- hands
instance ToJSON Dog
instance ToJSON Cat
-- actions to get stuff from db
getDog :: Monad m => Int -> m Dog
getDog i = return (Dog i (show i))
getCat :: Monad m => Int -> m Cat
getCat i = return (Cat i (show i))
-- dispatcher - picks which action to use
getAnimal :: Monad m => String -> Int -> m (Maybe Value)
getAnimal "dog" i = Just . toJSON <$> getDog i
getAnimal "cat" i = Just . toJSON <$> getCat i
getAnimal _ _ = return Nothing
main :: IO ()
main = do
getAnimal "dog" 2 >>= print
getAnimal "cat" 3 >>= print
getAnimal "chupakabra" 12 >>= print
High energy magic version
class Monad m => MonadAnimal m where
-- basically you want something that fetches extra argumets from HTTP or
-- whatevere, perform DB query and so on.
class Animal a where
animalName :: Proxy a -> String
animalGetter :: MonadAnimal m => m a
locateAnimals :: MonadAnimal m => Q [(String, m Value)]
locateAnimals -- implement using TH (reify function is your friend). It should look for
-- all the animal instances in scope and make a list from them with serialized
-- fetcher.
-- with that in place dispatcher should be easy to implement
How do I express the following idea in Haskell? While, the syntax is completely made up, here's what I'm trying to achieve:
My app has highly nested core data-types with each "level" having FromJson/ToJson instances
The JSON API powering the UI has the ability to manipulate individual "levels of nesting", eg. to edit the address, you don't need to edit the complete order.
However, I want to make sure that along with the data that was modified by the UI, the complete order is also sent back. This ensures that, if the edit has resulted in some dependent field in another part of the object being changed, it is communicated back to the UI.
Edit: The core question is not about the app logic, per-se. The core question is how to represent JSON keys in a type-safe manner while having the ability to parameterise over them. The simple solution is to have a different concrete type for each API return type, eg {orderItems :: [OrderItem], order :: Order} or {address :: Address, order :: Order} or {email :: Email, customer :: Customer}. But these will get repetitive quickly. I want to have a data-type which represents the idea of a JSON with a primary key-value pair and a secondary/supporting key-value pair, where the key names can be easily changed.
The pseudo-code given below is a generalisation of this idea:
data IncomingJson rootname payload = (FromJson payload, ToString rootname) => IncomingJson
{
rootname :: payload
}
data OutgoingJson rootname payload sidename sidepayload = (ToJson payload, ToString rootname, ToJson sidepayload, ToString sidename) => IncomingJson
{
rootname :: payload
, sidename :: sidepayload
}
createOrder :: IncomingJson "order" NewOrder -> OutgoingJson "order" Order Nothing ()
editOrderItems :: IncomingJson "items" [OrderItem] -> OutgoingJson "items" [OrderItem] "order" Order
editOrderAddress :: IncomingJson "address" Address -> OutgoingJson "address" Address "order" Order
(Edit: an attempt at a full answer to the revised question.)
The example code below may be close to what you want. This example defines OutgoingJSON and IncomingJSON with custom ToJSON and FromJSON instances respectively. (I included a ToJSON for the IncomingJSON datatype, too, though I suspect you don't need it.) It relies on each datatype being assigned a JSON key via a short KeyedJSON instance. It's possible to use GHC.Generics or some alternative to automate this, but that seems both ugly and ill-advised. (You don't really want your JSON keys directly tied to Haskell data type names, do you?)
If you load this up and look at the types of inExample1 and outExample1, they should match what you expect. inExample2 and inExample3 demonstrate type-safe parsing of a block of JSON -- it succeeds if the key for the expected type exists in the JSON block and fails if it doesn't. Finally, outExample1AsJSON shows how an OutgoingJSON example will be serialized with the desired primary and secondary keys.
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module JsonExample where
import GHC.Generics
import Data.Aeson
import Data.Text (Text)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as C
data Address = Address String deriving (Generic, ToJSON, FromJSON, Show)
data OrderItem = OrderItem Int String deriving (Generic, ToJSON, FromJSON, Show)
data Order = Order { address :: Address
, items :: [OrderItem]
} deriving (Generic, ToJSON, FromJSON, Show)
class KeyedJSON a where jsonKey :: a -> Text
instance KeyedJSON Address where jsonKey _ = "address"
instance KeyedJSON [OrderItem] where jsonKey _ = "orderitems"
instance KeyedJSON Order where jsonKey _ = "order"
--
-- OutgoingJSON
--
data OutgoingJSON primary secondary
= OutgoingJSON primary secondary deriving (Show)
instance (ToJSON primary, KeyedJSON primary,
ToJSON secondary, KeyedJSON secondary) =>
ToJSON (OutgoingJSON primary secondary) where
toJSON (OutgoingJSON prim sec) =
object [ jsonKey prim .= toJSON prim
, jsonKey sec .= toJSON sec
]
--
-- IncomingJSON
--
data IncomingJSON primary
= IncomingJSON primary deriving (Show)
-- don't know if ToJSON instance is needed?
instance (ToJSON primary, KeyedJSON primary) => ToJSON (IncomingJSON primary) where
toJSON (IncomingJSON prim) =
object [ jsonKey prim .= toJSON prim ]
instance (FromJSON primary, KeyedJSON primary) => FromJSON (IncomingJSON primary) where
parseJSON (Object v) = do
let key = jsonKey (undefined :: primary)
IncomingJSON <$> (v .: key >>= parseJSON)
-- Simple examples of typed `IncomingJSON` and `OutgoingJSON` values
-- inExample1 :: IncomingJSON Address
inExample1 = IncomingJSON
(Address "123 New Street")
-- outExample1 :: OutgoingJSON Address Order
outExample1 = OutgoingJSON
(Address "15 Old Street")
(Order (Address "15 Old Street") [OrderItem 1 "partridge", OrderItem 5 "golden rings"])
-- Reading a JSON address in a type-safe manner
aJSONAddress :: ByteString
aJSONAddress = C.pack "{\"address\":\"123 New Street\"}"
-- This returns a `Just (IncomingJSON Address)`
inExample2 :: Maybe (IncomingJSON Address)
inExample2 = decode aJSONAddress
-- This returns `Nothing`
inExample3 :: Maybe (IncomingJSON Order)
inExample3 = decode aJSONAddress
-- This demonstrates the JSON serialization of outExample1
outExample1AsJSON = encode outExample1
I have the following code:
{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
import Data.Aeson
import GHC.Generics
data CharClass = Fighter | Rogue | Wizard deriving (Generic, Show)
instance FromJSON CharClass
instance ToJSON CharClass
I can encode values of this type:
*Main> encode Fighter
"\"Fighter\""
But round-tripping doesn't work:
*Main> eitherDecode $ encode Fighter
Left "Failed reading: satisfy"
*Main> :t eitherDecode $ encode Fighter
eitherDecode $ encode Fighter :: FromJSON a => Either String a
It looks a lot like this answered question, but adding the expected type doesn't work:
*Main> eitherDecode $ encode Fighter :: Either String CharClass
Left "Failed reading: satisfy"
Interestingly, it does work for fromJSON/toJSON:
*Main> fromJSON $ toJSON Fighter :: Result CharClass
Success Fighter
Making at least one of the constructors non-nullary also makes things work, like if I do this:
data CharClass = Fighter Int | Rogue | Wizard deriving (Generic, Show)
And then try to round-trip again:
*Main> decode $ encode (Fighter 0) :: Maybe CharClass
Just (Fighter 0)
I'm sure I'm missing something simple, but attempting to trace this through the generic code made my head spin.
JSON is fundamentally a collection of key-value pairs, where values can be a few primitive types or another collection of key-value pairs. Nullary types just don't fit in very well with the whole idea of being JSON entities by themselves. However, they work fine when placed within other types that mesh well with the JSON concept.
data F = F { a :: CharClass, b :: CharClass }
deriving (Generic, Show)
instance FromJSON F
instance ToJSON F
This looks more like the sort of key-value collection JSON was designed for.
*Main> let x = F Fighter Rogue
*Main> x
F {a = Fighter, b = Rogue}
*Main> decode $ encode x :: Maybe F
Just (F {a = Fighter, b = Rogue})
The version of aeson that stack installed on my machine was from the 0.8 series, and in aeson 0.8 or earlier, only objects and arrays were parsed at the root level.
In aeson 0.9, decode uses value parser. So nullable object (represented as string) at top-level will work.
For 0.8 the below example works. I don't know why decodeWith isn't exposed.
{-# LANGUAGE DeriveGeneric #-}
import Control.Applicative
import GHC.Generics
import Data.Aeson
import Data.Aeson.Parser
import Data.ByteString.Lazy as L
import Data.Attoparsec.ByteString.Char8 (endOfInput, skipSpace)
import qualified Data.Attoparsec.Lazy as L
data CharClass = Fighter | Rogue | Wizard deriving (Generic, Show)
instance ToJSON CharClass
instance FromJSON CharClass
decodeWith p to s =
case L.parse p s of
L.Done _ v -> case to v of
Success a -> Just a
_ -> Nothing
_ -> Nothing
{-# INLINE decodeWith #-}
valueEOF = value <* skipSpace <* endOfInput
decodeValue :: (FromJSON a) => L.ByteString -> Maybe a
decodeValue = decodeWith valueEOF fromJSON
main :: IO ()
main = print (decodeValue (encode Fighter) :: Maybe CharClass)