Functionally changing key names in serialization to aeson with Text keys - json

I have a json object with a manually crafted ToJSON instance. I would like to replace this with a function that does not require my explicit enumeration of the key names.
I am using "rec*" as a prefix I would like to strip, and my fields start out as Text rather than string.
Starting with minimal data:
data R3 = R3 { recCode :: Code
, recValue :: Value} deriving (Show, Generic)
And smart constructor function:
makeR3 rawcode rawval = R3 code value where
code = rawcode
value = rawval
This implementation works fine:
instance ToJSON R3 where
toJSON (R3 recCode recValue) = object [ "code" .= recCode, "value" .= recValue]
But as you can imagine, typing out every key name by hand from "code" to "recCode" is not something I want to do.
tmp_r3 = makeR3 "TD" "100.42"
as_json = encode tmp_r3
main = do
let out = encodeToLazyText tmp_r3
I.putStrLn out
I.writeFile "./so.json" out
return ()
Output is correct:
{"value":100.42,"code":"TD"}
-- not recValue and recCode, correct!
However, when I try this function, it becomes unable to convert the text to string as it had automatically before.
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = T.toLower . IHaskellPrelude.drop 3 }
Output:
<interactive>:8:35: error:
• Couldn't match type ‘Text’ with ‘String’
Expected type: String -> String
Actual type: String -> Text
• In the ‘fieldLabelModifier’ field of a record
In the first argument of ‘genericToJSON’, namely ‘defaultOptions {fieldLabelModifier = toLower . IHaskellPrelude.drop 3}’
In the expression: genericToJSON defaultOptions {fieldLabelModifier = toLower . IHaskellPrelude.drop 3}
<interactive>:8:47: error:
• Couldn't match type ‘String’ with ‘Text’
Expected type: String -> Text
Actual type: String -> String
• In the second argument of ‘(.)’, namely ‘IHaskellPrelude.drop 3’
In the ‘fieldLabelModifier’ field of a record
In the first argument of ‘genericToJSON’, namely ‘defaultOptions {fieldLabelModifier = toLower . IHaskellPrelude.drop 3}’
The error itself is clear enough that Text doesn't work, but what should I change to strip my prefixes from keynames functionally in json output
and also correctly convert text to string?
I am also a little confused that I didn't change my input, it was Text type in both instances, but the first implementation was OK to work with it, while the second was not.
I am working in an ihaskell jupyter notebook.
Update
When I use the Data.Char recommended in answers below:
import Data.Char(toLower)
In:
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = Data.Char.toLower . IHaskellPrelude.drop 3 }
I get:
<interactive>:8:35: error:
• Couldn't match type ‘Char’ with ‘String’
Expected type: String -> String
Actual type: String -> Char
• In the ‘fieldLabelModifier’ field of a record
In the first argument of ‘genericToJSON’, namely ‘defaultOptions {fieldLabelModifier = Data.Char.toLower . IHaskellPrelude.drop 3}’
In the expression: genericToJSON defaultOptions {fieldLabelModifier = Data.Char.toLower . IHaskellPrelude.drop 3}
<interactive>:8:55: error:
• Couldn't match type ‘String’ with ‘Char’
Expected type: String -> Char
Actual type: String -> String
• In the second argument of ‘(.)’, namely ‘IHaskellPrelude.drop 3’
In the ‘fieldLabelModifier’ field of a record
In the first argument of ‘genericToJSON’, namely ‘defaultOptions {fieldLabelModifier = Data.Char.toLower . IHaskellPrelude.drop 3}’
And when I try a naked "drop" rather than an IHaskellPrelude drop, I get:
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = Data.Char.toLower . drop 3 }
<interactive>:8:55: error:
Ambiguous occurrence ‘drop’
It could refer to either ‘BS.drop’, imported from ‘Data.ByteString’
or ‘IHaskellPrelude.drop’, imported from ‘Prelude’ (and originally defined in ‘GHC.List’)
or ‘T.drop’, imported from ‘Data.Text’

