{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.JsonSpec (
Specification(..),
HasJsonEncodingSpec(..),
HasJsonDecodingSpec(..),
SpecJSON(..),
Tag(..),
Field(..),
unField,
JSONStructure,
Rec(..),
eitherDecode,
encode,
StructureFromJSON,
FieldSpec(..),
(:::),
(::?),
) where
import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON))
import Data.JsonSpec.Decode (HasJsonDecodingSpec(DecodingSpec,
fromJSONStructure), StructureFromJSON(reprParseJSON), eitherDecode)
import Data.JsonSpec.Encode (HasJsonEncodingSpec(EncodingSpec,
toJSONStructure), StructureToJSON(reprToJSON), encode)
import Data.JsonSpec.Spec (Field(Field), FieldSpec(Optional, Required),
Rec(Rec, unRec), Specification(JsonArray, JsonBool, JsonDateTime,
JsonEither, JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject,
JsonRaw, JsonRef, JsonString, JsonTag), Tag(Tag), (:::), (::?),
JSONStructure, unField)
import Prelude ((.), (<$>), (=<<))
newtype SpecJSON a = SpecJSON {forall a. SpecJSON a -> a
unSpecJson :: a}
instance (StructureToJSON (JSONStructure (EncodingSpec a)), HasJsonEncodingSpec a) => ToJSON (SpecJSON a) where
toJSON :: SpecJSON a -> Value
toJSON = JStruct '[] (EncodingSpec a) -> Value
forall a. StructureToJSON a => a -> Value
reprToJSON (JStruct '[] (EncodingSpec a) -> Value)
-> (SpecJSON a -> JStruct '[] (EncodingSpec a))
-> SpecJSON a
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> JStruct '[] (EncodingSpec a)
a -> JSONStructure (EncodingSpec a)
forall a.
HasJsonEncodingSpec a =>
a -> JSONStructure (EncodingSpec a)
toJSONStructure (a -> JStruct '[] (EncodingSpec a))
-> (SpecJSON a -> a) -> SpecJSON a -> JStruct '[] (EncodingSpec a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecJSON a -> a
forall a. SpecJSON a -> a
unSpecJson
instance (StructureFromJSON (JSONStructure (DecodingSpec a)), HasJsonDecodingSpec a) => FromJSON (SpecJSON a) where
parseJSON :: Value -> Parser (SpecJSON a)
parseJSON Value
v =
a -> SpecJSON a
forall a. a -> SpecJSON a
SpecJSON (a -> SpecJSON a) -> Parser a -> Parser (SpecJSON a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(JStruct '[] (DecodingSpec a) -> Parser a
JSONStructure (DecodingSpec a) -> Parser a
forall a.
HasJsonDecodingSpec a =>
JSONStructure (DecodingSpec a) -> Parser a
fromJSONStructure (JStruct '[] (DecodingSpec a) -> Parser a)
-> Parser (JStruct '[] (DecodingSpec a)) -> Parser a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser (JStruct '[] (DecodingSpec a))
forall a. StructureFromJSON a => Value -> Parser a
reprParseJSON Value
v)