autodocodec-0.2.0.3: Self-documenting encoder and decoder
Safe HaskellSafe-Inferred
LanguageHaskell2010

Autodocodec

Synopsis

Encoding and decoding JSON

encodeJSONViaCodec :: HasCodec a => a -> ByteString Source #

Encode a value as a JSON ByteString via its type's codec.

Instantiating ToJSON

toJSONViaCodec :: HasCodec a => a -> Value Source #

Implement toJSON via a type's codec.

toJSONVia :: ValueCodec a void -> a -> Value Source #

Implement toJSON via a given codec.

toEncodingViaCodec :: HasCodec a => a -> Encoding Source #

Implement toEncoding via a type's codec.

toEncodingVia :: ValueCodec a void -> a -> Encoding Source #

Implement toEncoding via the given codec.

Instantiating FromJSON

parseJSONViaCodec :: HasCodec a => Value -> Parser a Source #

Implement parseJSON via a type's codec.

parseJSONVia :: ValueCodec void a -> Value -> Parser a Source #

Implement parseJSON via a given codec.

Codec

type JSONCodec a = ValueCodec a a Source #

A completed autodocodec for parsing and rendering a Value.

You can use a value of this type to get everything else for free:

  • Encode values to JSON using toJSONViaCodec or toJSONVia
  • Decode values from JSON using parseJSONViaCodec or parseJSONVia
  • Produce a JSON Schema using jsonSchemaViaCodec or jsonSchemaVia from autodocodec-schema
  • Encode to and decode from Yaml using autodocodec-yaml
  • Produce a human-readible YAML schema using renderColouredSchemaViaCodec from autodocodec-yaml
  • Produce a Swagger2 schema using autodocodec-swagger2
  • Produce a OpenAPI3 schema using autodocodec-openapi3

type JSONObjectCodec a = ObjectCodec a a Source #

A completed autodocodec for parsing and rendering a Value.

class HasCodec value where Source #

A class for values which have a canonical codec.

There are no formal laws for this class. If you really want a law, it should be "Whomever uses the codec from your instance should not be surprised."

Minimal complete definition

codec

Methods

codec :: JSONCodec value Source #

A codec for a single value

See the sections on helper functions for implementing this for plenty of examples.

listCodecForStringCompatibility :: JSONCodec [value] Source #

A codec for a list of values

This is really only useful for cases like Char and String. We didn't call it listCodec so we could use that name for making a codec for a list of values from a single codec instead.

Instances

Instances details
HasCodec Value Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Void Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Int16 Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Int32 Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Int64 Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Int8 Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Word16 Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Word32 Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Word64 Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Word8 Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Ordering Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Scientific Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Text Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Text Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Day Source # 
Instance details

Defined in Autodocodec.Class

HasCodec DiffTime Source # 
Instance details

Defined in Autodocodec.Class

HasCodec NominalDiffTime Source # 
Instance details

Defined in Autodocodec.Class

HasCodec UTCTime Source # 
Instance details

Defined in Autodocodec.Class

HasCodec LocalTime Source # 
Instance details

Defined in Autodocodec.Class

HasCodec TimeOfDay Source # 
Instance details

Defined in Autodocodec.Class

HasCodec ZonedTime Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Bool Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Char Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Int Source # 
Instance details

Defined in Autodocodec.Class

HasCodec Word Source # 
Instance details

Defined in Autodocodec.Class

HasCodec v => HasCodec (KeyMap v) Source # 
Instance details

Defined in Autodocodec.Class

(Ord a, HasCodec a) => HasCodec (Set a) Source # 
Instance details

Defined in Autodocodec.Class

HasCodec a => HasCodec (NonEmpty a) Source # 
Instance details

Defined in Autodocodec.Class

HasCodec a => HasCodec (Maybe a) Source # 
Instance details

Defined in Autodocodec.Class

HasCodec a => HasCodec [a] Source # 
Instance details

Defined in Autodocodec.Class

(HasCodec l, HasCodec r) => HasCodec (Either l r) Source # 
Instance details

Defined in Autodocodec.Class

(Ord k, FromJSONKey k, ToJSONKey k, HasCodec v) => HasCodec (Map k v) Source # 
Instance details

Defined in Autodocodec.Class

(Eq k, Hashable k, FromJSONKey k, ToJSONKey k, HasCodec v) => HasCodec (HashMap k v) Source # 
Instance details

Defined in Autodocodec.Class

class HasObjectCodec object where Source #

A class for values which have a canonical object codec.

There are no formal laws for this class. If you really want a law, it should be "Whomever uses the codec from your instance should not be surprised."

Methods

objectCodec :: JSONObjectCodec object Source #

A object codec for the value

See the sections on helper functions for implementing this for plenty of examples.

Writing a codec

object :: Text -> ObjectCodec input output -> ValueCodec input output Source #

An object codec with a given name

Example usage

data Example = Example
  { exampleText :: !Text,
    exampleBool :: !Bool
  }

instance HasCodec Example where
  codec =
    object "Example" $
      Example
        <$> requiredField "text" "a text" .= exampleText
        <*> requiredField "bool" "a bool" .= exampleBool

API Note

This is a forward-compatible version ObjectOfCodec with a name.

object name = ObjectOfCodec (Just name)

named :: Text -> ValueCodec input output -> ValueCodec input output Source #

Name a codec.

This is used to allow for references to the codec, and that's necessary to produce finite documentation for recursive codecs.

API Note

This is a forward-compatible version of ReferenceCodec.

named = ReferenceCodec

codecViaAeson Source #

Arguments

:: (FromJSON a, ToJSON a) 
=> Text

Name

-> JSONCodec a 

Produce a codec using a type's FromJSON and ToJSON instances.

You will only want to use this if you cannot figure out how to produce a JSONCodec for your type.

Note that this will not have good documentation because, at a codec level, it's just parsing and rendering a Value.

Example usage

