{-# LANGUAGE CPP #-}
module Data.Aeson.Combinators.Encode (
Encoder(..)
, auto
, run
, KeyValueEncoder
, object
, field
, KeyValueEncoder'
, object'
, field'
, list
, vector
, jsonArray
, void
, unit, bool
, int, integer, int8, int16, int32, int64
, word, word8, word16, word32, word64
#if (MIN_VERSION_base(4,8,0))
, natural
#endif
, float, double
, scientific
, char, text, string
, uuid, version
, zonedTime, localTime, timeOfDay
, utcTime
, day
#if (MIN_VERSION_time_compat(1,9,2))
, dayOfWeek
#endif
, encode
, toEncoding
, module Data.Aeson.Combinators.Compat
) where
import Control.Applicative
import Control.Monad (join)
import Data.Functor.Contravariant
import Data.Aeson (ToJSON, Value (..))
import qualified Data.Aeson as Aeson
import Data.Aeson.Combinators.Compat
import qualified Data.Aeson.Encoding as E
import Data.Aeson.Types (Pair)
import qualified Data.ByteString.Lazy as BS
import Data.Text (Text)
import Data.Vector (Vector, fromList, (!?))
import qualified Data.Vector as Vector
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Time.Calendar (Day)
#if (MIN_VERSION_time_compat(1,9,2))
import Data.Time.Calendar.Compat (DayOfWeek)
#endif
import Data.Time.Clock (UTCTime)
import Data.Time.LocalTime (LocalTime, TimeOfDay, ZonedTime)
import Data.UUID.Types (UUID)
import Data.Version (Version)
import Data.Void (Void)
import Data.Word (Word, Word16, Word32, Word64,
Word8)
#if (MIN_VERSION_base(4,8,0))
import GHC.Natural (Natural)
#endif
import qualified Data.HashMap.Lazy as HL
import qualified Data.HashMap.Strict as HS
import qualified Data.Map.Lazy as ML
import qualified Data.Map.Strict as MS
import Data.Scientific (Scientific)
import Data.Traversable (traverse)
newtype Encoder a = Encoder (a -> Value)
instance Contravariant Encoder where
contramap :: (a -> b) -> Encoder b -> Encoder a
contramap a -> b
f (Encoder b -> Value
enc) = (a -> Value) -> Encoder a
forall a. (a -> Value) -> Encoder a
Encoder (b -> Value
enc (b -> Value) -> (a -> b) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
{-# INLINE contramap #-}
run :: Encoder a -> a -> Value
run :: Encoder a -> a -> Value
run (Encoder a -> Value
f) = a -> Value
f
{-# INLINE run #-}
auto :: ToJSON a => Encoder a
auto :: Encoder a
auto = (a -> Value) -> Encoder a
forall a. (a -> Value) -> Encoder a
Encoder a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON
{-# INLINE auto #-}
type KeyValueEncoder a = a -> Pair
object :: [KeyValueEncoder a] -> Encoder a
object :: [KeyValueEncoder a] -> Encoder a
object [KeyValueEncoder a]
xs = (a -> Value) -> Encoder a
forall a. (a -> Value) -> Encoder a
Encoder ((a -> Value) -> Encoder a) -> (a -> Value) -> Encoder a
forall a b. (a -> b) -> a -> b
$ \a
val -> [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (KeyValueEncoder a -> Pair) -> [KeyValueEncoder a] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\KeyValueEncoder a
f -> KeyValueEncoder a
f a
val) [KeyValueEncoder a]
xs
{-# INLINE object #-}
field :: Key -> Encoder b -> (a -> b) -> KeyValueEncoder a
field :: Key -> Encoder b -> (a -> b) -> KeyValueEncoder a
field Key
name (Encoder b -> Value
enc) a -> b
get a
v = (Key
name, b -> Value
enc (b -> Value) -> b -> Value
forall a b. (a -> b) -> a -> b
$ a -> b
get a
v)
{-# INLINE field #-}
type KeyValueEncoder' a = a -> [Pair]
object' :: KeyValueEncoder' a -> Encoder a
object' :: KeyValueEncoder' a -> Encoder a
object' KeyValueEncoder' a
f = (a -> Value) -> Encoder a
forall a. (a -> Value) -> Encoder a
Encoder ((a -> Value) -> Encoder a) -> (a -> Value) -> Encoder a
forall a b. (a -> b) -> a -> b
$ \a
val -> [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ KeyValueEncoder' a
f a
val
{-# INLINE object' #-}
field' :: Key -> Encoder a -> a -> (Key, Value)
field' :: Key -> Encoder a -> a -> Pair
field' Key
name (Encoder a -> Value
enc) a
val = (Key
name, a -> Value
enc a
val)
{-# INLINE field' #-}
vector :: Encoder a -> Encoder (Vector a)
vector :: Encoder a -> Encoder (Vector a)
vector (Encoder a -> Value
f) = (Vector a -> Value) -> Encoder (Vector a)
forall a. (a -> Value) -> Encoder a
Encoder ((Vector a -> Value) -> Encoder (Vector a))
-> (Vector a -> Value) -> Encoder (Vector a)
forall a b. (a -> b) -> a -> b
$ \Vector a
val -> Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ a -> Value
f (a -> Value) -> Vector a -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a
val
{-# INLINE vector #-}
list :: Encoder a -> Encoder [a]
list :: Encoder a -> Encoder [a]
list (Encoder a -> Value
f) = ([a] -> Value) -> Encoder [a]
forall a. (a -> Value) -> Encoder a
Encoder (([a] -> Value) -> Encoder [a]) -> ([a] -> Value) -> Encoder [a]
forall a b. (a -> b) -> a -> b
$ \[a]
val -> Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ a -> Value
f (a -> Value) -> [a] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
val
{-# INLINE list #-}
jsonArray :: [Encoder a] -> Encoder a
jsonArray :: [Encoder a] -> Encoder a
jsonArray [Encoder a]
xs = (a -> Value) -> Encoder a
forall a. (a -> Value) -> Encoder a
Encoder ((a -> Value) -> Encoder a) -> (a -> Value) -> Encoder a
forall a b. (a -> b) -> a -> b
$ \a
a -> Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ (\(Encoder a -> Value
f) -> a -> Value
f a
a) (Encoder a -> Value) -> [Encoder a] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Encoder a]
xs
{-# INLINE jsonArray #-}
void :: Encoder Void
void :: Encoder Void
void = Encoder Void
forall a. ToJSON a => Encoder a
auto
{-# INLINE void #-}
unit :: Encoder ()
unit :: Encoder ()
unit = Encoder ()
forall a. ToJSON a => Encoder a
auto
{-# INLINE unit #-}
bool :: Encoder Bool
bool :: Encoder Bool
bool = Encoder Bool
forall a. ToJSON a => Encoder a
auto
{-# INLINE bool #-}
int :: Encoder Int
int :: Encoder Int
int = Encoder Int
forall a. ToJSON a => Encoder a
auto
{-# INLINE int #-}
int8 :: Encoder Int8
int8 :: Encoder Int8
int8 = Encoder Int8
forall a. ToJSON a => Encoder a
auto
{-# INLINE int8 #-}
int16 :: Encoder Int16
int16 :: Encoder Int16
int16 = Encoder Int16
forall a. ToJSON a => Encoder a
auto
{-# INLINE int16 #-}
int32 :: Encoder Int32
int32 :: Encoder Int32
int32 = Encoder Int32
forall a. ToJSON a => Encoder a
auto
{-# INLINE int32 #-}
int64 :: Encoder Int64
int64 :: Encoder Int64
int64 = Encoder Int64
forall a. ToJSON a => Encoder a
auto
{-# INLINE int64 #-}
integer :: Encoder Integer
integer :: Encoder Integer
integer = Encoder Integer
forall a. ToJSON a => Encoder a
auto
{-# INLINE integer #-}
#if (MIN_VERSION_base(4,8,0))
natural :: Encoder Natural
natural :: Encoder Natural
natural = Encoder Natural
forall a. ToJSON a => Encoder a
auto
{-# INLINE natural #-}
#endif
word :: Encoder Word
word :: Encoder Word
word = Encoder Word
forall a. ToJSON a => Encoder a
auto
{-# INLINE word #-}
word8 :: Encoder Word8
word8 :: Encoder Word8
word8 = Encoder Word8
forall a. ToJSON a => Encoder a
auto
{-# INLINE word8 #-}
word16 :: Encoder Word16
word16 :: Encoder Word16
word16 = Encoder Word16
forall a. ToJSON a => Encoder a
auto
{-# INLINE word16 #-}
word32 :: Encoder Word32
word32 :: Encoder Word32
word32 = Encoder Word32
forall a. ToJSON a => Encoder a
auto
{-# INLINE word32 #-}
word64 :: Encoder Word64
word64 :: Encoder Word64
word64 = Encoder Word64
forall a. ToJSON a => Encoder a
auto
{-# INLINE word64 #-}
float :: Encoder Float
float :: Encoder Float
float = Encoder Float
forall a. ToJSON a => Encoder a
auto
{-# INLINE float #-}
double :: Encoder Double
double :: Encoder Double
double = Encoder Double
forall a. ToJSON a => Encoder a
auto
{-# INLINE double #-}
scientific :: Encoder Scientific
scientific :: Encoder Scientific
scientific = Encoder Scientific
forall a. ToJSON a => Encoder a
auto
{-# INLINE scientific #-}
char :: Encoder Char
char :: Encoder Char
char = Encoder Char
forall a. ToJSON a => Encoder a
auto
{-# INLINE char #-}
string :: Encoder String
string :: Encoder String
string = Encoder String
forall a. ToJSON a => Encoder a
auto
{-# INLINE string #-}
text :: Encoder Text
text :: Encoder Text
text = Encoder Text
forall a. ToJSON a => Encoder a
auto
{-# INLINE text #-}
uuid :: Encoder UUID
uuid :: Encoder UUID
uuid = Encoder UUID
forall a. ToJSON a => Encoder a
auto
{-# INLINE uuid #-}
version :: Encoder Version
version :: Encoder Version
version = Encoder Version
forall a. ToJSON a => Encoder a
auto
{-# INLINE version #-}
zonedTime :: Encoder ZonedTime
zonedTime :: Encoder ZonedTime
zonedTime = Encoder ZonedTime
forall a. ToJSON a => Encoder a
auto
{-# INLINE zonedTime #-}
localTime :: Encoder LocalTime
localTime :: Encoder LocalTime
localTime = Encoder LocalTime
forall a. ToJSON a => Encoder a
auto
{-# INLINE localTime #-}
timeOfDay :: Encoder TimeOfDay
timeOfDay :: Encoder TimeOfDay
timeOfDay = Encoder TimeOfDay
forall a. ToJSON a => Encoder a
auto
{-# INLINE timeOfDay #-}
utcTime :: Encoder UTCTime
utcTime :: Encoder UTCTime
utcTime = Encoder UTCTime
forall a. ToJSON a => Encoder a
auto
{-# INLINE utcTime #-}
day :: Encoder Day
day :: Encoder Day
day = Encoder Day
forall a. ToJSON a => Encoder a
auto
{-# INLINE day #-}
#if (MIN_VERSION_time_compat(1,9,2))
dayOfWeek :: Encoder DayOfWeek
dayOfWeek :: Encoder DayOfWeek
dayOfWeek = Encoder DayOfWeek
forall a. ToJSON a => Encoder a
auto
{-# INLINE dayOfWeek #-}
#endif
encode :: Encoder a -> a -> BS.ByteString
encode :: Encoder a -> a -> ByteString
encode Encoder a
encoder =
Encoding' Value -> ByteString
forall a. Encoding' a -> ByteString
E.encodingToLazyByteString (Encoding' Value -> ByteString)
-> (a -> Encoding' Value) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder a -> a -> Encoding' Value
forall a. Encoder a -> a -> Encoding' Value
toEncoding Encoder a
encoder
{-# INLINE encode #-}
toEncoding :: Encoder a -> a -> E.Encoding
toEncoding :: Encoder a -> a -> Encoding' Value
toEncoding (Encoder a -> Value
enc) = Value -> Encoding' Value
E.value (Value -> Encoding' Value) -> (a -> Value) -> a -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
enc
{-# INLINE toEncoding #-}