| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Schemas.Internal
Synopsis
- data TypedSchemaFlex from a where
- 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
- TOneOf :: NonEmpty (TypedSchemaFlex from a) -> TypedSchemaFlex from a
- 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
- type TypedSchema a = TypedSchemaFlex a a
- named :: SchemaName -> TypedSchemaFlex from' a -> TypedSchemaFlex from' a
- enum :: Eq a => (a -> Text) -> NonEmpty a -> TypedSchema a
- stringMap :: TypedSchema a -> TypedSchema (HashMap Text a)
- list :: IsList l => TypedSchema (Item l) -> TypedSchema l
- vector :: TypedSchema a -> TypedSchema (Vector a)
- viaJSON :: (FromJSON a, ToJSON a) => Text -> TypedSchema a
- viaIso :: Iso' a b -> TypedSchema a -> TypedSchema b
- string :: TypedSchema String
- readShow :: (Read a, Show a) => TypedSchema a
- oneOf :: NonEmpty (TypedSchemaFlex from a) -> TypedSchemaFlex from a
- allOf :: NonEmpty (TypedSchemaFlex from a) -> TypedSchemaFlex from a
- data RecordField from a where
- RequiredAp :: {..} -> RecordField from a
- OptionalAp :: {..} -> RecordField from a
- fieldNameL :: Lens' (RecordField from a) Text
- newtype RecordFields from a = RecordFields {
- getRecordFields :: Alt (RecordField from) a
- overFieldNames :: (Text -> Text) -> RecordFields from a -> RecordFields from a
- record :: RecordFields from a -> TypedSchemaFlex from a
- fieldWith :: TypedSchema a -> Text -> (from -> a) -> RecordFields from a
- fieldWith' :: TypedSchemaFlex from a -> Text -> RecordFields from a
- liftPrism :: Text -> Prism s t a b -> TypedSchemaFlex a b -> TypedSchemaFlex s t
- liftJust :: TypedSchemaFlex a b -> TypedSchemaFlex (Maybe a) (Maybe b)
- liftRight :: TypedSchemaFlex a b -> TypedSchemaFlex (Either c a) (Either c b)
- optFieldWith :: forall a from. TypedSchemaFlex from (Maybe a) -> Text -> RecordFields from (Maybe a)
- optFieldGeneral :: forall a from. TypedSchemaFlex from a -> Text -> a -> RecordFields from a
- optFieldEitherWith :: TypedSchemaFlex from (Either e a) -> Text -> e -> RecordFields from (Either e a)
- extractFieldsHelper :: Alternative f => (forall a. RecordField from a -> f b) -> RecordFields from a -> f [b]
- union :: NonEmpty (Text, TypedSchema a) -> TypedSchema a
- data UnionTag from where
- UnionTag :: Text -> Prism' from b -> TypedSchema b -> UnionTag from
- altWith :: TypedSchema a -> Text -> Prism' from a -> UnionTag from
- union' :: NonEmpty (UnionTag from) -> TypedSchema from
- extractSchema :: TypedSchemaFlex from a -> NonEmpty Schema
- extractFields :: RecordFields from to -> [[(Text, Field)]]
- extractValidators :: TypedSchemaFlex from a -> Validators
- type E = [(Trace, Mismatch)]
- encodeWith :: TypedSchemaFlex from a -> from -> Value
- encodeToWith :: TypedSchemaFlex from a -> Schema -> Either E (from -> Value)
- type D = [(Trace, DecodeError)]
- type DecodeError = Mismatch
- runSchema :: TypedSchemaFlex enc dec -> enc -> Either [DecodeError] dec
- decodeWith :: TypedSchemaFlex from a -> Value -> Either D a
- decodeFromWith :: TypedSchemaFlex from a -> Schema -> Either D (Value -> Either D a)
- runAlt_ :: (Alternative g, Monoid m) => (forall a. f a -> g m) -> Alt f b -> g m
- (<.>) :: Functor f => (b -> c) -> (a -> f b) -> a -> f c
- unsafeDelay :: Except a c -> c
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.
- introduction forms:
record,enum,schema - operations:
encodeToWith,decodeFrom,extractSchema - composition:
dimap,union,stringMap,liftPrism
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
type TypedSchema a = TypedSchemaFlex a a Source #
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
allOf :: NonEmpty (TypedSchemaFlex from a) -> TypedSchemaFlex from a Source #
data RecordField from a where Source #
Constructors
| RequiredAp | |
Fields
| |
| OptionalAp | |
Fields
| |
Instances
| Profunctor RecordField Source # | |
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
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
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 #
type DecodeError = Mismatch 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
decodeFromWith :: TypedSchemaFlex from a -> Schema -> Either D (Value -> Either D a) Source #
unsafeDelay :: Except a c -> c Source #