Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type family CRepr (s :: Schema) :: Type where ...
- data TextConstraint
- data DemotedTextConstraint
- data NumberConstraint
- data DemotedNumberConstraint
- data ArrayConstraint = AEq Nat
- data DemotedArrayConstraint = DAEq Integer
- data Schema
- data DemotedSchema
- data FieldRepr :: (Symbol, Schema) -> Type where
- FieldRepr :: (SingI schema, KnownSymbol name) => JsonRepr schema -> FieldRepr '(name, schema)
- toJsonRepr :: FieldRepr '(fn, sch) -> JsonRepr sch
- knownFieldName :: forall proxy (fieldName :: Symbol) schema. KnownSymbol fieldName => proxy '(fieldName, schema) -> Text
- knownFieldSchema :: forall proxy fieldName schema. SingI schema => proxy '(fieldName, schema) -> Sing schema
- type family USubsets (u :: [k]) :: Constraint where ...
- data JsonRepr :: Schema -> Type where
- ReprText :: Text -> JsonRepr (SchemaText cs)
- ReprNumber :: Scientific -> JsonRepr (SchemaNumber cs)
- ReprBoolean :: Bool -> JsonRepr SchemaBoolean
- ReprNull :: JsonRepr SchemaNull
- ReprArray :: Vector (JsonRepr s) -> JsonRepr (SchemaArray cs s)
- ReprObject :: Rec FieldRepr fs -> JsonRepr (SchemaObject fs)
- ReprOptional :: Maybe (JsonRepr s) -> JsonRepr (SchemaOptional s)
- ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr (SchemaUnion (h ': tl))
- fromOptional :: SingI s => Sing (SchemaOptional s) -> Value -> Parser (Maybe (JsonRepr s))
- parseUnion :: FromJSON (JsonRepr (SchemaUnion ss)) => sing (ss :: [Schema]) -> Value -> Parser (JsonRepr (SchemaUnion ss))
- class FalseConstraint a
- type family TopLevel (schema :: Schema) :: Constraint where ...
Documentation
type family CRepr (s :: Schema) :: Type where ... Source #
CRepr (SchemaText cs) = TextConstraint | |
CRepr (SchemaNumber cs) = NumberConstraint | |
CRepr (SchemaObject fs) = (String, Schema) | |
CRepr (SchemaArray ar s) = ArrayConstraint |
data TextConstraint Source #
Instances
data DemotedTextConstraint Source #
Instances
data NumberConstraint Source #
Instances
data DemotedNumberConstraint Source #
Instances
data ArrayConstraint Source #
Instances
data DemotedArrayConstraint Source #
Instances
Eq DemotedArrayConstraint Source # | |
Defined in Data.Schematic.Schema | |
Show DemotedArrayConstraint Source # | |
Defined in Data.Schematic.Schema showsPrec :: Int -> DemotedArrayConstraint -> ShowS # show :: DemotedArrayConstraint -> String # showList :: [DemotedArrayConstraint] -> ShowS # | |
Generic DemotedArrayConstraint Source # | |
Defined in Data.Schematic.Schema type Rep DemotedArrayConstraint :: * -> * # | |
type Rep DemotedArrayConstraint Source # | |
Defined in Data.Schematic.Schema type Rep DemotedArrayConstraint = D1 (MetaData "DemotedArrayConstraint" "Data.Schematic.Schema" "schematic-0.5.0.0-J36RtftksLpFmJPcZ9Dyb" False) (C1 (MetaCons "DAEq" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer))) |
SchemaText [TextConstraint] | |
SchemaBoolean | |
SchemaNumber [NumberConstraint] | |
SchemaObject [(Symbol, Schema)] | |
SchemaArray [ArrayConstraint] Schema | |
SchemaNull | |
SchemaOptional Schema | |
SchemaUnion [Schema] |
Instances
data DemotedSchema Source #
Instances
data FieldRepr :: (Symbol, Schema) -> Type where Source #
FieldRepr :: (SingI schema, KnownSymbol name) => JsonRepr schema -> FieldRepr '(name, schema) |
toJsonRepr :: FieldRepr '(fn, sch) -> JsonRepr sch Source #
Forgetful Functor Ufr
knownFieldName :: forall proxy (fieldName :: Symbol) schema. KnownSymbol fieldName => proxy '(fieldName, schema) -> Text Source #
knownFieldSchema :: forall proxy fieldName schema. SingI schema => proxy '(fieldName, schema) -> Sing schema Source #
type family USubsets (u :: [k]) :: Constraint where ... Source #
data JsonRepr :: Schema -> Type where Source #
ReprText :: Text -> JsonRepr (SchemaText cs) | |
ReprNumber :: Scientific -> JsonRepr (SchemaNumber cs) | |
ReprBoolean :: Bool -> JsonRepr SchemaBoolean | |
ReprNull :: JsonRepr SchemaNull | |
ReprArray :: Vector (JsonRepr s) -> JsonRepr (SchemaArray cs s) | |
ReprObject :: Rec FieldRepr fs -> JsonRepr (SchemaObject fs) | |
ReprOptional :: Maybe (JsonRepr s) -> JsonRepr (SchemaOptional s) | |
ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr (SchemaUnion (h ': tl)) |
Instances
fromOptional :: SingI s => Sing (SchemaOptional s) -> Value -> Parser (Maybe (JsonRepr s)) Source #
parseUnion :: FromJSON (JsonRepr (SchemaUnion ss)) => sing (ss :: [Schema]) -> Value -> Parser (JsonRepr (SchemaUnion ss)) Source #
class FalseConstraint a Source #
type family TopLevel (schema :: Schema) :: Constraint where ... Source #
TopLevel (SchemaArray acs s) = () | |
TopLevel (SchemaObject o) = () | |
TopLevel spec = True ~ False |