highjson-0.4.0.0: Spec based JSON parsing/serialisation

Safe HaskellNone
LanguageHaskell2010

Data.HighJson

Contents

Synopsis

A json specification for any type

data HighSpec a ty as Source #

Constructors

HighSpec 

Fields

Construct specifications for records

recSpec :: (IsDataSpec q, DContainer q ~ RecordFields) => Text -> Maybe Text -> HVectElim (DFields q) (DType q) -> q -> RecordTypeSpec (DType q) (DFields q) Source #

The specification for a record. Contains a name, an optional description, the constructor and a description how to parse and serialize fields respecting a given json key.

type RecordTypeSpec t flds = HighSpec t SpecRecord flds Source #

A specification for a record

reqField :: FromJSON f => Text -> (t -> f) -> RecordField t f Source #

A required json field. The key must be present in the json.

(.=) :: FromJSON f => Text -> (t -> f) -> RecordField t f Source #

Alias for reqField

optField :: FromJSON f => Text -> (t -> Maybe f) -> RecordField t (Maybe f) Source #

An optional json field.

(.=?) :: FromJSON f => Text -> (t -> Maybe f) -> RecordField t (Maybe f) Source #

Alias for optField

Construct specifications for sum types

sumSpec :: (IsDataSpec q, DContainer q ~ SumOptions) => Text -> Maybe Text -> q -> SumTypeSpec (DType q) (DFields q) Source #

The specification for a sum type. Contains a name, an optional description and a mapping from all constructor (prims) to their respective json fields

type SumTypeSpec t flds = HighSpec t SpecSum flds Source #

A specification for an arbitrary sum type

sumOpt :: Text -> Prism' t o -> SumOption t o Source #

An option of a sum type

(.->) :: Text -> Prism' t o -> SumOption t o Source #

Alias for sumOpt

Construct specifications for enum types

enumSpec :: (IsDataSpec q, DContainer q ~ PhantomEnumContainer) => Text -> Maybe Text -> q -> EnumTypeSpec (DType q) (DFields q) Source #

The specification for a classic enum type. Contains a name, an optional description and a mapping from all constructors to ther counterpart json string names.

type EnumTypeSpec t flds = HighSpec t SpecEnum flds Source #

A specification for a classic enum

enumOpt :: Text -> Prism' t () -> EnumOption t Source #

An option of a classic enum

(@->) :: Text -> Prism' t () -> EnumOption t Source #

Alias for enumOpt

Shared between specifications for simplicity

class IsDataSpec t where Source #

A type class that allows a unified notation for records and sum types. Build specifications using '(:&)' and '(.=)', '(.=?)', '(.->)' or '(@->)'

Minimal complete definition

compileRec

Associated Types

type DFields t :: [*] Source #

type DType t Source #

type DContainer t :: * -> [*] -> * Source #

Methods

compileRec :: t -> DContainer t (DType t) (DFields t) Source #

Instances

IsDataSpec (EnumOption t) Source # 

Associated Types

type DFields (EnumOption t) :: [*] Source #

type DType (EnumOption t) :: * Source #

type DContainer (EnumOption t) :: * -> [*] -> * Source #

IsDataSpec (SumOption t f) Source # 

Associated Types

type DFields (SumOption t f) :: [*] Source #

type DType (SumOption t f) :: * Source #

type DContainer (SumOption t f) :: * -> [*] -> * Source #

IsDataSpec (RecordField t f) Source # 

Associated Types

type DFields (RecordField t f) :: [*] Source #

type DType (RecordField t f) :: * Source #

type DContainer (RecordField t f) :: * -> [*] -> * Source #

(IsDataSpec x, IsDataSpec y, (~) * (DType x) (DType y), (~) (* -> [*] -> *) (DContainer x) (DContainer y), CombinableContainer (DContainer x)) => IsDataSpec ((:&) x y) Source # 

Associated Types

type DFields ((:&) x y) :: [*] Source #

type DType ((:&) x y) :: * Source #

type DContainer ((:&) x y) :: * -> [*] -> * Source #

Methods

compileRec :: (x :& y) -> DContainer (x :& y) (DType (x :& y)) (DFields (x :& y)) Source #

