{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.ComposableAssociation.Aeson
(
module Data.ComposableAssociation
, JsonObjectEncodingException (..)
) where
import GHC.TypeLits
import Data.Proxy
import Data.Typeable
import Control.Exception
import qualified Data.Text as T
import Data.Aeson
import Data.Aeson.Types
import qualified Data.HashMap.Lazy as HashMap
import Data.ComposableAssociation
newtype JsonObjectEncodingException = JsonObjectEncodingException Value deriving (Int -> JsonObjectEncodingException -> ShowS
[JsonObjectEncodingException] -> ShowS
JsonObjectEncodingException -> String
(Int -> JsonObjectEncodingException -> ShowS)
-> (JsonObjectEncodingException -> String)
-> ([JsonObjectEncodingException] -> ShowS)
-> Show JsonObjectEncodingException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonObjectEncodingException] -> ShowS
$cshowList :: [JsonObjectEncodingException] -> ShowS
show :: JsonObjectEncodingException -> String
$cshow :: JsonObjectEncodingException -> String
showsPrec :: Int -> JsonObjectEncodingException -> ShowS
$cshowsPrec :: Int -> JsonObjectEncodingException -> ShowS
Show, Typeable)
instance Exception JsonObjectEncodingException where
toException :: JsonObjectEncodingException -> SomeException
toException = ObjectEncodingException -> SomeException
forall e. Exception e => e -> SomeException
toException (ObjectEncodingException -> SomeException)
-> (JsonObjectEncodingException -> ObjectEncodingException)
-> JsonObjectEncodingException
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonObjectEncodingException -> ObjectEncodingException
forall e. Exception e => e -> ObjectEncodingException
ObjectEncodingException
fromException :: SomeException -> Maybe JsonObjectEncodingException
fromException SomeException
x = do
ObjectEncodingException e
e <- SomeException -> Maybe ObjectEncodingException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
e -> Maybe JsonObjectEncodingException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
instance (ToJSON obj, KnownSymbol key) => ToJSON (Association key obj) where
toJSON :: Association key obj -> Value
toJSON (Association Proxy key
key obj
obj) = [Pair] -> Value
object [Text
keyName Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= obj -> Value
forall a. ToJSON a => a -> Value
toJSON obj
obj]
where keyName :: Text
keyName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy key
key
instance (FromJSON obj, KnownSymbol key) => FromJSON (Association key obj) where
parseJSON :: Value -> Parser (Association key obj)
parseJSON = String
-> (Object -> Parser (Association key obj))
-> Value
-> Parser (Association key obj)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Association" ((Object -> Parser (Association key obj))
-> Value -> Parser (Association key obj))
-> (Object -> Parser (Association key obj))
-> Value
-> Parser (Association key obj)
forall a b. (a -> b) -> a -> b
$ \Object
v' -> Proxy key -> obj -> Association key obj
forall k (key :: k) value.
Proxy key -> value -> Association key value
Association Proxy key
proxy (obj -> Association key obj)
-> Parser obj -> Parser (Association key obj)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v' Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
key Parser (Maybe Value) -> Value -> Parser Value
forall a. Parser (Maybe a) -> a -> Parser a
.!= Value
Null Parser Value -> (Value -> Parser obj) -> Parser obj
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser obj
forall a. FromJSON a => Value -> Parser a
parseJSON)
where proxy :: Proxy key
proxy = Proxy key
forall k (t :: k). Proxy t
Proxy :: Proxy key
key :: Text
key = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy key
proxy
instance (ToJSON base, ToJSON obj, KnownSymbol key) => ToJSON (base :<> Association key obj) where
toJSON :: (base :<> Association key obj) -> Value
toJSON (base
base :<> Association Proxy key
key obj
obj) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
keyName Value
objJson Object
baseJsonMap
where keyName :: Text
keyName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy key
key
baseJsonMap :: Object
baseJsonMap = case base -> Value
forall a. ToJSON a => a -> Value
toJSON base
base of (Object Object
jsonObjVal) -> Object
jsonObjVal
Value
notAnObject -> JsonObjectEncodingException -> Object
forall a e. Exception e => e -> a
throw (JsonObjectEncodingException -> Object)
-> JsonObjectEncodingException -> Object
forall a b. (a -> b) -> a -> b
$ Value -> JsonObjectEncodingException
JsonObjectEncodingException Value
notAnObject
objJson :: Value
objJson = obj -> Value
forall a. ToJSON a => a -> Value
toJSON obj
obj
instance (FromJSON base, FromJSON obj, KnownSymbol key) => FromJSON (base :<> Association key obj) where
parseJSON :: Value -> Parser (base :<> Association key obj)
parseJSON = String
-> (Object -> Parser (base :<> Association key obj))
-> Value
-> Parser (base :<> Association key obj)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"base :<> assoc" ((Object -> Parser (base :<> Association key obj))
-> Value -> Parser (base :<> Association key obj))
-> (Object -> Parser (base :<> Association key obj))
-> Value
-> Parser (base :<> Association key obj)
forall a b. (a -> b) -> a -> b
$ \Object
v' -> base -> Association key obj -> base :<> Association key obj
forall base assoc. base -> assoc -> base :<> assoc
(:<>) (base -> Association key obj -> base :<> Association key obj)
-> Parser base
-> Parser (Association key obj -> base :<> Association key obj)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Value -> Parser base
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete Text
key Object
v') Parser (Association key obj -> base :<> Association key obj)
-> Parser (Association key obj)
-> Parser (base :<> Association key obj)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(obj -> Association key obj)
-> Parser obj -> Parser (Association key obj)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy key -> obj -> Association key obj
forall k (key :: k) value.
Proxy key -> value -> Association key value
Association Proxy key
proxy) (Object
v' Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
key Parser (Maybe Value) -> Value -> Parser Value
forall a. Parser (Maybe a) -> a -> Parser a
.!= Value
Null Parser Value -> (Value -> Parser obj) -> Parser obj
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser obj
forall a. FromJSON a => Value -> Parser a
parseJSON)
where proxy :: Proxy key
proxy = Proxy key
forall k (t :: k). Proxy t
Proxy :: Proxy key
key :: Text
key = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy key
proxy