pa-json-0.3.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 a json 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 #

Show Enc Source # 
Instance details

Defined in Json.Enc

Methods

showsPrec :: Int -> Enc -> ShowS #

show :: Enc -> String #

showList :: [Enc] -> ShowS #

IntegerLiteral Enc Source #

You can create an Enc any that renders a json number value with an integer literal.

Instance details

Defined in Json.Enc

RationalLiteral Enc Source #

You can create an Enc any that renders a json 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

encToBytesUtf8 :: Enc -> ByteString Source #

Convert an Enc to a strict UTF8-bytestring which is valid JSON (minified).

encToBytesUtf8Lazy :: Enc -> ByteString Source #

Convert an Enc to a lazy UTF8-bytestring which is valid JSON (minified).

encToTextPretty :: Enc -> Text Source #

Convert an Enc to a strict Text which is valid JSON (prettyfied).

ATTN: will re-parse the json through Value, so only use for user-interactions like pretty-printing.

encToTextPrettyLazy :: Enc -> Text Source #

Convert an Enc to a lazy Text which is valid JSON (prettyfied).

ATTN: will re-parse the json through Value, so only use for user-interactions like pretty-printing.

encoding :: Encoding -> Enc Source #

Embed a 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 json list

emptyObject :: Enc Source #

Encode an empty json dict

text :: Text -> Enc Source #

Encode a Text as a json string

lazyText :: Text -> Enc Source #

Encode a lazy Text as a json string

base64Bytes :: ByteString -> Enc Source #

Encode a ByteString as a base64-encoded json string

base64 :: Text -> Enc Source #

Encode a Text as a base64-encoded json string

string :: String -> Enc Source #

Encode a String as a json string

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

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

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

Encode a list as a json list

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

Encode a NonEmpty as a json list.

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

Encode the given list of keys and their encoders as json dict.

If the list contains the same key multiple times, the first value in the list is retained:

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

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 as a json dict

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 as a json dict

null :: Enc Source #

Encode Null

bool :: Bool -> Enc Source #

Encode a Bool as a json boolean

integer :: Integer -> Enc Source #

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

scientific :: Scientific -> Enc Source #

Encode a Scientific as a json number.

natural :: Natural -> Enc Source #

Encode a Natural as a json number.

int :: Int -> Enc Source #

Encode an Int as a json number.

int64 :: Int64 -> Enc Source #

Encode an Int64 as a json number.

utcTime :: UTCTime -> Enc Source #

Encode UTCTime as a json string, 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 a json 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 a json 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 #