-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Helpers for the @aeson@ package.
--
-- Currently we need this module due to "GHC stage restriction".

module Morley.Client.RPC.Aeson
  ( morleyClientAesonOptions
  , ClientJSON(..)
  ) where

import Data.Aeson qualified as JSON
import Data.Aeson.Casing (aesonPrefix, snakeCase)
import GHC.Generics (Rep)

-- | We use these @Options@ to produce JSON encoding in the format
-- that RPC expects. We are not using defaults from @morley@ because
-- we need a specific format.
morleyClientAesonOptions :: JSON.Options
morleyClientAesonOptions :: Options
morleyClientAesonOptions = (String -> String) -> Options
aesonPrefix String -> String
snakeCase

newtype ClientJSON a = ClientJSON { forall a. ClientJSON a -> a
unClientJSON :: a }

instance (Generic a, JSON.GToJSON JSON.Zero (Rep a), JSON.GToEncoding JSON.Zero (Rep a))
  => JSON.ToJSON (ClientJSON a) where
  toJSON :: ClientJSON a -> Value
toJSON = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
JSON.genericToJSON Options
morleyClientAesonOptions (a -> Value) -> (ClientJSON a -> a) -> ClientJSON a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientJSON a -> a
forall a. ClientJSON a -> a
unClientJSON
  toEncoding :: ClientJSON a -> Encoding
toEncoding = Options -> a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
JSON.genericToEncoding Options
morleyClientAesonOptions (a -> Encoding) -> (ClientJSON a -> a) -> ClientJSON a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientJSON a -> a
forall a. ClientJSON a -> a
unClientJSON

instance (Generic a, JSON.GFromJSON JSON.Zero (Rep a)) => JSON.FromJSON (ClientJSON a) where
  parseJSON :: Value -> Parser (ClientJSON a)
parseJSON = (a -> ClientJSON a) -> Parser a -> Parser (ClientJSON a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ClientJSON a
forall a. a -> ClientJSON a
ClientJSON (Parser a -> Parser (ClientJSON a))
-> (Value -> Parser a) -> Value -> Parser (ClientJSON a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
JSON.genericParseJSON Options
morleyClientAesonOptions