ToJSON Maybe (Maybe a) is not correct

[nekonistyle]

I find a bug as the follows.

print $ toJSON (Nothing :: Maybe (Maybe Int))
-- = Null
print $ toJSON (Just Nothing :: Maybe (Maybe Int))
-- = Null

That is, the instance ToJSON (Maybe (Maybe Int)) is automatically defined because of ToJSON a => ToJSON (Maybe a) and ToJSON Int, but toJSON can't separate Nothing and Just Nothing.

---

I consider the converter should satisfy the following condition for any x:

 fromJSON (toJSON x) == Success x

In particular, toJSON must be an injective function.

However, the definition of toJSON in ToJSON (Maybe a) is not generally injective because toJSON (Just x) = toJSON x has a possibility of Null.

Therefore, I suggest two ways to improve the library to avoid this problem.

---

One way is to create a class that doesn't return 'Null'.

data NotNullValue = NotNullObject !Object
                  | NotNullArray !Array
                  | NotNullString !Text
                  | NotNullNumber !Scientific
                  | NotNullBool !Bool
                  deriving (Eq, Read, Typeable, Data, Generic)
-- Without 'Null' from 'Value'.

fromNotNullValue :: NotNullValue -> Value
fromNotNullValue v =
    case v of
        NotNullObject o -> Object o
        NotNullArray a -> Array a
        NotNullString s -> String s
        NotNullNumber n -> Number n
        NotNullBool b -> Bool b

-- Class of 'ToJSON' that doesn't return 'Null'.
class ToNotNullJSON a where
    toNotNullJSON :: a -> NotNullValue

    toNotNullEncoding :: a -> Encoding
    toNotNullEncoding = E.value . fromNotNullValue . toNotNullJSON


-- Should define instances of 'ToNotNullJSON' on basic types.

-- Example
instance ToNotNullJSON Bool where
    toNotNullJSON = NotNullBool
    toNotNullEncoding = E.bool
-- Other instances also can define like 'ToJSON'.


instance toNotNullJSON a => toJSON (Maybe a) where
    toJSON Nothing = Null
    toJSON (Just x) = fromNotNullValue $ toNotNullJSON x
-- 'toJSON (Just x)' cannot return 'Null' because 'toNotNullJSON x' is not 'Null'.

    toEncoding Nothing = null_
    toEncoding (Just x) = toNotNullEncoding x

This definition is not allow toJSON (Maybe (Maybe a)) because ToNotNullJSON (Maybe a) is not defined.
However, if it is needed, we can define it as Either keeping the injectivity.

instance ToNotNullJSON a => ToNotNullJSON (Maybe a) where
    toNotNullJSON Nothing = notNullObject ["Nothing" .= Null]
    toNotNullJSON (Just x) = notNullObject ["Just" .= fromNotNullValue (toNotNullJSON x)]

    toNotNullEncoding Nothing = E.pairs $ E.pair "Nothing" E.null_
    toNotNullEncoding (Just x) = E.pairs $ E.pair "Just" $ toNotNullEncoding x

Then, we can define FromJSON satisfying fromJSON . toJSON = Success as the follows:

notNullValue :: a -> (NotNullValue -> a) -> Value -> a
notNullValue n _ Null = n
notNullValue _ f (Object o) = f $ NotNullObject o
notNullValue _ f (Array a) = f $ NotNullArray a
notNullValue _ f (String s) = f $ NotNullString s
notNullValue _ f (Number n) = f $ NotNullNumber n
notNullValue _ f (Bool b) = f $ NotNullBool b


class FromNotNullJSON a where
    parseNotNullJSON :: NotNullValue -> Parser a

instance FromNotNullJSON Bool where
    parseNotNullJSON = parseJSON . fromNotNullValue
-- Other instances also can be defined like this.

instance FromNotNullJSON a => FromJSON (Maybe a) where
    parseJSON = notNullValue (pure Nothing) (\v -> Just <$> parseNotNullJSON v)

instance FromNotNullJSON a => FromNotNullJSON (Maybe a) where
      parseNotNullJSON (NotNullObject (H.toList -> [(key,value)]))
        | key == nothing = pure Nothing
        | key == just = Just <$> notNullValue err parseNotNullJSON value
        where
            nothing, just :: Text
            nothing = "Nothing"
            just = "Just"
            err = fail $
                  "expected an object with a single property " ++
                  "where the property value should not be Null"
      parseNotNullJSON _ = fail $
              "expected an object with a single property " ++
              "where the property key should be either " ++
              "\"Nothing\" or \"Just\""

But, this way should be needed a lot of code.

---

Another suggestion is to remove Null from Value but use Nothing :: Maybe Value as Null.

type Object = HashMap Text (Maybe Value)
type Array = Vector (Maybe Value)

-- Remove 'Null' from 'Value'.
data Value = Object !Object
           | Array !Array
           | String !Text
           | Number !Scientific
           | Bool !Bool
           deriving (Eq, Read, Typeable, Data, Generic)

-- 'Null' is defined as 'Nothing' in 'Maybe Value'.
nullValue :: Maybe Value
nullValue = Nothing

-- Rewrite instances of 'ToJSON' to 'ToValue' if these don't return 'Null'.
class ToValue a where
    toValue :: a -> Value
    toValueEncoding :: a -> Encoding

-- Instances that returns 'Null' are only defined as 'ToJSON'.
class ToJSON a where
    toJSON :: a -> Maybe Value
    toEncoding :: a -> Encoding

-- 'ToValue' to 'ToJSON' is naturally defined.
instance {-# OVERLAPPABLE #-} ToValue a => ToJSON a where
    toJSON = Just . ToValue
    toEncoding = toValueEncoding

-- 'ToJSON (Maybe a)' is also naturally defined.
instance ToValue a => ToJSON (Maybe a) where
    toJSON = (<$>) toValue
    toEncoding = maybe null_ toValueEncoding

I recommend this way and would like to join this project.

[phadej]

Duplicate of #376