Copyright | (c) Marek Fajkus |
---|---|
License | BSD3 |
Maintainer | [email protected] |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Data.Aeson.Combinators.Encode
Description
Functions in this module serve as an alternative
ToJSON
type class. This allows to define for mapping
from data type into multiple JSON representations.
type level wrapping.
There are two way of defining such encoder:
- Using simple function
a -> Value
which doesn't require this library - Using this library as DSL together with
Contravariant
Synopsis
- newtype Encoder a = Encoder (a -> Value)
- auto :: ToJSON a => Encoder a
- run :: Encoder a -> a -> Value
- type KeyValueEncoder a = a -> Pair
- object :: [KeyValueEncoder a] -> Encoder a
- field :: Key -> Encoder b -> (a -> b) -> KeyValueEncoder a
- type KeyValueEncoder' a = a -> [Pair]
- object' :: KeyValueEncoder' a -> Encoder a
- field' :: Key -> Encoder a -> a -> (Key, Value)
- list :: Encoder a -> Encoder [a]
- vector :: Encoder a -> Encoder (Vector a)
- jsonArray :: [Encoder a] -> Encoder a
- void :: Encoder Void
- unit :: Encoder ()
- bool :: Encoder Bool
- int :: Encoder Int
- integer :: Encoder Integer
- int8 :: Encoder Int8
- int16 :: Encoder Int16
- int32 :: Encoder Int32
- int64 :: Encoder Int64
- word :: Encoder Word
- word8 :: Encoder Word8
- word16 :: Encoder Word16
- word32 :: Encoder Word32
- word64 :: Encoder Word64
- natural :: Encoder Natural
- float :: Encoder Float
- double :: Encoder Double
- scientific :: Encoder Scientific
- char :: Encoder Char
- text :: Encoder Text
- string :: Encoder String
- uuid :: Encoder UUID
- version :: Encoder Version
- zonedTime :: Encoder ZonedTime
- localTime :: Encoder LocalTime
- timeOfDay :: Encoder TimeOfDay
- utcTime :: Encoder UTCTime
- day :: Encoder Day
- dayOfWeek :: Encoder DayOfWeek
- encode :: Encoder a -> a -> ByteString
- toEncoding :: Encoder a -> a -> Encoding
- data KeyMap v
- toHashMapText :: KeyMap v -> HashMap Text v
- data Key
- toText :: Key -> Text
- fromText :: Text -> Key
Importing
This module as meant to be import as qualified
import Data.Aeson.Combinators.Encode as Encode
Alternative to using Encode
Combinators
Be aware than in most cause you won't need to use this module.
you can utilize Aeson's Value
type and it's instance of ToJSON
directly.
>>>
import qualified Data.Aeson as Aeson
>>>
import Data.Aeson ((.=))
>>>
data Object = Object { tag :: String, id :: Int }
Define custom encoding function:
>>>
:{
encodeObject :: Object -> Value encodeObject (Object tag id) = Aeson.object ["tag" .= tag, "id" .= id] :}
>>>
Aeson.encode (encodeObject (Object "foo" 42))
"{\"tag\":\"foo\",\"id\":42}"
Example Usage
>>>
:set -XOverloadedStrings
>>>
:set -XDeriveGeneric
First lets define some type
>>>
:{
data Person = Person { name :: String , age :: Int } deriving (Show, Eq) :}
And first encoder for this type:
>>>
:{
personEncoder :: Encoder Person personEncoder = object [ field "name" string name , field "age" int age ] :}
We can use this Encoder
to encode value into JSON:
>>>
encode personEncoder (Person "Jane" 42)
"{\"age\":42,\"name\":\"Jane\"}"
Now we can use Contravariant
to manipulate our encoder.
Our type might be wrap in some rither type like this one:
>>>
import Data.Functor.Contravariant
>>>
data Surrounding = S Person Bool
But we still want to be able to encode it:
>>>
:{
surroundingEncoder :: Encoder Surrounding surroundingEncoder = contramap (\(S person _) -> person) personEncoder :}
Encoder
Value describing encoding of a
into a JSON Value
.
This is essentially just a wrapper around function that
should be applied later.
Covariant to map function over input
Given:
>>>
:{
data Person = Person { name :: String , age :: Int } deriving (Show, Eq) :}
>>>
:{
personEncoder :: Encoder Person personEncoder = object [ field "name" string name , field "age" int age ] :}
We can extract person from any pair:
>>>
:{
-- Using personEncoder definition from example above pairEncoder2 :: Encoder (Person, a) pairEncoder2 = contramap fst personEncoder :}
>>>
encode pairEncoder2 (Person "Jane" 42, Nothing)
"{\"age\":42,\"name\":\"Jane\"}"
Divisible and Decidable
Some of you might know library covariant
and ask what is a support for
other covariant typeclasses.
It's not possible to define lawful Divisble instance for JSON Value
and by extension it's not possible to define Decidable either.
While it is posible to provide somewhat useful unlawful instances for these this
library opts to not to do that.
run :: Encoder a -> a -> Value Source #
Run Encoder
given a value. this is essentially just a function application.
Object Encoding
There are two alternative ways of defining Object encodings.
Both provide "eqvivalent" types and functions with consistent naming.
Variants without and with '
suffix are meant to be used together.
type KeyValueEncoder a = a -> Pair Source #
Object Encoder
>>>
:{
data Object = Object { name :: Text , age :: Int } deriving (Show, Eq) :}
>>>
:{
objectEncoder :: Encoder Object objectEncoder = object [ field "name" text name , field "age" int age ] :}
>>>
encode objectEncoder $ Object "Joe" 30
"{\"age\":30,\"name\":\"Joe\"}"
object :: [KeyValueEncoder a] -> Encoder a Source #
Object combinators
Alternative Object Encoding
type KeyValueEncoder' a = a -> [Pair] Source #
Object Encoder (alternative)
>>>
:set -XRecordWildCards
>>>
:{
data Object = Object { name :: Text , age :: Int } deriving (Show, Eq) :}
>>>
:{
objectEncoder' :: Encoder Object objectEncoder' = object' $ \Object{..} -> [ field' "name" text name , field' "age" int age ] :}
>>>
encode objectEncoder' $ Object "Joe" 30
"{\"age\":30,\"name\":\"Joe\"}"
object' :: KeyValueEncoder' a -> Encoder a Source #
Object combinators (alternative)
Collections
Encoding Primitive Values
Void, Unit, Bool
Encode any JSON value to Void
value
which is impossible to construct.
This Encoder is guarenteed to fail.
Integers (and Natural)
natural :: Encoder Natural Source #
Encode JSON number to GHC's Natural
(non negative)
This function requires base
>= 4.8.0
Floating Points
scientific :: Encoder Scientific Source #
Encode JSON number to arbitrary precision Scientific
Strings
Encoding Time
zonedTime :: Encoder ZonedTime Source #
Encode JSON string to ZonedTime
using Aeson's instance implementation.
Supported string formats:
YYYY-MM-DD HH:MM Z YYYY-MM-DD HH:MM:SS Z YYYY-MM-DD HH:MM:SS.SSS Z
The first space may instead be a T, and the second space is optional. The Z represents UTC. The Z may be replaced with a time zone offset of the form +0000 or -08:00, where the first two digits are hours, the : is optional and the second two digits (also optional) are minutes.
localTime :: Encoder LocalTime Source #
Encode JSON string to LocalTime
using Aeson's instance implementation.
timeOfDay :: Encoder TimeOfDay Source #
Encode JSON string to TimeOfDay
using Aeson's instance implementation.
utcTime :: Encoder UTCTime Source #
Encode JSON string to UTCTime
using Aesons's instance implementation
dayOfWeek :: Encoder DayOfWeek Source #
Encode JSON string to DayOfWeek
using Aesons's instance implementation
This function requires 'time-compat' >= 1.9.2
Evaluating Encoders
encode :: Encoder a -> a -> ByteString Source #
Encode value into (Lazy) ByteString
toEncoding :: Encoder a -> a -> Encoding Source #
Convert value to encoding
Aeson compatibility helpers
Aeson compatibility layer to support Aeson 2.0 and older versions.
Re-exposes Key
and KeyMap
, together with suitable conversion functions.
For older aeson versions, we provide type definitions for Key
and
KeyMap
.
Users may use fromText
and toText
to write decoders/encoders for
forwards and backwards compatibility.
See Key and KeyMap in aeson >= 2.0 for more details.
A map from JSON key type Key
to v
.
Instances
Arbitrary1 KeyMap | Since: aeson-2.0.3.0 |
Defined in Data.Aeson.KeyMap Methods liftArbitrary :: Gen a -> Gen (KeyMap a) # liftShrink :: (a -> [a]) -> KeyMap a -> [KeyMap a] # | |
FromJSON1 KeyMap | Since: aeson-2.0.1.0 |
Defined in Data.Aeson.Types.FromJSON | |
ToJSON1 KeyMap | |
Defined in Data.Aeson.Types.ToJSON Methods liftToJSON :: (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> KeyMap a -> Value # liftToJSONList :: (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [KeyMap a] -> Value # liftToEncoding :: (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding) -> KeyMap a -> Encoding # liftToEncodingList :: (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding) -> [KeyMap a] -> Encoding # liftOmitField :: (a -> Bool) -> KeyMap a -> Bool # | |
Foldable KeyMap | |
Defined in Data.Aeson.KeyMap Methods fold :: Monoid m => KeyMap m -> m # foldMap :: Monoid m => (a -> m) -> KeyMap a -> m # foldMap' :: Monoid m => (a -> m) -> KeyMap a -> m # foldr :: (a -> b -> b) -> b -> KeyMap a -> b # foldr' :: (a -> b -> b) -> b -> KeyMap a -> b # foldl :: (b -> a -> b) -> b -> KeyMap a -> b # foldl' :: (b -> a -> b) -> b -> KeyMap a -> b # foldr1 :: (a -> a -> a) -> KeyMap a -> a # foldl1 :: (a -> a -> a) -> KeyMap a -> a # elem :: Eq a => a -> KeyMap a -> Bool # maximum :: Ord a => KeyMap a -> a # minimum :: Ord a => KeyMap a -> a # | |
Traversable KeyMap | |
Functor KeyMap | |
Align KeyMap | |
Defined in Data.Aeson.KeyMap | |
Semialign KeyMap | |
Zip KeyMap | |
Filterable KeyMap | |
Witherable KeyMap | |
Defined in Data.Aeson.KeyMap Methods wither :: Applicative f => (a -> f (Maybe b)) -> KeyMap a -> f (KeyMap b) # witherM :: Monad m => (a -> m (Maybe b)) -> KeyMap a -> m (KeyMap b) # filterA :: Applicative f => (a -> f Bool) -> KeyMap a -> f (KeyMap a) # witherMap :: Applicative m => (KeyMap b -> r) -> (a -> m (Maybe b)) -> KeyMap a -> m r # | |
FoldableWithIndex Key KeyMap | |
Defined in Data.Aeson.KeyMap | |
FunctorWithIndex Key KeyMap | |
TraversableWithIndex Key KeyMap | |
Defined in Data.Aeson.KeyMap | |
SemialignWithIndex Key KeyMap | |
Defined in Data.Aeson.KeyMap | |
ZipWithIndex Key KeyMap | |
FilterableWithIndex Key KeyMap | |
WitherableWithIndex Key KeyMap | |
value ~ Value => KeyValue Value (KeyMap value) | Constructs a singleton |
value ~ Value => KeyValueOmit Value (KeyMap value) | |
Lift v => Lift (KeyMap v :: TYPE LiftedRep) | |
Arbitrary v => Arbitrary (KeyMap v) | Since: aeson-2.0.3.0 |
CoArbitrary v => CoArbitrary (KeyMap v) | Since: aeson-2.0.3.0 |
Defined in Data.Aeson.KeyMap Methods coarbitrary :: KeyMap v -> Gen b -> Gen b # | |
Function v => Function (KeyMap v) | Since: aeson-2.0.3.0 |
FromJSON v => FromJSON (KeyMap v) | Since: aeson-2.0.1.0 |
Defined in Data.Aeson.Types.FromJSON | |
ToJSON v => ToJSON (KeyMap v) | |
Data v => Data (KeyMap v) | |
Defined in Data.Aeson.KeyMap Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> KeyMap v -> c (KeyMap v) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (KeyMap v) # toConstr :: KeyMap v -> Constr # dataTypeOf :: KeyMap v -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (KeyMap v)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (KeyMap v)) # gmapT :: (forall b. Data b => b -> b) -> KeyMap v -> KeyMap v # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KeyMap v -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KeyMap v -> r # gmapQ :: (forall d. Data d => d -> u) -> KeyMap v -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> KeyMap v -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> KeyMap v -> m (KeyMap v) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> KeyMap v -> m (KeyMap v) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> KeyMap v -> m (KeyMap v) # | |
Monoid (KeyMap v) | |
Semigroup (KeyMap v) | |
IsList (KeyMap v) | Since: aeson-2.0.2.0 |
Read v => Read (KeyMap v) | |
Show v => Show (KeyMap v) | |
NFData v => NFData (KeyMap v) | |
Defined in Data.Aeson.KeyMap | |
Eq v => Eq (KeyMap v) | |
Ord v => Ord (KeyMap v) | |
Defined in Data.Aeson.KeyMap | |
Hashable v => Hashable (KeyMap v) | |
Defined in Data.Aeson.KeyMap | |
type Item (KeyMap v) | |
Defined in Data.Aeson.KeyMap |
Key
Instances
Arbitrary Key | Since: aeson-2.0.3.0 |
CoArbitrary Key | Since: aeson-2.0.3.0 |
Defined in Data.Aeson.Key Methods coarbitrary :: Key -> Gen b -> Gen b # | |
Function Key | Since: aeson-2.0.3.0 |
FromJSON Key | |
Defined in Data.Aeson.Types.FromJSON | |
FromJSONKey Key | |
Defined in Data.Aeson.Types.FromJSON | |
ToJSON Key | |
ToJSONKey Key | |
Defined in Data.Aeson.Types.ToJSON | |
Data Key | |
Defined in Data.Aeson.Key Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Key -> c Key # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Key # dataTypeOf :: Key -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Key) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key) # gmapT :: (forall b. Data b => b -> b) -> Key -> Key # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r # gmapQ :: (forall d. Data d => d -> u) -> Key -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Key -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Key -> m Key # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Key -> m Key # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Key -> m Key # | |
IsString Key | |
Defined in Data.Aeson.Key Methods fromString :: String -> Key # | |
Monoid Key | |
Semigroup Key | |
Read Key | |
Show Key | |
NFData Key | |
Defined in Data.Aeson.Key | |
Eq Key | |
Ord Key | |
Hashable Key | |
Defined in Data.Aeson.Key | |
FoldableWithIndex Key KeyMap | |
Defined in Data.Aeson.KeyMap | |
FunctorWithIndex Key KeyMap | |
TraversableWithIndex Key KeyMap | |
Defined in Data.Aeson.KeyMap | |
SemialignWithIndex Key KeyMap | |
Defined in Data.Aeson.KeyMap | |
ZipWithIndex Key KeyMap | |
Lift Key | |
FilterableWithIndex Key KeyMap | |
WitherableWithIndex Key KeyMap | |
FromPairs Value (DList Pair) | |
Defined in Data.Aeson.Types.ToJSON | |
v ~ Value => KeyValuePair v (DList Pair) | |
Defined in Data.Aeson.Types.ToJSON |