{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module:      Data.Time.Format.Typed
-- Copyright:   (c) 20021 Gautier DI FOLCO
-- License:     ISC
-- Maintainer:  Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability:   experimental
-- Portability: GHC
--
-- Provide a newtype to be used with DerivingVia to correctly derive <https://hackage.haskell.org/package/aeson-1.5.6.0/docs/Data-Aeson.html#g:7 ToJSON>.
--
-- As simple as:
--
--
-- @
-- data W = W Int Int
--   deriving stock (Generic)
--   deriving (ToJSON) via (ModernToJSON W)
-- @
module Data.Aeson.ToJSON.Deriving
  ( ModernToJSON (..),
    ToJSON (..),
  )
where

import Data.Aeson
import GHC.Generics

newtype ModernToJSON a = ModernToJSON {ModernToJSON a -> a
unModernToJSON :: a}
  deriving stock (ModernToJSON a -> ModernToJSON a -> Bool
(ModernToJSON a -> ModernToJSON a -> Bool)
-> (ModernToJSON a -> ModernToJSON a -> Bool)
-> Eq (ModernToJSON a)
forall a. Eq a => ModernToJSON a -> ModernToJSON a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModernToJSON a -> ModernToJSON a -> Bool
$c/= :: forall a. Eq a => ModernToJSON a -> ModernToJSON a -> Bool
== :: ModernToJSON a -> ModernToJSON a -> Bool
$c== :: forall a. Eq a => ModernToJSON a -> ModernToJSON a -> Bool
Eq, Int -> ModernToJSON a -> ShowS
[ModernToJSON a] -> ShowS
ModernToJSON a -> String
(Int -> ModernToJSON a -> ShowS)
-> (ModernToJSON a -> String)
-> ([ModernToJSON a] -> ShowS)
-> Show (ModernToJSON a)
forall a. Show a => Int -> ModernToJSON a -> ShowS
forall a. Show a => [ModernToJSON a] -> ShowS
forall a. Show a => ModernToJSON a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModernToJSON a] -> ShowS
$cshowList :: forall a. Show a => [ModernToJSON a] -> ShowS
show :: ModernToJSON a -> String
$cshow :: forall a. Show a => ModernToJSON a -> String
showsPrec :: Int -> ModernToJSON a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ModernToJSON a -> ShowS
Show, (forall x. ModernToJSON a -> Rep (ModernToJSON a) x)
-> (forall x. Rep (ModernToJSON a) x -> ModernToJSON a)
-> Generic (ModernToJSON a)
forall x. Rep (ModernToJSON a) x -> ModernToJSON a
forall x. ModernToJSON a -> Rep (ModernToJSON a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ModernToJSON a) x -> ModernToJSON a
forall a x. ModernToJSON a -> Rep (ModernToJSON a) x
$cto :: forall a x. Rep (ModernToJSON a) x -> ModernToJSON a
$cfrom :: forall a x. ModernToJSON a -> Rep (ModernToJSON a) x
Generic)

instance
  ( Generic a,
    ToJSON a,
    GToJSON' Value Zero (Rep a),
    GToJSON' Encoding Zero (Rep a)
  ) =>
  ToJSON (ModernToJSON a)
  where
  toJSON :: ModernToJSON a -> Value
toJSON = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions (a -> Value) -> (ModernToJSON a -> a) -> ModernToJSON a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModernToJSON a -> a
forall a. ModernToJSON a -> a
unModernToJSON
  toEncoding :: ModernToJSON a -> Encoding
toEncoding = Options -> a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions (a -> Encoding)
-> (ModernToJSON a -> a) -> ModernToJSON a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModernToJSON a -> a
forall a. ModernToJSON a -> a
unModernToJSON