>>> toJSONVia (codecViaAeson "Int") (5 :: Int)
Number 5.0
>>> JSON.parseMaybe (parseJSONVia (codecViaAeson "Int")) (Number 5) :: Maybe Int
Just 5

Field codecs

With documentation

requiredField Source #

Arguments

:: HasCodec output 
=> Text

Key

-> Text

Documentation

-> ObjectCodec output output 

A required field

During decoding, the field must be in the object.

During encoding, the field will always be in the object.

See requiredFieldWith

optionalField Source #

Arguments

:: HasCodec output 
=> Text

Key

-> Text

Documentation

-> ObjectCodec (Maybe output) (Maybe output) 

An optional field

During decoding, the field may be in the object. Nothing will be parsed otherwise.

During encoding, the field will be in the object if it is not Nothing, and omitted otherwise.

See optionalFieldWith

(.=) :: ObjectCodec oldInput output -> (newInput -> oldInput) -> ObjectCodec newInput output Source #

Infix version of lmapCodec

Use this function to supply the rendering side of a codec.

(.=) = flip lmapCodec

Example usage

data Example = Example
  { exampleText :: !Text,
    exampleBool :: !Bool
  }
instance HasCodec Example where
  codec =
    object "Example" $
      Example
        <$> requiredField "text" .= exampleText
        <*> requiredField "bool" .= exampleBool

optionalFieldOrNull Source #

Arguments

:: forall output. HasCodec output 
=> Text

Key

-> Text

Documentation

-> ObjectCodec (Maybe output) (Maybe output) 

An optional, or null, field

During decoding, the field may be in the object. Nothing will be parsed if it is not. If the field is null, then it will be parsed as Nothing as well.

During encoding, the field will be in the object if it is not Nothing, and omitted otherwise.

optionalFieldWithDefault Source #

Arguments

:: HasCodec output 
=> Text

Key

-> output

Default value

-> Text

Documentation

-> ObjectCodec output output 

An optional field with a default value

During decoding, the field may be in the object. The default value will be parsed otherwise.

During encoding, the field will be in the object. The default value is ignored.

The shown version of the default value will appear in the documentation.

requiredFieldWith Source #

Arguments

:: Text

Key

-> ValueCodec input output

Codec for the value

-> Text

Documentation

-> ObjectCodec input output 

A required field

During decoding, the field must be in the object.

During encoding, the field will always be in the object.

optionalFieldWith Source #

Arguments

:: Text

Key

-> ValueCodec input output

Codec for the value

-> Text

Documentation

-> ObjectCodec (Maybe input) (Maybe output) 

An optional field

During decoding, the field may be in the object. Nothing will be parsed otherwise.

During encoding, the field will be omitted from the object if it is Nothing.

optionalFieldOrNullWith Source #

Arguments

:: Text

Key

-> ValueCodec input output

Codec for the value

-> Text

Documentation

-> ObjectCodec (Maybe input) (Maybe output) 

An optional, or null, field

During decoding, the field may be in the object. Nothing will be parsed if it is not. If the field is null, then it will be parsed as Nothing as well.

During encoding, the field will be omitted from the object if it is Nothing.

optionalFieldWithDefaultWith Source #

Arguments

:: Text

Key

-> JSONCodec output

Codec for the value

-> output

Default value

-> Text

Documentation

-> ObjectCodec output output 

An optional field with default value

During decoding, the field may be in the object. The default value will be parsed otherwise.

During encoding, the field will always be in the object. The default value is ignored.

The shown version of the default value will appear in the documentation.

optionalFieldWithOmittedDefault Source #

Arguments

:: (Eq output, HasCodec output) 
=> Text

Key

-> output

Default value

-> Text

Documentation

-> ObjectCodec output output 

optionalFieldWithOmittedDefaultWith Source #

Arguments

:: Eq output 
=> Text

Key

-> JSONCodec output

Codec for the value

-> output

Default value

-> Text

Documentation

-> ObjectCodec output output 

An optional field with default value that can be omitted when encoding

During decoding, the field may be in the object. The default value will be parsed otherwise.

During encoding, the field will be omitted from the object if it is equal to the default value.

The shown version of the default value will appear in the documentation.

optionalFieldOrNullWithOmittedDefault Source #

Arguments

:: (Eq output, HasCodec output) 
=> Text

Key

-> output

Default value

-> Text

Documentation

-> ObjectCodec output output 

optionalFieldOrNullWithOmittedDefaultWith Source #

Arguments

:: Eq output 
=> Text

Key

-> JSONCodec output

Codec for the value

-> output

Default value

-> Text

Documentation

-> ObjectCodec output output 

Like optionalFieldWithOmittedDefaultWith, but the value may also be null and that will be interpreted as the default value.

Documentation-less versions of field codecs

requiredField' Source #

Arguments

:: HasCodec output 
=> Text

Key

-> ObjectCodec output output 

Like requiredField, but without documentation

optionalField' Source #

Arguments

:: HasCodec output 
=> Text

Key

-> ObjectCodec (Maybe output) (Maybe output) 

Like optionalField, but without documentation

optionalFieldOrNull' Source #

Arguments

:: forall output. HasCodec output 
=> Text

Key

-> ObjectCodec (Maybe output) (Maybe output) 

Like optionalFieldOrNull, but without documentation

optionalFieldWithDefault' Source #

Arguments

:: HasCodec output 
=> Text

Key

-> output

Default value

-> ObjectCodec output output 

Like optionalFieldWithDefault, but without documentation

requiredFieldWith' Source #

Arguments

:: Text

Key

-> ValueCodec input output

Codec for the value

-> ObjectCodec input output 

Like requiredFieldWith, but without documentation.

optionalFieldWith' Source #

Arguments

:: Text

Key

-> ValueCodec input output

Codec for the value

-> ObjectCodec (Maybe input) (Maybe output) 

