Decode untagged JSON with argonaut-generic library

Hello,
I am attempting to decode

[ {"_buttonOnCount": 1, "_buttonClickCount": 2}
, {"_buttonOnCount": 3, "_buttonClickCount": 4}
]

into a list of

newtype Foo =
    Foo {
      _buttonOnCount :: Int
    , _buttonClickCount :: Int
    }

using https://pursuit.purescript.org/packages/purescript-argonaut-generic/6.0.0 .

These are provided:

derive instance genericFoo :: Generic Foo _
derive instance newtypeFoo :: Newtype Foo _
instance decodeFoo :: DecodeJson Foo where
  decodeJson = genericDecodeJson

It appears to me the “argonaut-generic” library does not support decoding untagged JSON: https://pursuit.purescript.org/packages/purescript-argonaut-generic/6.0.0/docs/Data.Argonaut.Types.Generic.Rep

I would expect this to work (assuming the values key is set correctly; Aeson uses “contents”):

[{"tag":"Foo", "contents": {"_buttonOnCount":1,"_buttonClickCount":2}}
,{"tag":"Foo", "contents": {"_buttonOnCount":3,"_buttonClickCount":4}}
]

Server-side is Haskell and Aeson. I cannot easily produce tagged JSON because it seems Aeson discourages the use of tagged JSON for product types (referred to as single constructor types by Aeson). I am attempting to implement the advice of this StackOverflow question and use untagged JSON: https://stackoverflow.com/questions/57628831/single-tag-constructors-in-aeson

Is it correct that “argonaut-generic” does not support decoding untagged JSON?

Thank you

1 Like

The tag is from your newtype wrapping. If you just tell Argonaut to decode to a record type instead you get the desired result: https://try.purescript.org/?gist=36843c09f769e42d25075cc3fc94beb4

module Main where

import Prelude

import Effect (Effect)
import TryPureScript (render, withConsole)
import Data.Argonaut as A
import Data.Either (Either)
import Effect.Console as Console

json :: String
json = """
[ {"_buttonOnCount": 1, "_buttonClickCount": 2}
, {"_buttonOnCount": 3, "_buttonClickCount": 4}
]
"""

type Foo = 
  { _buttonOnCount :: Int
  , _buttonClickCount :: Int
  }
  
foos :: Either String (Array Foo) 
foos = do
  j <- A.jsonParser json
  A.decodeJson j

main :: Effect Unit
main = render =<< withConsole (Console.logShow foos)
3 Likes

Thank you very much!

1 Like

@peterbecich
On the Aeson side of things in Haskell you actually have quite a bit of control over the tagging. I see the Stackoverflow post you linked refers to the defaultOptions for generic encoding and on the Data.Aeson Hackage page you will see the set of options that you can customize. A few of them are around tagging.

instance ToJSON Person where
  toEncoding = genericToEncoding defaultOptions -- customize these options
instance FromJSON Person

There’s also a funky package called deriving-aeson to do this when you define your data type.

Let me preface this by saying I am a complete newbie with type-level Haskell (aside from Servant), but the ‘pattern’ was simple enough for me to follow along and adopt with my own types. All of those same features are available at the value level too by customizing the defaultOptions for the ToJSON instance as I mentioned at the start.

e.g. using your actual Foo data type:

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PolyKinds #-}

import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Deriving.Aeson             as DA
import           Deriving.Aeson             (CustomJSON(..)) 

data Foo = Foo
  { _buttonOnCount :: Int
  , _buttonClickCount :: Int
  } deriving ( Show, Eq, Generic )
    deriving ( FromJSON, ToJSON )
      via CustomJSON '[DA.TagSingleConstructors, DA.SumObjectWithSingleField] Foo

…which gives output of:

λ> BL.putStrLn $ A.encode [ Foo 1 2, Foo 3 4 ]
[{"Foo":{"_buttonOnCount":1,"_buttonClickCount":2}},{"Foo":{"_buttonOnCount":3,"_buttonClickCount":4}}]

It’s a bit more lightweight as you can see than having "tag" and "contents" (or equivalents) in your JSON.

If I was going to re-use that pattern on a lot of types I could do:

type MyJSONPattern =
  CustomJSON '[DA.TagSingleConstructors, DA.SumObjectWithSingleField]

data Foo = Foo
  { _buttonOnCount :: Int
  , _buttonClickCount :: Int
  } deriving ( Show, Eq, Generic )
    deriving ( FromJSON, ToJSON )
      via MyJSONPattern Foo

If I was working with a more complicated constructor type and wanted snake_case for both the tag and the keys if it has multiple words, I would do:

-- | A data type where I want things in snake_case and _button stripped
data ComplexFoo = ComplexFoo
  { _buttonOnCount :: Int
  , _buttonClickCount :: Int
  } deriving ( Show, Eq, Generic )
    deriving ( FromJSON, ToJSON )
      via (MyJSONPattern2 "_button") ComplexFoo

-- | The type I'm deriving via that makes my JSON output
-- | ..that I can reuse for any product type I want to convert to JSON in a similar way
type MyJSONPattern2 stripme = CustomJSON 
  '[ DA.TagSingleConstructors
   , DA.SumObjectWithSingleField
   , DA.ConstructorTagModifier DA.CamelToSnake
   , DA.FieldLabelModifier (DA.StripPrefix stripme, DA.CamelToSnake)
   ]

Giving output like:

