pa-json-0.1.0.0: Our JSON parsers/encoders
Safe HaskellSafe-Inferred
LanguageGHC2021

Json.Enc

Synopsis

Documentation

newtype Enc Source #

A JSON encoder.

It is faster than going through Value, because Encoding is just a wrapper around a Bytes.Builder. But the aeson interface for Encoding is extremely bad, so let’s build a better one.

Constructors

Enc 

Fields

Instances

Instances details
IsString Enc Source #

You can create an Enc any that renders an String value with OverloadedStrings.

Instance details

Defined in Json.Enc

Methods

fromString :: String -> Enc #

Num Enc Source # 
Instance details

Defined in Json.Enc

Methods

(+) :: Enc -> Enc -> Enc #

(-) :: Enc -> Enc -> Enc #

(*) :: Enc -> Enc -> Enc #

negate :: Enc -> Enc #

abs :: Enc -> Enc #

signum :: Enc -> Enc #

fromInteger :: Integer -> Enc #

Fractional Enc Source # 
Instance details

Defined in Json.Enc

Methods

(/) :: Enc -> Enc -> Enc #

recip :: Enc -> Enc #

fromRational :: Rational -> Enc #

IntegerLiteral Enc Source #

You can create an Enc any that renders an Number value with an integer literal.

Instance details

Defined in Json.Enc

RationalLiteral Enc Source #

You can create an Enc any that renders an Number value with an floating point literal.

ATTN: Bear in mind that this will crash on repeating rationals, so only use for literals in code!

Instance details

Defined in Json.Enc

encoding :: Encoding -> Enc Source #

Embed an Encoding verbatim (it’s a valid JSON value)

value :: Value -> Enc Source #

Encode a Value verbatim (it’s a valid JSON value)

emptyArray :: Enc Source #

Encode an empty Array

emptyObject :: Enc Source #

Encode an empty Object

lazyText :: Text -> Enc Source #

Encode a lazy Text

string :: String -> Enc Source #

Encode a Value

nullOr :: (a -> Enc) -> Maybe a -> Enc Source #

Encode as Null if Nothing, else use the given encoder for Just a

list :: (a -> Enc) -> [a] -> Enc Source #

Encode a list as Array

nonEmpty :: (a -> Enc) -> NonEmpty a -> Enc Source #

Encode a NonEmpty as an Array.

object :: Foldable t => t (Text, Enc) -> Enc Source #

Encode the given list of keys and their encoders as Object.

Like with fromList, if the list contains the same key multiple times, the last value in the list is retained:

(object [ ("foo", 42), ("foo", 23) ])
~= "{"foo":23}"

data Choice Source #

A tag/value encoder; See choice

Constructors

Choice Text Enc 

choice :: (from -> Choice) -> from -> Enc Source #

Encode a sum type as a Choice, an object with a tag/value pair, which is the conventional json sum type representation in our codebase.

foo :: Maybe Text -> Enc
foo = choice $ case
  Nothing -> Choice "no" emptyObject ()
  Just t -> Choice "yes" text t

ex = foo Nothing == "{"tag": "no", "value": {}}"
ex2 = foo (Just "hi") == "{"tag": "yes", "value": "hi"}"

singleChoice :: Text -> Enc -> Enc Source #

Like choice, but simply encode a single possibility into a tag/value object. This can be useful, but if you want to match on an enum, use choice instead.

map :: forall k v. Coercible k Text => (v -> Enc) -> Map k v -> Enc Source #

Encode a Map.

We can’t really set the key to anything but text (We don’t keep the tag of Encoding) so instead we allow anything that’s coercible from text as map key (i.e. newtypes).

keyMap :: (v -> Enc) -> KeyMap v -> Enc Source #

Encode a KeyMap

null :: Enc Source #

Encode Null

bool :: Bool -> Enc Source #

Encode Value

integer :: Integer -> Enc Source #

Encode an Integer as Number. TODO: is it okay to just encode an arbitrarily-sized integer into json?

int :: Int -> Enc Source #

Encode an Int as Number.

int64 :: Int64 -> Enc Source #

Encode an Int64 as Number.

utcTime :: UTCTime -> Enc Source #

Encode UTCTime as Value, as an ISO8601 timestamp with timezone (yyyy-mm-ddThh:mm:ss[.sss]Z)

class IntegerLiteral a where Source #

Implement this class if you want your type to only implement the part of Num that allows creating them from Integer-literals, then derive Num via NumLiteralOnly:

data Foo = Foo Integer
  deriving (Num) via (NumLiteralOnly Foo Foo)

instance IntegerLiteral Foo where
 integerLiteral i = Foo i

Instances

Instances details
IntegerLiteral Enc Source #

You can create an Enc any that renders an Number value with an integer literal.

Instance details

Defined in Json.Enc

class RationalLiteral a where Source #

The same as IntegerLiteral but for floating point literals.

Instances

Instances details
RationalLiteral Enc Source #

You can create an Enc any that renders an Number value with an floating point literal.

ATTN: Bear in mind that this will crash on repeating rationals, so only use for literals in code!

Instance details

Defined in Json.Enc

newtype NumLiteralOnly (sym :: Symbol) num Source #

Helper class for deriving (Num) via …, implements only literal syntax for integer and floating point numbers, and throws descriptive runtime errors for any other methods in Num.

See IntegerLiteral and RationalLiteral for examples.

Constructors

NumLiteralOnly num 

Instances

Instances details
(IntegerLiteral num, KnownSymbol sym) => Num (NumLiteralOnly sym num) Source # 
Instance details

Defined in Json.Enc

Methods

(+) :: NumLiteralOnly sym num -> NumLiteralOnly sym num -> NumLiteralOnly sym num #

(-) :: NumLiteralOnly sym num -> NumLiteralOnly sym num -> NumLiteralOnly sym num #

(*) :: NumLiteralOnly sym num -> NumLiteralOnly sym num -> NumLiteralOnly sym num #

negate :: NumLiteralOnly sym num -> NumLiteralOnly sym num #

abs :: NumLiteralOnly sym num -> NumLiteralOnly sym num #

signum :: NumLiteralOnly sym num -> NumLiteralOnly sym num #

fromInteger :: Integer -> NumLiteralOnly sym num #

(IntegerLiteral num, RationalLiteral num, KnownSymbol sym) => Fractional (NumLiteralOnly sym num) Source # 
Instance details

Defined in Json.Enc

Methods

(/) :: NumLiteralOnly sym num -> NumLiteralOnly sym num -> NumLiteralOnly sym num #

recip :: NumLiteralOnly sym num -> NumLiteralOnly sym num #

fromRational :: Rational -> NumLiteralOnly sym num #