Like optionalFieldWith, but without documentation.

optionalFieldOrNullWith' Source #

Arguments

:: Text

Key

-> ValueCodec input output

Codec for the value

-> ObjectCodec (Maybe input) (Maybe output) 

Like optionalFieldOrNullWith, but without documentation

optionalFieldWithDefaultWith' Source #

Arguments

:: Text

Key

-> JSONCodec output

Codec for the value

-> output

Default value

-> ObjectCodec output output 

Like optionalFieldWithDefaultWith, but without documentation.

optionalFieldWithOmittedDefault' Source #

Arguments

:: (Eq output, HasCodec output) 
=> Text

Key

-> output

Default value

-> ObjectCodec output output 

optionalFieldWithOmittedDefaultWith' Source #

Arguments

:: Eq output 
=> Text

Key

-> JSONCodec output

Codec for the value

-> output

Default value

-> ObjectCodec output output 

Like optionalFieldWithOmittedDefaultWith, but without documentation.

optionalFieldOrNullWithOmittedDefault' Source #

Arguments

:: (Eq output, HasCodec output) 
=> Text

Key

-> output

Default value

-> ObjectCodec output output 

optionalFieldOrNullWithOmittedDefaultWith' Source #

Arguments

:: Eq output 
=> Text

Key

-> JSONCodec output

Codec for the value

-> output

Default value

-> ObjectCodec output output 

Like optionalFieldWithOmittedDefaultWith', but the value may also be null and that will be interpreted as the default value.

Writing your own value codecs.

Primitive codecs

nullCodec :: JSONCodec () Source #

Codec for null

Example usage

>>> toJSONVia nullCodec ()
Null
>>> JSON.parseMaybe (parseJSONVia nullCodec) Null
Just ()
>>> JSON.parseMaybe (parseJSONVia nullCodec) (Number 5)
Nothing

API Note

This is a forward-compatible version of NullCodec.

nullCodec = NullCodec

boolCodec :: JSONCodec Bool Source #

Codec for boolean values

Example usage

>>> toJSONVia boolCodec True
Bool True

API Note

This is a forward-compatible version of BoolCodec without a name.

boolCodec = BoolCodec Nothing

textCodec :: JSONCodec Text Source #

Codec for text values

Example usage

>>> toJSONVia textCodec "hello"
String "hello"

API Note

This is a forward-compatible version of StringCodec without a name.

textCodec = StringCodec Nothing

stringCodec :: JSONCodec String Source #

Codec for String values

Example usage

>>> toJSONVia stringCodec "hello"
String "hello"

WARNING

This codec uses unpack and pack to dimap a textCodec, so it does not roundtrip.

>>> toJSONVia stringCodec "\55296"
String "\65533"

API Note

This is a String version of textCodec.

scientificCodec :: JSONCodec Scientific Source #

Codec for Scientific values

Example usage

>>> toJSONVia scientificCodec 5
Number 5.0
>>> JSON.parseMaybe (parseJSONVia scientificCodec) (Number 3)
Just 3.0

WARNING

Scientific is a type that is only for JSON parsing and rendering. Do not use it for any calculations. Instead, convert to another number type before doing any calculations.

λ> (1 / 3) :: Scientific
*** Exception: fromRational has been applied to a repeating decimal which can't be represented as a Scientific! It's better to avoid performing fractional operations on Scientifics and convert them to other fractional types like Double as early as possible.

API Note

This is a forward-compatible version of NumberCodec without a name.

scientificCodec = NumberCodec Nothing Nothing

scientificWithBoundsCodec :: NumberBounds -> JSONCodec Scientific Source #

Codec for Scientific values with bounds

Example usage

>>> let c = scientificWithBoundsCodec NumberBounds {numberBoundsLower = 2, numberBoundsUpper = 4}
>>> toJSONVia c 3
Number 3.0
>>> toJSONVia c 5
Number 5.0
>>> JSON.parseMaybe (parseJSONVia c) (Number 3)
Just 3.0
>>> JSON.parseMaybe (parseJSONVia c) (Number 5)
Nothing

WARNING

Scientific is a type that is only for JSON parsing and rendering. Do not use it for any calculations. Instead, convert to another number type before doing any calculations.

λ> (1 / 3) :: Scientific
*** Exception: fromRational has been applied to a repeating decimal which can't be represented as a Scientific! It's better to avoid performing fractional operations on Scientifics and convert them to other fractional types like Double as early as possible.

API Note

This is a forward-compatible version of NumberCodec without a name.

scientificWithBoundsCodec bounds = NumberCodec Nothing (Just bounds)

valueCodec :: JSONCodec Value Source #

Codec for a Value

This is essentially your escape-hatch for when you would normally need a monad instance for Codec. You can build monad parsing by using valueCodec together with bimapCodec and supplying your own parsing function.

Note that this _does_ mean that the documentation will just say that you are parsing and rendering a value, so you may want to document the extra parsing further using <?>.

API Note

This is a forward-compatible version of Codec.

valueCodec = ValueCodec

Integral codecs

boundedIntegralCodec :: forall i. (Integral i, Bounded i) => JSONCodec i Source #

A codec for bounded integers like Int, Int8, and Word.

This codec will not have a name, and it will use the boundedNumberBounds to add number bounds.

>>> let c = boundedIntegralCodec :: JSONCodec Int8
>>> toJSONVia c 5
Number 5.0
>>> JSON.parseMaybe (parseJSONVia c) (Number 100)
Just 100
>>> JSON.parseMaybe (parseJSONVia c) (Number 200)
Nothing

boundedIntegralNumberBounds :: forall i. (Integral i, Bounded i) => NumberBounds Source #

NumberBounds for a bounded integral type.

You can call this using TypeApplications: boundedIntegralNumberBounds Word@

Literal value codecs

literalTextCodec :: Text -> JSONCodec Text Source #

A codec for a literal piece of Text.