λ> BL.putStrLn $ A.encode [ ComplexFoo 1 2, ComplexFoo 3 4 ]
[{"complex_foo":{"on_count":1,"click_count":2}},{"complex_foo":{"on_count":3,"click_count":4}}]

…or prettyprinted a bit:

[
  {
    "complex_foo": {
      "click_count": 2,
      "on_count": 1
    }
  },
  {
    "complex_foo": {
      "click_count": 4,
      "on_count": 3
    }
  }
]

Again, you can see Aeson pretty flexible, and you don’t have to spell it out with "tag" and "contents". Nor do you have to have your JSON include the _button parts from what I was assume you making lenses in Haskell :slight_smile:

1 Like

If you do want to customize the "tag" & "contents" pattern, here’s what that might look like.
I’m going to assume you want to rename both "tag" and "contents" (to “my_tag” and “my_contents”) as well as provide your own value for that my_tag based on your data type (say "baz_iz_my_tag"). Like

λ> BL.putStrLn $ encodePretty [ Baz 4 2, Baz 5 2 ]

[
  {
    "my_tag": "baz_iz_my_tag",
    "my_contents": {
      "click_count": 2,
      "on_count": 4
    }
  },
  {
    "my_tag": "baz_iz_my_tag",
    "my_contents": {
      "click_count": 2,
      "on_count": 5
    }
  }
]
-- | Your record type to encode to the above:
data Baz = Baz
  { _buttonOnCount :: Int
  , _buttonClickCount :: Int
   } deriving ( Show, Eq, Generic )
    deriving ( FromJSON, ToJSON )
      via Wrapper "baz_iz_my_tag" (MyInnerRecordType "_button" Baz)

------------------------------------------------------------
-- | Wrapper types and encoding                  --
------------------------------------------------------------
-- | And then stashed off in some other module
-- | you have the reusable boiler-plate for any
-- | other types like `Baz` above:
newtype Wrapper (tag::Symbol) a = Wrapper a
  deriving ( Show, Eq, Generic )
  deriving ( FromJSON, ToJSON )
    via MyWrapperType tag (Wrapper tag a)

type MyWrapperType tag = CustomJSON
  '[ DA.ConstructorTagModifier (ConstTag tag)
  , DA.SumTaggedObject "my_tag" "my_contents"
  , DA.TagSingleConstructors
  ]

type MyInnerRecordType labelPrefix = CustomJSON
  '[ DA.SumObjectWithSingleField
  , DA.ConstructorTagModifier DA.CamelToSnake
  , DA.FieldLabelModifier (DA.StripPrefix labelPrefix, DA.CamelToSnake)
  ]

The only fancy bit is that new ConstTag modifier, where I basically took the code the Deriving.Aeson library uses for CamelToSnake and modified it to let me write the tag "baz_iz_my_tag" myself.

--------------------------------------------------------------------------------
-- | Custom constructors                                                      --
--------------------------------------------------------------------------------
import GHC.TypeLits (Symbol, symbolVal, KnownSymbol, TypeError, ErrorMessage (Text))
data ConstTag (tag :: Symbol)

instance (KnownSymbol tag, NonEmptyString tag) => StringModifier (ConstTag tag) where
  getStringModifier = const string
    where
      string = symbolVal (Proxy @tag)

type family NonEmptyString (xs :: Symbol) :: Constraint where
  NonEmptyString "" = TypeError ('Text "Empty string provided for ConstTag constructor tag")
  NonEmptyString _  = ()

Okay this is all a bit too far :sweat_smile: I’ve just discovered a new tool I love and now it’s me with a hammer viewing everything as nails.

TL;DR Even without the silly stuff, Data.Aeson can use generics produce some nice simple tagged objects. Either at the value level like mentioned in your StackOverflow link or as I showed in my first reply at the type level if you bring in Deriving.Aeson. In both cases, it’s just a case of turning on the right generic encoding option

@and-pete , thank you very much for your detailed answers! I have replicated your work here:

Sure enough, tagged JSON is produced:

{
  "contents": {
    "message": "Hello",
    "number": 123
  },
  "tag": "bar"
}

The bridge between Bar in Haskell and Bar in Purescript fails at the moment, because Purescript expects this:

{"_barNumber":789,"_barMessage":"Hello","tag":"Bar"} 

I believe these two generated instances are not behaving as expected, and the next step is to upgrade the Purescript libraries used:

instance encodeBar :: Encode Bar where
  encode = genericEncode $ defaultOptions { unwrapSingleConstructors = false }
instance decodeBar :: Decode Bar where
  decode = genericDecode $ defaultOptions { unwrapSingleConstructors = false }

The correct field name is unwrapSingleArguments: https://pursuit.purescript.org/packages/purescript-argonaut-generic/6.0.0/docs/Data.Argonaut.Types.Generic.Rep#t:Encoding

Much appreciated!

1 Like

Jeez how much caffeine did I have on Feb 15th? :face_with_raised_eyebrow:

Glad it helped.

I feel like with a bit of playing around there’d be a way to clean up

  deriving ( FromJSON, ToJSON )
    via Wrapper "bar" (MyInnerRecordType "_bar" Bar)

to be something like:

  deriving ( FromJSON, ToJSON )
    via TaggedRecord "bar" "_bar" Bar

Maybe just with a type alias. Or changing the existing wrapper stuff around.
It feels like it’d be a friendlier interface for anyone else who is going to be using that type to expand the app’s API

2 Likes

Much appreciated. My aim is to merge the example to https://github.com/eskimor/purescript-bridge/tree/master/example and also have this project updated to Purescript 0.14.

2 Likes