{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
module Deriving.Aeson
( CustomJSON(..)
, FieldLabelModifier
, ConstrctorTagModifier
, OmitNothingFields
, TagSingleConstructors
, NoAllNullaryToStringTag
, StripPrefix
, CamelToKebab
, CamelToSnake
, AesonOptions(..)
, StringModifier(..)
, FromJSON
, ToJSON
, Generic
)where
import Data.Aeson
import Data.Coerce
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import Data.Proxy
import GHC.Generics
import GHC.TypeLits
newtype CustomJSON t a = CustomJSON { CustomJSON t a -> a
unCustomJSON :: a }
instance (AesonOptions t, Generic a, GFromJSON Zero (Rep a)) => FromJSON (CustomJSON t a) where
parseJSON :: Value -> Parser (CustomJSON t a)
parseJSON = (Parser a -> Parser (CustomJSON t a)
forall a b. Coercible a b => a -> b
coerce (Parser a -> Parser (CustomJSON t a))
-> (Parser a -> Parser (CustomJSON t a))
-> Parser a
-> Parser (CustomJSON t a)
forall a. a -> a -> a
`asTypeOf` (a -> CustomJSON t a) -> Parser a -> Parser (CustomJSON t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> CustomJSON t a
forall k (t :: k) a. a -> CustomJSON t a
CustomJSON) (Parser a -> Parser (CustomJSON t a))
-> (Value -> Parser a) -> Value -> Parser (CustomJSON t 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
genericParseJSON (AesonOptions t => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @t)
{-# INLINE parseJSON #-}
instance (AesonOptions t, Generic a, GToJSON Zero (Rep a)) => ToJSON (CustomJSON t a) where
toJSON :: CustomJSON t a -> Value
toJSON = Options -> a -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (AesonOptions t => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @t) (a -> Value) -> (CustomJSON t a -> a) -> CustomJSON t a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomJSON t a -> a
forall k (t :: k) a. CustomJSON t a -> a
unCustomJSON
{-# INLINE toJSON #-}
data FieldLabelModifier t
data ConstrctorTagModifier t
data OmitNothingFields
data TagSingleConstructors
data NoAllNullaryToStringTag
data StripPrefix t
data CamelToSnake
data CamelToKebab
class StringModifier t where
getStringModifier :: String -> String
instance KnownSymbol k => StringModifier (StripPrefix k) where
getStringModifier :: String -> String
getStringModifier = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (Proxy k -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy k
forall k (t :: k). Proxy t
Proxy @k))
instance (StringModifier a, StringModifier b) => StringModifier (a, b) where
getStringModifier :: String -> String
getStringModifier = StringModifier b => String -> String
forall k (t :: k). StringModifier t => String -> String
getStringModifier @b (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringModifier a => String -> String
forall k (t :: k). StringModifier t => String -> String
getStringModifier @a
instance StringModifier CamelToKebab where
getStringModifier :: String -> String
getStringModifier = Char -> String -> String
camelTo2 '-'
instance StringModifier CamelToSnake where
getStringModifier :: String -> String
getStringModifier = Char -> String -> String
camelTo2 '_'
class AesonOptions xs where
aesonOptions :: Options
instance AesonOptions '[] where
aesonOptions :: Options
aesonOptions = Options
defaultOptions
instance AesonOptions xs => AesonOptions (OmitNothingFields ': xs) where
aesonOptions :: Options
aesonOptions = (AesonOptions xs => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @xs) { omitNothingFields :: Bool
omitNothingFields = Bool
True }
instance (StringModifier f, AesonOptions xs) => AesonOptions (FieldLabelModifier f ': xs) where
aesonOptions :: Options
aesonOptions = (AesonOptions xs => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @xs) { fieldLabelModifier :: String -> String
fieldLabelModifier = StringModifier f => String -> String
forall k (t :: k). StringModifier t => String -> String
getStringModifier @f }
instance (StringModifier f, AesonOptions xs) => AesonOptions (ConstrctorTagModifier f ': xs) where
aesonOptions :: Options
aesonOptions = (AesonOptions xs => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @xs) { constructorTagModifier :: String -> String
constructorTagModifier = StringModifier f => String -> String
forall k (t :: k). StringModifier t => String -> String
getStringModifier @f }
instance AesonOptions xs => AesonOptions (TagSingleConstructors ': xs) where
aesonOptions :: Options
aesonOptions = (AesonOptions xs => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @xs) { tagSingleConstructors :: Bool
tagSingleConstructors = Bool
True }
instance AesonOptions xs => AesonOptions (NoAllNullaryToStringTag ': xs) where
aesonOptions :: Options
aesonOptions = (AesonOptions xs => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @xs) { allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
False }