data a :& b infixr 8 Source #

Combination of two local specifications. For records, these are fields, for sum types and enums these are the options.

Constructors

a :& b infixr 8 

Instances

Functor ((:&) a) Source # 

Methods

fmap :: (a -> b) -> (a :& a) -> a :& b #

(<$) :: a -> (a :& b) -> a :& a #

Foldable ((:&) a) Source # 

Methods

fold :: Monoid m => (a :& m) -> m #

foldMap :: Monoid m => (a -> m) -> (a :& a) -> m #

foldr :: (a -> b -> b) -> b -> (a :& a) -> b #

foldr' :: (a -> b -> b) -> b -> (a :& a) -> b #

foldl :: (b -> a -> b) -> b -> (a :& a) -> b #

foldl' :: (b -> a -> b) -> b -> (a :& a) -> b #

foldr1 :: (a -> a -> a) -> (a :& a) -> a #

foldl1 :: (a -> a -> a) -> (a :& a) -> a #

toList :: (a :& a) -> [a] #

null :: (a :& a) -> Bool #

length :: (a :& a) -> Int #

elem :: Eq a => a -> (a :& a) -> Bool #

maximum :: Ord a => (a :& a) -> a #

minimum :: Ord a => (a :& a) -> a #

sum :: Num a => (a :& a) -> a #

product :: Num a => (a :& a) -> a #

Traversable ((:&) a) Source # 

Methods

traverse :: Applicative f => (a -> f b) -> (a :& a) -> f (a :& b) #

sequenceA :: Applicative f => (a :& f a) -> f (a :& a) #

mapM :: Monad m => (a -> m b) -> (a :& a) -> m (a :& b) #

sequence :: Monad m => (a :& m a) -> m (a :& a) #

(Bounded b, Bounded a) => Bounded ((:&) a b) Source # 

Methods

minBound :: a :& b #

maxBound :: a :& b #

(Eq b, Eq a) => Eq ((:&) a b) Source # 

Methods

(==) :: (a :& b) -> (a :& b) -> Bool #

(/=) :: (a :& b) -> (a :& b) -> Bool #

(Show b, Show a) => Show ((:&) a b) Source # 

Methods

showsPrec :: Int -> (a :& b) -> ShowS #

show :: (a :& b) -> String #

showList :: [a :& b] -> ShowS #

(Monoid a, Monoid b) => Monoid ((:&) a b) Source # 

Methods

mempty :: a :& b #

mappend :: (a :& b) -> (a :& b) -> a :& b #

mconcat :: [a :& b] -> a :& b #

(IsDataSpec x, IsDataSpec y, (~) * (DType x) (DType y), (~) (* -> [*] -> *) (DContainer x) (DContainer y), CombinableContainer (DContainer x)) => IsDataSpec ((:&) x y) Source # 

Associated Types

type DFields ((:&) x y) :: [*] Source #

type DType ((:&) x y) :: * Source #

type DContainer ((:&) x y) :: * -> [*] -> * Source #

Methods

compileRec :: (x :& y) -> DContainer (x :& y) (DType (x :& y)) (DFields (x :& y)) Source #

type DFields ((:&) x y) Source # 
type DFields ((:&) x y) = Append (DFields x) (DFields y)
type DType ((:&) x y) Source # 
type DType ((:&) x y) = DType x
type DContainer ((:&) x y) Source # 
type DContainer ((:&) x y) = DContainer x

Generate json serializers/encoders and parsers from specs

Specification structures

data BodySpec ty a as where Source #

Constructors

BodySpecRecord :: !(RecordSpec a as) -> BodySpec SpecRecord a as 
BodySpecSum :: !(SumSpec a as) -> BodySpec SpecSum a as 
BodySpecEnum :: !(EnumSpec a) -> BodySpec SpecEnum a as 

data RecordField t f Source #

Constructors

RecordField 

Fields

Instances

IsDataSpec (RecordField t f) Source # 

Associated Types

type DFields (RecordField t f) :: [*] Source #

type DType (RecordField t f) :: * Source #

type DContainer (RecordField t f) :: * -> [*] -> * Source #

