{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module AesonVia
( AesonRecord (..)
, AesonNewtype (..)
, AesonTag (..)
, HasJSONOptions (..)
, HasTagPrefix (..)
)
where
import Control.Newtype.Generics (Newtype, O, pack, unpack)
import Data.Aeson
( FromJSON (..)
, GFromJSON
, GToEncoding
, GToJSON
, Options (..)
, ToJSON (..)
, Zero
, defaultOptions
, genericParseJSON
, genericToEncoding
, genericToJSON
)
import Data.Aeson.Casing (aesonPrefix, snakeCase)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Generic, Rep)
import Prelude
recordOptions :: Options
recordOptions :: Options
recordOptions = ((String -> String) -> Options
aesonPrefix String -> String
snakeCase) {omitNothingFields :: Bool
omitNothingFields = Bool
True}
tagOptions :: Text -> Options
tagOptions :: Text -> Options
tagOptions Text
prefix =
let prefixLen :: Int
prefixLen = Text -> Int
Text.length Text
prefix
in Options
defaultOptions
{ allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True
, constructorTagModifier :: String -> String
constructorTagModifier = String -> String
snakeCase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
prefixLen
}
newtypeOptions :: Options
newtypeOptions :: Options
newtypeOptions =
Options
defaultOptions
{ unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True
}
class HasJSONOptions a where
getJSONOptions :: Proxy a -> Options
class HasTagPrefix a where
getTagPrefix :: Proxy a -> Text
newtype AesonTag a = AesonTag {forall a. AesonTag a -> a
unAesonTag :: a}
instance HasTagPrefix a => HasJSONOptions (AesonTag a) where
getJSONOptions :: Proxy (AesonTag a) -> Options
getJSONOptions Proxy (AesonTag a)
_ = Text -> Options
tagOptions (forall a. HasTagPrefix a => Proxy a -> Text
getTagPrefix (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
instance (HasJSONOptions (AesonTag a), Generic a, GToJSON Zero (Rep a), GToEncoding Zero (Rep a)) => ToJSON (AesonTag a) where
toJSON :: AesonTag a -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy (AesonTag a))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AesonTag a -> a
unAesonTag
toEncoding :: AesonTag a -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy (AesonTag a))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AesonTag a -> a
unAesonTag
instance (HasJSONOptions (AesonTag a), Generic a, GFromJSON Zero (Rep a)) => FromJSON (AesonTag a) where
parseJSON :: Value -> Parser (AesonTag a)
parseJSON = (forall a. a -> AesonTag a
AesonTag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy (AesonTag a)))
newtype AesonRecord a = AesonRecord {forall a. AesonRecord a -> a
unAesonRecord :: a}
instance HasJSONOptions (AesonRecord a) where
getJSONOptions :: Proxy (AesonRecord a) -> Options
getJSONOptions Proxy (AesonRecord a)
_ = Options
recordOptions
instance (HasJSONOptions (AesonRecord a), Generic a, GToJSON Zero (Rep a), GToEncoding Zero (Rep a)) => ToJSON (AesonRecord a) where
toJSON :: AesonRecord a -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy (AesonRecord a))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AesonRecord a -> a
unAesonRecord
toEncoding :: AesonRecord a -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy (AesonRecord a))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AesonRecord a -> a
unAesonRecord
instance (HasJSONOptions (AesonRecord a), Generic a, GFromJSON Zero (Rep a)) => FromJSON (AesonRecord a) where
parseJSON :: Value -> Parser (AesonRecord a)
parseJSON = (forall a. a -> AesonRecord a
AesonRecord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy (AesonRecord a)))
newtype AesonNewtype n o = AesonNewtype {forall n o. AesonNewtype n o -> n
unAesonNewtype :: n}
instance HasJSONOptions (AesonNewtype n o) where
getJSONOptions :: Proxy (AesonNewtype n o) -> Options
getJSONOptions Proxy (AesonNewtype n o)
_ = Options
newtypeOptions
instance (Newtype n, o ~ O n, ToJSON o) => ToJSON (AesonNewtype n o) where
toJSON :: AesonNewtype n o -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Newtype n => n -> O n
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n o. AesonNewtype n o -> n
unAesonNewtype
toEncoding :: AesonNewtype n o -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Newtype n => n -> O n
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n o. AesonNewtype n o -> n
unAesonNewtype
instance (Newtype n, o ~ O n, FromJSON o) => FromJSON (AesonNewtype n o) where
parseJSON :: Value -> Parser (AesonNewtype n o)
parseJSON = ((forall n o. n -> AesonNewtype n o
AesonNewtype forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Newtype n => O n -> n
pack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON