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

-- |
-- Module:      Data.Time.Format.Typed
-- Copyright:   (c) 2021-2022 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-2.1.0.0/docs/Data-Aeson.html#g:7 ToJSON>.
--
-- As simple as:
--
--
-- @
-- data W = W Int Int
--   deriving stock (Generic)
--   deriving (ToJSON) via (GenericallyToJSONToEncoding W)
-- @
--
-- @
-- data X = X Int Int
--   deriving stock (Generic)
--   deriving (ToJSON) via (GenericallyToEncoding X)
-- @
module Data.Aeson.ToJSON.Deriving
  ( GenericallyToJSONToEncoding (..),
    GenericallyToEncoding (..),
    ToJSON (..),
  )
where

import Data.Aeson
import Data.Maybe (fromMaybe)
import GHC.Generics

-- | Deriving via 'Generic' 'toJSON' and 'toEncoding'.
newtype GenericallyToJSONToEncoding a = GenericallyToJSONToEncoding {GenericallyToJSONToEncoding a -> a
unGenericallyToJSONToEncoding :: a}
  deriving stock (GenericallyToJSONToEncoding a
-> GenericallyToJSONToEncoding a -> Bool
(GenericallyToJSONToEncoding a
 -> GenericallyToJSONToEncoding a -> Bool)
-> (GenericallyToJSONToEncoding a
    -> GenericallyToJSONToEncoding a -> Bool)
-> Eq (GenericallyToJSONToEncoding a)
forall a.
Eq a =>
GenericallyToJSONToEncoding a
-> GenericallyToJSONToEncoding a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericallyToJSONToEncoding a
-> GenericallyToJSONToEncoding a -> Bool
$c/= :: forall a.
Eq a =>
GenericallyToJSONToEncoding a
-> GenericallyToJSONToEncoding a -> Bool
== :: GenericallyToJSONToEncoding a
-> GenericallyToJSONToEncoding a -> Bool
$c== :: forall a.
Eq a =>
GenericallyToJSONToEncoding a
-> GenericallyToJSONToEncoding a -> Bool
Eq, Int -> GenericallyToJSONToEncoding a -> ShowS
[GenericallyToJSONToEncoding a] -> ShowS
GenericallyToJSONToEncoding a -> String
(Int -> GenericallyToJSONToEncoding a -> ShowS)
-> (GenericallyToJSONToEncoding a -> String)
-> ([GenericallyToJSONToEncoding a] -> ShowS)
-> Show (GenericallyToJSONToEncoding a)
forall a. Show a => Int -> GenericallyToJSONToEncoding a -> ShowS
forall a. Show a => [GenericallyToJSONToEncoding a] -> ShowS
forall a. Show a => GenericallyToJSONToEncoding a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericallyToJSONToEncoding a] -> ShowS
$cshowList :: forall a. Show a => [GenericallyToJSONToEncoding a] -> ShowS
show :: GenericallyToJSONToEncoding a -> String
$cshow :: forall a. Show a => GenericallyToJSONToEncoding a -> String
showsPrec :: Int -> GenericallyToJSONToEncoding a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GenericallyToJSONToEncoding a -> ShowS
Show, (forall x.
 GenericallyToJSONToEncoding a
 -> Rep (GenericallyToJSONToEncoding a) x)
-> (forall x.
    Rep (GenericallyToJSONToEncoding a) x
    -> GenericallyToJSONToEncoding a)
-> Generic (GenericallyToJSONToEncoding a)
forall x.
Rep (GenericallyToJSONToEncoding a) x
-> GenericallyToJSONToEncoding a
forall x.
GenericallyToJSONToEncoding a
-> Rep (GenericallyToJSONToEncoding a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (GenericallyToJSONToEncoding a) x
-> GenericallyToJSONToEncoding a
forall a x.
GenericallyToJSONToEncoding a
-> Rep (GenericallyToJSONToEncoding a) x
$cto :: forall a x.
Rep (GenericallyToJSONToEncoding a) x
-> GenericallyToJSONToEncoding a
$cfrom :: forall a x.
GenericallyToJSONToEncoding a
-> Rep (GenericallyToJSONToEncoding a) x
Generic)

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