You seem to be using toLower from Data.Text, which works with Text, not with String, so quite naturally, it doesn't fit there.
Instead, you could use toLower from Data.Char and map it over the String:
fieldLabelModifier = map toLower . drop 3

You compose two function T.toLower and drop 3, but the types do not match. Indeed, if we lookup the types, we see toLower :: Text -> Text and drop :: Int -> [a] -> [a]. A String is a list of Chars, but Text is not: a Text can be seen as a packed "block" of characters.
We can however compose a function of type String -> String, the type of the field fieldLabelModifier :: String -> String:
import Data.Char(toLower)
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = map toLower . drop 3
}
We thus use the toLower :: Char -> Char function of the Data.Char module, and perform a mapping, such that all characters in the string are mapped.
Note that if you simply want to derive FromJson and ToJSON with different options, you can make use of template Haskell, like:
{-# LANGUAGE DeriveGeneric, TemplateHaskell #-}
import Data.Char(toUpper)
import Data.Aeson.TH(deriveJSON, defaultOptions, Options(fieldLabelModifier))
data Test = Test { attribute :: String } deriving Show
$(deriveJSON defaultOptions {fieldLabelModifier = map toUpper . drop 3} ''Test)
In that case the template Haskell part will implement the FromJSON and ToJSON instances.
Note: We can use qualified imports in order to make it more clear what function we use, for example:
import qualified Data.List as L
import qualified Data.Char as C
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = map C.toLower . L.drop 3
}
Note: As for the smart constructor, you can simplify this expression to:
makeR3 = R3

Related

Parsing nested JSON into a list of Tuples with Aeson

Say I have the following structure:
data AddressDto = AddressDto
{ addressDtoId :: UUID
, addressDtoCode :: Text
, addressDtoCity :: Maybe Text
, addressDtoStreet :: Text
, addressDtoPostCode :: Text
} deriving (Eq, Show, Generic)
instance FromJSON AddressDto where
parseJSON = genericParseJSON $ apiOptions "addressDto"
instance ToJSON AddressDto where
toJSON = genericToJSON $ apiOptions "addressDto"
toEncoding = genericToEncoding $ apiOptions "addressDto"
This works as you would expect.
Now say I want to parse a JSON structure of the format:
{ UUID: AddressDto, UUID: AddressDto, UUID: AddressDto }
A reasonable Haskell representation would seem to be:
data AddressListDto = AddressListDto [(UUID, AddressDto)]
Creating a helper function like so:
keyAndValueToList :: Either ServiceError AddressListDto -> Text -> DiscountDto -> Either ServiceError AddressListDto
keyAndValueToList (Left err) _ _ = Left err
keyAndValueToList (Right (AddressListDto ald)) k v = do
let maybeUUID = fromString $ toS k
case maybeUUID of
Nothing -> Left $ ParseError $ InvalidDiscountId k
Just validUUID -> Right $ AddressListDto $ (validUUID, v) : ald
and finally an instance of FromJSON:
instance FromJSON AddressListDto where
parseJSON = withObject "tuple" $ \o -> do
let result = foldlWithKey' keyAndValueToList (Right $ AddressListDto []) o
case result of
Right res -> pure res
Left err -> throwError err
This fails to compile with:
Couldn't match type ‘aeson-1.4.5.0:Data.Aeson.Types.Internal.Value’
with ‘AddressDto’
Expected type: unordered-containers-0.2.10.0:Data.HashMap.Base.HashMap
Text AddressDto
Two questions:
1) How do I make sure the nested values in the hashmap get parsed correctly to an AddressDto.
2) How do I avoid forcing the initial value into an either? Is there a function I could use instead of foldlWithKey' that didn't make me wrap the initial value like this?
Funny answer. To implement parseJSON, you can use
parseJSON :: Value -> Parser (HashMap Text AddressDto)
...but even better, why not just use a type alias instead of a fresh data type, so:
type AddressListDto = HashMap UUID AddressDto
This already has a suitable FromJSON instance, so then you don't even need to write any code yourself.

Recursively change a JSON data structure in Haskell

