{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
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 { AesonTag a -> a
unAesonTag :: a }
instance HasTagPrefix a => HasJSONOptions (AesonTag a) where
getJSONOptions :: Proxy (AesonTag a) -> Options
getJSONOptions Proxy (AesonTag a)
_ = Text -> Options
tagOptions (Proxy a -> Text
forall a. HasTagPrefix a => Proxy a -> Text
getTagPrefix (Proxy a
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 = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Proxy (AesonTag a) -> Options
forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (Proxy (AesonTag a)
forall k (t :: k). Proxy t
Proxy :: Proxy (AesonTag a))) (a -> Value) -> (AesonTag a -> a) -> AesonTag a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonTag a -> a
forall a. AesonTag a -> a
unAesonTag
toEncoding :: AesonTag a -> Encoding
toEncoding = Options -> a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Proxy (AesonTag a) -> Options
forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (Proxy (AesonTag a)
forall k (t :: k). Proxy t
Proxy :: Proxy (AesonTag a))) (a -> Encoding) -> (AesonTag a -> a) -> AesonTag a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonTag a -> a
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 = (a -> AesonTag a
forall a. a -> AesonTag a
AesonTag (a -> AesonTag a) -> Parser a -> Parser (AesonTag a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser a -> Parser (AesonTag a))
-> (Value -> Parser a) -> Value -> Parser (AesonTag 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 (Proxy (AesonTag a) -> Options
forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (Proxy (AesonTag a)
forall k (t :: k). Proxy t
Proxy :: Proxy (AesonTag a)))
newtype AesonRecord a = AesonRecord { 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 = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Proxy (AesonRecord a) -> Options
forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (Proxy (AesonRecord a)
forall k (t :: k). Proxy t
Proxy :: Proxy (AesonRecord a))) (a -> Value) -> (AesonRecord a -> a) -> AesonRecord a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonRecord a -> a
forall a. AesonRecord a -> a
unAesonRecord
toEncoding :: AesonRecord a -> Encoding
toEncoding = Options -> a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Proxy (AesonRecord a) -> Options
forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (Proxy (AesonRecord a)
forall k (t :: k). Proxy t
Proxy :: Proxy (AesonRecord a))) (a -> Encoding)
-> (AesonRecord a -> a) -> AesonRecord a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonRecord a -> a
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 = (a -> AesonRecord a
forall a. a -> AesonRecord a
AesonRecord (a -> AesonRecord a) -> Parser a -> Parser (AesonRecord a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser a -> Parser (AesonRecord a))
-> (Value -> Parser a) -> Value -> Parser (AesonRecord 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 (Proxy (AesonRecord a) -> Options
forall a. HasJSONOptions a => Proxy a -> Options
getJSONOptions (Proxy (AesonRecord a)
forall k (t :: k). Proxy t
Proxy :: Proxy (AesonRecord a)))
newtype AesonNewtype n o = AesonNewtype { 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 = o -> Value
forall a. ToJSON a => a -> Value
toJSON (o -> Value)
-> (AesonNewtype n o -> o) -> AesonNewtype n o -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> o
forall n. Newtype n => n -> O n
unpack (n -> o) -> (AesonNewtype n o -> n) -> AesonNewtype n o -> o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonNewtype n o -> n
forall n o. AesonNewtype n o -> n
unAesonNewtype
toEncoding :: AesonNewtype n o -> Encoding
toEncoding = o -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (o -> Encoding)
-> (AesonNewtype n o -> o) -> AesonNewtype n o -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> o
forall n. Newtype n => n -> O n
unpack (n -> o) -> (AesonNewtype n o -> n) -> AesonNewtype n o -> o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonNewtype n o -> n
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 = ((n -> AesonNewtype n o
forall n o. n -> AesonNewtype n o
AesonNewtype (n -> AesonNewtype n o) -> (o -> n) -> o -> AesonNewtype n o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> n
forall n. Newtype n => O n -> n
pack) (o -> AesonNewtype n o) -> Parser o -> Parser (AesonNewtype n o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser o -> Parser (AesonNewtype n o))
-> (Value -> Parser o) -> Value -> Parser (AesonNewtype n o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser o
forall a. FromJSON a => Value -> Parser a
parseJSON