-- | Deriving via 'Generic' 'toEncoding' ('toJSON' is done via 'decode . encode').
newtype GenericallyToEncoding a = GenericallyToEncoding {GenericallyToEncoding a -> a
unGenericallyToEncoding :: a}
  deriving stock (GenericallyToEncoding a -> GenericallyToEncoding a -> Bool
(GenericallyToEncoding a -> GenericallyToEncoding a -> Bool)
-> (GenericallyToEncoding a -> GenericallyToEncoding a -> Bool)
-> Eq (GenericallyToEncoding a)
forall a.
Eq a =>
GenericallyToEncoding a -> GenericallyToEncoding a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericallyToEncoding a -> GenericallyToEncoding a -> Bool
$c/= :: forall a.
Eq a =>
GenericallyToEncoding a -> GenericallyToEncoding a -> Bool
== :: GenericallyToEncoding a -> GenericallyToEncoding a -> Bool
$c== :: forall a.
Eq a =>
GenericallyToEncoding a -> GenericallyToEncoding a -> Bool
Eq, Int -> GenericallyToEncoding a -> ShowS
[GenericallyToEncoding a] -> ShowS
GenericallyToEncoding a -> String
(Int -> GenericallyToEncoding a -> ShowS)
-> (GenericallyToEncoding a -> String)
-> ([GenericallyToEncoding a] -> ShowS)
-> Show (GenericallyToEncoding a)
forall a. Show a => Int -> GenericallyToEncoding a -> ShowS
forall a. Show a => [GenericallyToEncoding a] -> ShowS
forall a. Show a => GenericallyToEncoding a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericallyToEncoding a] -> ShowS
$cshowList :: forall a. Show a => [GenericallyToEncoding a] -> ShowS
show :: GenericallyToEncoding a -> String
$cshow :: forall a. Show a => GenericallyToEncoding a -> String
showsPrec :: Int -> GenericallyToEncoding a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GenericallyToEncoding a -> ShowS
Show, (forall x.
 GenericallyToEncoding a -> Rep (GenericallyToEncoding a) x)
-> (forall x.
    Rep (GenericallyToEncoding a) x -> GenericallyToEncoding a)
-> Generic (GenericallyToEncoding a)
forall x.
Rep (GenericallyToEncoding a) x -> GenericallyToEncoding a
forall x.
GenericallyToEncoding a -> Rep (GenericallyToEncoding a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (GenericallyToEncoding a) x -> GenericallyToEncoding a
forall a x.
GenericallyToEncoding a -> Rep (GenericallyToEncoding a) x
$cto :: forall a x.
Rep (GenericallyToEncoding a) x -> GenericallyToEncoding a
$cfrom :: forall a x.
GenericallyToEncoding a -> Rep (GenericallyToEncoding a) x
Generic)

instance
  ( Generic a,
    ToJSON a,
    GToJSON' Encoding Zero (Rep a)
  ) =>
  ToJSON (GenericallyToEncoding a)
  where
  toJSON :: GenericallyToEncoding a -> Value
toJSON =
    Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (String -> Value
forall a. HasCallStack => String -> a
error String
"GenericallyToEncoding.toJSON: unable to decode encoded Value")
      (Maybe Value -> Value)
-> (GenericallyToEncoding a -> Maybe Value)
-> GenericallyToEncoding a
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode
      (ByteString -> Maybe Value)
-> (GenericallyToEncoding a -> ByteString)
-> GenericallyToEncoding a
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode
      (a -> ByteString)
-> (GenericallyToEncoding a -> a)
-> GenericallyToEncoding a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericallyToEncoding a -> a
forall a. GenericallyToEncoding a -> a
unGenericallyToEncoding
  toEncoding :: GenericallyToEncoding a -> Encoding
toEncoding =
    Options -> a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
      (a -> Encoding)
-> (GenericallyToEncoding a -> a)
-> GenericallyToEncoding a
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericallyToEncoding a -> a
forall a. GenericallyToEncoding a -> a
unGenericallyToEncoding