I am trying to write a function that will take a JSON object, make a change to every string value in it and return a new JSON object. So far my code is:
applyContext :: FromJSON a => a -> a
applyContext x =
case x of
Array _ -> map applyContext x
Object _ -> map applyContext x
String _ -> parseValue x
_ -> x
However, the compiler complains about second second case line:
Couldn't match expected type `[b0]' with actual type `a'
`a' is a rigid type variable bound by
the type signature for:
applyContext :: forall a. FromJSON a => a -> a
at app\Main.hs:43:17
I'm guessing that is because map is meant to work on lists, but I would have naively expected it to use Data.HashMap.Lazy.map instead, since that is what the type actually is in that case. If I explicitly use that function I get
Couldn't match expected type `HashMap.HashMap k0 v20' with actual type `a'
which also makes sense, since I haven't constrained a to that extent because then it wouldn't work for the other cases. I suspect that if I throw enough explicit types at this I could make it work but it feels like it should be a lot simpler. What is an idiomatic way of writing this function, or if this is good then what would be the simplest way of getting the types right?
First of all, what FromJSON a => a does mean? It's type of some thing what says: it can be thing with any type but only from class FromJSON. This class can contain types which very differently constructed and you can't do any pattern matching. You can only do what is specified in the class FromJSON declaration by programmer. Basically, there is one method parseJSON :: FromJSON a => Value -> Parser a.
Secondly, you should use some isomorphic representation of JSON for your work. The type Value is good one. So, you can do the main work by the function like Value -> Value. After that, you can compose this fuction with parseJSON and toJSON for generalse types.
Like this:
change :: Value -> Value
change (Array x) = Array . fmap change $ x
change (Object x) = Object . fmap change $ x
change (String x) = Object . parseValue $ x
change x = x
apply :: (ToJSON a, FromJSON b) => (Value -> Value) -> a -> Result b
apply change = fromJSON . change . toJSON
unsafeApply :: (ToJSON a, FromJSON b) => (Value -> Value) -> a -> b
unsafeApply change x = case apply change x of
Success x -> x
Error msg -> error $ "unsafeApply: " ++ msg
applyContext :: (ToJSON a, FromJSON b) => a -> b
applyContext = unsafeApply change
You can write more complicated transformations like Value -> Value with lens and lens-aeson. For example:
import Control.Lens
import Control.Monad.State
import Data.Aeson
import Data.Aeson.Lens
import Data.Text.Lens
import Data.Char
change :: Value -> Value
change = execState go
where
go = do
zoom values go
zoom members go
_String . _Text . each %= toUpper
_Bool %= not
_Number *= 10
main = print $ json & _Value %~ change
where json = "{\"a\":[1,\"foo\",false],\"b\":\"bar\",\"c\":{\"d\":5}}"
Output will be:
"{\"a\":[10,\"FOO\",true],\"b\":\"BAR\",\"c\":{\"d\":50}}"

Parsing an Options Object to a List of Options

I have been working on a small library against an JSON-based API. This library makes use of an "options" object, a series of key-value pairs that specify advanced behaviour:
{
"id": 1234
...
"options": {
"notify_no_data": True,
"no_data_timeframe": 20,
"notify_audit": False,
"silenced": {"*" :1428937807}
}
}
I've represented the options concept in Haskell using a list of options:
data Option = NotifyNoData NominalDiffTime -- notify after xyz
| NotifyAudit -- notify on changes
| Silenced (Maybe UTCTime) -- silence all notifications ("*") until xyz (or indefinitely)
newtype Options = Options [Option]
Implementing toJSON was simple enough; I instantiated toJSON for the Option type, and then used those as helpers for the Options type.
instance ToJSON Option where
toJSON (Silenced mtime) =
Object $ Data.HashMap.fromList [("silenced", mapping)]
where stamp = maybe Null (jsonTime . floor . utcTimeToPOSIXSeconds) mtime
mapping = Object $ Data.HashMap.singleton "*" stamp
toJSON (NotifyNoData difftime) =
Object $ Data.HashMap.fromList [("notify_no_data", Bool True)
,("no_data_timeframe", stamp)]
where stamp = jsonTime $ floor (difftime / 60)
toJSON NotifyAudit =
Object $ Data.HashMap.fromList [("notify_audit", Bool True)]
instance ToJSON Options where
toJSON (Options options) = Object $ Data.HashMap.unions $ reverse $ (opts:) $ map ((\(Object o) -> o) . toJSON) options
where opts = Data.HashMap.fromList [("silenced", Object Data.HashMap.empty)
,("notify_no_data", Bool False)
,("notify_audit", Bool False)]
The problem I am running into is in the fromJSON implementation for Options. All the use cases I've seen before supply a fairly simple json-object-representation to data-representation mapping. What I need to do is convert an object to an object of options to a list of data (Option) representations. For example, the sample JSON under "options" that I gave at the start would have to become:
Options [NotifyNoData 20, Silenced (Just (posixSecondsToUTCTime 1428937807))]
FromJSON requires an implementation of parseJSON :: FromJSON a => Value -> Parser a. I am having trouble understanding how to build a Parser using this optional object structure given by the API. Is there a standard approach to parsing a JSON object to a list like this? It may be that I am failing to fully understand the Parser typeclass.
You can maybe use the parser monad to extract all the information, something like:
parseJSON (Object v) = do
maybeNotify <- v .:? "notify_no_data"
maybeTimeFrame <- v .:? "no_data_timeframe"
let nots = case (maybeNotify,maybeTimeFrame) of
(Just True,Just stamp) -> [NotifyNoData $ fromJsontime stamp]
_ -> []
return $ Options nots
(fromJsontime is just a helper function to convert from the JSON value to your NominalDiffTime, I suppose you have something for that).
Do the same for the other types of options, concatenating the result.
Using the json-stream parser (which I am the author of), it would look like this (from my head, untested):
option = NotifyNoData <$> "no_data_timeframe" .: value
<* filterI id ("notify_no_data" .: bool)
<|> const NotifyAudit <$> filterI id ("notify_audit" .: bool)
<|> Silenced <$> "silenced" .: "*" .:? value
optionList = Options <$> toList option
The code expects you have FromJSON instance for UTCTime (or you could just use 'integer' and some kind of fromposixtime etc.).

How can you have two records with the same field names?

I'm writing a JSON service for JIRA, and I've come across a requirement that conflicts with Haskell's namespace.
I have this record
data Assignee = Assignee {name :: Text} deriving Generic
instance ToJSON Assignee
This is dictated by what JIRA wants, unfortunately it wants the same field for a different object.
data Reporter = Reporter {name :: Text} deriving Generic
instance ToJSON Reporter
I see a few options:
Maybe I can circumvent the compiler's complaining with template Haskell, but how?
I could simply not have a Reporter record, and change the reporter field with a seperate service after the ticket has been created. That I know how to do, but is it the best way?
Create the JSON object by hand, but I form it from this record:
data Fields = Fields
{ project :: HashMap Key Project
, summary :: Text
, issuetype :: HashMap Name Task
, versions :: [HashMap Name Text]
, description :: Text
, assignee :: Assignee
} deriving (Generic)
The thought of making this by hand gives me the wiggins. If I must I will.
So, my question now is, if there is no other better way than the ones I've presented, which of these is the best course of action?
The most straightforward way is to enable the -XDisambiguateRecordFields extension.
If DisambiguateRecordFields and/or keeping the records in separate modules works for you, that's excellent.
If not, then a common way to work around this problem is to prefix record field labels in some way, to disambiguate:
data Assignee = Assignee {assigneeName :: Text} deriving Generic
data Reporter = Reporter {reporterName :: Text} deriving Generic
You can still use GHC Generics to derive the JSON translation functions, but you have to configure it so that the field labels are changed, for example like this:
stripPrefix :: Eq a => [a] -> [a] -> [a]
stripPrefix p x = case splitAt (length p) x of
(y, z)
| y == p -> z
| otherwise -> x
lower :: String -> String
lower [] = []
lower (x : xs) = toLower x : xs
stripPrefixOptions :: String -> Options
stripPrefixOptions p = defaultOptions {
fieldLabelModifier = lower . stripPrefix p
}
Then you can say:
data Assignee = Assignee {assigneeName :: Text} deriving Generic
instance ToJSON Assignee where
toJSON = genericToJSON (stripPrefixOptions "assignee")
data Reporter = Reporter {reporterName :: Text} deriving Generic
instance ToJSON Reporter where
toJSON = genericToJSON (stripPrefixOptions "reporter")
Testing in GHCi:
GHCi> > encode (Assignee { assigneeName = "foo" })
"{\"name\":\"foo\"}"

Parse strings that are surrounded with quotes

I'm parsing some data I don't control. I have values that are an array of strings. They can either be normal strings, a string representation of a number, or a number with quotes around it.
["This is just a string", "\"5\"", "3"]
I would like to write a function toValue that converts them into the appropriate type to be converted to JSON.
toValue :: (ToJSON a) => String -> a
toValue (if a number) = parseInt
toValue (if a quoted number) = parseInt . stripQuotes
toValue _ = id
I would like to strip the quotes if it is a number surrounded by quotes, then convert it to a number if a number, otherwise pass it back as a string.
Can I do this with pattern matching? Some other way?
import Data.Char
import Data.Bool
parse a#('"':n:'"':[]) = bool (Left a) (Right (read [n] :: Int)) (isNumber n)
parse a#('"':n:m:'"':[]) = bool (Left a) (Right (read [n,n] :: Int)) (isNumber n && isNumber m)
parse a#(n:[]) = bool (Left a) (Right (read [n] :: Int)) (isNumber n)
parse a#(n:m:[]) = bool (Left a) (Right (read [n,n] :: Int)) (isNumber n && isNumber m)
parse xs = Left xs
> map parse ["This is just a string", "\"5\"", "3"]
[Left "This is just a string",Right 5,Right 3]
then, you can use either function from Data.Either module to encode number (Rights) and string (Lefts) to JSON.
Writing a function toValue :: ToJSON a => String -> a as you are proposing is not so hard: let us simply make toValue a method of the class ToJSON
class ToJSON a where
toValue :: String -> a
and then define the instance for Int as
instance ToJSON Int where
toValue s#('\"' : _) = read (read s) -- with quotes
toValue s = read s -- without quotes
The instance for String is slightly more involved (as String is a synonym for [Char]) but by no means rocket science:
class ToJSONList a where
toValues :: String -> [a]
instance ToJSONList Char where
toValues = id
instance ToJSONList a => ToJSON [a] where
toValue = toValues
Now, testing it in an interactive session, we have:
> toValue "This is just a string" :: String
"This is just a string"
> toValue "\"5\"" :: Int
5
> toValue "3" :: Int
3
However, from your question it seems that you have a use case that is not well supported by such a function toValue, i.e., to convert all elements of a list to their appropriate JSON-representation. To do so, you probably want to introduce an algebraic datatype for representing JSON-values:
data JSON = JInt Int | JString String deriving Show
and then have function toJSON that takes strings to their most appropriate JSON-representation:
toJSON :: String -> JSON
toJSON s =
case reads s of
[(n, "")] -> JInt n -- Int, no quotes
_ -> case reads s of
[(s, "")] -> case reads s of
[(n, "")] -> JInt n -- Int, quotes
_ -> JString s -- String, quotes
_ -> JString s -- String, no quotes
Indeed, to answer that part of your question, this function is defined just by (nested) pattern matching. However, if the (grammar of the) language you need to parse becomes more complicated then just integer literals, quoted integer literals, and string literals, this way of defining parsers quickly becomes to clumsy and error-prone, and you may want to start looking into parser combinators or parser generators then.
For your simple language of JSON values, this is arguably still fine though. Here is a simple example in an interactive session:
> map toJSON ["This is just a string", "\"5\"", "3"]
[JString "This is just a string",JInt 5,JInt 3]