schemas-0.3.0: schema guided serialization

Safe HaskellNone
LanguageHaskell2010

Schemas.Internal

Synopsis

Documentation

data TypedSchemaFlex from a where Source #

TypedSchemaFlex enc dec is a schema for encoding from enc and decoding to dec. Usually we want enc and dec to be the same type but this flexibility comes in handy for composition.

Constructors

TNamed :: SchemaName -> TypedSchemaFlex from' a' -> (a' -> a) -> (from -> from') -> TypedSchemaFlex from a 
TEnum :: NonEmpty (Text, a) -> (from -> Text) -> TypedSchemaFlex from a 
TArray :: TypedSchemaFlex b b -> (Vector b -> a) -> (from -> Vector b) -> TypedSchemaFlex from a 
TMap :: TypedSchemaFlex b b -> (HashMap Text b -> a) -> (from -> HashMap Text b) -> TypedSchemaFlex from a 
TAllOf :: NonEmpty (TypedSchemaFlex from a) -> TypedSchemaFlex from a

Encoding and decoding support all alternatives

TOneOf :: NonEmpty (TypedSchemaFlex from a) -> TypedSchemaFlex from a

Decoding from all alternatives, but encoding only to one

TEmpty :: a -> TypedSchemaFlex from a 
TPrim :: Text -> (Value -> Result a) -> (from -> Value) -> TypedSchemaFlex from a 
TTry :: Text -> TypedSchemaFlex a b -> (a' -> Maybe a) -> TypedSchemaFlex a' b 
RecordSchema :: RecordFields from a -> TypedSchemaFlex from a 
Instances
Profunctor TypedSchemaFlex Source # 
Instance details

Defined in Schemas.Internal

Methods

dimap :: (a -> b) -> (c -> d) -> TypedSchemaFlex b c -> TypedSchemaFlex a d #

lmap :: (a -> b) -> TypedSchemaFlex b c -> TypedSchemaFlex a c #

rmap :: (b -> c) -> TypedSchemaFlex a b -> TypedSchemaFlex a c #

(#.) :: Coercible c b => q b c -> TypedSchemaFlex a b -> TypedSchemaFlex a c #

(.#) :: Coercible b a => TypedSchemaFlex b c -> q a b -> TypedSchemaFlex a c #

Functor (TypedSchemaFlex from) Source # 
Instance details

Defined in Schemas.Internal

Methods

fmap :: (a -> b) -> TypedSchemaFlex from a -> TypedSchemaFlex from b #

(<$) :: a -> TypedSchemaFlex from b -> TypedSchemaFlex from a #

Show (TypedSchemaFlex from a) Source # 
Instance details

Defined in Schemas.Internal

Methods

showsPrec :: Int -> TypedSchemaFlex from a -> ShowS #

show :: TypedSchemaFlex from a -> String #

showList :: [TypedSchemaFlex from a] -> ShowS #

Semigroup (TypedSchemaFlex f a) Source # 
Instance details

Defined in Schemas.Internal

Monoid a => Monoid (TypedSchemaFlex f a) Source # 
Instance details

Defined in Schemas.Internal

named :: SchemaName -> TypedSchemaFlex from' a -> TypedSchemaFlex from' a Source #

named n sc annotates a schema with a name, allowing for circular schemas.

enum :: Eq a => (a -> Text) -> NonEmpty a -> TypedSchema a Source #

enum values mapping construct a schema for a non empty set of values with a Text mapping

stringMap :: TypedSchema a -> TypedSchema (HashMap Text a) Source #

stringMap sc is the schema for a stringmap where the values have schema sc

list :: IsList l => TypedSchema (Item l) -> TypedSchema l Source #

list sc is the schema for a list of values with schema sc

vector :: TypedSchema a -> TypedSchema (Vector a) Source #

vector sc is the schema for a vector of values with schema sc

viaJSON :: (FromJSON a, ToJSON a) => Text -> TypedSchema a Source #

viaJson label constructs a schema reusing existing aeson instances. The resulting schema is opaque and cannot be subtyped and/or versioned, so this constructor should be used sparingly. The label is used to describe the extracted Schema.

viaIso :: Iso' a b -> TypedSchema a -> TypedSchema b Source #

Apply an isomorphism to a schema

string :: TypedSchema String Source #

The schema of String values

readShow :: (Read a, Show a) => TypedSchema a Source #

A schema for types that can be parsed and pretty-printed. The resulting schema is opaque and cannot be subtyped/versioned, so this constructor is best used for primitive value

oneOf :: NonEmpty (TypedSchemaFlex from a) -> TypedSchemaFlex from a Source #

The schema of undiscriminated unions. Prefer using union where possible

data RecordField from a where Source #

Constructors

RequiredAp 

Fields

OptionalAp 

Fields

Instances
Profunctor RecordField Source # 
Instance details

Defined in Schemas.Internal

Methods

dimap :: (a -> b) -> (c -> d) -> RecordField b c -> RecordField a d #

lmap :: (a -> b) -> RecordField b c -> RecordField a c #

rmap :: (b -> c) -> RecordField a b -> RecordField a c #

(#.) :: Coercible c b => q b c -> RecordField a b -> RecordField a c #

(.#) :: Coercible b a => RecordField b c -> q a b -> RecordField a c #

fieldNameL :: Lens' (RecordField from a) Text Source #

Lens for the fieldName attribute

newtype RecordFields from a Source #

An Alternative profunctor for defining record schemas with versioning

 schemaPerson = Person
            <$> (field "name" name <|> field "full name" name)
            <*> (field "age" age <|> pure -1)

Constructors

RecordFields 

Fields

Instances
Profunctor RecordFields Source # 
Instance details

Defined in Schemas.Internal

Methods

dimap :: (a -> b) -> (c -> d) -> RecordFields b c -> RecordFields a d #

lmap :: (a -> b) -> RecordFields b c -> RecordFields a c #

rmap :: (b -> c) -> RecordFields a b -> RecordFields a c #

(#.) :: Coercible c b => q b c -> RecordFields a b -> RecordFields a c #

(.#) :: Coercible b a => RecordFields b c -> q a b -> RecordFields a c #

Functor (RecordFields from) Source # 
Instance details

Defined in Schemas.Internal

Methods

fmap :: (a -> b) -> RecordFields from a -> RecordFields from b #

(<$) :: a -> RecordFields from b -> RecordFields from a #

Applicative (RecordFields from) Source # 
Instance details

Defined in Schemas.Internal

Methods

pure :: a -> RecordFields from a #

(<*>) :: RecordFields from (a -> b) -> RecordFields from a -> RecordFields from b #

liftA2 :: (a -> b -> c) -> RecordFields from a -> RecordFields from b -> RecordFields from c #

(*>) :: RecordFields from a -> RecordFields from b -> RecordFields from b #

(<*) :: RecordFields from a -> RecordFields from b -> RecordFields from a #

Alternative (RecordFields from) Source # 
Instance details

Defined in Schemas.Internal

Methods

empty :: RecordFields from a #

(<|>) :: RecordFields from a -> RecordFields from a -> RecordFields from a #

some :: RecordFields from a -> RecordFields from [a] #

many :: RecordFields from a -> RecordFields from [a] #

Semigroup (RecordFields from a) Source # 
Instance details

Defined in Schemas.Internal

Methods

(<>) :: RecordFields from a -> RecordFields from a -> RecordFields from a #

sconcat :: NonEmpty (RecordFields from a) -> RecordFields from a #

stimes :: Integral b => b -> RecordFields from a -> RecordFields from a #

Monoid (RecordFields from a) Source # 
Instance details

Defined in Schemas.Internal

Methods

mempty :: RecordFields from a #

mappend :: RecordFields from a -> RecordFields from a -> RecordFields from a #

mconcat :: [RecordFields from a] -> RecordFields from a #

overFieldNames :: (Text -> Text) -> RecordFields from a -> RecordFields from a Source #

Map a function over all the field names

record :: RecordFields from a -> TypedSchemaFlex from a Source #

Wrap an applicative record schema

fieldWith :: TypedSchema a -> Text -> (from -> a) -> RecordFields from a Source #

fieldWith sc n get introduces a field

fieldWith' :: TypedSchemaFlex from a -> Text -> RecordFields from a Source #

Generalised version of fieldWith

liftPrism :: Text -> Prism s t a b -> TypedSchemaFlex a b -> TypedSchemaFlex s t Source #

Project a schema through a Prism. Returns a partial schema. When encoding/decoding a value that doesn't fit the prism, an optional field will be omitted, and a required field will cause this alternative to be aborted.

liftJust :: TypedSchemaFlex a b -> TypedSchemaFlex (Maybe a) (Maybe b) Source #

liftJust = liftPrism _Just

liftRight :: TypedSchemaFlex a b -> TypedSchemaFlex (Either c a) (Either c b) Source #

liftRight = liftPrism _Right

optFieldWith :: forall a from. TypedSchemaFlex from (Maybe a) -> Text -> RecordFields from (Maybe a) Source #

A generalized version of optField. Does not handle infinite/circular data.

optFieldGeneral :: forall a from. TypedSchemaFlex from a -> Text -> a -> RecordFields from a Source #

The most general introduction form for optional alts

optFieldEitherWith :: TypedSchemaFlex from (Either e a) -> Text -> e -> RecordFields from (Either e a) Source #

A generalized version of optFieldEither. Does not handle infinite/circular data

extractFieldsHelper :: Alternative f => (forall a. RecordField from a -> f b) -> RecordFields from a -> f [b] Source #

union :: NonEmpty (Text, TypedSchema a) -> TypedSchema a Source #

The schema of discriminated unions

  import Schemas
  import "generic-lens" Data.Generics.Labels ()
  import GHC.Generics

  data Education = Degree Text | PhD Text | NoEducation

  schemaEducation = union'
    [ alt "NoEducation" #_NoEducation
    , alt "Degree"      #_Degree
    , alt "PhD"         #_PhD
    ]
  

Given a non empty set of tagged partial schemas, constructs the schema that applies them in order and selects the first successful match.

data UnionTag from where Source #

Existential wrapper for convenient definition of discriminated unions

Constructors

UnionTag :: Text -> Prism' from b -> TypedSchema b -> UnionTag from 

altWith :: TypedSchema a -> Text -> Prism' from a -> UnionTag from Source #

altWith name prism schema introduces a discriminated union alternative

union' :: NonEmpty (UnionTag from) -> TypedSchema from Source #

Given a non empty set of constructors, construct the schema that selects the first matching constructor

extractSchema :: TypedSchemaFlex from a -> NonEmpty Schema Source #

Extract an untyped schema that can be serialized.

For schemas with alternatives, this enumerates all the possible versions lazily. Beware when using on schemas with multiple alternatives, as the number of versions is exponential.

extractFields :: RecordFields from to -> [[(Text, Field)]] Source #

Extract all the field groups (from alternatives) in the record

extractValidators :: TypedSchemaFlex from a -> Validators Source #

Returns all the primitive validators embedded in this typed schema

type E = [(Trace, Mismatch)] Source #

encodeWith :: TypedSchemaFlex from a -> from -> Value Source #

Given a typed schema, produce a JSON encoder to the firt version returned by extractSchema

encodeToWith :: TypedSchemaFlex from a -> Schema -> Either E (from -> Value) Source #

Given source and target schemas, produce a JSON encoder

type D = [(Trace, DecodeError)] Source #

runSchema :: TypedSchemaFlex enc dec -> enc -> Either [DecodeError] dec Source #

Runs a schema as a function enc -> dec. Loops for infinite/circular data

decodeWith :: TypedSchemaFlex from a -> Value -> Either D a Source #

Given a JSON Value and a typed schema, extract a Haskell value

runAlt_ :: (Alternative g, Monoid m) => (forall a. f a -> g m) -> Alt f b -> g m Source #

(<.>) :: Functor f => (b -> c) -> (a -> f b) -> a -> f c infixr 8 Source #