{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.JsonSpec.Encode (
HasJsonEncodingSpec(..),
StructureToJSON(..),
) where
import Data.Aeson (ToJSON(toJSON), Value)
import Data.JsonSpec.Spec (Field(Field), JSONStructure, Specification,
Tag, sym)
import Data.Scientific (Scientific)
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.TypeLits (KnownSymbol)
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
class HasJsonEncodingSpec a where
type EncodingSpec a :: Specification
toJSONStructure :: a -> JSONStructure (EncodingSpec a)
class StructureToJSON a where
reprToJSON :: a -> Value
instance StructureToJSON () where
reprToJSON :: () -> Value
reprToJSON () = [Pair] -> Value
A.object []
instance StructureToJSON Text where
reprToJSON :: Text -> Value
reprToJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON
instance StructureToJSON Scientific where
reprToJSON :: Scientific -> Value
reprToJSON = Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON
instance StructureToJSON Int where
reprToJSON :: Int -> Value
reprToJSON = Int -> Value
forall a. ToJSON a => a -> Value
toJSON
instance (ToJSONObject (a, b)) => StructureToJSON (a, b) where
reprToJSON :: (a, b) -> Value
reprToJSON = Object -> Value
A.Object (Object -> Value) -> ((a, b) -> Object) -> (a, b) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject
instance (StructureToJSON left, StructureToJSON right) => StructureToJSON (Either left right) where
reprToJSON :: Either left right -> Value
reprToJSON = \case
Left left
val -> left -> Value
forall a. StructureToJSON a => a -> Value
reprToJSON left
val
Right right
val -> right -> Value
forall a. StructureToJSON a => a -> Value
reprToJSON right
val
instance (KnownSymbol const) => StructureToJSON (Tag const) where
reprToJSON :: Tag const -> Value
reprToJSON Tag const
_proxy = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @const @Text)
instance (StructureToJSON a) => StructureToJSON [a] where
reprToJSON :: [a] -> Value
reprToJSON = [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
forall a. StructureToJSON a => a -> Value
reprToJSON
instance StructureToJSON UTCTime where
reprToJSON :: UTCTime -> Value
reprToJSON = UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON
instance (StructureToJSON a) => StructureToJSON (Maybe a) where
reprToJSON :: Maybe a -> Value
reprToJSON = Value -> (a -> Value) -> Maybe a -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
A.Null a -> Value
forall a. StructureToJSON a => a -> Value
reprToJSON
class ToJSONObject a where
toJSONObject :: a -> A.Object
instance ToJSONObject () where
toJSONObject :: () -> Object
toJSONObject ()
_ = Object
forall a. Monoid a => a
mempty
instance (KnownSymbol key, StructureToJSON val, ToJSONObject more) => ToJSONObject (Field key val, more) where
toJSONObject :: (Field key val, more) -> Object
toJSONObject (Field val
val, more
more) =
Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert
(forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @key)
(val -> Value
forall a. StructureToJSON a => a -> Value
reprToJSON val
val)
(more -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject more
more)