type DFields (RecordField t f) Source # 
type DFields (RecordField t f) = (:) * f ([] *)
type DType (RecordField t f) Source # 
type DType (RecordField t f) = t
type DContainer (RecordField t f) Source # 

data RecordSpec a fs Source #

Constructors

RecordSpec 

Fields

data RecordFields t fs where Source #

Constructors

RFEmpty :: RecordFields t '[] 
(:+:) :: RecordField t f -> RecordFields t fs -> RecordFields t (f ': fs) infixr 5 

data SumOption t o Source #

Constructors

SumOption 

Fields

Instances

IsDataSpec (SumOption t f) Source # 

Associated Types

type DFields (SumOption t f) :: [*] Source #

type DType (SumOption t f) :: * Source #

type DContainer (SumOption t f) :: * -> [*] -> * Source #

type DFields (SumOption t f) Source # 
type DFields (SumOption t f) = (:) * f ([] *)
type DType (SumOption t f) Source # 
type DType (SumOption t f) = t
type DContainer (SumOption t f) Source # 

data SumSpec a os Source #

Constructors

SumSpec 

Fields

data SumOptions t os where Source #

Constructors

SOEmpty :: SumOptions t '[] 
(:|:) :: SumOption t o -> SumOptions t os -> SumOptions t (o ': os) infixr 5 

data EnumOption t Source #

Constructors

EnumOption 

Fields

Instances

IsDataSpec (EnumOption t) Source # 

Associated Types

type DFields (EnumOption t) :: [*] Source #

type DType (EnumOption t) :: * Source #

type DContainer (EnumOption t) :: * -> [*] -> * Source #

type DFields (EnumOption t) Source # 
type DFields (EnumOption t) = (:) * () ([] *)
type DType (EnumOption t) Source # 
type DType (EnumOption t) = t
type DContainer (EnumOption t) Source # 

data EnumSpec a Source #

Constructors

EnumSpec 

Fields

Aeson reexports

class ToJSON a where #

A type that can be converted to JSON.

An example type and instance:

-- Allow ourselves to write Text literals.
{-# LANGUAGE OverloadedStrings #-}

data Coord = Coord { x :: Double, y :: Double }

instance ToJSON Coord where
  toJSON (Coord x y) = object ["x" .= x, "y" .= y]

  toEncoding (Coord x y) = pairs ("x" .= x <> "y" .= y)

Instead of manually writing your ToJSON instance, there are two options to do it automatically:

  • Data.Aeson.TH provides Template Haskell functions which will derive an instance at compile time. The generated instance is optimized for your type so will probably be more efficient than the following two options:
  • The compiler can provide a default generic implementation for toJSON.

To use the second, simply add a deriving Generic clause to your datatype and declare a ToJSON instance for your datatype without giving definitions for toJSON or toEncoding.

For example, the previous example can be simplified to a more minimal instance:

{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics

data Coord = Coord { x :: Double, y :: Double } deriving Generic

instance ToJSON Coord where
    toEncoding = genericToEncoding defaultOptions

Why do we provide an implementation for toEncoding here? The toEncoding function is a relatively new addition to this class. To allow users of older versions of this library to upgrade without having to edit all of their instances or encounter surprising incompatibilities, the default implementation of toEncoding uses toJSON. This produces correct results, but since it performs an intermediate conversion to a Value, it will be less efficient than directly emitting an Encoding. Our one-liner definition of toEncoding above bypasses the intermediate Value.

If DefaultSignatures doesn't give exactly the results you want, you can customize the generic encoding with only a tiny amount of effort, using genericToJSON and genericToEncoding with your preferred Options:

instance ToJSON Coord where
    toJSON     = genericToJSON defaultOptions
    toEncoding = genericToEncoding defaultOptions

Methods

toJSON :: a -> Value #

Convert a Haskell value to a JSON-friendly intermediate type.

toEncoding :: a -> Encoding #

Encode a Haskell value as JSON.

The default implementation of this method creates an intermediate Value using toJSON. This provides source-level compatibility for people upgrading from older versions of this library, but obviously offers no performance advantage.

To benefit from direct encoding, you must provide an implementation for this method. The easiest way to do so is by having your types implement Generic using the DeriveGeneric extension, and then have GHC generate a method body as follows.

instance ToJSON Coord where
    toEncoding = genericToEncoding defaultOptions

toJSONList :: [a] -> Value #

toEncodingList :: [a] -> Encoding #

Instances

ToJSON Bool 
ToJSON Char 
ToJSON Double 
ToJSON Float 
ToJSON Int 
ToJSON Int8 
ToJSON Int16 
ToJSON Int32 
ToJSON Int64 
ToJSON Integer 
ToJSON Ordering 
ToJSON Word 
ToJSON Word8 
ToJSON Word16 
ToJSON Word32 
ToJSON Word64 
ToJSON () 

Methods

toJSON :: () -> Value #

toEncoding :: () -> Encoding #

toJSONList :: [()] -> Value #

toEncodingList :: [()] -> Encoding #

ToJSON Scientific 
ToJSON Number 
ToJSON Text 
ToJSON UTCTime 
ToJSON Value 
ToJSON DotNetTime 
ToJSON Text 
ToJSON Natural 
ToJSON Version 
ToJSON IntSet 
ToJSON LocalTime 
ToJSON ZonedTime 
ToJSON TimeOfDay 
ToJSON NominalDiffTime 
ToJSON Day 
ToJSON UUID 
ToJSON a => ToJSON [a] 

Methods

toJSON :: [a] -> Value #

toEncoding :: [a] -> Encoding #

toJSONList :: [[a]] -> Value #

toEncodingList :: [[a]] -> Encoding #

ToJSON a => ToJSON (Maybe a) 
(ToJSON a, Integral a) => ToJSON (Ratio a) 
ToJSON a => ToJSON (Identity a) 
ToJSON a => ToJSON (Min a) 

Methods

toJSON :: Min a -> Value #

toEncoding :: Min a -> Encoding #

toJSONList :: [Min a] -> Value #

toEncodingList :: [Min a] -> Encoding #

ToJSON a => ToJSON (Max a) 

Methods

toJSON :: Max a -> Value #

toEncoding :: Max a -> Encoding #

toJSONList :: [Max a] -> Value #

toEncodingList :: [Max a] -> Encoding #

ToJSON a => ToJSON (First a) 
ToJSON a => ToJSON (Last a) 
ToJSON a => ToJSON (WrappedMonoid a) 
ToJSON a => ToJSON (Option a) 
ToJSON a => ToJSON (NonEmpty a) 
HasResolution a => ToJSON (Fixed a) 
ToJSON a => ToJSON (Dual a) 
ToJSON a => ToJSON (First a) 
ToJSON a => ToJSON (Last a) 
ToJSON a => ToJSON (IntMap a) 
ToJSON v => ToJSON (Tree v) 
ToJSON a => ToJSON (Seq a) 

Methods

toJSON :: Seq a -> Value #

toEncoding :: Seq a -> Encoding #

toJSONList :: [Seq a] -> Value #

toEncodingList :: [Seq a] -> Encoding #

ToJSON a => ToJSON (Set a) 

Methods

toJSON :: Set a -> Value #

toEncoding :: Set a -> Encoding #

toJSONList :: [Set a] -> Value #

toEncodingList :: [Set a] -> Encoding #

ToJSON a => ToJSON (DList a) 
ToJSON a => ToJSON (Vector a) 
(Prim a, ToJSON a) => ToJSON (Vector a) 
(Storable a, ToJSON a) => ToJSON (Vector a) 
(Vector Vector a, ToJSON a) => ToJSON (Vector a) 
ToJSON a => ToJSON (HashSet a) 
(ToJSON a, ToJSON b) => ToJSON (Either a b) 

Methods

toJSON :: Either a b -> Value #

toEncoding :: Either a b -> Encoding #

toJSONList :: [Either a b] -> Value #

toEncodingList :: [Either a b] -> Encoding #

(ToJSON a, ToJSON b) => ToJSON (a, b) 

Methods

toJSON :: (a, b) -> Value #

toEncoding :: (a, b) -> Encoding #

toJSONList :: [(a, b)] -> Value #

toEncodingList :: [(a, b)] -> Encoding #

(ToJSON v, ToJSONKey k) => ToJSON (HashMap k v) 
(ToJSON v, ToJSONKey k) => ToJSON (Map k v) 

Methods

toJSON :: Map k v -> Value #

toEncoding :: Map k v -> Encoding #

toJSONList :: [Map k v] -> Value #

toEncodingList :: [Map k v] -> Encoding #

ToJSON (Proxy k a) 

Methods

toJSON :: Proxy k a -> Value #

toEncoding :: Proxy k a -> Encoding #

toJSONList :: [Proxy k a] -> Value #

toEncodingList :: [Proxy k a] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c) => ToJSON (a, b, c) 

Methods

toJSON :: (a, b, c) -> Value #

toEncoding :: (a, b, c) -> Encoding #

toJSONList :: [(a, b, c)] -> Value #

toEncodingList :: [(a, b, c)] -> Encoding #

ToJSON a => ToJSON (Const k a b) 

Methods

toJSON :: Const k a b -> Value #

toEncoding :: Const k a b -> Encoding #

toJSONList :: [Const k a b] -> Value #

toEncodingList :: [Const k a b] -> Encoding #

ToJSON b => ToJSON (Tagged k a b) 

Methods

toJSON :: Tagged k a b -> Value #

toEncoding :: Tagged k a b -> Encoding #

toJSONList :: [Tagged k a b] -> Value #

toEncodingList :: [Tagged k a b] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a, b, c, d) 

Methods

toJSON :: (a, b, c, d) -> Value #

toEncoding :: (a, b, c, d) -> Encoding #

toJSONList :: [(a, b, c, d)] -> Value #

toEncodingList :: [(a, b, c, d)] -> Encoding #

(ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum * f g a) 

Methods

toJSON :: Sum * f g a -> Value #

toEncoding :: Sum * f g a -> Encoding #

toJSONList :: [Sum * f g a] -> Value #

toEncodingList :: [Sum * f g a] -> Encoding #

(ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product * f g a) 

Methods

toJSON :: Product * f g a -> Value #

toEncoding :: Product * f g a -> Encoding #

toJSONList :: [Product * f g a] -> Value #

toEncodingList :: [Product * f g a] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON (a, b, c, d, e) 

Methods

toJSON :: (a, b, c, d, e) -> Value #

toEncoding :: (a, b, c, d, e) -> Encoding #

toJSONList :: [(a, b, c, d, e)] -> Value #

toEncodingList :: [(a, b, c, d, e)] -> Encoding #

(ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose * * f g a) 

Methods

toJSON :: Compose * * f g a -> Value #

toEncoding :: Compose * * f g a -> Encoding #

toJSONList :: [Compose * * f g a] -> Value #

toEncodingList :: [Compose * * f g a] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON (a, b, c, d, e, f) 

Methods

toJSON :: (a, b, c, d, e, f) -> Value #

toEncoding :: (a, b, c, d, e, f) -> Encoding #

toJSONList :: [(a, b, c, d, e, f)] -> Value #

toEncodingList :: [(a, b, c, d, e, f)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON (a, b, c, d, e, f, g) 

Methods

toJSON :: (a, b, c, d, e, f, g) -> Value #

toEncoding :: (a, b, c, d, e, f, g) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON (a, b, c, d, e, f, g, h) 

Methods

toJSON :: (a, b, c, d, e, f, g, h) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON (a, b, c, d, e, f, g, h, i) 

Methods

toJSON :: (a, b, c, d, e, f, g, h, i) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON (a, b, c, d, e, f, g, h, i, j) 

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON (a, b, c, d, e, f, g, h, i, j, k) 

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l) 

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k, l) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k, l) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k, l)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k, l)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m) 

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) 

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n, ToJSON o) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) 

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)] -> Encoding #

class FromJSON a where #

A type that can be converted from JSON, with the possibility of failure.

In many cases, you can get the compiler to generate parsing code for you (see below). To begin, let's cover writing an instance by hand.

There are various reasons a conversion could fail. For example, an Object could be missing a required key, an Array could be of the wrong size, or a value could be of an incompatible type.

The basic ways to signal a failed conversion are as follows:

  • empty and mzero work, but are terse and uninformative
  • fail yields a custom error message
  • typeMismatch produces an informative message for cases when the value encountered is not of the expected type

An example type and instance:

-- Allow ourselves to write Text literals.
{-# LANGUAGE OverloadedStrings #-}

data Coord = Coord { x :: Double, y :: Double }

instance FromJSON Coord where
  parseJSON (Object v) = Coord    <$>
                         v .: "x" <*>
                         v .: "y"

  -- We do not expect a non-Object value here.
  -- We could use mzero to fail, but typeMismatch
  -- gives a much more informative error message.
  parseJSON invalid    = typeMismatch "Coord" invalid

Instead of manually writing your FromJSON instance, there are two options to do it automatically:

  • Data.Aeson.TH provides Template Haskell functions which will derive an instance at compile time. The generated instance is optimized for your type so will probably be more efficient than the following two options:
  • The compiler can provide a default generic implementation for parseJSON.

To use the second, simply add a deriving Generic clause to your datatype and declare a FromJSON instance for your datatype without giving a definition for parseJSON.

For example, the previous example can be simplified to just:

{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics

data Coord = Coord { x :: Double, y :: Double } deriving Generic

instance FromJSON Coord

If DefaultSignatures doesn't give exactly the results you want, you can customize the generic decoding with only a tiny amount of effort, using genericParseJSON with your preferred Options:

instance FromJSON Coord where
    parseJSON = genericParseJSON defaultOptions

Methods

parseJSON :: Value -> Parser a #

parseJSONList :: Value -> Parser [a] #

Instances

FromJSON Bool 
FromJSON Char 
FromJSON Double 
FromJSON Float 
FromJSON Int 
FromJSON Int8 
FromJSON Int16 
FromJSON Int32 
FromJSON Int64 
FromJSON Integer

WARNING: Only parse Integers from trusted input since an attacker could easily fill up the memory of the target system by specifying a scientific number with a big exponent like 1e1000000000.

FromJSON Ordering 
FromJSON Word 
FromJSON Word8 
FromJSON Word16 
FromJSON Word32 
FromJSON Word64 
FromJSON () 

Methods

parseJSON :: Value -> Parser () #

parseJSONList :: Value -> Parser [()] #

FromJSON Scientific 
FromJSON Number 
FromJSON Text 
FromJSON UTCTime 
FromJSON Value 
FromJSON DotNetTime 
FromJSON Text 
FromJSON Natural 
FromJSON Version 
FromJSON IntSet 
FromJSON LocalTime 
FromJSON ZonedTime 
FromJSON TimeOfDay 
FromJSON NominalDiffTime

WARNING: Only parse lengths of time from trusted input since an attacker could easily fill up the memory of the target system by specifying a scientific number with a big exponent like 1e1000000000.

FromJSON Day 
FromJSON UUID 
FromJSON a => FromJSON [a] 

Methods

parseJSON :: Value -> Parser [a] #

parseJSONList :: Value -> Parser [[a]] #

FromJSON a => FromJSON (Maybe a) 
(FromJSON a, Integral a) => FromJSON (Ratio a) 
FromJSON a => FromJSON (Identity a) 
FromJSON a => FromJSON (Min a) 

Methods

parseJSON :: Value -> Parser (Min a) #

parseJSONList :: Value -> Parser [Min a] #

FromJSON a => FromJSON (Max a) 

Methods

parseJSON :: Value -> Parser (Max a) #

parseJSONList :: Value -> Parser [Max a] #

FromJSON a => FromJSON (First a) 
FromJSON a => FromJSON (Last a) 
FromJSON a => FromJSON (WrappedMonoid a) 
FromJSON a => FromJSON (Option a) 
FromJSON a => FromJSON (NonEmpty a) 
HasResolution a => FromJSON (Fixed a)

WARNING: Only parse fixed-precision numbers from trusted input since an attacker could easily fill up the memory of the target system by specifying a scientific number with a big exponent like 1e1000000000.

FromJSON a => FromJSON (Dual a) 
FromJSON a => FromJSON (First a) 
FromJSON a => FromJSON (Last a) 
FromJSON a => FromJSON (IntMap a) 
FromJSON v => FromJSON (Tree v) 
FromJSON a => FromJSON (Seq a) 

Methods

parseJSON :: Value -> Parser (Seq a) #

parseJSONList :: Value -> Parser [Seq a] #

(Ord a, FromJSON a) => FromJSON (Set a) 

Methods

parseJSON :: Value -> Parser (Set a) #

parseJSONList :: Value -> Parser [Set a] #

FromJSON a => FromJSON (DList a) 
FromJSON a => FromJSON (Vector a) 
(Prim a, FromJSON a) => FromJSON (Vector a) 
(Storable a, FromJSON a) => FromJSON (Vector a) 
(Vector Vector a, FromJSON a) => FromJSON (Vector a) 
(Eq a, Hashable a, FromJSON a) => FromJSON (HashSet a) 
(FromJSON a, FromJSON b) => FromJSON (Either a b) 

Methods

parseJSON :: Value -> Parser (Either a b) #

parseJSONList :: Value -> Parser [Either a b] #

(FromJSON a, FromJSON b) => FromJSON (a, b) 

Methods

parseJSON :: Value -> Parser (a, b) #

parseJSONList :: Value -> Parser [(a, b)] #

(FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (HashMap k v) 
(FromJSONKey k, Ord k, FromJSON v) => FromJSON (Map k v) 

Methods

parseJSON :: Value -> Parser (Map k v) #

parseJSONList :: Value -> Parser [Map k v] #

FromJSON (Proxy k a) 

Methods

parseJSON :: Value -> Parser (Proxy k a) #

parseJSONList :: Value -> Parser [Proxy k a] #

(FromJSON a, FromJSON b, FromJSON c) => FromJSON (a, b, c) 

Methods

parseJSON :: Value -> Parser (a, b, c) #

parseJSONList :: Value -> Parser [(a, b, c)] #

FromJSON a => FromJSON (Const k a b) 

Methods

parseJSON :: Value -> Parser (Const k a b) #

parseJSONList :: Value -> Parser [Const k a b] #

FromJSON b => FromJSON (Tagged k a b) 

Methods

parseJSON :: Value -> Parser (Tagged k a b) #

parseJSONList :: Value -> Parser [Tagged k a b] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a, b, c, d) 

Methods

parseJSON :: Value -> Parser (a, b, c, d) #

parseJSONList :: Value -> Parser [(a, b, c, d)] #

(FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Sum * f g a) 

Methods

parseJSON :: Value -> Parser (Sum * f g a) #

parseJSONList :: Value -> Parser [Sum * f g a] #

(FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Product * f g a) 

Methods

parseJSON :: Value -> Parser (Product * f g a) #

parseJSONList :: Value -> Parser [Product * f g a] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON (a, b, c, d, e) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e) #

parseJSONList :: Value -> Parser [(a, b, c, d, e)] #

(FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Compose * * f g a) 

Methods

parseJSON :: Value -> Parser (Compose * * f g a) #

parseJSONList :: Value -> Parser [Compose * * f g a] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON (a, b, c, d, e, f) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f)] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON (a, b, c, d, e, f, g) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f, g) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f, g)] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON (a, b, c, d, e, f, g, h) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f, g, h)] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON (a, b, c, d, e, f, g, h, i) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f, g, h, i)] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON (a, b, c, d, e, f, g, h, i, j) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f, g, h, i, j)] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON (a, b, c, d, e, f, g, h, i, j, k) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f, g, h, i, j, k)] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f, g, h, i, j, k, l)] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f, g, h, i, j, k, l, m)] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f, g, h, i, j, k, l, m, n)] #

(FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) 

Methods

parseJSON :: Value -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) #

parseJSONList :: Value -> Parser [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)] #

Implementation detail structures

class CombinableContainer t where Source #

A monoidal type class that respects type level lists associated to the bodies

Minimal complete definition

combineContainer

Methods

combineContainer :: t a (as :: [*]) -> t a (bs :: [*]) -> t a (Append as bs) Source #