aeson-schemas-1.0.0: Easily consume JSON data on-demand with type-safety

MaintainerBrandon Chinn <brandon@leapyear.io>
Stabilityexperimental
Portabilityportable
Safe HaskellNone
LanguageHaskell2010

Data.Aeson.Schema.Internal

Description

Internal definitions for declaring JSON schemas.

Synopsis

Documentation

newtype Object (schema :: SchemaType) Source #

The object containing JSON data and its schema.

Has a FromJSON instance, so you can use the usual Aeson decoding functions.

obj = decode "{\"a\": 1}" :: Maybe (Object [schema| { a: Int } |])
Instances
IsSchemaObject schema => Show (Object schema) Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

Methods

showsPrec :: Int -> Object schema -> ShowS #

show :: Object schema -> String #

showList :: [Object schema] -> ShowS #

IsSchemaObject schema => FromJSON (Object schema) Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

Methods

parseJSON :: Value -> Parser (Object schema) #

parseJSONList :: Value -> Parser [Object schema] #

type IsSchemaObject schema = (IsSchemaType schema, SchemaResult schema ~ Object schema) Source #

A constraint that checks if the given schema is a 'SchemaObject.

data SchemaType Source #

The type-level schema definition for JSON data.

To view a schema for debugging, use showSchema.

Instances
(KnownSymbol key, IsSchemaType inner, Show (SchemaResult inner), Typeable (SchemaResult inner), IsSchemaObject (SchemaObject rest), Typeable rest) => IsSchemaType (SchemaObject ((,) key inner ': rest)) Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

Methods

parseValue :: [Text] -> Value -> Parser (SchemaResult (SchemaObject ((key, inner) ': rest))) Source #

showValue :: SchemaResult (SchemaObject ((key, inner) ': rest)) -> String Source #

IsSchemaType (SchemaObject ([] :: [(Symbol, SchemaType)])) Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

showSchema :: forall (a :: SchemaType). Typeable a => String Source #

Pretty show the given SchemaType.

type family SchemaResult (schema :: SchemaType) where ... Source #

A type family mapping SchemaType to the corresponding Haskell type.

class Typeable schema => IsSchemaType (schema :: SchemaType) where Source #

A type-class for types that can be parsed from JSON for an associated schema type.

Minimal complete definition

Nothing

Instances
IsSchemaType SchemaBool Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

IsSchemaType SchemaInt Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

IsSchemaType SchemaDouble Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

IsSchemaType SchemaText Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

(Show inner, Typeable inner, FromJSON inner) => IsSchemaType (SchemaCustom inner) Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

(IsSchemaType inner, Show (SchemaResult inner)) => IsSchemaType (SchemaMaybe inner) Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

(IsSchemaType inner, Show (SchemaResult inner)) => IsSchemaType (SchemaList inner) Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

(KnownSymbol key, IsSchemaType inner, Show (SchemaResult inner), Typeable (SchemaResult inner), IsSchemaObject (SchemaObject rest), Typeable rest) => IsSchemaType (SchemaObject ((,) key inner ': rest)) Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

Methods

parseValue :: [Text] -> Value -> Parser (SchemaResult (SchemaObject ((key, inner) ': rest))) Source #

showValue :: SchemaResult (SchemaObject ((key, inner) ': rest)) -> String Source #

IsSchemaType (SchemaObject ([] :: [(Symbol, SchemaType)])) Source # 
Instance details

Defined in Data.Aeson.Schema.Internal

parseFail :: forall (schema :: SchemaType) m a. (Monad m, Typeable schema) => [Text] -> Value -> m a Source #

A helper for creating fail messages when parsing a schema.

type family LookupSchema (key :: Symbol) (schema :: SchemaType) :: SchemaType where ... Source #

The type-level function that return the schema of the given key in a SchemaObject.

Equations

LookupSchema key (SchemaObject schema) = Eval (Snd =<< (FromMaybe (TypeError (((Text "Key '" :<>: Text key) :<>: Text "' does not exist in the following schema:") :$$: ShowType schema)) =<< Find (TyEq key <=< Fst) schema)) 
LookupSchema key schema = TypeError (((Text "Attempted to lookup key '" :<>: Text key) :<>: Text "' in the following schema:") :$$: ShowType schema) 

getKey :: forall key schema endSchema result. (endSchema ~ LookupSchema key schema, result ~ SchemaResult endSchema, KnownSymbol key, Typeable result, Typeable endSchema) => Object schema -> result Source #

Get a key from the given Object, returned as the type encoded in its schema.

let o = .. :: Object
            ( 'SchemaObject
               '[ '("foo", 'SchemaInt)
                , '("bar", 'SchemaObject
                     '[ '("name", 'SchemaText)
                      ]
                , '("baz", 'SchemaMaybe 'SchemaBool)
                ]
            )

getKey @"foo" o                  :: Bool
getKey @"bar" o                  :: Object ('SchemaObject '[ '("name", 'SchemaText) ])
getKey @"name" $ getKey @"bar" o :: Text
getKey @"baz" o                  :: Maybe Bool