During parsing, only the given Text is accepted.

During rendering, the given Text is always output.

Example usage

>>> let c = literalTextCodec "hello"
>>> toJSONVia c "hello"
String "hello"
>>> toJSONVia c "world"
String "hello"
>>> JSON.parseMaybe (parseJSONVia c) (String "hello")
Just "hello"
>>> JSON.parseMaybe (parseJSONVia c) (String "world")
Nothing

literalTextValueCodec :: value -> Text -> JSONCodec value Source #

A codec for a literal value corresponding to a literal piece of Text.

During parsing, only the given Text is accepted.

During rendering, the given value is always output.

Example usage

>>> let c = literalTextValueCodec True "yes"
>>> toJSONVia c True
String "yes"
>>> toJSONVia c False
String "yes"
>>> JSON.parseMaybe (parseJSONVia c) (String "yes") :: Maybe Bool
Just True
>>> JSON.parseMaybe (parseJSONVia c) (String "no") :: Maybe Bool
Nothing

Enums

shownBoundedEnumCodec :: forall enum. (Show enum, Eq enum, Enum enum, Bounded enum) => JSONCodec enum Source #

A codec for a Bounded Enum that uses its Show instance to have the values correspond to literal Text values.

Example usage

>>> data Fruit = Apple | Orange deriving (Show, Eq, Enum, Bounded)
>>> let c = shownBoundedEnumCodec
>>> toJSONVia c Apple
String "Apple"
>>> JSON.parseMaybe (parseJSONVia c) (String "Orange") :: Maybe Fruit
Just Orange

stringConstCodec :: forall constant. Eq constant => NonEmpty (constant, Text) -> JSONCodec constant Source #

A codec for an enum that can be written as constant string values

Example usage

>>> data Fruit = Apple | Orange deriving (Show, Eq)
>>> let c = stringConstCodec [(Apple, "foo"), (Orange, "bar")]
>>> toJSONVia c Orange
String "bar"
>>> JSON.parseMaybe (parseJSONVia c) (String "foo") :: Maybe Fruit
Just Apple

WARNING

If you don't provide a string for one of the type's constructors, the last string in the list will be used instead:

>>> let c = stringConstCodec [(Apple, "foo")]
>>> toJSONVia c Orange
String "foo"

enumCodec :: forall enum context. Eq enum => NonEmpty (enum, Codec context enum enum) -> Codec context enum enum Source #

A codec for an enum that can be written each with their own codec.

WARNING

If you don't provide a string for one of the type's constructors, the last codec in the list will be used instead.

Sum type codecs

eitherCodec :: Codec context input1 output1 -> Codec context input2 output2 -> Codec context (Either input1 input2) (Either output1 output2) Source #

Either codec

During encoding, parse a value according to either codec. During encoding, use the corresponding codec to encode either value.

HasCodec instance for sum types

To write a HasCodec instance for sum types, you will need to decide whether encoding is disjoint or not. The default, so also the implementation of this function, is possiblyJointEitherCodec, but you may want to use disjointEitherCodec instead.

Ask yourself: Can the encoding of a Left value be decoded as Right value (or vice versa)?

Yes -> use possiblyJointEitherCodec.

No -> use disjointEitherCodec.

Example usage

>>> let c = eitherCodec codec codec :: JSONCodec (Either Int String)
>>> toJSONVia c (Left 5)
Number 5.0
>>> toJSONVia c (Right "hello")
String "hello"
>>> JSON.parseMaybe (parseJSONVia c) (String "world") :: Maybe (Either Int String)
Just (Right "world")

API Note

This is a forward-compatible version of possiblyJointEitherCodec.

eitherCodec = possiblyJointEitherCodec

disjointEitherCodec :: Codec context input1 output1 -> Codec context input2 output2 -> Codec context (Either input1 input2) (Either output1 output2) Source #

Possibly joint either codec

During encoding, parse a value according to either codec. During encoding, use the corresponding codec to encode either value.

This codec is for the case in which parsing must be disjoint.

HasCodec instance for sum types with an encoding that is definitely disjoint.

The eitherCodec can be used to implement HasCodec instances for sum types for which the encoding is definitely disjoint.

>>> data War = WorldWar Word8 | OtherWar Text deriving (Show, Eq)
>>> :{
  instance HasCodec War where
   codec =
     dimapCodec f g $
       disjointEitherCodec
         (codec :: JSONCodec Word8)
         (codec :: JSONCodec Text)
     where
       f = \case
         Left w -> WorldWar w
         Right t -> OtherWar t
       g = \case
         WorldWar w -> Left w
         OtherWar t -> Right t
:}

Note that this incoding is indeed disjoint because an encoded String can never be parsed as an Word8 and vice versa.

>>> toJSONViaCodec (WorldWar 2)
Number 2.0
>>> toJSONViaCodec (OtherWar "OnDrugs")
String "OnDrugs"
>>> JSON.parseMaybe parseJSONViaCodec (String "of the roses") :: Maybe War
Just (OtherWar "of the roses")

WARNING

If it turns out that the encoding of a value is not disjoint, decoding may fail and documentation may be wrong.

>>> let c = disjointEitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec Int)
>>> JSON.parseMaybe (parseJSONVia c) (Number 5) :: Maybe (Either Int Int)
Nothing

Encoding still works as expected, however:

>>> toJSONVia c (Left 5)
Number 5.0
>>> toJSONVia c (Right 6)
Number 6.0

Example usage

>>> toJSONVia (disjointEitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec String)) (Left 5)
Number 5.0
>>> toJSONVia (disjointEitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec String)) (Right "hello")
String "hello"

API Note

This is a forward-compatible version of 'EitherCodec DisjointUnion'.

disjointEitherCodec = EitherCodec DisjointUnion

possiblyJointEitherCodec :: Codec context input1 output1 -> Codec context input2 output2 -> Codec context (Either input1 input2) (Either output1 output2) Source #

