{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Override.Aeson.Options.Internal where
import Data.Aeson
import Data.Coerce (coerce)
import Data.Proxy (Proxy(..))
import GHC.Generics (Generic, Rep)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import qualified Data.Aeson as Aeson
newtype WithAesonOptions (a :: *) (options :: [AesonOption]) = WithAesonOptions a
instance
( ApplyAesonOptions options
, Generic a
, Aeson.GToJSON Aeson.Zero (Rep a)
, Aeson.GToEncoding Aeson.Zero (Rep a)
) => ToJSON (WithAesonOptions a options)
where
toJSON :: WithAesonOptions a options -> Value
toJSON = (a -> Value) -> WithAesonOptions a options -> Value
coerce ((a -> Value) -> WithAesonOptions a options -> Value)
-> (a -> Value) -> WithAesonOptions a options -> Value
forall a b. (a -> b) -> a -> b
$ (Generic a, GToJSON Zero (Rep a)) => Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON @a (Options -> a -> Value) -> Options -> a -> Value
forall a b. (a -> b) -> a -> b
$ Proxy options -> Options -> Options
forall (options :: [AesonOption]).
ApplyAesonOptions options =>
Proxy options -> Options -> Options
applyAesonOptions (Proxy options
forall k (t :: k). Proxy t
Proxy @options) Options
defaultOptions
toEncoding :: WithAesonOptions a options -> Encoding
toEncoding = (a -> Encoding) -> WithAesonOptions a options -> Encoding
coerce ((a -> Encoding) -> WithAesonOptions a options -> Encoding)
-> (a -> Encoding) -> WithAesonOptions a options -> Encoding
forall a b. (a -> b) -> a -> b
$ (Generic a, GToEncoding Zero (Rep a)) => Options -> a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding @a (Options -> a -> Encoding) -> Options -> a -> Encoding
forall a b. (a -> b) -> a -> b
$ Proxy options -> Options -> Options
forall (options :: [AesonOption]).
ApplyAesonOptions options =>
Proxy options -> Options -> Options
applyAesonOptions (Proxy options
forall k (t :: k). Proxy t
Proxy @options) Options
defaultOptions
instance
( ApplyAesonOptions options
, Generic a
, Aeson.GFromJSON Aeson.Zero (Rep a)
) => FromJSON (WithAesonOptions a options)
where
parseJSON :: Value -> Parser (WithAesonOptions a options)
parseJSON = (Value -> Parser a) -> Value -> Parser (WithAesonOptions a options)
coerce ((Value -> Parser a)
-> Value -> Parser (WithAesonOptions a options))
-> (Value -> Parser a)
-> Value
-> Parser (WithAesonOptions a options)
forall a b. (a -> b) -> a -> b
$ (Generic a, GFromJSON Zero (Rep a)) => Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON @a (Options -> Value -> Parser a) -> Options -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ Proxy options -> Options -> Options
forall (options :: [AesonOption]).
ApplyAesonOptions options =>
Proxy options -> Options -> Options
applyAesonOptions (Proxy options
forall k (t :: k). Proxy t
Proxy @options) Options
defaultOptions
data AesonOption =
AllNullaryToStringTag Bool
| OmitNothingFields
| SumEncodingTaggedObject Symbol Symbol
| SumEncodingUntaggedValue
| SumEncodingObjectWithSingleField
| SumEncodingTwoElemArray
| UnwrapUnaryRecords
| TagSingleConstructors
class ApplyAesonOptions (options :: [AesonOption]) where
applyAesonOptions :: Proxy options -> Options -> Options
instance ApplyAesonOptions '[] where
applyAesonOptions :: Proxy '[] -> Options -> Options
applyAesonOptions Proxy '[]
_ = Options -> Options
forall a. a -> a
id
instance
( ApplyAesonOption option
, ApplyAesonOptions options
) => ApplyAesonOptions (option ': options)
where
applyAesonOptions :: Proxy (option : options) -> Options -> Options
applyAesonOptions Proxy (option : options)
_ =
Proxy option -> Options -> Options
forall (option :: AesonOption).
ApplyAesonOption option =>
Proxy option -> Options -> Options
applyAesonOption (Proxy option
forall k (t :: k). Proxy t
Proxy @option) (Options -> Options) -> (Options -> Options) -> Options -> Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proxy options -> Options -> Options
forall (options :: [AesonOption]).
ApplyAesonOptions options =>
Proxy options -> Options -> Options
applyAesonOptions (Proxy options
forall k (t :: k). Proxy t
Proxy @options))
class ApplyAesonOption (option :: AesonOption) where
applyAesonOption :: Proxy option -> Options -> Options
instance ApplyAesonOption ('AllNullaryToStringTag 'True) where
applyAesonOption :: Proxy ('AllNullaryToStringTag 'True) -> Options -> Options
applyAesonOption Proxy ('AllNullaryToStringTag 'True)
_ Options
o = Options
o { allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True }
instance ApplyAesonOption ('AllNullaryToStringTag 'False) where
applyAesonOption :: Proxy ('AllNullaryToStringTag 'False) -> Options -> Options
applyAesonOption Proxy ('AllNullaryToStringTag 'False)
_ Options
o = Options
o { allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
False }
instance ApplyAesonOption 'OmitNothingFields where
applyAesonOption :: Proxy 'OmitNothingFields -> Options -> Options
applyAesonOption Proxy 'OmitNothingFields
_ Options
o = Options
o { omitNothingFields :: Bool
omitNothingFields = Bool
True }
instance (KnownSymbol k, KnownSymbol v) => ApplyAesonOption ('SumEncodingTaggedObject k v) where
applyAesonOption :: Proxy ('SumEncodingTaggedObject k v) -> Options -> Options
applyAesonOption Proxy ('SumEncodingTaggedObject k v)
_ Options
o = Options
o { sumEncoding :: SumEncoding
sumEncoding = String -> String -> SumEncoding
TaggedObject (Proxy k -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy k
forall k (t :: k). Proxy t
Proxy @k)) (Proxy v -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy v
forall k (t :: k). Proxy t
Proxy @v)) }
instance ApplyAesonOption 'SumEncodingUntaggedValue where
applyAesonOption :: Proxy 'SumEncodingUntaggedValue -> Options -> Options
applyAesonOption Proxy 'SumEncodingUntaggedValue
_ Options
o = Options
o { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue }
instance ApplyAesonOption 'SumEncodingObjectWithSingleField where
applyAesonOption :: Proxy 'SumEncodingObjectWithSingleField -> Options -> Options
applyAesonOption Proxy 'SumEncodingObjectWithSingleField
_ Options
o = Options
o { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
ObjectWithSingleField }
instance ApplyAesonOption 'SumEncodingTwoElemArray where
applyAesonOption :: Proxy 'SumEncodingTwoElemArray -> Options -> Options
applyAesonOption Proxy 'SumEncodingTwoElemArray
_ Options
o = Options
o { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
TwoElemArray }
instance ApplyAesonOption 'UnwrapUnaryRecords where
applyAesonOption :: Proxy 'UnwrapUnaryRecords -> Options -> Options
applyAesonOption Proxy 'UnwrapUnaryRecords
_ Options
o = Options
o { unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True }
instance ApplyAesonOption 'TagSingleConstructors where
applyAesonOption :: Proxy 'TagSingleConstructors -> Options -> Options
applyAesonOption Proxy 'TagSingleConstructors
_ Options
o = Options
o { tagSingleConstructors :: Bool
tagSingleConstructors = Bool
True }