Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- class ToAesonOptions a where
- toAesonOptions :: Proxy a -> Options
- type ToAesonOptionsListError = ((((((((((((((Text "aeson-deriving constraint error for ToAesonOptions class:" :$$: Text "Don't forget to \"tick\" your opening list bracket.") :$$: Text "There is no ToAesonOptions instance for list types.") :$$: Text "Rather, there are instances for promoted list values.") :$$: Text "") :$$: Text "You likely should correct your deriving declaration to something like:") :$$: Text "") :$$: Text " via GenericEncoded '[myVal1,..]") :$$: Text "") :$$: Text "Instead of:") :$$: Text "") :$$: Text " via GenericEncoded [myVal1,..]") :$$: Text "") :$$: Text "For explanation, see GHC documentation on datatype promotion:") :$$: Text "https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#datatype-promotion") :$$: Text ""
- class ToAesonOptionsField x where
- toAesonOptionsField :: Proxy x -> Options -> Options
- data FieldLabelModifier
- data ConstructorTagModifier
- data AllNullaryToStringTag
- data OmitNothingFields
- data UnwrapUnaryRecords
- data TagSingleConstructors
- data GenericOptions :: fieldLabelModifier -> constructorTagModifier -> allNullaryToStringTag -> omitNothingFields -> sumEncoding -> unwrapUnaryRecords -> tagSingleConstructors -> Type
- newtype GenericEncoded opts a = GenericEncoded a
- type family LoopWarning (n :: Type -> Type) (a :: Type) :: Constraint where ...
- newtype DisableLoopWarning a = DisableLoopWarning a
- newtype RecordSumEncoded (tagKey :: Symbol) (tagModifier :: k) (a :: Type) = RecordSumEncoded a
- stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
- dropPrefix :: Eq a => [a] -> [a] -> [a]
- dropSuffix :: Eq a => [a] -> [a] -> [a]
- class StringFunction (a :: k) where
- stringFunction :: Proxy a -> String -> String
- data Id
- data SnakeCase
- data Uppercase
- data Lowercase
- data DropLowercasePrefix
- data DropPrefix (str :: Symbol)
- data DropSuffix (str :: Symbol)
- class ToSumEncoding a where
- toSumEncoding :: Proxy a -> SumEncoding
- data UntaggedValue
- data ObjectWithSingleField
- data TwoElemArray
- data TaggedObject (tagFieldName :: Symbol) (contentsFieldName :: Symbol)
- snakeCase :: String -> String
- dropLowercasePrefix :: String -> String
- newtype x & f = Ampersand {
- unAmpersand :: f x
Documentation
class ToAesonOptions a where Source #
A class for defining Options
for Aeson's Generic deriving support.
It is generally instantiated either by specifying all Options
fields, using
GenericOptions
, or simply be overriding a few specific fields, by giving a
(type-level) list. In both cases, for the sake of explicitness and to reduce the
possibility of mistakes, fields are specified in a record-like form using the
'(:=)' data type.
Users may also provide their own instances for their own data types if desired, but this should not generally be necessary.
toAesonOptions :: Proxy a -> Options Source #
Instances
type ToAesonOptionsListError = ((((((((((((((Text "aeson-deriving constraint error for ToAesonOptions class:" :$$: Text "Don't forget to \"tick\" your opening list bracket.") :$$: Text "There is no ToAesonOptions instance for list types.") :$$: Text "Rather, there are instances for promoted list values.") :$$: Text "") :$$: Text "You likely should correct your deriving declaration to something like:") :$$: Text "") :$$: Text " via GenericEncoded '[myVal1,..]") :$$: Text "") :$$: Text "Instead of:") :$$: Text "") :$$: Text " via GenericEncoded [myVal1,..]") :$$: Text "") :$$: Text "For explanation, see GHC documentation on datatype promotion:") :$$: Text "https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#datatype-promotion") :$$: Text "" Source #
class ToAesonOptionsField x where Source #
A class that knows about fields of aeson's Options
.
Instances
data FieldLabelModifier Source #
Instances
data ConstructorTagModifier Source #
Instances
data AllNullaryToStringTag Source #
Instances
data OmitNothingFields Source #
Instances
(All (StringFunction :: k2 -> Constraint) (fieldLabelModifier ': (constructorTagModifier ': ([] :: [k2]))), ToSumEncoding sumEncoding, All KnownBool (allNullaryToStringTag ': (omitNothingFields ': (unwrapUnaryRecords ': (tagSingleConstructors ': ([] :: [Bool])))))) => ToAesonOptions (GenericOptions (FieldLabelModifier := fieldLabelModifier) (ConstructorTagModifier := constructorTagModifier) (AllNullaryToStringTag := allNullaryToStringTag) (OmitNothingFields := omitNothingFields) (SumEncoding := sumEncoding) (UnwrapUnaryRecords := unwrapUnaryRecords) (TagSingleConstructors := tagSingleConstructors) :: Type) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toAesonOptions :: Proxy (GenericOptions (FieldLabelModifier := fieldLabelModifier) (ConstructorTagModifier := constructorTagModifier) (AllNullaryToStringTag := allNullaryToStringTag) (OmitNothingFields := omitNothingFields) (SumEncoding := sumEncoding) (UnwrapUnaryRecords := unwrapUnaryRecords) (TagSingleConstructors := tagSingleConstructors)) -> Options Source # | |
KnownBool b => ToAesonOptionsField (OmitNothingFields := b :: Type) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toAesonOptionsField :: Proxy (OmitNothingFields := b) -> Options -> Options Source # |
data UnwrapUnaryRecords Source #
Instances
(All (StringFunction :: k2 -> Constraint) (fieldLabelModifier ': (constructorTagModifier ': ([] :: [k2]))), ToSumEncoding sumEncoding, All KnownBool (allNullaryToStringTag ': (omitNothingFields ': (unwrapUnaryRecords ': (tagSingleConstructors ': ([] :: [Bool])))))) => ToAesonOptions (GenericOptions (FieldLabelModifier := fieldLabelModifier) (ConstructorTagModifier := constructorTagModifier) (AllNullaryToStringTag := allNullaryToStringTag) (OmitNothingFields := omitNothingFields) (SumEncoding := sumEncoding) (UnwrapUnaryRecords := unwrapUnaryRecords) (TagSingleConstructors := tagSingleConstructors) :: Type) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toAesonOptions :: Proxy (GenericOptions (FieldLabelModifier := fieldLabelModifier) (ConstructorTagModifier := constructorTagModifier) (AllNullaryToStringTag := allNullaryToStringTag) (OmitNothingFields := omitNothingFields) (SumEncoding := sumEncoding) (UnwrapUnaryRecords := unwrapUnaryRecords) (TagSingleConstructors := tagSingleConstructors)) -> Options Source # | |
KnownBool b => ToAesonOptionsField (UnwrapUnaryRecords := b :: Type) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toAesonOptionsField :: Proxy (UnwrapUnaryRecords := b) -> Options -> Options Source # |
data TagSingleConstructors Source #
Instances
data GenericOptions :: fieldLabelModifier -> constructorTagModifier -> allNullaryToStringTag -> omitNothingFields -> sumEncoding -> unwrapUnaryRecords -> tagSingleConstructors -> Type Source #
Type-level representation of the Aeson Generic deriving Options
.
This representation is useful explicitly setting all options.
Instances
(All (StringFunction :: k2 -> Constraint) (fieldLabelModifier ': (constructorTagModifier ': ([] :: [k2]))), ToSumEncoding sumEncoding, All KnownBool (allNullaryToStringTag ': (omitNothingFields ': (unwrapUnaryRecords ': (tagSingleConstructors ': ([] :: [Bool])))))) => ToAesonOptions (GenericOptions (FieldLabelModifier := fieldLabelModifier) (ConstructorTagModifier := constructorTagModifier) (AllNullaryToStringTag := allNullaryToStringTag) (OmitNothingFields := omitNothingFields) (SumEncoding := sumEncoding) (UnwrapUnaryRecords := unwrapUnaryRecords) (TagSingleConstructors := tagSingleConstructors) :: Type) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toAesonOptions :: Proxy (GenericOptions (FieldLabelModifier := fieldLabelModifier) (ConstructorTagModifier := constructorTagModifier) (AllNullaryToStringTag := allNullaryToStringTag) (OmitNothingFields := omitNothingFields) (SumEncoding := sumEncoding) (UnwrapUnaryRecords := unwrapUnaryRecords) (TagSingleConstructors := tagSingleConstructors)) -> Options Source # |
newtype GenericEncoded opts a Source #
Specify your encoding scheme in terms of aeson's out-of-the box Generic
functionality. This type is never used directly, only "coerced through".
Use some of the pre-defined types supplied here for the opts
phantom parameter,
or define your with an instance of ToAesonOptions
.
Instances
(ToAesonOptions opts, Generic a, GToJSON Zero (Rep a)) => ToJSON (GenericEncoded opts a) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toJSON :: GenericEncoded opts a -> Value # toEncoding :: GenericEncoded opts a -> Encoding # toJSONList :: [GenericEncoded opts a] -> Value # toEncodingList :: [GenericEncoded opts a] -> Encoding # | |
(ToAesonOptions opts, Generic a, GFromJSON Zero (Rep a)) => FromJSON (GenericEncoded opts a) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic parseJSON :: Value -> Parser (GenericEncoded opts a) # parseJSONList :: Value -> Parser [GenericEncoded opts a] # |
type family LoopWarning (n :: Type -> Type) (a :: Type) :: Constraint where ... Source #
Used in FromJSON/ToJSON superclass constraints for newtypes that recursively modify
the instances. A guard against the common mistake of deriving encoders in terms
of such a newtype over the naked base type instead of the GenericEncoded
version.
This can lead to nasty runtime bugs.
This error can be disabled by wrapping your type in DisableLoopWarning
.
This should never be necessary to use the functionality of this package. It may be
required if you, for example, combine our newtypes with another library's types
for generating aeson instances.
LoopWarning n (GenericEncoded opts a) = () | |
LoopWarning n (RecordSumEncoded tagKey tagValMod a) = () | |
LoopWarning n (DisableLoopWarning a) = () | |
LoopWarning n (x & f) = LoopWarning n (f x) | |
LoopWarning n (f x) = LoopWarning n x | |
LoopWarning n x = TypeError (((((((((((((((((Text "Uh oh! Watch out for those infinite loops!" :$$: Text "Newtypes that recursively modify aeson instances, namely:") :$$: Text "") :$$: (Text " " :<>: ShowType n)) :$$: Text "") :$$: Text "must only be used atop a type that creates the instances non-recursively: ") :$$: Text "") :$$: Text " \65518 GenericEncoded") :$$: Text " \65518 RecordSumEncoded") :$$: Text "") :$$: Text "We observe instead the inner type: ") :$$: Text "") :$$: (Text " " :<>: ShowType x)) :$$: Text "") :$$: Text "You probably created an infinitely recursive encoder/decoder pair.") :$$: Text "See `LoopWarning` for details.") :$$: Text "This check can be disabled by wrapping the inner type in `DisableLoopWarning`.") :$$: Text "") |
newtype DisableLoopWarning a Source #
Assert that you know what you're doing and to nullify the LoopWarning
constraint family.
This should not be necessary.
Instances
ToJSON a => ToJSON (DisableLoopWarning a) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toJSON :: DisableLoopWarning a -> Value # toEncoding :: DisableLoopWarning a -> Encoding # toJSONList :: [DisableLoopWarning a] -> Value # toEncodingList :: [DisableLoopWarning a] -> Encoding # | |
FromJSON a => FromJSON (DisableLoopWarning a) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic parseJSON :: Value -> Parser (DisableLoopWarning a) # parseJSONList :: Value -> Parser [DisableLoopWarning a] # |
newtype RecordSumEncoded (tagKey :: Symbol) (tagModifier :: k) (a :: Type) Source #
An encoding scheme for sums of records that are defined as distinct data types.
If we have a number of record types we want to combine under a sum, a straightforward
solution is to ensure that each each inner type uses a constructor tag, and then
derive the sum with SumEncoding := UntaggedValue
. This works fine for the happy
path, but makes for very bad error messages, since it means that decoding proceeds by
trying each case in sequence. Thus error messages always pertain to the last type in
the sum, even when it wasn't the intended payload. This newtype improves on that
solution by providing the relevant error messages, by remembering the correspondence
between the constructor tag and the intended inner type/parser.
In order to work correctly, the inner types must use the TaggedObject
encoding.
The same tag field name and ConstructorTagModifier
must be supplied to this type.
Instances
(Generic a, GToJSON Zero (Rep a)) => ToJSON (RecordSumEncoded tagKey tagModifier a) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toJSON :: RecordSumEncoded tagKey tagModifier a -> Value # toEncoding :: RecordSumEncoded tagKey tagModifier a -> Encoding # toJSONList :: [RecordSumEncoded tagKey tagModifier a] -> Value # toEncodingList :: [RecordSumEncoded tagKey tagModifier a] -> Encoding # | |
(Generic a, GFromJSON Zero (Rep a), GTagParserMap (Rep a), Rep a ~ D1 meta cs, Datatype meta, StringFunction tagModifier, KnownSymbol tagKey) => FromJSON (RecordSumEncoded tagKey tagModifier a) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic parseJSON :: Value -> Parser (RecordSumEncoded tagKey tagModifier a) # parseJSONList :: Value -> Parser [RecordSumEncoded tagKey tagModifier a] # |
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] Source #
dropPrefix :: Eq a => [a] -> [a] -> [a] Source #
dropSuffix :: Eq a => [a] -> [a] -> [a] Source #
class StringFunction (a :: k) where Source #
Instances
Instances
StringFunction Id Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic |
Applies snakeCase
Instances
StringFunction SnakeCase Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic |
Instances
StringFunction Uppercase Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic |
Instances
StringFunction Lowercase Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic |
data DropLowercasePrefix Source #
Applies dropLowercasePrefix
, dropping until the first uppercase character.
Instances
StringFunction DropLowercasePrefix Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic stringFunction :: Proxy DropLowercasePrefix -> String -> String Source # |
data DropPrefix (str :: Symbol) Source #
Instances
KnownSymbol str => StringFunction (DropPrefix str :: Type) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic stringFunction :: Proxy (DropPrefix str) -> String -> String Source # |
data DropSuffix (str :: Symbol) Source #
Instances
KnownSymbol str => StringFunction (DropSuffix str :: Type) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic stringFunction :: Proxy (DropSuffix str) -> String -> String Source # |
class ToSumEncoding a where Source #
Type-level encoding for SumEncoding
toSumEncoding :: Proxy a -> SumEncoding Source #
Instances
ToSumEncoding TwoElemArray Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic | |
ToSumEncoding ObjectWithSingleField Source # | |
ToSumEncoding UntaggedValue Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic | |
(KnownSymbol tag, KnownSymbol contents) => ToSumEncoding (TaggedObject tag contents :: Type) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toSumEncoding :: Proxy (TaggedObject tag contents) -> SumEncoding Source # |
data UntaggedValue Source #
Instances
ToSumEncoding UntaggedValue Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic |
data ObjectWithSingleField Source #
Instances
ToSumEncoding ObjectWithSingleField Source # | |
data TwoElemArray Source #
Instances
ToSumEncoding TwoElemArray Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic |
data TaggedObject (tagFieldName :: Symbol) (contentsFieldName :: Symbol) Source #
A constructor will be encoded to an object with a field tagFieldName which specifies the constructor tag (modified by the constructorTagModifier). If the constructor is a record the encoded record fields will be unpacked into this object. So make sure that your record doesn't have a field with the same label as the tagFieldName. Otherwise the tag gets overwritten by the encoded value of that field! If the constructor is not a record the encoded constructor contents will be stored under the contentsFieldName field.
Instances
(KnownSymbol tag, KnownSymbol contents) => ToSumEncoding (TaggedObject tag contents :: Type) Source # | |
Defined in Data.Aeson.Deriving.Internal.Generic toSumEncoding :: Proxy (TaggedObject tag contents) -> SumEncoding Source # |
snakeCase :: String -> String Source #
Field name modifier function that separates camel-case words by underscores (i.e. on capital letters). Also knows to handle a consecutive sequence of capitals as a single word.
dropLowercasePrefix :: String -> String Source #
Drop the first lowercase sequence (i.e. until isUpper
returns True) from the start
of a string. Used for the common idiom where fields are prefixed by the type name in
all lowercase. The definition is taken from the aeson-casing package.