Possibly joint either codec

During encoding, parse a value according to either codec. During encoding, use the corresponding codec to encode either value.

This codec is for the case in which parsing may not be disjoint.

HasCodec instance for sum types with an encoding that is not disjoint.

The eitherCodec can be used to implement HasCodec instances for sum types. If you just have two codecs that you want to try in order, while parsing, you can do this:

>>> :{
  data Ainur
    = Valar Text Text
    | Maiar Text
    deriving (Show, Eq)
:}
>>> :{
  instance HasCodec Ainur where
    codec =
      dimapCodec f g $
        possiblyJointEitherCodec
          (object "Valar" $
            (,)
             <$> requiredField "domain" "Domain which the Valar rules over" .= fst
             <*> requiredField "name" "Name of the Valar" .= snd)
          (object "Maiar" $ requiredField "name" "Name of the Maiar")
      where
        f = \case
          Left (domain, name) -> Valar domain name
          Right name -> Maiar name
        g = \case
          Valar domain name -> Left (domain, name)
          Maiar name -> Right name
:}

Note that this encoding is indeed not disjoint, because a Valar object can parse as a Maiar value.

>>> toJSONViaCodec (Valar "Stars" "Varda")
Object (fromList [("domain",String "Stars"),("name",String "Varda")])
>>> toJSONViaCodec (Maiar "Sauron")
Object (fromList [("name",String "Sauron")])
>>> JSON.parseMaybe parseJSONViaCodec (Object (Compat.fromList [("name",String "Olorin")])) :: Maybe Ainur
Just (Maiar "Olorin")

WARNING

The order of the codecs in a possiblyJointEitherCodec matters.

In the above example, decoding works as expected because the Valar case is parsed first. If the Maiar case were first in the possiblyJointEitherCodec, then Valar could never be parsed.

API Note

This is a forward-compatible version of 'EitherCodec PossiblyJointUnion'.

possiblyJointEitherCodec = EitherCodec PossiblyJointUnion

Discriminated unions

mapToEncoder :: b -> Codec context b any -> Codec context a () Source #

Wrap up a value of type b with its codec to produce and encoder for as that ignores its input and instead encodes the value b. This is useful for building discriminatedUnionCodecs.

mapToDecoder :: (b -> a) -> Codec context any b -> Codec context Void a Source #

Map a codec for decoding bs into a decoder for as. This is useful for building discriminatedUnionCodecs.

discriminatedUnionCodec Source #

Arguments

:: Text

propertyName

-> (input -> (Discriminator, ObjectCodec input ()))

how to encode the input

Use mapToEncoder to produce the ObjectCodecs.

-> HashMap Discriminator (Text, ObjectCodec Void output)

how to decode the output

The Text field is the name to use for the object schema.

Use mapToDecoder to produce the ObjectCodecs.

-> ObjectCodec input output 

Encode/decode a discriminated union of objects

The type of object being encoded/decoded is discriminated by a designated "discriminator" property on the object which takes a string value.

When encoding, the provided function is applied to the input to obtain a new encoder for the input. The function mapToEncoder is provided to assist with building these encoders. See examples in hs.

When decoding, the value of the discriminator property is looked up in the HashMap to obtain a decoder for the output. The function mapToDecoder is provided to assist with building these decoders. See examples in hs.

The HashMap is also used to generate schemas for the type. In particular, for OpenAPI 3, it will generate a schema with a discriminator, as defined by https://swagger.io/docs/specification/data-models/inheritance-and-polymorphism/

API Note

This is a forward-compatible version of DiscriminatedUnionCodec.

discriminatedUnionCodec = 'DiscriminatedUnionCodec'

Mapping

dimapCodec Source #

Arguments

:: (oldOutput -> newOutput)

Function to make to the new type

-> (newInput -> oldInput)

Function to make from the new type

-> Codec context oldInput oldOutput

Codec for the old type

-> Codec context newInput newOutput 

Map both directions of a codec

You can use this function to change the type of a codec as long as the two functions are inverses.

HasCodec instance for newtypes

A good use-case is implementing HasCodec for newtypes:

newtype MyInt = MyInt { unMyInt :: Int }
instance HasCodec MyInt where
  codec = dimapCodec MyInt unMyInt codec

bimapCodec :: (oldOutput -> Either String newOutput) -> (newInput -> oldInput) -> Codec context oldInput oldOutput -> Codec context newInput newOutput Source #

Map a codec's input and output types.

This function allows you to have the parsing fail in a new way.

If you use this function, then you will most likely want to add documentation about how not every value that the schema specifies will be accepted.

This function is like BimapCodec except it also combines one level of a nested BimapCodecs.

Example usage

logLevelCodec :: JSONCodec LogLevel logLevelCodec = bimapCodec parseLogLevel renderLogLevel codec ? "Valid values include DEBUG, INFO, WARNING, ERROR."

rmapCodec :: (oldOutput -> newOutput) -> Codec context input oldOutput -> Codec context input newOutput Source #

Map the output part of a codec

You can use this function if you only need to map the parsing-side of a codec. This function is probably only useful if the function you map does not change the codec type.

WARNING: This can be used to produce a codec that does not roundtrip.

>>> JSON.parseMaybe (parseJSONVia (rmapCodec (*2) codec)) (Number 5) :: Maybe Int
Just 10

lmapCodec :: (newInput -> oldInput) -> Codec context oldInput output -> Codec context newInput output Source #

Map the input part of a codec

You can use this function if you only need to map the rendering-side of a codec. This function is probably only useful if the function you map does not change the codec type.

WARNING: This can be used to produce a codec that does not roundtrip.

>>> toJSONVia (lmapCodec (*2) (codec :: JSONCodec Int)) 5
Number 10.0

Composing codecs

maybeCodec :: ValueCodec input output -> ValueCodec (Maybe input) (Maybe output) Source #

Maybe codec

This can be used to also allow null during decoding of a Maybe value.

During decoding, also accept a null value as Nothing. During encoding, encode as usual.

Example usage

>>> toJSONVia (maybeCodec codec) (Just 'a')
String "a"
>>> toJSONVia (maybeCodec codec) (Nothing :: Maybe Char)
Null

listCodec :: ValueCodec input output -> ValueCodec [input] [output] Source #

List codec

Build a codec for lists of values from a codec for a single value.

Example usage

>>> toJSONVia (listCodec codec) ['a','b']
Array [String "a",String "b"]

API Note

This is the list version of vectorCodec.

nonEmptyCodec :: ValueCodec input output -> ValueCodec (NonEmpty input) (NonEmpty output) Source #

Build a codec for nonempty lists of values from a codec for a single value.

Example usage

>>> toJSONVia (nonEmptyCodec codec) ('a' :| ['b'])
Array [String "a",String "b"]

API Note

This is the non-empty list version of vectorCodec.

singleOrListCodec :: ValueCodec input output -> ValueCodec [input] [output] Source #

Single or list codec

This codec behaves like listCodec, except the values may also be simplified as a single value.

During parsing, a single element may be parsed as the list of just that element. During rendering, a list with only one element will be rendered as just that element.

Example usage

>>> let c = singleOrListCodec codec :: JSONCodec [Int]
>>> toJSONVia c [5]
Number 5.0
>>> toJSONVia c [5,6]
Array [Number 5.0,Number 6.0]
>>> JSON.parseMaybe (parseJSONVia c) (Number 5) :: Maybe [Int]
Just [5]
>>> JSON.parseMaybe (parseJSONVia c) (Array [Number 5, Number 6]) :: Maybe [Int]
Just [5,6]

WARNING

If you use nested lists, for example when the given value codec is also a listCodec, you may get in trouble with ambiguities during parsing.

singleOrNonEmptyCodec :: ValueCodec input output -> ValueCodec (NonEmpty input) (NonEmpty output) Source #

Single or nonempty list codec

This codec behaves like nonEmptyCodec, except the values may also be simplified as a single value.

During parsing, a single element may be parsed as the list of just that element. During rendering, a list with only one element will be rendered as just that element.

Example usage

>>> let c = singleOrNonEmptyCodec codec :: JSONCodec (NonEmpty Int)
>>> toJSONVia c (5 :| [])
Number 5.0
>>> toJSONVia c (5 :| [6])
Array [Number 5.0,Number 6.0]
>>> JSON.parseMaybe (parseJSONVia c) (Number 5) :: Maybe (NonEmpty Int)
Just (5 :| [])
>>> JSON.parseMaybe (parseJSONVia c) (Array [Number 5, Number 6]) :: Maybe (NonEmpty Int)
Just (5 :| [6])

WARNING

If you use nested lists, for example when the given value codec is also a nonEmptyCodec, you may get in trouble with ambiguities during parsing.

API Note

This is a nonempty version of singleOrListCodec.

vectorCodec :: ValueCodec input output -> ValueCodec (Vector input) (Vector output) Source #

Vector codec

Build a codec for vectors of values from a codec for a single value.

Example usage

>>> toJSONVia (vectorCodec codec) (Vector.fromList ['a','b'])
Array [String "a",String "b"]

API Note

This is a forward-compatible version of ArrayOfCodec without a name.

vectorCodec = ArrayOfCodec Nothing

Alternative parsing

parseAlternative Source #

Arguments

:: Codec context input output

Main codec, for parsing and rendering

-> Codec context input' output

Alternative codecs just for parsing

-> Codec context input output 

Like parseAlternatives, but with only one alternative codec

Example usage

>>> data Fruit = Apple | Orange deriving (Show, Eq, Bounded, Enum)
>>> let c = parseAlternative shownBoundedEnumCodec (stringConstCodec [(Apple, "foo"), (Orange, "bar")])
>>> toJSONVia c Apple
String "Apple"
>>> JSON.parseMaybe (parseJSONVia c) (String "foo") :: Maybe Fruit
Just Apple
>>> JSON.parseMaybe (parseJSONVia c) (String "Apple") :: Maybe Fruit
Just Apple

parseAlternatives Source #

Arguments

:: Codec context input output

Main codec, for parsing and rendering

-> [Codec context input output]

Alternative codecs just for parsing

-> Codec context input output 

Use one codec for the default way of parsing and rendering, but then also use a list of other codecs for potentially different parsing.

You can use this for keeping old ways of parsing intact while already rendering in the new way.

Example usage

>>> data Fruit = Apple | Orange deriving (Show, Eq, Bounded, Enum)
>>> let c = parseAlternatives shownBoundedEnumCodec [stringConstCodec [(Apple, "foo"), (Orange, "bar")]]
>>> toJSONVia c Apple
String "Apple"
>>> JSON.parseMaybe (parseJSONVia c) (String "foo") :: Maybe Fruit
Just Apple
>>> JSON.parseMaybe (parseJSONVia c) (String "Apple") :: Maybe Fruit
Just Apple

Choice

matchChoiceCodec Source #

Arguments

:: Codec context input output

First codec

-> Codec context input' output

Second codec

-> (newInput -> Either input input')

Rendering chooser

-> Codec context newInput output 

A choice codec, but unlike eitherCodec, it's for the same output type instead of different ones.

While parsing, this codec will first try the left codec, then the right if that fails.

While rendering, the provided function is used to decide which codec to use for rendering.

Note: The reason this is less primitive than the eitherCodec is that Either makes it clear which codec you want to use for rendering. In this case, we need to provide our own function for choosing which codec we want to use for rendering.

Example usage

>>> :{
  let c =
       matchChoiceCodec
        (literalTextCodec "even")
        (literalTextCodec "odd")
        (\s -> if s == "even" then Left s else Right s)
:}
>>> toJSONVia c "even"
String "even"
>>> toJSONVia c "odd"
String "odd"
>>> JSON.parseMaybe (parseJSONVia c) (String "even") :: Maybe Text
Just "even"
>>> JSON.parseMaybe (parseJSONVia c) (String "odd") :: Maybe Text
Just "odd"

API Note

This is a forward-compatible version of 'matchChoiceCodecAs PossiblyJointUnion':

disjointMatchChoiceCodec = matchChoiceCodecAs PossiblyJointUnion

disjointMatchChoiceCodec Source #

Arguments

:: Codec context input output

First codec

-> Codec context input' output

Second codec

-> (newInput -> Either input input')

Rendering chooser

-> Codec context newInput output 

Disjoint version of matchChoiceCodec

API Note

This is a forward-compatible version of 'matchChoiceCodecAs DisjointUnion':

disjointMatchChoiceCodec = matchChoiceCodecAs DisjointUnion

matchChoiceCodecAs Source #

Arguments

:: Union

Is the union DisjointUnion or PossiblyJointUnion

-> Codec context input output

First codec

-> Codec context input' output

Second codec

-> (newInput -> Either input input')

Rendering chooser

-> Codec context newInput output 

An even more general version of matchChoiceCodec and disjointMatchChoiceCodec.

matchChoicesCodec Source #

Arguments

:: [(input -> Maybe input, Codec context input output)]

Codecs, each with their own rendering matcher

-> Codec context input output

Fallback codec, in case none of the matchers in the list match

-> Codec context input output 

A choice codec for a list of options, each with their own rendering matcher.

During parsing, each of the codecs are tried from first to last until one succeeds.

During rendering, each matching function is tried until either one succeeds and the corresponding codec is used, or none succeed and the fallback codec is used.

Example usage

>>> :{
  let c =
       matchChoicesCodec
         [ (\s -> if s == "even" then Just s else Nothing, literalTextCodec "even")
         , (\s -> if s == "odd" then Just s else Nothing, literalTextCodec "odd")
         ] (literalTextCodec "fallback")
:}
>>> toJSONVia c "even"
String "even"
>>> toJSONVia c "odd"
String "odd"
>>> toJSONVia c "foobar"
String "fallback"
>>> JSON.parseMaybe (parseJSONVia c) (String "even") :: Maybe Text
Just "even"
>>> JSON.parseMaybe (parseJSONVia c) (String "odd") :: Maybe Text
Just "odd"
>>> JSON.parseMaybe (parseJSONVia c) (String "foobar") :: Maybe Text
Nothing
>>> JSON.parseMaybe (parseJSONVia c) (String "fallback") :: Maybe Text
Just "fallback"

API Note

This is a forward-compatible version of 'matchChoicesCodecAs DisjointUnion'.

disjointMatchChoiceCodec = matchChoicesCodecAs DisjointUnion

disjointMatchChoicesCodec Source #

Arguments

:: [(input -> Maybe input, Codec context input output)]

Codecs, each with their own rendering matcher

-> Codec context input output

Fallback codec, in case none of the matchers in the list match

-> Codec context input output 

Disjoint version of matchChoicesCodec

API Note

This is a forward-compatible version of 'matchChoicesCodecAs DisjointUnion'.

disjointMatchChoiceCodec = matchChoicesCodecAs DisjointUnion

matchChoicesCodecAs Source #

Arguments

:: Union 
-> [(input -> Maybe input, Codec context input output)]

Codecs, each with their own rendering matcher

-> Codec context input output

Fallback codec, in case none of the matchers in the list match

-> Codec context input output 

An even more general version of matchChoicesCodec and disjointMatchChoicesCodec

Adding documentation to a codec

(<?>) Source #

Arguments

:: ValueCodec input output 
-> Text

Comment

-> ValueCodec input output 

Add a comment to a codec

This is an infix version of CommentCodec > (?) = flip CommentCodec

(<??>) Source #

Arguments

:: ValueCodec input output 
-> [Text]

Lines of comments

-> ValueCodec input output 

A version of <?> that lets you supply a list of lines of text instead of a single text.

This helps when you use an automated formatter that deals with lists more nicely than with multi-line strings.

Bare codec

data Codec context input output where Source #

A Self-documenting encoder and decoder,

also called an Autodocodec.

In an ideal situation, this type would have only one type parameter: 'Codec value'. This does not work very well because we want to be able to implement Functor and Applicative, which each require a kind '* -> *'. So instead we use two type parameters.

The two type parameters correspond to the phase in which they are used:

  • The input parameter is used for the type that is used during encoding of a value, so it's the input to the codec.
  • The output parameter is used for the type that is used during decoding of a value, so it's the output of the codec.
  • Both parameters are unused during documentation.

Constructors

NullCodec :: ValueCodec () ()

Encode () to the null value, and decode null as ().

BoolCodec

Encode a Bool to a boolean value, and decode a boolean value as a Bool.

Fields

StringCodec

Encode Text to a string value, and decode a string value as a Text.

This is named after the primitive type String in json, not after the haskell type string.

Fields

NumberCodec

Encode Scientific to a number value, and decode a number value as a Scientific.

The number has optional NumberBounds. These are only enforced at decoding time, not at encoding-time.

NOTE: We use Scientific here because that is what aeson uses.

Fields

HashMapCodec :: (Eq k, Hashable k, FromJSONKey k, ToJSONKey k) => JSONCodec v -> JSONCodec (HashMap k v)

Encode a HashMap, and decode any HashMap.

MapCodec :: (Ord k, FromJSONKey k, ToJSONKey k) => JSONCodec v -> JSONCodec (Map k v)

Encode a Map, and decode any Map.

ValueCodec :: JSONCodec Value

Encode a Value, and decode any Value.

ArrayOfCodec

Encode a Vector of values as an array value, and decode an array value as a Vector of values.

Fields

ObjectOfCodec

Encode a value as a an object value using the given ObjectCodec, and decode an object value as a value using the given ObjectCodec.

Fields

EqCodec

Match a given value using its Eq instance during decoding, and encode exactly that value during encoding.

Fields

BimapCodec :: (oldOutput -> Either String newOutput) -> (newInput -> oldInput) -> Codec context oldInput oldOutput -> Codec context newInput newOutput

Map a codec in both directions.

This is not strictly dimap, because the decoding function is allowed to fail, but we can implement dimap using this function by using a decoding function that does not fail. Otherwise we would have to have another constructor here.

EitherCodec

Encode/Decode an Either value

During encoding, encode either value of an Either using their own codec. During decoding, try to parse the Left side first, and the Right side only when that fails.

This codec is used to implement choice.

Note that this codec works for both values and objects. However: due to the complex nature of documentation, the documentation may not be as good as you would hope when you use this codec. In particular, you should prefer using it for values rather than objects, because those docs are easier to generate.

Fields

  • :: !Union

    What type of union we encode and decode

  • -> Codec context input1 output1

    Codec for the Left side

  • -> Codec context input2 output2

    Codec for the Right side

  • -> Codec context (Either input1 input2) (Either output1 output2)
     
DiscriminatedUnionCodec

Encode/decode a discriminated union of objects

The type of object being encoded/decoded is discriminated by a designated "discriminator" property on the object which takes a string value.

When encoding, the provided function is applied to the input to obtain a new encoder for the input. The function mapToEncoder is provided to assist with building these encoders.

When decoding, the value of the discriminator property is looked up in the HashMap to obtain a decoder for the output. The function mapToDecoder is provided to assist with building these decoders. See examples in hs.

The HashMap is also used to generate schemas for the type. In particular, for OpenAPI 3, it will generate a schema with a discriminator, as defined by https://swagger.io/docs/specification/data-models/inheritance-and-polymorphism/

Fields

CommentCodec

A comment codec

This is used to add implementation-irrelevant but human-relevant information.

Fields

ReferenceCodec

A reference codec

This is used for naming a codec, so that recursive codecs can have a finite schema.

It doesn't _need_ to be recursive, and you may just have wanted to name the codec, but it _may_ be recursive from here downward.

This value MUST be lazy, otherwise we can never define recursive codecs.

Fields

RequiredKeyCodec 

Fields

OptionalKeyCodec 

Fields

OptionalKeyWithDefaultCodec 

Fields

OptionalKeyWithOmittedDefaultCodec 

Fields

PureCodec

To implement pure from Applicative.

Pure is not available for non-object codecs because there is no mempty for Value, which we would need during encoding.

Fields

ApCodec :: ObjectCodec input (output -> newOutput) -> ObjectCodec input output -> ObjectCodec input newOutput

To implement <*> from Applicative.

Ap is not available for non-object codecs because we cannot combine (mappend) two encoded Values

Instances

Instances details
Applicative (ObjectCodec input) Source # 
Instance details

Defined in Autodocodec.Codec

Methods

pure :: a -> ObjectCodec input a #

(<*>) :: ObjectCodec input (a -> b) -> ObjectCodec input a -> ObjectCodec input b #

liftA2 :: (a -> b -> c) -> ObjectCodec input a -> ObjectCodec input b -> ObjectCodec input c #

(*>) :: ObjectCodec input a -> ObjectCodec input b -> ObjectCodec input b #

(<*) :: ObjectCodec input a -> ObjectCodec input b -> ObjectCodec input a #

Functor (Codec context input) Source # 
Instance details

Defined in Autodocodec.Codec

Methods

fmap :: (a -> b) -> Codec context input a -> Codec context input b #

(<$) :: a -> Codec context input b -> Codec context input a #

type ValueCodec = Codec Value Source #

A codec within the Value context.

An Codec can be used to turn a Haskell value into a Value or to parse a Value into a haskell value.

This cannot be used in certain places where ObjectCodec could be used, and vice versa.

type ObjectCodec = Codec Object Source #

A codec within the Value context.

An Object can be used to turn a Haskell value into a Value or to parse a Value into a haskell value.

This cannot be used in certain places where Codec could be used, and vice versa.

pureCodec :: output -> ObjectCodec input output Source #

Produce a value without parsing any part of an Object.

This function exists to implement Applicative (ObjectCodec input).

API Note

This is a forward-compatible version of PureCodec.

pureCodec = PureCodec

apCodec :: ObjectCodec input (output -> newOutput) -> ObjectCodec input output -> ObjectCodec input newOutput Source #

Sequentially apply two codecs that parse part of an Object.

This function exists to implement Applicative (ObjectCodec input).

API Note

This is a forward-compatible version of ApCodec.

apCodec = ApCodec

Deriving Via

newtype Autodocodec a Source #

Autodocodec is a wrapper to provide codec-based deriving strategies.

Example usage

data Via = Via {viaOne :: !Text, viaTwo :: !Text}
  deriving stock (Show, Eq, Generic)
  deriving (FromJSON, ToJSON) via (Autodocodec Via)

instance HasCodec Via where
  codec =
    object "Via" $
      Via
        <$> requiredField "one" "first field" .= viaOne
        <*> requiredField "two" "second field" .= viaTwo

Constructors

Autodocodec 

Fields

Instances

Instances details
HasCodec a => FromJSON (Autodocodec a) Source # 
Instance details

Defined in Autodocodec.Aeson.Decode

HasCodec a => ToJSON (Autodocodec a) Source # 
Instance details

Defined in Autodocodec.Aeson.Encode

Internals you most likely don't need

showCodecABit :: Codec context input output -> String Source #

Show a codec to a human.

This function exists for codec debugging. It omits any unshowable information from the output.

To make sure we definitely export everything