{-|
Module      : Z.Data.JSON.Base
Description : Fast JSON serialization/deserialization
Copyright   : (c) Dong Han, 2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides 'Converter' to convert 'Value' to haskell data types, and various tools to help
user define 'JSON' instance. It's recommended to use "Z.Data.JSON" instead since it contain more instances.

-}

module Z.Data.JSON.Base
  ( -- * JSON Class
    JSON(..), Value(..), defaultSettings, Settings(..)
  , -- * Encode & Decode
    DecodeError
  , decode, decode', decodeText, decodeText'
  , P.ParseChunks, decodeChunk, decodeChunks
  , encode, encodeChunks, encodeText
  , prettyJSON, JB.prettyValue
    -- * parse into JSON Value
  , JV.parseValue, JV.parseValue'
  -- * Generic functions
  , gToValue, gFromValue, gEncodeJSON
  -- * Convert 'Value' to Haskell data
  , convertValue, Converter(..), fail', (<?>), prependContext
  , PathElement(..), ConvertError(..)
  , typeMismatch, fromNull, withBool, withScientific, withBoundedScientific, withRealFloat
  , withBoundedIntegral, withText, withArray, withKeyValues, withFlatMap, withFlatMapR
  , withHashMap, withHashMapR, withEmbeddedJSON
  , (.:), (.:?), (.:!), convertField, convertFieldMaybe, convertFieldMaybe'
  -- * Helper for manually writing instance.
  , (.=), object, (.!), object', KVItem
  , JB.kv, JB.kv'
  , JB.string
  , B.curly, B.square
  , commaSepList
  , commaSepVec
  ) where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST
import           Data.Char                      (ord)
import           Data.Fixed
import           Data.Hashable
import qualified Data.Foldable                  as Foldable
import qualified Data.HashMap.Strict            as HM
import qualified Data.HashSet                   as HS
import qualified Data.IntMap                    as IM
import qualified Data.IntSet                    as IS
import qualified Data.Map.Strict                as M
import qualified Data.Sequence                  as Seq
import qualified Data.Set                       as Set
import qualified Data.Tree                      as Tree
import           Data.Int
import           Data.Kind                      (Type)
import           Data.List.NonEmpty             (NonEmpty (..))
import qualified Data.List.NonEmpty             as NonEmpty
import qualified Data.Primitive.ByteArray       as A
import qualified Data.Primitive.SmallArray      as A
import           Data.Primitive.Types           (Prim)
import           Data.Ratio                     (Ratio, denominator, numerator, (%))
import           Data.Scientific                (Scientific, base10Exponent, toBoundedInteger)
import qualified Data.Scientific                as Scientific
import           Data.Word
import           GHC.Exts                       (Proxy#, proxy#)
import           GHC.Generics
import           GHC.Natural
import qualified Z.Data.Array                   as A
import qualified Z.Data.Builder                 as B
import           Z.Data.Generics.Utils
import qualified Z.Data.JSON.Builder            as JB
import           Z.Data.JSON.Converter
import           Z.Data.JSON.Value              (Value (..))
import qualified Z.Data.JSON.Value              as JV
import qualified Z.Data.Parser                  as P
import qualified Z.Data.Text                    as T
import qualified Z.Data.Text.Base               as T
import qualified Z.Data.Text.Print              as T
import qualified Z.Data.Vector.Base             as V
import qualified Z.Data.Vector.Base64           as Base64
import qualified Z.Data.Vector.Extra            as V
import qualified Z.Data.Vector.FlatIntMap       as FIM
import qualified Z.Data.Vector.FlatIntSet       as FIS
import qualified Z.Data.Vector.FlatMap          as FM
import qualified Z.Data.Vector.FlatSet          as FS

--------------------------------------------------------------------------------

-- | Type class for encode & decode JSON.
class JSON a where
    fromValue :: Value -> Converter a
    default fromValue :: (Generic a, GFromValue (Rep a)) => Value -> Converter a
    fromValue Value
v = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Converter (Rep a Any) -> Converter a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> Value -> Converter (Rep a Any)
forall k (f :: k -> *) (a :: k).
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
defaultSettings Value
v
    {-# INLINABLE fromValue #-}

    toValue :: a -> Value
    default toValue :: (Generic a, GToValue (Rep a)) => a -> Value
    toValue = Settings -> Rep a Any -> Value
forall k (f :: k -> *) (a :: k).
GToValue f =>
Settings -> f a -> Value
gToValue Settings
defaultSettings (Rep a Any -> Value) -> (a -> Rep a Any) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
    {-# INLINABLE toValue #-}

    encodeJSON :: a -> B.Builder ()
    default encodeJSON :: (Generic a, GEncodeJSON (Rep a)) => a -> B.Builder ()
    encodeJSON = Settings -> Rep a Any -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
defaultSettings (Rep a Any -> Builder ()) -> (a -> Rep a Any) -> a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
    {-# INLINABLE encodeJSON #-}

--------------------------------------------------------------------------------

-- There're two possible failures here:
--
--   * 'P.ParseError' is an error during parsing bytes to 'Value'.
--   * 'ConvertError' is an error when converting 'Value' to target data type.
type DecodeError = Either P.ParseError ConvertError

-- | Decode a JSON doc, only trailing JSON whitespace are allowed.
decodeText' :: JSON a => T.Text -> Either DecodeError a
{-# INLINE decodeText' #-}
decodeText' :: Text -> Either DecodeError a
decodeText' = Bytes -> Either DecodeError a
forall a. JSON a => Bytes -> Either DecodeError a
decode' (Bytes -> Either DecodeError a)
-> (Text -> Bytes) -> Text -> Either DecodeError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bytes
T.getUTF8Bytes

-- | Decode a JSON text, return any trailing text.
decodeText :: JSON a => T.Text -> (T.Text, Either DecodeError a)
{-# INLINE decodeText #-}
decodeText :: Text -> (Text, Either DecodeError a)
decodeText Text
t =
    let (Bytes
rest, Either DecodeError a
r) = Bytes -> (Bytes, Either DecodeError a)
forall a. JSON a => Bytes -> (Bytes, Either DecodeError a)
decode (Text -> Bytes
T.getUTF8Bytes Text
t)
    in (Bytes -> Text
T.Text Bytes
rest, Either DecodeError a
r) -- JSON parser consume bytes in unit of UTF8 codepoint

-- | Decode a JSON doc, only trailing JSON whitespace are allowed.
decode' :: JSON a => V.Bytes -> Either DecodeError a
{-# INLINE decode' #-}
decode' :: Bytes -> Either DecodeError a
decode' Bytes
bs = case Parser Value -> Bytes -> Either ParseError Value
forall a. Parser a -> Bytes -> Either ParseError a
P.parse' (Parser Value
JV.value Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
JV.skipSpaces Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
P.endOfInput) Bytes
bs of
    Left ParseError
pErr -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (ParseError -> DecodeError
forall a b. a -> Either a b
Left ParseError
pErr)
    Right Value
v -> case Value -> Either ConvertError a
forall a. JSON a => Value -> Either ConvertError a
convertValue Value
v of
        Left ConvertError
cErr -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (ConvertError -> DecodeError
forall a b. b -> Either a b
Right ConvertError
cErr)
        Right a
r   -> a -> Either DecodeError a
forall a b. b -> Either a b
Right a
r

-- | Decode a JSON bytes, return any trailing bytes.
decode :: JSON a => V.Bytes -> (V.Bytes, Either DecodeError a)
{-# INLINE decode #-}
decode :: Bytes -> (Bytes, Either DecodeError a)
decode Bytes
bs = case Parser Value -> Bytes -> (Bytes, Either ParseError Value)
forall a. Parser a -> Bytes -> (Bytes, Either ParseError a)
P.parse Parser Value
JV.value Bytes
bs of
    (Bytes
bs', Left ParseError
pErr) -> (Bytes
bs', DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (ParseError -> DecodeError
forall a b. a -> Either a b
Left ParseError
pErr))
    (Bytes
bs', Right Value
v) -> case Value -> Either ConvertError a
forall a. JSON a => Value -> Either ConvertError a
convertValue Value
v of
        Left ConvertError
cErr -> (Bytes
bs', DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (ConvertError -> DecodeError
forall a b. b -> Either a b
Right ConvertError
cErr))
        Right a
r   -> (Bytes
bs', a -> Either DecodeError a
forall a b. b -> Either a b
Right a
r)

-- | Decode a JSON doc chunk.
decodeChunk :: JSON a => V.Bytes -> P.Result DecodeError a
{-# INLINE decodeChunk #-}
decodeChunk :: Bytes -> Result DecodeError a
decodeChunk Bytes
bs = Result ParseError Value -> Result DecodeError a
forall r a.
JSON r =>
Result a Value -> Result (Either a ConvertError) r
loop (Parser Value -> Bytes -> Result ParseError Value
forall a. Parser a -> Bytes -> Result ParseError a
P.parseChunk Parser Value
JV.value Bytes
bs)
  where
    loop :: Result a Value -> Result (Either a ConvertError) r
loop Result a Value
r = do
        case Result a Value
r of
            P.Success Value
v Bytes
rest ->
                case Value -> Either ConvertError r
forall a. JSON a => Value -> Either ConvertError a
convertValue Value
v of
                    Left ConvertError
cErr -> Either a ConvertError -> Bytes -> Result (Either a ConvertError) r
forall e r. e -> Bytes -> Result e r
P.Failure (ConvertError -> Either a ConvertError
forall a b. b -> Either a b
Right ConvertError
cErr) Bytes
rest
                    Right r
r'  -> r -> Bytes -> Result (Either a ConvertError) r
forall e r. r -> Bytes -> Result e r
P.Success r
r' Bytes
rest
            P.Failure a
e Bytes
rest -> Either a ConvertError -> Bytes -> Result (Either a ConvertError) r
forall e r. e -> Bytes -> Result e r
P.Failure (a -> Either a ConvertError
forall a b. a -> Either a b
Left a
e) Bytes
rest
            P.Partial ParseStep a Value
f' -> (Bytes -> Result (Either a ConvertError) r)
-> Result (Either a ConvertError) r
forall e r. (Bytes -> Result e r) -> Result e r
P.Partial (Result a Value -> Result (Either a ConvertError) r
loop (Result a Value -> Result (Either a ConvertError) r)
-> ParseStep a Value -> Bytes -> Result (Either a ConvertError) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseStep a Value
f')

-- | Decode JSON doc chunks, return trailing bytes.
decodeChunks :: (JSON a, Monad m) => P.ParseChunks m DecodeError a
{-# INLINE decodeChunks #-}
decodeChunks :: ParseChunks m DecodeError a
decodeChunks = (Bytes -> Result DecodeError a) -> ParseChunks m DecodeError a
forall (m :: * -> *) e a.
Monad m =>
(Bytes -> Result e a) -> ParseChunks m e a
P.parseChunks Bytes -> Result DecodeError a
forall a. JSON a => Bytes -> Result DecodeError a
decodeChunk

-- | Directly encode data to JSON bytes.
--
-- This function use 'B.buildWith' 'V.smallChunkSize' to balance common use case, if you need fine tuning on memory usage,
-- please use 'B.buildWith' and a custom initial chunk size with 'encodeJSON'.
encode :: JSON a => a -> V.Bytes
{-# INLINE encode #-}
encode :: a -> Bytes
encode = Int -> Builder () -> Bytes
forall a. Int -> Builder a -> Bytes
B.buildWith Int
V.smallChunkSize (Builder () -> Bytes) -> (a -> Builder ()) -> a -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON

-- | Encode data to JSON bytes chunks.
encodeChunks :: JSON a => a -> [V.Bytes]
{-# INLINE encodeChunks #-}
encodeChunks :: a -> [Bytes]
encodeChunks = Builder () -> [Bytes]
forall a. Builder a -> [Bytes]
B.buildChunks (Builder () -> [Bytes]) -> (a -> Builder ()) -> a -> [Bytes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON

-- | Text version 'encode'.
encodeText :: JSON a => a -> T.Text
{-# INLINE encodeText #-}
encodeText :: a -> Text
encodeText = Bytes -> Text
T.Text (Bytes -> Text) -> (a -> Bytes) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bytes
forall a. JSON a => a -> Bytes
encode

-- | Run a 'Converter' with input value.
convertValue :: (JSON a) => Value -> Either ConvertError a
{-# INLINE convertValue #-}
convertValue :: Value -> Either ConvertError a
convertValue = (Value -> Converter a) -> Value -> Either ConvertError a
forall a r. (a -> Converter r) -> a -> Either ConvertError r
convert Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue

-- | Directly encode data to JSON bytes.
prettyJSON :: JSON a => a -> B.Builder ()
{-# INLINE prettyJSON #-}
prettyJSON :: a -> Builder ()
prettyJSON = Value -> Builder ()
JB.prettyValue (Value -> Builder ()) -> (a -> Value) -> a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. JSON a => a -> Value
toValue

--------------------------------------------------------------------------------

-- | Produce an error message like @converting XXX failed, expected XXX, encountered XXX@.
typeMismatch :: T.Text     -- ^ The name of the type you are trying to convert.
             -> T.Text     -- ^ The JSON value type you expecting to meet.
             -> Value      -- ^ The actual value encountered.
             -> Converter a
{-# INLINE typeMismatch #-}
typeMismatch :: Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
expected Value
v =
    Text -> Converter a
forall a. Text -> Converter a
fail' (Text -> Converter a) -> Text -> Converter a
forall a b. (a -> b) -> a -> b
$ ParseError -> Text
T.concat [Text
"converting ", Text
name, Text
" failed, expected ", Text
expected, Text
", encountered ", Text
actual]
  where
    actual :: Text
actual = case Value
v of
        Object Vector (Text, Value)
_ -> Text
"Object"
        Array Vector Value
_  -> Text
"Array"
        String Text
_ -> Text
"String"
        Number Scientific
_ -> Text
"Number"
        Bool Bool
_   -> Text
"Boolean"
        Value
_        -> Text
"Null"

fromNull :: T.Text -> a -> Value -> Converter a
{-# INLINE fromNull #-}
fromNull :: Text -> a -> Value -> Converter a
fromNull Text
_ a
a Value
Null = a -> Converter a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
fromNull Text
c a
_ Value
v    = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
c Text
"Null" Value
v

withBool :: T.Text -> (Bool -> Converter a) -> Value ->  Converter a
{-# INLINE withBool #-}
withBool :: Text -> (Bool -> Converter a) -> Value -> Converter a
withBool Text
_    Bool -> Converter a
f (Bool Bool
x) = Bool -> Converter a
f Bool
x
withBool Text
name Bool -> Converter a
_ Value
v        = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Bool" Value
v

-- | @'withScientific' name f value@ applies @f@ to the 'Scientific' number
-- when @value@ is a 'Z.Data.JSON.Value.Number' and fails using 'typeMismatch'
-- otherwise.
--
-- /Warning/: If you are converting from a scientific to an unbounded
-- type such as 'Integer' you may want to add a restriction on the
-- size of the exponent (see 'withBoundedScientific') to prevent
-- malicious input from filling up the memory of the target system.
--
-- ==== Error message example
--
-- > withScientific "MyType" f (String "oops")
-- > -- Error: "converting MyType failed, expected Number, but encountered String"
withScientific :: T.Text -> (Scientific -> Converter a) -> Value ->  Converter a
{-# INLINE withScientific #-}
withScientific :: Text -> (Scientific -> Converter a) -> Value -> Converter a
withScientific Text
_    Scientific -> Converter a
f (Number Scientific
x) = Scientific -> Converter a
f Scientific
x
withScientific Text
name Scientific -> Converter a
_ Value
v          = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Number" Value
v

-- | @'withRealFloat' try to convert floating number with following rules:
--
--   * Use @±Infinity@ to represent out of range numbers.
--   * Convert @Null@ as @NaN@
--
withRealFloat :: RealFloat a => T.Text -> (a -> Converter r) -> Value -> Converter r
{-# INLINE withRealFloat #-}
withRealFloat :: Text -> (a -> Converter r) -> Value -> Converter r
withRealFloat Text
_    a -> Converter r
f (Number Scientific
s) = a -> Converter r
f (Scientific -> a
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat Scientific
s)
withRealFloat Text
_    a -> Converter r
f Value
Null       = a -> Converter r
f (a
0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
withRealFloat Text
name a -> Converter r
_ Value
v          = Text -> Text -> Value -> Converter r
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Number or Null" Value
v

-- | @'withBoundedScientific' name f value@ applies @f@ to the 'Scientific' number
-- when @value@ is a 'Number' with exponent less than or equal to 1024.
withBoundedScientific :: T.Text -> (Scientific -> Converter a) -> Value ->  Converter a
{-# INLINE withBoundedScientific #-}
withBoundedScientific :: Text -> (Scientific -> Converter a) -> Value -> Converter a
withBoundedScientific Text
name Scientific -> Converter a
f (Number Scientific
x)
    | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1024 = Scientific -> Converter a
f Scientific
x
    | Bool
otherwise = Text -> Converter a
forall a. Text -> Converter a
fail' (Text -> Converter a)
-> (Builder () -> Text) -> Builder () -> Converter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Text
forall a. Builder a -> Text
B.unsafeBuildText (Builder () -> Converter a) -> Builder () -> Converter a
forall a b. (a -> b) -> a -> b
$ do
        Builder ()
"converting "
        Text -> Builder ()
T.text Text
name
        Builder ()
" failed, found a number with exponent "
        Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
T.int Int
e
        Builder ()
", but it must not be greater than 1024"
  where e :: Int
e = Scientific -> Int
base10Exponent Scientific
x
withBoundedScientific Text
name Scientific -> Converter a
_ Value
v = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Number" Value
v

-- | @'withBoundedScientific' name f value@ applies @f@ to the 'Scientific' number
-- when @value@ is a 'Number' and value is within @minBound ~ maxBound@.
withBoundedIntegral :: (Bounded a, Integral a) => T.Text -> (a -> Converter r) -> Value -> Converter r
{-# INLINE withBoundedIntegral #-}
withBoundedIntegral :: Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
name a -> Converter r
f (Number Scientific
x) =
    case Scientific -> Maybe a
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
x of
        Just a
i -> a -> Converter r
f a
i
        Maybe a
_      -> Text -> Converter r
forall a. Text -> Converter a
fail' (Text -> Converter r)
-> (Builder () -> Text) -> Builder () -> Converter r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Text
forall a. Builder a -> Text
B.unsafeBuildText (Builder () -> Converter r) -> Builder () -> Converter r
forall a b. (a -> b) -> a -> b
$ do
            Builder ()
"converting "
            Text -> Builder ()
T.text Text
name
            Builder ()
"failed, value is either floating or will cause over or underflow: "
            Scientific -> Builder ()
T.scientific Scientific
x
withBoundedIntegral Text
name a -> Converter r
_ Value
v = Text -> Text -> Value -> Converter r
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Number" Value
v

withText :: T.Text -> (T.Text -> Converter a) -> Value -> Converter a
{-# INLINE withText #-}
withText :: Text -> (Text -> Converter a) -> Value -> Converter a
withText Text
_    Text -> Converter a
f (String Text
x) = Text -> Converter a
f Text
x
withText Text
name Text -> Converter a
_ Value
v          = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"String" Value
v

withArray :: T.Text -> (V.Vector Value -> Converter a) -> Value -> Converter a
{-# INLINE withArray #-}
withArray :: Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
_ Vector Value -> Converter a
f (Array Vector Value
arr) = Vector Value -> Converter a
f Vector Value
arr
withArray Text
name Vector Value -> Converter a
_ Value
v        = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Array" Value
v

-- | Directly use 'Object' as key-values for further converting.
withKeyValues :: T.Text -> (V.Vector (T.Text, Value) -> Converter a) -> Value -> Converter a
{-# INLINE withKeyValues #-}
withKeyValues :: Text
-> (Vector (Text, Value) -> Converter a) -> Value -> Converter a
withKeyValues Text
_    Vector (Text, Value) -> Converter a
f (Object Vector (Text, Value)
kvs) = Vector (Text, Value) -> Converter a
f Vector (Text, Value)
kvs
withKeyValues Text
name Vector (Text, Value) -> Converter a
_ Value
v            = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Object" Value
v

-- | Take a 'Object' as an 'FM.FlatMap T.Text Value', on key duplication prefer first one.
withFlatMap :: T.Text -> (FM.FlatMap T.Text Value -> Converter a) -> Value -> Converter a
{-# INLINE withFlatMap #-}
withFlatMap :: Text -> (FlatMap Text Value -> Converter a) -> Value -> Converter a
withFlatMap Text
_    FlatMap Text Value -> Converter a
f (Object Vector (Text, Value)
obj) = FlatMap Text Value -> Converter a
f (Vector (Text, Value) -> FlatMap Text Value
forall k v. Ord k => Vector (k, v) -> FlatMap k v
FM.packVector Vector (Text, Value)
obj)
withFlatMap Text
name FlatMap Text Value -> Converter a
_ Value
v            = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Object" Value
v

-- | Take a 'Object' as an 'FM.FlatMap T.Text Value', on key duplication prefer last one.
withFlatMapR :: T.Text -> (FM.FlatMap T.Text Value -> Converter a) -> Value -> Converter a
{-# INLINE withFlatMapR #-}
withFlatMapR :: Text -> (FlatMap Text Value -> Converter a) -> Value -> Converter a
withFlatMapR Text
_    FlatMap Text Value -> Converter a
f (Object Vector (Text, Value)
obj) = FlatMap Text Value -> Converter a
f (Vector (Text, Value) -> FlatMap Text Value
forall k v. Ord k => Vector (k, v) -> FlatMap k v
FM.packVectorR Vector (Text, Value)
obj)
withFlatMapR Text
name FlatMap Text Value -> Converter a
_ Value
v            = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Object" Value
v

-- | Take a 'Object' as an 'HM.HashMap T.Text Value', on key duplication prefer first one.
withHashMap :: T.Text -> (HM.HashMap T.Text Value -> Converter a) -> Value -> Converter a
{-# INLINE withHashMap #-}
withHashMap :: Text -> (HashMap Text Value -> Converter a) -> Value -> Converter a
withHashMap Text
_    HashMap Text Value -> Converter a
f (Object Vector (Text, Value)
obj) = HashMap Text Value -> Converter a
f ([(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (Vector (Text, Value) -> [(Text, Value)]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpackR Vector (Text, Value)
obj))
withHashMap Text
name HashMap Text Value -> Converter a
_ Value
v            = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Object" Value
v

-- | Take a 'Object' as an 'HM.HashMap T.Text Value', on key duplication prefer last one.
withHashMapR :: T.Text -> (HM.HashMap T.Text Value -> Converter a) -> Value -> Converter a
{-# INLINE withHashMapR #-}
withHashMapR :: Text -> (HashMap Text Value -> Converter a) -> Value -> Converter a
withHashMapR Text
_    HashMap Text Value -> Converter a
f (Object Vector (Text, Value)
obj) = HashMap Text Value -> Converter a
f ([(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (Vector (Text, Value) -> [(Text, Value)]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector (Text, Value)
obj))
withHashMapR Text
name HashMap Text Value -> Converter a
_ Value
v            = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Object" Value
v

-- | Decode a nested JSON-encoded string.
withEmbeddedJSON :: T.Text                  -- ^ data type name
                 -> (Value -> Converter a)     -- ^ a inner converter which will get the converted 'Value'.
                 -> Value -> Converter a       -- a converter take a JSON String
{-# INLINE withEmbeddedJSON #-}
withEmbeddedJSON :: Text -> (Value -> Converter a) -> Value -> Converter a
withEmbeddedJSON Text
_ Value -> Converter a
innerConverter (String Text
txt) = (forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf a -> r
k ->
        case Bytes -> Either DecodeError Value
forall a. JSON a => Bytes -> Either DecodeError a
decode' (Text -> Bytes
T.getUTF8Bytes Text
txt) of
            Right Value
v -> Converter a -> ([PathElement] -> Text -> r) -> (a -> r) -> r
forall a.
Converter a
-> forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
runConverter (Value -> Converter a
innerConverter Value
v) (\ [PathElement]
paths Text
msg -> [PathElement] -> Text -> r
kf (PathElement
EmbeddedPathElement -> [PathElement] -> [PathElement]
forall a. a -> [a] -> [a]
:[PathElement]
paths) Text
msg) a -> r
k
            Left (Left ParseError
pErr) -> [PathElement] -> Text -> r
kf [] (Text -> ParseError -> Text
T.intercalate Text
", " (Text
"parsing embeded JSON failed "Text -> ParseError -> ParseError
forall a. a -> [a] -> [a]
: ParseError
pErr))
            Either DecodeError Value
_                -> [Char] -> r
forall a. HasCallStack => [Char] -> a
error [Char]
"Z.JSON.Base: impossible, converting to Value should not fail")
withEmbeddedJSON Text
name Value -> Converter a
_ Value
v = Text -> Text -> Value -> Converter a
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"String" Value
v

-- | Retrieve the value associated with the given key of an 'Object'.
-- The result is 'empty' if the key is not present or the value cannot
-- be converted to the desired type.
--
-- This accessor is appropriate if the key and value /must/ be present
-- in an object for it to be valid.  If the key and value are
-- optional, use '.:?' instead.
(.:) :: (JSON a) => FM.FlatMap T.Text Value -> T.Text -> Converter a
{-# INLINE (.:) #-}
.: :: FlatMap Text Value -> Text -> Converter a
(.:) = (Value -> Converter a) -> FlatMap Text Value -> Text -> Converter a
forall a.
(Value -> Converter a) -> FlatMap Text Value -> Text -> Converter a
convertField Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue

-- | Retrieve the value associated with the given key of an 'Object'. The
-- result is 'Nothing' if the key is not present or if its value is 'Null',
-- or fail if the value cannot be converted to the desired type.
--
-- This accessor is most useful if the key and value can be absent
-- from an object without affecting its validity.  If the key and
-- value are mandatory, use '.:' instead.
(.:?) :: (JSON a) => FM.FlatMap T.Text Value -> T.Text -> Converter (Maybe a)
{-# INLINE (.:?) #-}
.:? :: FlatMap Text Value -> Text -> Converter (Maybe a)
(.:?) = (Value -> Converter a)
-> FlatMap Text Value -> Text -> Converter (Maybe a)
forall a.
(Value -> Converter a)
-> FlatMap Text Value -> Text -> Converter (Maybe a)
convertFieldMaybe Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue

-- | Retrieve the value associated with the given key of an 'Object'.
-- The result is 'Nothing' if the key is not present or fail if the
-- value cannot be converted to the desired type.
--
-- This differs from '.:?' by attempting to convert 'Null' the same as any
-- other JSON value, instead of interpreting it as 'Nothing'.
(.:!) :: (JSON a) => FM.FlatMap T.Text Value -> T.Text -> Converter (Maybe a)
{-# INLINE (.:!) #-}
.:! :: FlatMap Text Value -> Text -> Converter (Maybe a)
(.:!) = (Value -> Converter a)
-> FlatMap Text Value -> Text -> Converter (Maybe a)
forall a.
(Value -> Converter a)
-> FlatMap Text Value -> Text -> Converter (Maybe a)
convertFieldMaybe' Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue

convertField :: (Value -> Converter a)  -- ^ the field converter (value part of a key value pair)
           -> FM.FlatMap T.Text Value -> T.Text -> Converter a
{-# INLINE convertField #-}
convertField :: (Value -> Converter a) -> FlatMap Text Value -> Text -> Converter a
convertField Value -> Converter a
p FlatMap Text Value
obj Text
key = case Text -> FlatMap Text Value -> Maybe Value
forall k v. Ord k => k -> FlatMap k v -> Maybe v
FM.lookup Text
key FlatMap Text Value
obj of
    Just Value
v -> Value -> Converter a
p Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
key
    Maybe Value
_      -> Text -> Converter a
forall a. Text -> Converter a
fail' (ParseError -> Text
T.concat (ParseError -> Text) -> ParseError -> Text
forall a b. (a -> b) -> a -> b
$ [Text
"key ", Text
key, Text
" not present"])

-- | Variant of '.:?' with explicit converter function.
convertFieldMaybe :: (Value -> Converter a) -> FM.FlatMap T.Text Value -> T.Text -> Converter (Maybe a)
{-# INLINE convertFieldMaybe #-}
convertFieldMaybe :: (Value -> Converter a)
-> FlatMap Text Value -> Text -> Converter (Maybe a)
convertFieldMaybe Value -> Converter a
p FlatMap Text Value
obj Text
key = case Text -> FlatMap Text Value -> Maybe Value
forall k v. Ord k => k -> FlatMap k v -> Maybe v
FM.lookup Text
key FlatMap Text Value
obj of
    Just Value
Null -> Maybe a -> Converter (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just Value
v    -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Converter a -> Converter (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Converter a
p Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
key
    Maybe Value
_         -> Maybe a -> Converter (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- | Variant of '.:!' with explicit converter function.
convertFieldMaybe' :: (Value -> Converter a) -> FM.FlatMap T.Text Value -> T.Text -> Converter (Maybe a)
{-# INLINE convertFieldMaybe' #-}
convertFieldMaybe' :: (Value -> Converter a)
-> FlatMap Text Value -> Text -> Converter (Maybe a)
convertFieldMaybe' Value -> Converter a
p FlatMap Text Value
obj Text
key = case Text -> FlatMap Text Value -> Maybe Value
forall k v. Ord k => k -> FlatMap k v -> Maybe v
FM.lookup Text
key FlatMap Text Value
obj of
    Just Value
v -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Converter a -> Converter (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Converter a
p Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
key
    Maybe Value
_      -> Maybe a -> Converter (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------

-- | Use @,@ as separator to connect list of builders.
commaSepList :: JSON a => [a] -> B.Builder ()
{-# INLINE commaSepList #-}
commaSepList :: [a] -> Builder ()
commaSepList = Builder () -> (a -> Builder ()) -> [a] -> Builder ()
forall a. Builder () -> (a -> Builder ()) -> [a] -> Builder ()
B.intercalateList Builder ()
B.comma a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON

-- | Use @,@ as separator to connect a vector of builders.
commaSepVec :: (JSON a, V.Vec v a) => v a ->  B.Builder ()
{-# INLINE commaSepVec #-}
commaSepVec :: v a -> Builder ()
commaSepVec = Builder () -> (a -> Builder ()) -> v a -> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
B.intercalateVec Builder ()
B.comma a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON

-- | A newtype for 'B.Builder', whose semigroup's instance is to connect two builder with 'B.comma'.
newtype KVItem = KVItem (B.Builder ())

instance Semigroup KVItem where
    {-# INLINE (<>) #-}
    KVItem Builder ()
a <> :: KVItem -> KVItem -> KVItem
<> KVItem Builder ()
b = Builder () -> KVItem
KVItem (Builder ()
a Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
B.comma Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
b)

-- | Connect key and value to a 'KVItem' using 'B.colon', key will be escaped.
(.!) :: JSON v => T.Text -> v -> KVItem
{-# INLINE (.!) #-}
Text
k .! :: Text -> v -> KVItem
.! v
v = Builder () -> KVItem
KVItem (Text
k Text -> Builder () -> Builder ()
`JB.kv'` v -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON v
v)
infixr 8 .!

-- | Add curly for comma connected 'KVItem's.
object' :: KVItem -> B.Builder ()
{-# INLINE object' #-}
object' :: KVItem -> Builder ()
object' (KVItem Builder ()
kvb) = Builder () -> Builder ()
B.curly Builder ()
kvb

-- | Connect key and value to a tuple to be used with 'object'.
(.=) :: JSON v => T.Text -> v -> (T.Text, Value)
{-# INLINE (.=) #-}
Text
k .= :: Text -> v -> (Text, Value)
.= v
v = let !v' :: Value
v' = v -> Value
forall a. JSON a => a -> Value
toValue v
v in  (Text
k, Value
v')
infixr 8 .=

-- | Alias for @Object . pack@.
object :: [(T.Text, Value)] -> Value
{-# INLINE object #-}
object :: [(Text, Value)] -> Value
object = Vector (Text, Value) -> Value
Object (Vector (Text, Value) -> Value)
-> ([(Text, Value)] -> Vector (Text, Value))
-> [(Text, Value)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Vector (Text, Value)
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack

--------------------------------------------------------------------------------
-- | Generic encode/decode Settings
--
-- There should be no control characters in formatted texts since we don't escaping those
-- field names or constructor names ('defaultSettings' relys on Haskell's lexical property).
-- Otherwise 'encodeJSON' will output illegal JSON string.
data Settings = Settings
    { Settings -> [Char] -> Text
fieldFmt  :: String -> T.Text -- ^ format field labels
    , Settings -> [Char] -> Text
constrFmt :: String -> T.Text -- ^ format constructor names
    , Settings -> Bool
missingKeyAsNull :: Bool      -- ^ take missing field as 'Null'?
    }

-- | @Settings T.pack T.pack False@
defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings = ([Char] -> Text) -> ([Char] -> Text) -> Bool -> Settings
Settings [Char] -> Text
T.pack [Char] -> Text
T.pack Bool
False

--------------------------------------------------------------------------------
-- GToValue
--------------------------------------------------------------------------------

class GToValue f where
    gToValue :: Settings -> f a -> Value

--------------------------------------------------------------------------------
-- Selectors

type family Field f where
    Field (a :*: b) = Field a
    Field (S1 (MetaSel Nothing u ss ds) f) = Value
    Field (S1 (MetaSel (Just l) u ss ds) f) = (T.Text, Value)

class GWriteFields f where
    gWriteFields :: Settings -> A.SmallMutableArray s (Field f) -> Int -> f a -> ST s ()

instance (ProductSize a, GWriteFields a, GWriteFields b, Field a ~ Field b) => GWriteFields (a :*: b) where
    {-# INLINE gWriteFields #-}
    gWriteFields :: Settings
-> SmallMutableArray s (Field (a :*: b))
-> Int
-> (:*:) a b a
-> ST s ()
gWriteFields Settings
s SmallMutableArray s (Field (a :*: b))
marr Int
idx (a a
a :*: b a
b) = do
        Settings -> SmallMutableArray s (Field a) -> Int -> a a -> ST s ()
forall k (f :: k -> *) s (a :: k).
GWriteFields f =>
Settings -> SmallMutableArray s (Field f) -> Int -> f a -> ST s ()
gWriteFields Settings
s SmallMutableArray s (Field a)
SmallMutableArray s (Field (a :*: b))
marr Int
idx a a
a
        Settings -> SmallMutableArray s (Field b) -> Int -> b a -> ST s ()
forall k (f :: k -> *) s (a :: k).
GWriteFields f =>
Settings -> SmallMutableArray s (Field f) -> Int -> f a -> ST s ()
gWriteFields Settings
s SmallMutableArray s (Field b)
SmallMutableArray s (Field (a :*: b))
marr (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy# a -> Int
forall (f :: * -> *). KnownNat (PSize f) => Proxy# f -> Int
productSize (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a)) b a
b

instance (GToValue f) => GWriteFields (S1 (MetaSel Nothing u ss ds) f) where
    {-# INLINE gWriteFields #-}
    gWriteFields :: Settings
-> SmallMutableArray s (Field (S1 ('MetaSel 'Nothing u ss ds) f))
-> Int
-> S1 ('MetaSel 'Nothing u ss ds) f a
-> ST s ()
gWriteFields Settings
s SmallMutableArray s (Field (S1 ('MetaSel 'Nothing u ss ds) f))
marr Int
idx (M1 f a
x) = SmallMutableArray (PrimState (ST s)) Value
-> Int -> Value -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (Field (S1 ('MetaSel 'Nothing u ss ds) f))
SmallMutableArray (PrimState (ST s)) Value
marr Int
idx (Settings -> f a -> Value
forall k (f :: k -> *) (a :: k).
GToValue f =>
Settings -> f a -> Value
gToValue Settings
s f a
x)

instance (GToValue f, Selector (MetaSel (Just l) u ss ds)) => GWriteFields (S1 (MetaSel (Just l) u ss ds) f) where
    {-# INLINE gWriteFields #-}
    gWriteFields :: Settings
-> SmallMutableArray s (Field (S1 ('MetaSel ('Just l) u ss ds) f))
-> Int
-> S1 ('MetaSel ('Just l) u ss ds) f a
-> ST s ()
gWriteFields Settings
s SmallMutableArray s (Field (S1 ('MetaSel ('Just l) u ss ds) f))
marr Int
idx m1 :: S1 ('MetaSel ('Just l) u ss ds) f a
m1@(M1 f a
x) = SmallMutableArray (PrimState (ST s)) (Text, Value)
-> Int -> (Text, Value) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (Field (S1 ('MetaSel ('Just l) u ss ds) f))
SmallMutableArray (PrimState (ST s)) (Text, Value)
marr Int
idx ((Settings -> [Char] -> Text
fieldFmt Settings
s) (S1 ('MetaSel ('Just l) u ss ds) f a -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName S1 ('MetaSel ('Just l) u ss ds) f a
m1), Settings -> f a -> Value
forall k (f :: k -> *) (a :: k).
GToValue f =>
Settings -> f a -> Value
gToValue Settings
s f a
x)

instance (GToValue f, Selector (MetaSel (Just l) u ss ds)) => GToValue (S1 (MetaSel (Just l) u ss ds) f) where
    {-# INLINE gToValue #-}
    gToValue :: Settings -> S1 ('MetaSel ('Just l) u ss ds) f a -> Value
gToValue Settings
s m1 :: S1 ('MetaSel ('Just l) u ss ds) f a
m1@(M1 f a
x) =
        let !k :: Text
k = Settings -> [Char] -> Text
fieldFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ S1 ('MetaSel ('Just l) u ss ds) f a -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName S1 ('MetaSel ('Just l) u ss ds) f a
m1
            !v :: Value
v = Settings -> f a -> Value
forall k (f :: k -> *) (a :: k).
GToValue f =>
Settings -> f a -> Value
gToValue Settings
s f a
x
        in Vector (Text, Value) -> Value
Object ((Text, Value) -> Vector (Text, Value)
forall (v :: * -> *) a. Vec v a => a -> v a
V.singleton (Text
k, Value
v))

instance GToValue f => GToValue (S1 (MetaSel Nothing u ss ds) f) where
    {-# INLINE gToValue #-}
    gToValue :: Settings -> S1 ('MetaSel 'Nothing u ss ds) f a -> Value
gToValue Settings
s (M1 f a
x) = Settings -> f a -> Value
forall k (f :: k -> *) (a :: k).
GToValue f =>
Settings -> f a -> Value
gToValue Settings
s f a
x

instance JSON a => GToValue (K1 i a) where
    {-# INLINE gToValue #-}
    gToValue :: Settings -> K1 i a a -> Value
gToValue Settings
_ (K1 a
x) = a -> Value
forall a. JSON a => a -> Value
toValue a
x

class GMergeFields f where
    gMergeFields :: Proxy# f -> A.SmallMutableArray s (Field f) -> ST s Value

instance GMergeFields a => GMergeFields (a :*: b) where
    {-# INLINE gMergeFields #-}
    gMergeFields :: Proxy# (a :*: b)
-> SmallMutableArray s (Field (a :*: b)) -> ST s Value
gMergeFields Proxy# (a :*: b)
_ = Proxy# a -> SmallMutableArray s (Field a) -> ST s Value
forall k (f :: k -> *) s.
GMergeFields f =>
Proxy# f -> SmallMutableArray s (Field f) -> ST s Value
gMergeFields (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a)

instance GMergeFields (S1 (MetaSel Nothing u ss ds) f) where
    {-# INLINE gMergeFields #-}
    gMergeFields :: Proxy# (S1 ('MetaSel 'Nothing u ss ds) f)
-> SmallMutableArray s (Field (S1 ('MetaSel 'Nothing u ss ds) f))
-> ST s Value
gMergeFields Proxy# (S1 ('MetaSel 'Nothing u ss ds) f)
_ SmallMutableArray s (Field (S1 ('MetaSel 'Nothing u ss ds) f))
marr = do
        SmallArray Value
arr <- SmallMutableArray (PrimState (ST s)) Value
-> ST s (SmallArray Value)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
A.unsafeFreezeSmallArray SmallMutableArray s (Field (S1 ('MetaSel 'Nothing u ss ds) f))
SmallMutableArray (PrimState (ST s)) Value
marr
        let l :: Int
l = SmallArray Value -> Int
forall a. SmallArray a -> Int
A.sizeofSmallArray SmallArray Value
arr
        Value -> ST s Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Value -> Value
Array (SmallArray Value -> Int -> Int -> Vector Value
forall a. SmallArray a -> Int -> Int -> Vector a
V.Vector SmallArray Value
arr Int
0 Int
l))

instance GMergeFields (S1 (MetaSel (Just l) u ss ds) f) where
    {-# INLINE gMergeFields #-}
    gMergeFields :: Proxy# (S1 ('MetaSel ('Just l) u ss ds) f)
-> SmallMutableArray s (Field (S1 ('MetaSel ('Just l) u ss ds) f))
-> ST s Value
gMergeFields Proxy# (S1 ('MetaSel ('Just l) u ss ds) f)
_ SmallMutableArray s (Field (S1 ('MetaSel ('Just l) u ss ds) f))
marr = do
        SmallArray (Text, Value)
arr <- SmallMutableArray (PrimState (ST s)) (Text, Value)
-> ST s (SmallArray (Text, Value))
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
A.unsafeFreezeSmallArray SmallMutableArray s (Field (S1 ('MetaSel ('Just l) u ss ds) f))
SmallMutableArray (PrimState (ST s)) (Text, Value)
marr
        let l :: Int
l = SmallArray (Text, Value) -> Int
forall a. SmallArray a -> Int
A.sizeofSmallArray SmallArray (Text, Value)
arr
        Value -> ST s Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector (Text, Value) -> Value
Object (SmallArray (Text, Value) -> Int -> Int -> Vector (Text, Value)
forall a. SmallArray a -> Int -> Int -> Vector a
V.Vector SmallArray (Text, Value)
arr Int
0 Int
l))

--------------------------------------------------------------------------------
-- Constructors

class GConstrToValue f where
    gConstrToValue :: Bool -> Settings -> f a -> Value

instance GConstrToValue V1 where
    {-# INLINE gConstrToValue #-}
    gConstrToValue :: Bool -> Settings -> V1 a -> Value
gConstrToValue Bool
_ Settings
_ V1 a
_ = [Char] -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"Z.Data.JSON.Base: empty data type"

instance (GConstrToValue f, GConstrToValue g) => GConstrToValue (f :+: g) where
    {-# INLINE gConstrToValue #-}
    gConstrToValue :: Bool -> Settings -> (:+:) f g a -> Value
gConstrToValue Bool
_ Settings
s (L1 f a
x) = Bool -> Settings -> f a -> Value
forall k (f :: k -> *) (a :: k).
GConstrToValue f =>
Bool -> Settings -> f a -> Value
gConstrToValue Bool
True Settings
s f a
x
    gConstrToValue Bool
_ Settings
s (R1 g a
x) = Bool -> Settings -> g a -> Value
forall k (f :: k -> *) (a :: k).
GConstrToValue f =>
Bool -> Settings -> f a -> Value
gConstrToValue Bool
True Settings
s g a
x

-- | Constructor without payload, convert to String
instance (Constructor c) => GConstrToValue (C1 c U1) where
    {-# INLINE gConstrToValue #-}
    gConstrToValue :: Bool -> Settings -> C1 c U1 a -> Value
gConstrToValue Bool
_ Settings
s (M1 U1 a
_) = Text -> Value
String (Text -> Value) -> ([Char] -> Text) -> [Char] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Value) -> [Char] -> Value
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName (forall k k (t :: Meta -> (k -> *) -> k -> *) (a :: k). t c U1 a
forall a. HasCallStack => a
undefined :: t c U1 a)

-- | Constructor with a single payload
instance (Constructor c, GToValue (S1 sc f)) => GConstrToValue (C1 c (S1 sc f)) where
    {-# INLINE gConstrToValue #-}
    gConstrToValue :: Bool -> Settings -> C1 c (S1 sc f) a -> Value
gConstrToValue Bool
False Settings
s (M1 S1 sc f a
x) = Settings -> S1 sc f a -> Value
forall k (f :: k -> *) (a :: k).
GToValue f =>
Settings -> f a -> Value
gToValue Settings
s S1 sc f a
x
    gConstrToValue Bool
True Settings
s (M1 S1 sc f a
x) =
        let !k :: Text
k = Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
            !v :: Value
v = Settings -> S1 sc f a -> Value
forall k (f :: k -> *) (a :: k).
GToValue f =>
Settings -> f a -> Value
gToValue Settings
s S1 sc f a
x
        in Vector (Text, Value) -> Value
Object ((Text, Value) -> Vector (Text, Value)
forall (v :: * -> *) a. Vec v a => a -> v a
V.singleton (Text
k, Value
v))

-- | Constructor with multiple payloads
instance (ProductSize (a :*: b), GWriteFields (a :*: b), GMergeFields (a :*: b), Constructor c)
    => GConstrToValue (C1 c (a :*: b)) where
    {-# INLINE gConstrToValue #-}
    gConstrToValue :: Bool -> Settings -> C1 c (a :*: b) a -> Value
gConstrToValue Bool
False Settings
s (M1 (:*:) a b a
x) = (forall s. ST s Value) -> Value
forall a. (forall s. ST s a) -> a
runST (do
        SmallMutableArray s (Field a)
marr <- Int
-> Field a -> ST s (SmallMutableArray (PrimState (ST s)) (Field a))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
A.newSmallArray (Proxy# (a :*: b) -> Int
forall (f :: * -> *). KnownNat (PSize f) => Proxy# f -> Int
productSize (Proxy# (a :*: b)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (a :*: b))) Field a
forall a. HasCallStack => a
undefined
        Settings
-> SmallMutableArray s (Field (a :*: b))
-> Int
-> (:*:) a b a
-> ST s ()
forall k (f :: k -> *) s (a :: k).
GWriteFields f =>
Settings -> SmallMutableArray s (Field f) -> Int -> f a -> ST s ()
gWriteFields Settings
s SmallMutableArray s (Field a)
SmallMutableArray s (Field (a :*: b))
marr Int
0 (:*:) a b a
x
        Proxy# (a :*: b)
-> SmallMutableArray s (Field (a :*: b)) -> ST s Value
forall k (f :: k -> *) s.
GMergeFields f =>
Proxy# f -> SmallMutableArray s (Field f) -> ST s Value
gMergeFields (Proxy# (a :*: b)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (a :*: b)) SmallMutableArray s (Field a)
SmallMutableArray s (Field (a :*: b))
marr)
    gConstrToValue Bool
True Settings
s (M1 (:*:) a b a
x) =
        let !k :: Text
k = Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
            !v :: Value
v = (forall s. ST s Value) -> Value
forall a. (forall s. ST s a) -> a
runST (do
                    SmallMutableArray s (Field a)
marr <- Int
-> Field a -> ST s (SmallMutableArray (PrimState (ST s)) (Field a))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
A.newSmallArray (Proxy# (a :*: b) -> Int
forall (f :: * -> *). KnownNat (PSize f) => Proxy# f -> Int
productSize (Proxy# (a :*: b)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (a :*: b))) Field a
forall a. HasCallStack => a
undefined
                    Settings
-> SmallMutableArray s (Field (a :*: b))
-> Int
-> (:*:) a b a
-> ST s ()
forall k (f :: k -> *) s (a :: k).
GWriteFields f =>
Settings -> SmallMutableArray s (Field f) -> Int -> f a -> ST s ()
gWriteFields Settings
s SmallMutableArray s (Field a)
SmallMutableArray s (Field (a :*: b))
marr Int
0 (:*:) a b a
x
                    Proxy# (a :*: b)
-> SmallMutableArray s (Field (a :*: b)) -> ST s Value
forall k (f :: k -> *) s.
GMergeFields f =>
Proxy# f -> SmallMutableArray s (Field f) -> ST s Value
gMergeFields (Proxy# (a :*: b)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (a :*: b)) SmallMutableArray s (Field a)
SmallMutableArray s (Field (a :*: b))
marr)
        in Vector (Text, Value) -> Value
Object ((Text, Value) -> Vector (Text, Value)
forall (v :: * -> *) a. Vec v a => a -> v a
V.singleton (Text
k, Value
v))

--------------------------------------------------------------------------------
-- Data types
instance GConstrToValue f => GToValue (D1 c f) where
    {-# INLINE gToValue #-}
    gToValue :: Settings -> D1 c f a -> Value
gToValue Settings
s (M1 f a
x) = Bool -> Settings -> f a -> Value
forall k (f :: k -> *) (a :: k).
GConstrToValue f =>
Bool -> Settings -> f a -> Value
gConstrToValue Bool
False Settings
s f a
x

--------------------------------------------------------------------------------
-- JSON
--------------------------------------------------------------------------------

class GEncodeJSON f where
    gEncodeJSON :: Settings -> f a -> B.Builder ()

--------------------------------------------------------------------------------
-- Selectors

instance (GEncodeJSON f, Selector (MetaSel (Just l) u ss ds)) => GEncodeJSON (S1 (MetaSel (Just l) u ss ds) f) where
    {-# INLINE gEncodeJSON #-}
    gEncodeJSON :: Settings -> S1 ('MetaSel ('Just l) u ss ds) f a -> Builder ()
gEncodeJSON Settings
s m1 :: S1 ('MetaSel ('Just l) u ss ds) f a
m1@(M1 f a
x) = (Settings -> [Char] -> Text
fieldFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ S1 ('MetaSel ('Just l) u ss ds) f a -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName S1 ('MetaSel ('Just l) u ss ds) f a
m1) Text -> Builder () -> Builder ()
`JB.kv` Settings -> f a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s f a
x

instance GEncodeJSON f => GEncodeJSON (S1 (MetaSel Nothing u ss ds) f) where
    {-# INLINE gEncodeJSON #-}
    gEncodeJSON :: Settings -> S1 ('MetaSel 'Nothing u ss ds) f a -> Builder ()
gEncodeJSON Settings
s (M1 f a
x) = Settings -> f a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s f a
x

instance (GEncodeJSON a, GEncodeJSON b) => GEncodeJSON (a :*: b) where
    {-# INLINE gEncodeJSON #-}
    gEncodeJSON :: Settings -> (:*:) a b a -> Builder ()
gEncodeJSON Settings
s (a a
a :*: b a
b) = Settings -> a a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s a a
a Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
B.comma Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Settings -> b a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s b a
b

instance JSON a => GEncodeJSON (K1 i a) where
    {-# INLINE gEncodeJSON #-}
    gEncodeJSON :: Settings -> K1 i a a -> Builder ()
gEncodeJSON Settings
_ (K1 a
x) = a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON a
x

class GAddPunctuation (f :: Type -> Type) where
    gAddPunctuation :: Proxy# f -> B.Builder () -> B.Builder ()

instance GAddPunctuation a => GAddPunctuation (a :*: b) where
    {-# INLINE gAddPunctuation #-}
    gAddPunctuation :: Proxy# (a :*: b) -> Builder () -> Builder ()
gAddPunctuation Proxy# (a :*: b)
_ = Proxy# a -> Builder () -> Builder ()
forall (f :: * -> *).
GAddPunctuation f =>
Proxy# f -> Builder () -> Builder ()
gAddPunctuation (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a)

instance GAddPunctuation (S1 (MetaSel Nothing u ss ds) f) where
    {-# INLINE gAddPunctuation #-}
    gAddPunctuation :: Proxy# (S1 ('MetaSel 'Nothing u ss ds) f)
-> Builder () -> Builder ()
gAddPunctuation Proxy# (S1 ('MetaSel 'Nothing u ss ds) f)
_ Builder ()
b = Builder () -> Builder ()
B.square Builder ()
b

instance GAddPunctuation (S1 (MetaSel (Just l) u ss ds) f) where
    {-# INLINE gAddPunctuation #-}
    gAddPunctuation :: Proxy# (S1 ('MetaSel ('Just l) u ss ds) f)
-> Builder () -> Builder ()
gAddPunctuation Proxy# (S1 ('MetaSel ('Just l) u ss ds) f)
_ Builder ()
b = Builder () -> Builder ()
B.curly Builder ()
b

--------------------------------------------------------------------------------
-- Constructors

class GConstrEncodeJSON f where
    gConstrEncodeJSON :: Bool -> Settings -> f a -> B.Builder ()

instance GConstrEncodeJSON V1 where
    {-# INLINE gConstrEncodeJSON #-}
    gConstrEncodeJSON :: Bool -> Settings -> V1 a -> Builder ()
gConstrEncodeJSON Bool
_ Settings
_ V1 a
_ = [Char] -> Builder ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Z.Data.JSON.Base: empty data type"

instance (GConstrEncodeJSON f, GConstrEncodeJSON g) => GConstrEncodeJSON (f :+: g) where
    {-# INLINE gConstrEncodeJSON #-}
    gConstrEncodeJSON :: Bool -> Settings -> (:+:) f g a -> Builder ()
gConstrEncodeJSON Bool
_ Settings
s (L1 f a
x) = Bool -> Settings -> f a -> Builder ()
forall k (f :: k -> *) (a :: k).
GConstrEncodeJSON f =>
Bool -> Settings -> f a -> Builder ()
gConstrEncodeJSON Bool
True Settings
s f a
x
    gConstrEncodeJSON Bool
_ Settings
s (R1 g a
x) = Bool -> Settings -> g a -> Builder ()
forall k (f :: k -> *) (a :: k).
GConstrEncodeJSON f =>
Bool -> Settings -> f a -> Builder ()
gConstrEncodeJSON Bool
True Settings
s g a
x

-- | Constructor without payload, convert to String
instance (Constructor c) => GConstrEncodeJSON (C1 c U1) where
    {-# INLINE gConstrEncodeJSON #-}
    -- There should be no chars need escaping in constructor name
    gConstrEncodeJSON :: Bool -> Settings -> C1 c U1 a -> Builder ()
gConstrEncodeJSON Bool
_ Settings
s (M1 U1 a
_) = Builder () -> Builder ()
B.quotes (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$
        Text -> Builder ()
B.text (Text -> Builder ()) -> ([Char] -> Text) -> [Char] -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Builder ()) -> [Char] -> Builder ()
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName (forall k k (t :: Meta -> (k -> *) -> k -> *) (a :: k). t c U1 a
forall a. HasCallStack => a
undefined :: t c U1 a)

-- | Constructor with a single payload
instance (Constructor c, GEncodeJSON (S1 (MetaSel Nothing u ss ds) f))
    => GConstrEncodeJSON (C1 c (S1 (MetaSel Nothing u ss ds) f)) where
    {-# INLINE gConstrEncodeJSON #-}
    gConstrEncodeJSON :: Bool
-> Settings
-> C1 c (S1 ('MetaSel 'Nothing u ss ds) f) a
-> Builder ()
gConstrEncodeJSON Bool
False Settings
s (M1 S1 ('MetaSel 'Nothing u ss ds) f a
x) = Settings -> S1 ('MetaSel 'Nothing u ss ds) f a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s S1 ('MetaSel 'Nothing u ss ds) f a
x
    gConstrEncodeJSON Bool
True Settings
s (M1 S1 ('MetaSel 'Nothing u ss ds) f a
x) = Builder () -> Builder ()
B.curly (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        (Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined) Text -> Builder () -> Builder ()
`JB.kv` Settings -> S1 ('MetaSel 'Nothing u ss ds) f a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s S1 ('MetaSel 'Nothing u ss ds) f a
x

instance (Constructor c, GEncodeJSON (S1 (MetaSel (Just l) u ss ds) f))
    => GConstrEncodeJSON (C1 c (S1 (MetaSel (Just l) u ss ds) f)) where
    {-# INLINE gConstrEncodeJSON #-}
    gConstrEncodeJSON :: Bool
-> Settings
-> C1 c (S1 ('MetaSel ('Just l) u ss ds) f) a
-> Builder ()
gConstrEncodeJSON Bool
False Settings
s (M1 S1 ('MetaSel ('Just l) u ss ds) f a
x) = Builder () -> Builder ()
B.curly (Settings -> S1 ('MetaSel ('Just l) u ss ds) f a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s S1 ('MetaSel ('Just l) u ss ds) f a
x)
    gConstrEncodeJSON Bool
True Settings
s (M1 S1 ('MetaSel ('Just l) u ss ds) f a
x) = Builder () -> Builder ()
B.curly (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        (Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined) Text -> Builder () -> Builder ()
`JB.kv` Builder () -> Builder ()
B.curly (Settings -> S1 ('MetaSel ('Just l) u ss ds) f a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s S1 ('MetaSel ('Just l) u ss ds) f a
x)

-- | Constructor with multiple payloads
instance (GEncodeJSON (a :*: b), GAddPunctuation (a :*: b), Constructor c)
    => GConstrEncodeJSON (C1 c (a :*: b)) where
    {-# INLINE gConstrEncodeJSON #-}
    gConstrEncodeJSON :: Bool -> Settings -> C1 c (a :*: b) a -> Builder ()
gConstrEncodeJSON Bool
False Settings
s (M1 (:*:) a b a
x) = Proxy# (a :*: b) -> Builder () -> Builder ()
forall (f :: * -> *).
GAddPunctuation f =>
Proxy# f -> Builder () -> Builder ()
gAddPunctuation (Proxy# (a :*: b)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (a :*: b)) (Settings -> (:*:) a b a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s (:*:) a b a
x)
    gConstrEncodeJSON Bool
True Settings
s (M1 (:*:) a b a
x) = Builder () -> Builder ()
B.curly (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        (Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c @_ @_ @_ Any c Any Any
forall a. HasCallStack => a
undefined) Text -> Builder () -> Builder ()
`JB.kv`
            Proxy# (a :*: b) -> Builder () -> Builder ()
forall (f :: * -> *).
GAddPunctuation f =>
Proxy# f -> Builder () -> Builder ()
gAddPunctuation (Proxy# (a :*: b)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (a :*: b)) (Settings -> (:*:) a b a -> Builder ()
forall k (f :: k -> *) (a :: k).
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s (:*:) a b a
x)

--------------------------------------------------------------------------------
-- Data types
instance GConstrEncodeJSON f => GEncodeJSON (D1 c f) where
    {-# INLINE gEncodeJSON #-}
    gEncodeJSON :: Settings -> D1 c f a -> Builder ()
gEncodeJSON Settings
s (M1 f a
x) = Bool -> Settings -> f a -> Builder ()
forall k (f :: k -> *) (a :: k).
GConstrEncodeJSON f =>
Bool -> Settings -> f a -> Builder ()
gConstrEncodeJSON Bool
False Settings
s f a
x

--------------------------------------------------------------------------------
-- GFromValue
--------------------------------------------------------------------------------

class GFromValue f where
    gFromValue :: Settings -> Value -> Converter (f a)

--------------------------------------------------------------------------------
-- Selectors

type family LookupTable f where
    LookupTable (a :*: b) = LookupTable a
    LookupTable (S1 (MetaSel Nothing u ss ds) f) = V.Vector Value
    LookupTable (S1 (MetaSel (Just l) u ss ds) f) = FM.FlatMap T.Text Value

class GFromFields f where
    gFromFields :: Settings -> LookupTable f -> Int -> Converter (f a)

instance (ProductSize a, GFromFields a, GFromFields b, LookupTable a ~ LookupTable b)
    => GFromFields (a :*: b) where
    {-# INLINE gFromFields #-}
    gFromFields :: Settings -> LookupTable (a :*: b) -> Int -> Converter ((:*:) a b a)
gFromFields Settings
s LookupTable (a :*: b)
v Int
idx = do
        !a a
a <- Settings -> LookupTable a -> Int -> Converter (a a)
forall k (f :: k -> *) (a :: k).
GFromFields f =>
Settings -> LookupTable f -> Int -> Converter (f a)
gFromFields Settings
s LookupTable a
LookupTable (a :*: b)
v Int
idx
        !b a
b <- Settings -> LookupTable b -> Int -> Converter (b a)
forall k (f :: k -> *) (a :: k).
GFromFields f =>
Settings -> LookupTable f -> Int -> Converter (f a)
gFromFields Settings
s LookupTable b
LookupTable (a :*: b)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy# a -> Int
forall (f :: * -> *). KnownNat (PSize f) => Proxy# f -> Int
productSize (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a))
        (:*:) a b a -> Converter ((:*:) a b a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a a
a a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
b)

instance (GFromValue f) => GFromFields (S1 (MetaSel Nothing u ss ds) f) where
    {-# INLINE gFromFields #-}
    gFromFields :: Settings
-> LookupTable (S1 ('MetaSel 'Nothing u ss ds) f)
-> Int
-> Converter (S1 ('MetaSel 'Nothing u ss ds) f a)
gFromFields Settings
s LookupTable (S1 ('MetaSel 'Nothing u ss ds) f)
v Int
idx = do
        Value
v' <- Vector Value -> Int -> Converter Value
forall (v :: * -> *) a (m :: * -> *).
(Vec v a, Monad m) =>
v a -> Int -> m a
V.unsafeIndexM Vector Value
LookupTable (S1 ('MetaSel 'Nothing u ss ds) f)
v Int
idx
        f a -> S1 ('MetaSel 'Nothing u ss ds) f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> S1 ('MetaSel 'Nothing u ss ds) f a)
-> Converter (f a)
-> Converter (S1 ('MetaSel 'Nothing u ss ds) f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> Value -> Converter (f a)
forall k (f :: k -> *) (a :: k).
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
s Value
v' Converter (f a) -> PathElement -> Converter (f a)
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
idx

instance (GFromValue f, Selector (MetaSel (Just l) u ss ds)) => GFromFields (S1 (MetaSel (Just l) u ss ds) f) where
    {-# INLINE gFromFields #-}
    gFromFields :: Settings
-> LookupTable (S1 ('MetaSel ('Just l) u ss ds) f)
-> Int
-> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
gFromFields Settings
s LookupTable (S1 ('MetaSel ('Just l) u ss ds) f)
v Int
_ = do
        case Text -> FlatMap Text Value -> Maybe Value
forall k v. Ord k => k -> FlatMap k v -> Maybe v
FM.lookup Text
fn FlatMap Text Value
LookupTable (S1 ('MetaSel ('Just l) u ss ds) f)
v of
            Just Value
v' -> f a -> S1 ('MetaSel ('Just l) u ss ds) f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> S1 ('MetaSel ('Just l) u ss ds) f a)
-> Converter (f a)
-> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> Value -> Converter (f a)
forall k (f :: k -> *) (a :: k).
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
s Value
v' Converter (f a) -> PathElement -> Converter (f a)
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
fn
            Maybe Value
_ | Settings -> Bool
missingKeyAsNull Settings
s -> f a -> S1 ('MetaSel ('Just l) u ss ds) f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> S1 ('MetaSel ('Just l) u ss ds) f a)
-> Converter (f a)
-> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> Value -> Converter (f a)
forall k (f :: k -> *) (a :: k).
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
s Value
Null Converter (f a) -> PathElement -> Converter (f a)
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
fn
              | Bool
otherwise -> Text -> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
forall a. Text -> Converter a
fail' (Text
"Z.Data.JSON.Base: missing field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
fn)
      where
        fn :: Text
fn = (Settings -> [Char] -> Text
fieldFmt Settings
s) (M1 S ('MetaSel ('Just l) u ss ds) f Any -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName (forall (a :: k). M1 S ('MetaSel ('Just l) u ss ds) f a
forall a. HasCallStack => a
undefined :: S1 (MetaSel (Just l) u ss ds) f a))

instance GFromValue f => GFromValue (S1 (MetaSel Nothing u ss ds) f) where
    {-# INLINE gFromValue #-}
    gFromValue :: Settings -> Value -> Converter (S1 ('MetaSel 'Nothing u ss ds) f a)
gFromValue Settings
s Value
x = f a -> S1 ('MetaSel 'Nothing u ss ds) f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> S1 ('MetaSel 'Nothing u ss ds) f a)
-> Converter (f a)
-> Converter (S1 ('MetaSel 'Nothing u ss ds) f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> Value -> Converter (f a)
forall k (f :: k -> *) (a :: k).
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
s Value
x

instance (GFromValue f, Selector (MetaSel (Just l) u ss ds)) => GFromValue (S1 (MetaSel (Just l) u ss ds) f) where
    {-# INLINE gFromValue #-}
    gFromValue :: Settings
-> Value -> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
gFromValue Settings
s (Object Vector (Text, Value)
v) = do
        case Text -> FlatMap Text Value -> Maybe Value
forall k v. Ord k => k -> FlatMap k v -> Maybe v
FM.lookup Text
fn (Vector (Text, Value) -> FlatMap Text Value
forall k v. Ord k => Vector (k, v) -> FlatMap k v
FM.packVectorR Vector (Text, Value)
v) of
            Just Value
v' -> f a -> S1 ('MetaSel ('Just l) u ss ds) f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> S1 ('MetaSel ('Just l) u ss ds) f a)
-> Converter (f a)
-> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> Value -> Converter (f a)
forall k (f :: k -> *) (a :: k).
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
s Value
v' Converter (f a) -> PathElement -> Converter (f a)
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
fn
            Maybe Value
_ | Settings -> Bool
missingKeyAsNull Settings
s -> f a -> S1 ('MetaSel ('Just l) u ss ds) f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> S1 ('MetaSel ('Just l) u ss ds) f a)
-> Converter (f a)
-> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> Value -> Converter (f a)
forall k (f :: k -> *) (a :: k).
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
s Value
Null Converter (f a) -> PathElement -> Converter (f a)
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
fn
              | Bool
otherwise -> Text -> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
forall a. Text -> Converter a
fail' (Text
"Z.Data.JSON.Base: missing field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
fn)
      where fn :: Text
fn = (Settings -> [Char] -> Text
fieldFmt Settings
s) (M1 S ('MetaSel ('Just l) u ss ds) f Any -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName (forall (a :: k). M1 S ('MetaSel ('Just l) u ss ds) f a
forall a. HasCallStack => a
undefined :: S1 (MetaSel (Just l) u ss ds) f a))
    gFromValue Settings
s Value
v = Text
-> Text -> Value -> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
forall a. Text -> Text -> Value -> Converter a
typeMismatch (Text
"field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fn) Text
"Object" Value
v Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
-> PathElement -> Converter (S1 ('MetaSel ('Just l) u ss ds) f a)
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
fn
      where fn :: Text
fn = (Settings -> [Char] -> Text
fieldFmt Settings
s) (M1 S ('MetaSel ('Just l) u ss ds) f Any -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName (forall (a :: k). M1 S ('MetaSel ('Just l) u ss ds) f a
forall a. HasCallStack => a
undefined :: S1 (MetaSel (Just l) u ss ds) f a))

instance JSON a => GFromValue (K1 i a) where
    {-# INLINE gFromValue #-}
    gFromValue :: Settings -> Value -> Converter (K1 i a a)
gFromValue Settings
_ Value
x = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> Converter a -> Converter (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
x

class GBuildLookup f where
    gBuildLookup :: Proxy# f -> Int -> T.Text -> Value -> Converter (LookupTable f)

instance (GBuildLookup a, GBuildLookup b) => GBuildLookup (a :*: b) where
    {-# INLINE gBuildLookup #-}
    gBuildLookup :: Proxy# (a :*: b)
-> Int -> Text -> Value -> Converter (LookupTable (a :*: b))
gBuildLookup Proxy# (a :*: b)
_ Int
siz = Proxy# a -> Int -> Text -> Value -> Converter (LookupTable a)
forall k (f :: k -> *).
GBuildLookup f =>
Proxy# f -> Int -> Text -> Value -> Converter (LookupTable f)
gBuildLookup (Proxy# a
forall k (a :: k). Proxy# a
proxy# :: Proxy# a) Int
siz

instance GBuildLookup (S1 (MetaSel Nothing u ss ds) f) where
    {-# INLINE gBuildLookup #-}
    gBuildLookup :: Proxy# (S1 ('MetaSel 'Nothing u ss ds) f)
-> Int
-> Text
-> Value
-> Converter (LookupTable (S1 ('MetaSel 'Nothing u ss ds) f))
gBuildLookup Proxy# (S1 ('MetaSel 'Nothing u ss ds) f)
_ Int
siz Text
name (Array Vector Value
v)
        -- we have to check size here to use 'unsafeIndexM' later
        | Int
siz' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
siz = Text -> Converter (Vector Value)
forall a. Text -> Converter a
fail' (Text -> Converter (Vector Value))
-> (Builder () -> Text) -> Builder () -> Converter (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Text
forall a. Builder a -> Text
B.unsafeBuildText (Builder () -> Converter (Vector Value))
-> Builder () -> Converter (Vector Value)
forall a b. (a -> b) -> a -> b
$ do
            Builder ()
"converting "
            Text -> Builder ()
T.text Text
name
            Builder ()
" failed, product size mismatch, expected "
            Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
T.int Int
siz
            Builder ()
", get"
            Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
T.int Int
siz'
        | Bool
otherwise = Vector Value -> Converter (Vector Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector Value
v
      where siz' :: Int
siz' = Vector Value -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Vector Value
v
    gBuildLookup Proxy# (S1 ('MetaSel 'Nothing u ss ds) f)
_ Int
_   Text
name Value
x         = Text -> Text -> Value -> Converter (Vector Value)
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Array" Value
x

instance GBuildLookup (S1 ((MetaSel (Just l) u ss ds)) f) where
    {-# INLINE gBuildLookup #-}
    -- we don't check size, so that duplicated keys are preserved
    gBuildLookup :: Proxy# (S1 ('MetaSel ('Just l) u ss ds) f)
-> Int
-> Text
-> Value
-> Converter (LookupTable (S1 ('MetaSel ('Just l) u ss ds) f))
gBuildLookup Proxy# (S1 ('MetaSel ('Just l) u ss ds) f)
_ Int
_ Text
_ (Object Vector (Text, Value)
v) = FlatMap Text Value -> Converter (FlatMap Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FlatMap Text Value -> Converter (FlatMap Text Value))
-> FlatMap Text Value -> Converter (FlatMap Text Value)
forall a b. (a -> b) -> a -> b
$! Vector (Text, Value) -> FlatMap Text Value
forall k v. Ord k => Vector (k, v) -> FlatMap k v
FM.packVectorR Vector (Text, Value)
v
    gBuildLookup Proxy# (S1 ('MetaSel ('Just l) u ss ds) f)
_ Int
_ Text
name Value
x       = Text -> Text -> Value -> Converter (FlatMap Text Value)
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
name Text
"Object" Value
x

--------------------------------------------------------------------------------
-- Constructors

class GConstrFromValue f where
    gConstrFromValue :: Bool    -- ^ Is this a sum type(more than one constructor)?
                     -> Settings -> Value -> Converter (f a)

instance GConstrFromValue V1 where
    {-# INLINE gConstrFromValue #-}
    gConstrFromValue :: Bool -> Settings -> Value -> Converter (V1 a)
gConstrFromValue Bool
_ Settings
_ Value
_ = [Char] -> Converter (V1 a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Z.Data.JSON.Base: empty data type"

instance (GConstrFromValue f, GConstrFromValue g) => GConstrFromValue (f :+: g) where
    {-# INLINE gConstrFromValue #-}
    gConstrFromValue :: Bool -> Settings -> Value -> Converter ((:+:) f g a)
gConstrFromValue Bool
_ Settings
s Value
x = (f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> (:+:) f g a) -> Converter (f a) -> Converter ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Settings -> Value -> Converter (f a)
forall k (f :: k -> *) (a :: k).
GConstrFromValue f =>
Bool -> Settings -> Value -> Converter (f a)
gConstrFromValue Bool
True Settings
s Value
x) Converter ((:+:) f g a)
-> Converter ((:+:) f g a) -> Converter ((:+:) f g a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> (:+:) f g a) -> Converter (g a) -> Converter ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Settings -> Value -> Converter (g a)
forall k (f :: k -> *) (a :: k).
GConstrFromValue f =>
Bool -> Settings -> Value -> Converter (f a)
gConstrFromValue Bool
True Settings
s Value
x)

-- | Constructor without payload, convert to String
instance (Constructor c) => GConstrFromValue (C1 c U1) where
    {-# INLINE gConstrFromValue #-}
    gConstrFromValue :: Bool -> Settings -> Value -> Converter (C1 c U1 a)
gConstrFromValue Bool
_ Settings
s (String Text
x)
        | Text
cn Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x   = C1 c U1 a -> Converter (C1 c U1 a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 a -> C1 c U1 a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 U1 a
forall k (p :: k). U1 p
U1)
        | Bool
otherwise = Text -> Converter (C1 c U1 a)
forall a. Text -> Converter a
fail' (Text -> Converter (C1 c U1 a))
-> (ParseError -> Text) -> ParseError -> Converter (C1 c U1 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Text
T.concat (ParseError -> Converter (C1 c U1 a))
-> ParseError -> Converter (C1 c U1 a)
forall a b. (a -> b) -> a -> b
$ [Text
"converting ", Text
cn', Text
"failed, unknown constructor name ", Text
x]
      where cn :: Text
cn = Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName (forall k k (t :: Meta -> (k -> *) -> k -> *) (a :: k). t c U1 a
forall a. HasCallStack => a
undefined :: t c U1 a)
            cn' :: Text
cn' = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName (forall k k (t :: Meta -> (k -> *) -> k -> *) (a :: k). t c U1 a
forall a. HasCallStack => a
undefined :: t c U1 a)
    gConstrFromValue Bool
_ Settings
_ Value
v = Text -> Text -> Value -> Converter (C1 c U1 a)
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
cn' Text
"String" Value
v
      where cn' :: Text
cn' = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName (forall k k (t :: Meta -> (k -> *) -> k -> *) (a :: k). t c U1 a
forall a. HasCallStack => a
undefined :: t c U1 a)

-- | Constructor with a single payload
instance (Constructor c, GFromValue (S1 sc f)) => GConstrFromValue (C1 c (S1 sc f)) where
    {-# INLINE gConstrFromValue #-}
    -- | Single constructor
    gConstrFromValue :: Bool -> Settings -> Value -> Converter (C1 c (S1 sc f) a)
gConstrFromValue Bool
False Settings
s Value
x = S1 sc f a -> C1 c (S1 sc f) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (S1 sc f a -> C1 c (S1 sc f) a)
-> Converter (S1 sc f a) -> Converter (C1 c (S1 sc f) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> Value -> Converter (S1 sc f a)
forall k (f :: k -> *) (a :: k).
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
s Value
x
    gConstrFromValue Bool
True Settings
s Value
x = case Value
x of
        Object Vector (Text, Value)
v -> case Vector (Text, Value) -> Int -> Maybe (Text, Value)
forall (v :: * -> *) a (m :: * -> *).
(Vec v a, Monad m, HasCallStack) =>
v a -> Int -> m a
V.indexM Vector (Text, Value)
v Int
0 of
            Just (Text
k, Value
v') | Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
cn -> S1 sc f a -> C1 c (S1 sc f) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (S1 sc f a -> C1 c (S1 sc f) a)
-> Converter (S1 sc f a) -> Converter (C1 c (S1 sc f) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> Value -> Converter (S1 sc f a)
forall k (f :: k -> *) (a :: k).
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
s Value
v' Converter (S1 sc f a) -> PathElement -> Converter (S1 sc f a)
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
cn
            Maybe (Text, Value)
_                      -> Text -> Converter (C1 c (S1 sc f) a)
forall a. Text -> Converter a
fail' (Text -> Converter (C1 c (S1 sc f) a))
-> (ParseError -> Text)
-> ParseError
-> Converter (C1 c (S1 sc f) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ParseError -> Text
T.concat (ParseError -> Converter (C1 c (S1 sc f) a))
-> ParseError -> Converter (C1 c (S1 sc f) a)
forall a b. (a -> b) -> a -> b
$ [Text
"converting ", Text
cn', Text
" failed, constructor not found"]
        Value
_ ->  Text -> Text -> Value -> Converter (C1 c (S1 sc f) a)
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
cn' Text
"Object" Value
x
      where cn :: Text
cn = Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
            cn' :: Text
cn' = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined

-- | Constructor with multiple payloads
instance (ProductSize (a :*: b), GFromFields (a :*: b), GBuildLookup (a :*: b), Constructor c)
    => GConstrFromValue (C1 c (a :*: b)) where
    {-# INLINE gConstrFromValue #-}
    gConstrFromValue :: Bool -> Settings -> Value -> Converter (C1 c (a :*: b) a)
gConstrFromValue Bool
False Settings
s Value
x = do
        LookupTable a
t <- Proxy# (a :*: b)
-> Int -> Text -> Value -> Converter (LookupTable (a :*: b))
forall k (f :: k -> *).
GBuildLookup f =>
Proxy# f -> Int -> Text -> Value -> Converter (LookupTable f)
gBuildLookup Proxy# (a :*: b)
p (Proxy# (a :*: b) -> Int
forall (f :: * -> *). KnownNat (PSize f) => Proxy# f -> Int
productSize Proxy# (a :*: b)
p) Text
cn' Value
x
        (:*:) a b a -> C1 c (a :*: b) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((:*:) a b a -> C1 c (a :*: b) a)
-> Converter ((:*:) a b a) -> Converter (C1 c (a :*: b) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> LookupTable (a :*: b) -> Int -> Converter ((:*:) a b a)
forall k (f :: k -> *) (a :: k).
GFromFields f =>
Settings -> LookupTable f -> Int -> Converter (f a)
gFromFields Settings
s LookupTable a
LookupTable (a :*: b)
t Int
0
      where cn' :: Text
cn' = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
            p :: Proxy# (a :*: b)
p = Proxy# (a :*: b)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (a :*: b)
    gConstrFromValue Bool
True Settings
s Value
x = case Value
x of
        Object Vector (Text, Value)
v -> case Vector (Text, Value) -> Int -> Maybe (Text, Value)
forall (v :: * -> *) a (m :: * -> *).
(Vec v a, Monad m, HasCallStack) =>
v a -> Int -> m a
V.indexM Vector (Text, Value)
v Int
0 of
            Just (Text
k, Value
v') | Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
cn -> do LookupTable a
t <- Proxy# (a :*: b)
-> Int -> Text -> Value -> Converter (LookupTable (a :*: b))
forall k (f :: k -> *).
GBuildLookup f =>
Proxy# f -> Int -> Text -> Value -> Converter (LookupTable f)
gBuildLookup Proxy# (a :*: b)
p (Proxy# (a :*: b) -> Int
forall (f :: * -> *). KnownNat (PSize f) => Proxy# f -> Int
productSize Proxy# (a :*: b)
p) Text
cn' Value
v'
                                         (:*:) a b a -> C1 c (a :*: b) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((:*:) a b a -> C1 c (a :*: b) a)
-> Converter ((:*:) a b a) -> Converter (C1 c (a :*: b) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Settings -> LookupTable (a :*: b) -> Int -> Converter ((:*:) a b a)
forall k (f :: k -> *) (a :: k).
GFromFields f =>
Settings -> LookupTable f -> Int -> Converter (f a)
gFromFields Settings
s LookupTable a
LookupTable (a :*: b)
t Int
0
            Maybe (Text, Value)
_                      -> Text -> Converter (C1 c (a :*: b) a)
forall a. Text -> Converter a
fail' (Text -> Converter (C1 c (a :*: b) a))
-> (ParseError -> Text)
-> ParseError
-> Converter (C1 c (a :*: b) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ParseError -> Text
T.concat (ParseError -> Converter (C1 c (a :*: b) a))
-> ParseError -> Converter (C1 c (a :*: b) a)
forall a b. (a -> b) -> a -> b
$ [Text
"converting ", Text
cn', Text
" failed, constructor not found"]
        Value
_ ->  Text -> Text -> Value -> Converter (C1 c (a :*: b) a)
forall a. Text -> Text -> Value -> Converter a
typeMismatch Text
cn' Text
"Object" Value
x
      where cn :: Text
cn = Settings -> [Char] -> Text
constrFmt Settings
s ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
            cn' :: Text
cn' = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
            p :: Proxy# (a :*: b)
p = Proxy# (a :*: b)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (a :*: b)

--------------------------------------------------------------------------------
-- Data types
instance GConstrFromValue f => GFromValue (D1 c f) where
    {-# INLINE gFromValue #-}
    gFromValue :: Settings -> Value -> Converter (D1 c f a)
gFromValue Settings
s Value
x = f a -> D1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> D1 c f a) -> Converter (f a) -> Converter (D1 c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Settings -> Value -> Converter (f a)
forall k (f :: k -> *) (a :: k).
GConstrFromValue f =>
Bool -> Settings -> Value -> Converter (f a)
gConstrFromValue Bool
False Settings
s Value
x

--------------------------------------------------------------------------------
-- Built-in Instances
--------------------------------------------------------------------------------

instance JSON Value   where
    {-# INLINE fromValue #-}; fromValue :: Value -> Converter Value
fromValue = Value -> Converter Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure;
    {-# INLINE toValue #-}; toValue :: Value -> Value
toValue = Value -> Value
forall a. a -> a
id;
    {-# INLINE encodeJSON #-}; encodeJSON :: Value -> Builder ()
encodeJSON = Value -> Builder ()
JB.value;

instance JSON T.Text   where
    {-# INLINE fromValue #-}; fromValue :: Value -> Converter Text
fromValue = Text -> (Text -> Converter Text) -> Value -> Converter Text
forall a. Text -> (Text -> Converter a) -> Value -> Converter a
withText Text
"Text" Text -> Converter Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure;
    {-# INLINE toValue #-}; toValue :: Text -> Value
toValue = Text -> Value
String;
    {-# INLINE encodeJSON #-}; encodeJSON :: Text -> Builder ()
encodeJSON = Text -> Builder ()
JB.string;

-- | Note this instance doesn't reject large input
instance JSON Scientific where
    {-# INLINE fromValue #-}; fromValue :: Value -> Converter Scientific
fromValue = Text
-> (Scientific -> Converter Scientific)
-> Value
-> Converter Scientific
forall a.
Text -> (Scientific -> Converter a) -> Value -> Converter a
withScientific Text
"Scientific" Scientific -> Converter Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure;
    {-# INLINE toValue #-}; toValue :: Scientific -> Value
toValue = Scientific -> Value
Number;
    {-# INLINE encodeJSON #-}; encodeJSON :: Scientific -> Builder ()
encodeJSON = Scientific -> Builder ()
B.scientific';

-- | default instance prefer later key
instance JSON a => JSON (FM.FlatMap T.Text a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (FlatMap Text a)
fromValue = Text
-> (FlatMap Text Value -> Converter (FlatMap Text a))
-> Value
-> Converter (FlatMap Text a)
forall a.
Text -> (FlatMap Text Value -> Converter a) -> Value -> Converter a
withFlatMapR Text
"Z.Data.Vector.FlatMap.FlatMap"
        ((Text -> Value -> Converter a)
-> FlatMap Text Value -> Converter (FlatMap Text a)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> FlatMap k a -> t (FlatMap k b)
FM.traverseWithKey ((Text -> Value -> Converter a)
 -> FlatMap Text Value -> Converter (FlatMap Text a))
-> (Text -> Value -> Converter a)
-> FlatMap Text Value
-> Converter (FlatMap Text a)
forall a b. (a -> b) -> a -> b
$ \ Text
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
k)
    {-# INLINE toValue #-}
    toValue :: FlatMap Text a -> Value
toValue = Vector (Text, Value) -> Value
Object (Vector (Text, Value) -> Value)
-> (FlatMap Text a -> Vector (Text, Value))
-> FlatMap Text a
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatMap Text Value -> Vector (Text, Value)
forall k v. FlatMap k v -> Vector (k, v)
FM.sortedKeyValues (FlatMap Text Value -> Vector (Text, Value))
-> (FlatMap Text a -> FlatMap Text Value)
-> FlatMap Text a
-> Vector (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> FlatMap Text a -> FlatMap Text Value
forall v v' k. (v -> v') -> FlatMap k v -> FlatMap k v'
FM.map' a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: FlatMap Text a -> Builder ()
encodeJSON = (a -> Builder ()) -> Vector (Text, a) -> Builder ()
forall a. (a -> Builder ()) -> Vector (Text, a) -> Builder ()
JB.object' a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON (Vector (Text, a) -> Builder ())
-> (FlatMap Text a -> Vector (Text, a))
-> FlatMap Text a
-> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatMap Text a -> Vector (Text, a)
forall k v. FlatMap k v -> Vector (k, v)
FM.sortedKeyValues

instance (Ord a, JSON a) => JSON (FS.FlatSet a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (FlatSet a)
fromValue = Text
-> (Vector Value -> Converter (FlatSet a))
-> Value
-> Converter (FlatSet a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Z.Data.Vector.FlatSet.FlatSet" ((Vector Value -> Converter (FlatSet a))
 -> Value -> Converter (FlatSet a))
-> (Vector Value -> Converter (FlatSet a))
-> Value
-> Converter (FlatSet a)
forall a b. (a -> b) -> a -> b
$ \ Vector Value
vs ->
        Int -> [a] -> FlatSet a
forall v. Ord v => Int -> [v] -> FlatSet v
FS.packRN (Vector Value -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Vector Value
vs) ([a] -> FlatSet a) -> Converter [a] -> Converter (FlatSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            ((Int -> Value -> Converter a) -> [Int] -> [Value] -> Converter [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k) [Int
0..] (Vector Value -> [Value]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector Value
vs))
    {-# INLINE toValue #-}
    toValue :: FlatSet a -> Value
toValue = Vector Value -> Value
Array (Vector Value -> Value)
-> (FlatSet a -> Vector Value) -> FlatSet a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Vector a -> Vector Value
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map' a -> Value
forall a. JSON a => a -> Value
toValue (Vector a -> Vector Value)
-> (FlatSet a -> Vector a) -> FlatSet a -> Vector Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatSet a -> Vector a
forall v. FlatSet v -> Vector v
FS.sortedValues
    {-# INLINE encodeJSON #-}
    encodeJSON :: FlatSet a -> Builder ()
encodeJSON = (a -> Builder ()) -> Vector a -> Builder ()
forall a. (a -> Builder ()) -> Vector a -> Builder ()
JB.array' a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON (Vector a -> Builder ())
-> (FlatSet a -> Vector a) -> FlatSet a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatSet a -> Vector a
forall v. FlatSet v -> Vector v
FS.sortedValues

-- | default instance prefer later key
instance JSON a => JSON (HM.HashMap T.Text a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (HashMap Text a)
fromValue = Text
-> (HashMap Text Value -> Converter (HashMap Text a))
-> Value
-> Converter (HashMap Text a)
forall a.
Text -> (HashMap Text Value -> Converter a) -> Value -> Converter a
withHashMapR Text
"Data.HashMap.HashMap"
        ((Text -> Value -> Converter a)
-> HashMap Text Value -> Converter (HashMap Text a)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HM.traverseWithKey ((Text -> Value -> Converter a)
 -> HashMap Text Value -> Converter (HashMap Text a))
-> (Text -> Value -> Converter a)
-> HashMap Text Value
-> Converter (HashMap Text a)
forall a b. (a -> b) -> a -> b
$ \ Text
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
k)
    {-# INLINE toValue #-}
    toValue :: HashMap Text a -> Value
toValue = Vector (Text, Value) -> Value
Object (Vector (Text, Value) -> Value)
-> (HashMap Text a -> Vector (Text, Value))
-> HashMap Text a
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Vector (Text, Value)
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack ([(Text, Value)] -> Vector (Text, Value))
-> (HashMap Text a -> [(Text, Value)])
-> HashMap Text a
-> Vector (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text Value -> [(Text, Value)])
-> (HashMap Text a -> HashMap Text Value)
-> HashMap Text a
-> [(Text, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> HashMap Text a -> HashMap Text Value
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: HashMap Text a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.curly (Builder () -> Builder ())
-> (HashMap Text a -> Builder ()) -> HashMap Text a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder ()
-> ((Text, a) -> Builder ()) -> [(Text, a)] -> Builder ()
forall a. Builder () -> (a -> Builder ()) -> [a] -> Builder ()
B.intercalateList Builder ()
B.comma (\ (Text
k, a
v) -> Text
k Text -> Builder () -> Builder ()
`JB.kv'` a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON a
v) ([(Text, a)] -> Builder ())
-> (HashMap Text a -> [(Text, a)]) -> HashMap Text a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text a -> [(Text, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList

instance JSON a => JSON (M.Map T.Text a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (Map Text a)
fromValue = Text
-> (Vector (Text, Value) -> Converter (Map Text a))
-> Value
-> Converter (Map Text a)
forall a.
Text
-> (Vector (Text, Value) -> Converter a) -> Value -> Converter a
withKeyValues Text
"Data.Map.Map" ((Vector (Text, Value) -> Converter (Map Text a))
 -> Value -> Converter (Map Text a))
-> (Vector (Text, Value) -> Converter (Map Text a))
-> Value
-> Converter (Map Text a)
forall a b. (a -> b) -> a -> b
$
        ((Text -> Value -> Converter a)
-> Map Text Value -> Converter (Map Text a)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey (\ Text
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
k)) (Map Text Value -> Converter (Map Text a))
-> (Vector (Text, Value) -> Map Text Value)
-> Vector (Text, Value)
-> Converter (Map Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Value)] -> Map Text Value)
-> (Vector (Text, Value) -> [(Text, Value)])
-> Vector (Text, Value)
-> Map Text Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Text, Value) -> [(Text, Value)]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack
    {-# INLINE toValue #-}
    toValue :: Map Text a -> Value
toValue = Vector (Text, Value) -> Value
Object (Vector (Text, Value) -> Value)
-> (Map Text a -> Vector (Text, Value)) -> Map Text a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Vector (Text, Value)
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack ([(Text, Value)] -> Vector (Text, Value))
-> (Map Text a -> [(Text, Value)])
-> Map Text a
-> Vector (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Value -> [(Text, Value)])
-> (Map Text a -> Map Text Value) -> Map Text a -> [(Text, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Map Text a -> Map Text Value
forall a b k. (a -> b) -> Map k a -> Map k b
M.map a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: Map Text a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.curly (Builder () -> Builder ())
-> (Map Text a -> Builder ()) -> Map Text a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder ()
-> ((Text, a) -> Builder ()) -> [(Text, a)] -> Builder ()
forall a. Builder () -> (a -> Builder ()) -> [a] -> Builder ()
B.intercalateList Builder ()
B.comma (\ (Text
k, a
v) -> Text
k Text -> Builder () -> Builder ()
`JB.kv'` a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON a
v) ([(Text, a)] -> Builder ())
-> (Map Text a -> [(Text, a)]) -> Map Text a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text a -> [(Text, a)]
forall k a. Map k a -> [(k, a)]
M.toList

instance JSON a => JSON (FIM.FlatIntMap a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (FlatIntMap a)
fromValue = Text
-> (FlatMap Text Value -> Converter (FlatIntMap a))
-> Value
-> Converter (FlatIntMap a)
forall a.
Text -> (FlatMap Text Value -> Converter a) -> Value -> Converter a
withFlatMapR Text
"Z.Data.Vector.FlatIntMap.FlatIntMap" ((FlatMap Text Value -> Converter (FlatIntMap a))
 -> Value -> Converter (FlatIntMap a))
-> (FlatMap Text Value -> Converter (FlatIntMap a))
-> Value
-> Converter (FlatIntMap a)
forall a b. (a -> b) -> a -> b
$ \ FlatMap Text Value
m ->
        let kvs :: Vector (Text, Value)
kvs = FlatMap Text Value -> Vector (Text, Value)
forall k v. FlatMap k v -> Vector (k, v)
FM.sortedKeyValues FlatMap Text Value
m
        in Vector (IPair a) -> FlatIntMap a
forall v. Vector (IPair v) -> FlatIntMap v
FIM.packVectorR (Vector (IPair a) -> FlatIntMap a)
-> Converter (Vector (IPair a)) -> Converter (FlatIntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector (Text, Value)
-> ((Text, Value) -> Converter (IPair a))
-> Converter (Vector (IPair a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Vector (Text, Value)
kvs (((Text, Value) -> Converter (IPair a))
 -> Converter (Vector (IPair a)))
-> ((Text, Value) -> Converter (IPair a))
-> Converter (Vector (IPair a))
forall a b. (a -> b) -> a -> b
$ \ (Text
k, Value
v) -> do
            case Parser Int -> Bytes -> Either ParseError Int
forall a. Parser a -> Bytes -> Either ParseError a
P.parse' Parser Int
forall a. (Integral a, Bounded a) => Parser a
P.int (Text -> Bytes
T.getUTF8Bytes Text
k) of
                Right Int
k' -> do
                    a
v' <- Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
k
                    IPair a -> Converter (IPair a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a -> IPair a
forall a. Int -> a -> IPair a
V.IPair Int
k' a
v')
                Either ParseError Int
_ -> Text -> Converter (IPair a)
forall a. Text -> Converter a
fail' (Text
"converting Z.Data.Vector.FlatIntMap.FlatIntMap failed, unexpected key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k))
    {-# INLINE toValue #-}
    toValue :: FlatIntMap a -> Value
toValue = Vector (Text, Value) -> Value
Object (Vector (Text, Value) -> Value)
-> (FlatIntMap a -> Vector (Text, Value)) -> FlatIntMap a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IPair a -> (Text, Value))
-> Vector (IPair a) -> Vector (Text, Value)
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map' IPair a -> (Text, Value)
forall a. JSON a => IPair a -> (Text, Value)
toKV (Vector (IPair a) -> Vector (Text, Value))
-> (FlatIntMap a -> Vector (IPair a))
-> FlatIntMap a
-> Vector (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatIntMap a -> Vector (IPair a)
forall v. FlatIntMap v -> Vector (IPair v)
FIM.sortedKeyValues
      where toKV :: IPair a -> (Text, Value)
toKV (V.IPair Int
i a
x) = let !k :: Text
k = Int -> Text
forall a. Print a => a -> Text
T.toText Int
i
                                     !v :: Value
v = a -> Value
forall a. JSON a => a -> Value
toValue a
x
                                 in (Text
k, Value
v)
    {-# INLINE encodeJSON #-}
    encodeJSON :: FlatIntMap a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.curly (Builder () -> Builder ())
-> (FlatIntMap a -> Builder ()) -> FlatIntMap a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder ()
-> (IPair a -> Builder ()) -> Vector (IPair a) -> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
B.intercalateVec Builder ()
B.comma (\ (V.IPair Int
i a
x) -> do
        Builder () -> Builder ()
B.quotes (Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int Int
i)
        Builder ()
B.colon
        a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON a
x) (Vector (IPair a) -> Builder ())
-> (FlatIntMap a -> Vector (IPair a)) -> FlatIntMap a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatIntMap a -> Vector (IPair a)
forall v. FlatIntMap v -> Vector (IPair v)
FIM.sortedKeyValues

instance JSON a => JSON (IM.IntMap a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (IntMap a)
fromValue = Text
-> (Vector (Text, Value) -> Converter (IntMap a))
-> Value
-> Converter (IntMap a)
forall a.
Text
-> (Vector (Text, Value) -> Converter a) -> Value -> Converter a
withKeyValues Text
"Data.IntMap.IntMap" ((Vector (Text, Value) -> Converter (IntMap a))
 -> Value -> Converter (IntMap a))
-> (Vector (Text, Value) -> Converter (IntMap a))
-> Value
-> Converter (IntMap a)
forall a b. (a -> b) -> a -> b
$ \ Vector (Text, Value)
kvs ->
        [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, a)] -> IntMap a)
-> Converter [(Int, a)] -> Converter (IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Text, Value)]
-> ((Text, Value) -> Converter (Int, a)) -> Converter [(Int, a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Vector (Text, Value) -> [(Text, Value)]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector (Text, Value)
kvs) (((Text, Value) -> Converter (Int, a)) -> Converter [(Int, a)])
-> ((Text, Value) -> Converter (Int, a)) -> Converter [(Int, a)]
forall a b. (a -> b) -> a -> b
$ \ (Text
k, Value
v) -> do
            case Parser Int -> Bytes -> Either ParseError Int
forall a. Parser a -> Bytes -> Either ParseError a
P.parse' Parser Int
forall a. (Integral a, Bounded a) => Parser a
P.int (Text -> Bytes
T.getUTF8Bytes Text
k) of
                Right Int
k' -> do
                    !a
v' <- Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
k
                    (Int, a) -> Converter (Int, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
k', a
v')
                Either ParseError Int
_ -> Text -> Converter (Int, a)
forall a. Text -> Converter a
fail' (Text
"converting Data.IntMap.IntMap failed, unexpected key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k))
    {-# INLINE toValue #-}
    toValue :: IntMap a -> Value
toValue = Vector (Text, Value) -> Value
Object (Vector (Text, Value) -> Value)
-> (IntMap a -> Vector (Text, Value)) -> IntMap a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Vector (Text, Value)
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack ([(Text, Value)] -> Vector (Text, Value))
-> (IntMap a -> [(Text, Value)])
-> IntMap a
-> Vector (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a) -> (Text, Value)) -> [(Int, a)] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> (Text, Value)
forall a a. (JSON a, Print a) => (a, a) -> (Text, Value)
toKV ([(Int, a)] -> [(Text, Value)])
-> (IntMap a -> [(Int, a)]) -> IntMap a -> [(Text, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IM.toList
      where toKV :: (a, a) -> (Text, Value)
toKV (a
i, a
x) = let !k :: Text
k = a -> Text
forall a. Print a => a -> Text
T.toText a
i
                              !v :: Value
v = a -> Value
forall a. JSON a => a -> Value
toValue a
x
                          in (Text
k, Value
v)
    {-# INLINE encodeJSON #-}
    encodeJSON :: IntMap a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.curly (Builder () -> Builder ())
-> (IntMap a -> Builder ()) -> IntMap a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> ((Int, a) -> Builder ()) -> [(Int, a)] -> Builder ()
forall a. Builder () -> (a -> Builder ()) -> [a] -> Builder ()
B.intercalateList Builder ()
B.comma (\ (Int
i, a
x) -> do
        Builder () -> Builder ()
B.quotes (Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int Int
i)
        Builder ()
B.colon
        a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON a
x) ([(Int, a)] -> Builder ())
-> (IntMap a -> [(Int, a)]) -> IntMap a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IM.toList

instance JSON FIS.FlatIntSet where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter FlatIntSet
fromValue = Text
-> (Vector Value -> Converter FlatIntSet)
-> Value
-> Converter FlatIntSet
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Z.Data.Vector.FlatIntSet.FlatIntSet" ((Vector Value -> Converter FlatIntSet)
 -> Value -> Converter FlatIntSet)
-> (Vector Value -> Converter FlatIntSet)
-> Value
-> Converter FlatIntSet
forall a b. (a -> b) -> a -> b
$ \ Vector Value
vs ->
        Int -> [Int] -> FlatIntSet
FIS.packRN (Vector Value -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Vector Value
vs) ([Int] -> FlatIntSet) -> Converter [Int] -> Converter FlatIntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Value -> Converter Int)
-> [Int] -> [Value] -> Converter [Int]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ Int
k Value
v -> Value -> Converter Int
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter Int -> PathElement -> Converter Int
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k) [Int
0..] (Vector Value -> [Value]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector Value
vs)
    {-# INLINE toValue #-}
    toValue :: FlatIntSet -> Value
toValue = PrimVector Int -> Value
forall a. JSON a => a -> Value
toValue (PrimVector Int -> Value)
-> (FlatIntSet -> PrimVector Int) -> FlatIntSet -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatIntSet -> PrimVector Int
FIS.sortedValues
    {-# INLINE encodeJSON #-}
    encodeJSON :: FlatIntSet -> Builder ()
encodeJSON = PrimVector Int -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON (PrimVector Int -> Builder ())
-> (FlatIntSet -> PrimVector Int) -> FlatIntSet -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatIntSet -> PrimVector Int
FIS.sortedValues

instance JSON IS.IntSet where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter IntSet
fromValue = Text
-> (Vector Value -> Converter IntSet) -> Value -> Converter IntSet
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Data.IntSet.IntSet" ((Vector Value -> Converter IntSet) -> Value -> Converter IntSet)
-> (Vector Value -> Converter IntSet) -> Value -> Converter IntSet
forall a b. (a -> b) -> a -> b
$ \ Vector Value
vs ->
        [Int] -> IntSet
IS.fromList ([Int] -> IntSet) -> Converter [Int] -> Converter IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Value -> Converter Int)
-> [Int] -> [Value] -> Converter [Int]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ Int
k Value
v -> Value -> Converter Int
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter Int -> PathElement -> Converter Int
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k) [Int
0..] (Vector Value -> [Value]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector Value
vs)
    {-# INLINE toValue #-}
    toValue :: IntSet -> Value
toValue = [Int] -> Value
forall a. JSON a => a -> Value
toValue ([Int] -> Value) -> (IntSet -> [Int]) -> IntSet -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toList
    {-# INLINE encodeJSON #-}
    encodeJSON :: IntSet -> Builder ()
encodeJSON = [Int] -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON ([Int] -> Builder ()) -> (IntSet -> [Int]) -> IntSet -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toList

instance (Ord a, JSON a) => JSON (Set.Set a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (Set a)
fromValue = Text
-> (Vector Value -> Converter (Set a))
-> Value
-> Converter (Set a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Data.Set.Set" ((Vector Value -> Converter (Set a)) -> Value -> Converter (Set a))
-> (Vector Value -> Converter (Set a))
-> Value
-> Converter (Set a)
forall a b. (a -> b) -> a -> b
$ \ Vector Value
vs ->
        [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Converter [a] -> Converter (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Value -> Converter a) -> [Int] -> [Value] -> Converter [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k) [Int
0..] (Vector Value -> [Value]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector Value
vs)
    {-# INLINE toValue #-}
    toValue :: Set a -> Value
toValue = [a] -> Value
forall a. JSON a => a -> Value
toValue ([a] -> Value) -> (Set a -> [a]) -> Set a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList
    {-# INLINE encodeJSON #-}
    encodeJSON :: Set a -> Builder ()
encodeJSON = [a] -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON ([a] -> Builder ()) -> (Set a -> [a]) -> Set a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList

instance JSON a => JSON (Seq.Seq a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (Seq a)
fromValue = Text
-> (Vector Value -> Converter (Seq a))
-> Value
-> Converter (Seq a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Data.Seq.Seq" ((Vector Value -> Converter (Seq a)) -> Value -> Converter (Seq a))
-> (Vector Value -> Converter (Seq a))
-> Value
-> Converter (Seq a)
forall a b. (a -> b) -> a -> b
$ \ Vector Value
vs ->
        [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> Converter [a] -> Converter (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Value -> Converter a) -> [Int] -> [Value] -> Converter [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k) [Int
0..] (Vector Value -> [Value]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector Value
vs)
    {-# INLINE toValue #-}
    toValue :: Seq a -> Value
toValue = [a] -> Value
forall a. JSON a => a -> Value
toValue ([a] -> Value) -> (Seq a -> [a]) -> Seq a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
    {-# INLINE encodeJSON #-}
    encodeJSON :: Seq a -> Builder ()
encodeJSON = [a] -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON ([a] -> Builder ()) -> (Seq a -> [a]) -> Seq a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

instance JSON a => JSON (Tree.Tree a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (Tree a)
fromValue = Text
-> (FlatMap Text Value -> Converter (Tree a))
-> Value
-> Converter (Tree a)
forall a.
Text -> (FlatMap Text Value -> Converter a) -> Value -> Converter a
withFlatMapR Text
"Data.Tree" ((FlatMap Text Value -> Converter (Tree a))
 -> Value -> Converter (Tree a))
-> (FlatMap Text Value -> Converter (Tree a))
-> Value
-> Converter (Tree a)
forall a b. (a -> b) -> a -> b
$ \FlatMap Text Value
obj -> do
        !a
n <- FlatMap Text Value
obj FlatMap Text Value -> Text -> Converter a
forall a. JSON a => FlatMap Text Value -> Text -> Converter a
.: Text
"rootLabel"
        !Forest a
d <- FlatMap Text Value
obj FlatMap Text Value -> Text -> Converter (Forest a)
forall a. JSON a => FlatMap Text Value -> Text -> Converter a
.: Text
"subForest"
        Tree a -> Converter (Tree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Tree.Node a
n Forest a
d)
    {-# INLINE toValue #-}
    toValue :: Tree a -> Value
toValue Tree a
x = [(Text, Value)] -> Value
object [ Text
"rootLabel" Text -> a -> (Text, Value)
forall v. JSON v => Text -> v -> (Text, Value)
.= (Tree a -> a
forall a. Tree a -> a
Tree.rootLabel Tree a
x) , Text
"subForest" Text -> Forest a -> (Text, Value)
forall v. JSON v => Text -> v -> (Text, Value)
.= (Tree a -> Forest a
forall a. Tree a -> Forest a
Tree.subForest Tree a
x) ]
    {-# INLINE encodeJSON #-}
    encodeJSON :: Tree a -> Builder ()
encodeJSON Tree a
x = KVItem -> Builder ()
object' ( Text
"rootLabel" Text -> a -> KVItem
forall v. JSON v => Text -> v -> KVItem
.! (Tree a -> a
forall a. Tree a -> a
Tree.rootLabel Tree a
x) KVItem -> KVItem -> KVItem
forall a. Semigroup a => a -> a -> a
<> Text
"subForest" Text -> Forest a -> KVItem
forall v. JSON v => Text -> v -> KVItem
.! (Tree a -> Forest a
forall a. Tree a -> Forest a
Tree.subForest Tree a
x) )

instance JSON a => JSON (A.Array a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (Array a)
fromValue = Text
-> (Vector Value -> Converter (Array a))
-> Value
-> Converter (Array a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Z.Data.Array.Array"
        ((Int -> Value -> Converter a)
-> Vector Value -> Converter (Array a)
forall (v :: * -> *) a (u :: * -> *) b (f :: * -> *).
(Vec v a, Vec u b, Applicative f) =>
(Int -> a -> f b) -> v a -> f (u b)
V.traverseWithIndex ((Int -> Value -> Converter a)
 -> Vector Value -> Converter (Array a))
-> (Int -> Value -> Converter a)
-> Vector Value
-> Converter (Array a)
forall a b. (a -> b) -> a -> b
$ \ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k)
    {-# INLINE toValue #-}
    toValue :: Array a -> Value
toValue = Vector Value -> Value
Array (Vector Value -> Value)
-> (Array a -> Vector Value) -> Array a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Array a -> Vector Value
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: Array a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.square (Builder () -> Builder ())
-> (Array a -> Builder ()) -> Array a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array a -> Builder ()
forall a (v :: * -> *). (JSON a, Vec v a) => v a -> Builder ()
commaSepVec

instance JSON a => JSON (A.SmallArray a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (SmallArray a)
fromValue = Text
-> (Vector Value -> Converter (SmallArray a))
-> Value
-> Converter (SmallArray a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Z.Data.Array.SmallArray"
        ((Int -> Value -> Converter a)
-> Vector Value -> Converter (SmallArray a)
forall (v :: * -> *) a (u :: * -> *) b (f :: * -> *).
(Vec v a, Vec u b, Applicative f) =>
(Int -> a -> f b) -> v a -> f (u b)
V.traverseWithIndex ((Int -> Value -> Converter a)
 -> Vector Value -> Converter (SmallArray a))
-> (Int -> Value -> Converter a)
-> Vector Value
-> Converter (SmallArray a)
forall a b. (a -> b) -> a -> b
$ \ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k)
    {-# INLINE toValue #-}
    toValue :: SmallArray a -> Value
toValue = Vector Value -> Value
Array (Vector Value -> Value)
-> (SmallArray a -> Vector Value) -> SmallArray a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> SmallArray a -> Vector Value
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: SmallArray a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.square (Builder () -> Builder ())
-> (SmallArray a -> Builder ()) -> SmallArray a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmallArray a -> Builder ()
forall a (v :: * -> *). (JSON a, Vec v a) => v a -> Builder ()
commaSepVec

instance (Prim a, JSON a) => JSON (A.PrimArray a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (PrimArray a)
fromValue = Text
-> (Vector Value -> Converter (PrimArray a))
-> Value
-> Converter (PrimArray a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Z.Data.Array.PrimArray"
        ((Int -> Value -> Converter a)
-> Vector Value -> Converter (PrimArray a)
forall (v :: * -> *) a (u :: * -> *) b (f :: * -> *).
(Vec v a, Vec u b, Applicative f) =>
(Int -> a -> f b) -> v a -> f (u b)
V.traverseWithIndex ((Int -> Value -> Converter a)
 -> Vector Value -> Converter (PrimArray a))
-> (Int -> Value -> Converter a)
-> Vector Value
-> Converter (PrimArray a)
forall a b. (a -> b) -> a -> b
$ \ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k)
    {-# INLINE toValue #-}
    toValue :: PrimArray a -> Value
toValue = Vector Value -> Value
Array (Vector Value -> Value)
-> (PrimArray a -> Vector Value) -> PrimArray a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> PrimArray a -> Vector Value
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: PrimArray a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.square (Builder () -> Builder ())
-> (PrimArray a -> Builder ()) -> PrimArray a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimArray a -> Builder ()
forall a (v :: * -> *). (JSON a, Vec v a) => v a -> Builder ()
commaSepVec

instance JSON A.ByteArray where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter ByteArray
fromValue Value
value = do
        (A.PrimArray ByteArray#
ba# :: A.PrimArray Word8) <-
                Text
-> (Vector Value -> Converter (PrimArray Word8))
-> Value
-> Converter (PrimArray Word8)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Data.Primitive.ByteArray"
                    ((Int -> Value -> Converter Word8)
-> Vector Value -> Converter (PrimArray Word8)
forall (v :: * -> *) a (u :: * -> *) b (f :: * -> *).
(Vec v a, Vec u b, Applicative f) =>
(Int -> a -> f b) -> v a -> f (u b)
V.traverseWithIndex ((Int -> Value -> Converter Word8)
 -> Vector Value -> Converter (PrimArray Word8))
-> (Int -> Value -> Converter Word8)
-> Vector Value
-> Converter (PrimArray Word8)
forall a b. (a -> b) -> a -> b
$ \ Int
k Value
v -> Value -> Converter Word8
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter Word8 -> PathElement -> Converter Word8
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k) Value
value
        ByteArray -> Converter ByteArray
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteArray# -> ByteArray
A.ByteArray ByteArray#
ba#)
    {-# INLINE toValue #-}
    toValue :: ByteArray -> Value
toValue (A.ByteArray ByteArray#
ba#) =
        Vector Value -> Value
Array ((Word8 -> Value) -> PrimArray Word8 -> Vector Value
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map Word8 -> Value
forall a. JSON a => a -> Value
toValue (ByteArray# -> PrimArray Word8
forall a. ByteArray# -> PrimArray a
A.PrimArray ByteArray#
ba# :: A.PrimArray Word8))
    {-# INLINE encodeJSON #-}
    encodeJSON :: ByteArray -> Builder ()
encodeJSON (A.ByteArray ByteArray#
ba#) =
        Builder () -> Builder ()
B.square (PrimArray Word8 -> Builder ()
forall a (v :: * -> *). (JSON a, Vec v a) => v a -> Builder ()
commaSepVec (ByteArray# -> PrimArray Word8
forall a. ByteArray# -> PrimArray a
A.PrimArray ByteArray#
ba# :: A.PrimArray Word8))

instance (A.PrimUnlifted a, JSON a) => JSON (A.UnliftedArray a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (UnliftedArray a)
fromValue = Text
-> (Vector Value -> Converter (UnliftedArray a))
-> Value
-> Converter (UnliftedArray a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Z.Data.Array.UnliftedArray"
        ((Int -> Value -> Converter a)
-> Vector Value -> Converter (UnliftedArray a)
forall (v :: * -> *) a (u :: * -> *) b (f :: * -> *).
(Vec v a, Vec u b, Applicative f) =>
(Int -> a -> f b) -> v a -> f (u b)
V.traverseWithIndex ((Int -> Value -> Converter a)
 -> Vector Value -> Converter (UnliftedArray a))
-> (Int -> Value -> Converter a)
-> Vector Value
-> Converter (UnliftedArray a)
forall a b. (a -> b) -> a -> b
$ \ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k)
    {-# INLINE toValue #-}
    toValue :: UnliftedArray a -> Value
toValue = Vector Value -> Value
Array (Vector Value -> Value)
-> (UnliftedArray a -> Vector Value) -> UnliftedArray a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> UnliftedArray a -> Vector Value
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: UnliftedArray a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.square (Builder () -> Builder ())
-> (UnliftedArray a -> Builder ()) -> UnliftedArray a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnliftedArray a -> Builder ()
forall a (v :: * -> *). (JSON a, Vec v a) => v a -> Builder ()
commaSepVec

instance JSON a => JSON (V.Vector a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (Vector a)
fromValue = Text
-> (Vector Value -> Converter (Vector a))
-> Value
-> Converter (Vector a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Z.Data.Vector.Vector"
        ((Int -> Value -> Converter a)
-> Vector Value -> Converter (Vector a)
forall (v :: * -> *) a (u :: * -> *) b (f :: * -> *).
(Vec v a, Vec u b, Applicative f) =>
(Int -> a -> f b) -> v a -> f (u b)
V.traverseWithIndex ((Int -> Value -> Converter a)
 -> Vector Value -> Converter (Vector a))
-> (Int -> Value -> Converter a)
-> Vector Value
-> Converter (Vector a)
forall a b. (a -> b) -> a -> b
$ \ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k)
    {-# INLINE toValue #-}
    toValue :: Vector a -> Value
toValue = Vector Value -> Value
Array (Vector Value -> Value)
-> (Vector a -> Vector Value) -> Vector a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Vector a -> Vector Value
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: Vector a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.square (Builder () -> Builder ())
-> (Vector a -> Builder ()) -> Vector a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Builder ()
forall a (v :: * -> *). (JSON a, Vec v a) => v a -> Builder ()
commaSepVec

instance (Prim a, JSON a) => JSON (V.PrimVector a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (PrimVector a)
fromValue = Text
-> (Vector Value -> Converter (PrimVector a))
-> Value
-> Converter (PrimVector a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Z.Data.Vector.PrimVector"
        ((Int -> Value -> Converter a)
-> Vector Value -> Converter (PrimVector a)
forall (v :: * -> *) a (u :: * -> *) b (f :: * -> *).
(Vec v a, Vec u b, Applicative f) =>
(Int -> a -> f b) -> v a -> f (u b)
V.traverseWithIndex ((Int -> Value -> Converter a)
 -> Vector Value -> Converter (PrimVector a))
-> (Int -> Value -> Converter a)
-> Vector Value
-> Converter (PrimVector a)
forall a b. (a -> b) -> a -> b
$ \ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k)
    {-# INLINE toValue #-}
    toValue :: PrimVector a -> Value
toValue = Vector Value -> Value
Array (Vector Value -> Value)
-> (PrimVector a -> Vector Value) -> PrimVector a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> PrimVector a -> Vector Value
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: PrimVector a -> Builder ()
encodeJSON = Builder () -> Builder ()
B.square (Builder () -> Builder ())
-> (PrimVector a -> Builder ()) -> PrimVector a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimVector a -> Builder ()
forall a (v :: * -> *). (JSON a, Vec v a) => v a -> Builder ()
commaSepVec

-- | This is an INCOHERENT instance, encode binary data with base64 encoding.
instance {-# INCOHERENT #-} JSON V.Bytes where
    fromValue :: Value -> Converter Bytes
fromValue = Text -> (Text -> Converter Bytes) -> Value -> Converter Bytes
forall a. Text -> (Text -> Converter a) -> Value -> Converter a
withText Text
"Z.Data.Vector.Bytes" ((Text -> Converter Bytes) -> Value -> Converter Bytes)
-> (Text -> Converter Bytes) -> Value -> Converter Bytes
forall a b. (a -> b) -> a -> b
$ \ Text
t ->
        case Bytes -> Maybe Bytes
Base64.base64Decode (Text -> Bytes
T.getUTF8Bytes Text
t) of
            Just Bytes
bs -> Bytes -> Converter Bytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes
bs
            Maybe Bytes
Nothing -> Text -> Converter Bytes
forall a. Text -> Converter a
fail' Text
"illegal base64 encoding bytes"
    {-# INLINE toValue #-}
    toValue :: Bytes -> Value
toValue = Text -> Value
String (Text -> Value) -> (Bytes -> Text) -> Bytes -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Text
Base64.base64EncodeText
    {-# INLINE encodeJSON #-}
    encodeJSON :: Bytes -> Builder ()
encodeJSON = Builder () -> Builder ()
B.quotes (Builder () -> Builder ())
-> (Bytes -> Builder ()) -> Bytes -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Builder ()
Base64.base64EncodeBuilder

instance (Eq a, Hashable a, JSON a) => JSON (HS.HashSet a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (HashSet a)
fromValue = Text
-> (Vector Value -> Converter (HashSet a))
-> Value
-> Converter (HashSet a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"Z.Data.Vector.FlatSet.FlatSet" ((Vector Value -> Converter (HashSet a))
 -> Value -> Converter (HashSet a))
-> (Vector Value -> Converter (HashSet a))
-> Value
-> Converter (HashSet a)
forall a b. (a -> b) -> a -> b
$ \ Vector Value
vs ->
        [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([a] -> HashSet a) -> Converter [a] -> Converter (HashSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            ((Int -> Value -> Converter a) -> [Int] -> [Value] -> Converter [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k) [Int
0..] (Vector Value -> [Value]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector Value
vs))
    {-# INLINE toValue #-}
    toValue :: HashSet a -> Value
toValue = [a] -> Value
forall a. JSON a => a -> Value
toValue ([a] -> Value) -> (HashSet a -> [a]) -> HashSet a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> [a]
forall a. HashSet a -> [a]
HS.toList
    {-# INLINE encodeJSON #-}
    encodeJSON :: HashSet a -> Builder ()
encodeJSON = [a] -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON ([a] -> Builder ())
-> (HashSet a -> [a]) -> HashSet a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> [a]
forall a. HashSet a -> [a]
HS.toList

instance JSON a => JSON [a] where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter [a]
fromValue = Text -> (Vector Value -> Converter [a]) -> Value -> Converter [a]
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"[a]" ((Vector Value -> Converter [a]) -> Value -> Converter [a])
-> (Vector Value -> Converter [a]) -> Value -> Converter [a]
forall a b. (a -> b) -> a -> b
$ \ Vector Value
vs ->
        (Int -> Value -> Converter a) -> [Int] -> [Value] -> Converter [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k) [Int
0..] (Vector Value -> [Value]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector Value
vs)
    {-# INLINE toValue #-}
    toValue :: [a] -> Value
toValue = Vector Value -> Value
Array (Vector Value -> Value) -> ([a] -> Vector Value) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Vector Value
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack ([Value] -> Vector Value)
-> ([a] -> [Value]) -> [a] -> Vector Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
forall a. JSON a => a -> Value
toValue
    {-# INLINE encodeJSON #-}
    encodeJSON :: [a] -> Builder ()
encodeJSON = Builder () -> Builder ()
B.square (Builder () -> Builder ())
-> ([a] -> Builder ()) -> [a] -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Builder ()
forall a. JSON a => [a] -> Builder ()
commaSepList

-- | This is an INCOHERENT instance, to provide JSON text encoding behaviour.
instance {-# INCOHERENT #-} JSON [Char] where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter [Char]
fromValue = Text -> (Text -> Converter [Char]) -> Value -> Converter [Char]
forall a. Text -> (Text -> Converter a) -> Value -> Converter a
withText Text
"String" ([Char] -> Converter [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Converter [Char])
-> (Text -> [Char]) -> Text -> Converter [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack)
    {-# INLINE toValue #-}
    toValue :: [Char] -> Value
toValue = Text -> Value
String (Text -> Value) -> ([Char] -> Text) -> [Char] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
    {-# INLINE encodeJSON #-}
    encodeJSON :: [Char] -> Builder ()
encodeJSON = Text -> Builder ()
JB.string (Text -> Builder ()) -> ([Char] -> Text) -> [Char] -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

instance JSON a => JSON (NonEmpty a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (NonEmpty a)
fromValue = Text
-> (Vector Value -> Converter (NonEmpty a))
-> Value
-> Converter (NonEmpty a)
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"NonEmpty" ((Vector Value -> Converter (NonEmpty a))
 -> Value -> Converter (NonEmpty a))
-> (Vector Value -> Converter (NonEmpty a))
-> Value
-> Converter (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ \ Vector Value
vs -> do
        [a]
l <- (Int -> Value -> Converter a) -> [Int] -> [Value] -> Converter [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ Int
k Value
v -> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k) [Int
0..] (Vector Value -> [Value]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector Value
vs)
        case [a]
l of (a
x:[a]
xs) -> NonEmpty a -> Converter (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
                  [a]
_      -> Text -> Converter (NonEmpty a)
forall a. Text -> Converter a
fail' Text
"unexpected empty array"
    {-# INLINE toValue #-}
    toValue :: NonEmpty a -> Value
toValue = [a] -> Value
forall a. JSON a => a -> Value
toValue ([a] -> Value) -> (NonEmpty a -> [a]) -> NonEmpty a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList
    {-# INLINE encodeJSON #-}
    encodeJSON :: NonEmpty a -> Builder ()
encodeJSON = [a] -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON ([a] -> Builder ())
-> (NonEmpty a -> [a]) -> NonEmpty a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList

instance JSON Bool where
    {-# INLINE fromValue #-}; fromValue :: Value -> Converter Bool
fromValue = Text -> (Bool -> Converter Bool) -> Value -> Converter Bool
forall a. Text -> (Bool -> Converter a) -> Value -> Converter a
withBool Text
"Bool" Bool -> Converter Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure;
    {-# INLINE toValue #-}; toValue :: Bool -> Value
toValue = Bool -> Value
Bool;
    {-# INLINE encodeJSON #-}; encodeJSON :: Bool -> Builder ()
encodeJSON Bool
True = Builder ()
"true"; encodeJSON Bool
_ = Builder ()
"false";

instance JSON Char where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter Char
fromValue = Text -> (Text -> Converter Char) -> Value -> Converter Char
forall a. Text -> (Text -> Converter a) -> Value -> Converter a
withText Text
"Char" ((Text -> Converter Char) -> Value -> Converter Char)
-> (Text -> Converter Char) -> Value -> Converter Char
forall a b. (a -> b) -> a -> b
$ \ Text
t ->
        if (Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
        then Char -> Converter Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Char
T.head Text
t)
        else Text -> Converter Char
forall a. Text -> Converter a
fail' (ParseError -> Text
T.concat [Text
"converting Char failed, expected a string of length 1"])
    {-# INLINE toValue #-}
    toValue :: Char -> Value
toValue = Text -> Value
String (Text -> Value) -> (Char -> Text) -> Char -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton
-- @
--    \'\\b\':  \"\\b\"
--    \'\\f\':  \"\\f\"
--    \'\\n\':  \"\\n\"
--    \'\\r\':  \"\\r\"
--    \'\\t\':  \"\\t\"
--    \'\"\':  \"\\\"\"
--    \'\\\':  \"\\\\\"
--    \'\DEL\':  \"\\u007f\"
--    other chars <= 0x1F: "\\u00xx"
-- @
    {-# INLINE encodeJSON #-}
    encodeJSON :: Char -> Builder ()
encodeJSON Char
'\b' = Builder ()
"\"\\b\""
    encodeJSON Char
'\f' = Builder ()
"\"\\f\""
    encodeJSON Char
'\n' = Builder ()
"\"\\n\""
    encodeJSON Char
'\r' = Builder ()
"\"\\r\""
    encodeJSON Char
'\t' = Builder ()
"\"\\t\""
    encodeJSON Char
'\"' = Builder ()
"\"\\\"\""
    encodeJSON Char
'\\' = Builder ()
"\"\\\\\""
    encodeJSON Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\US' = Builder ()
"\"\\u00" Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
forall a. (FiniteBits a, Integral a) => a -> Builder ()
B.hex (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) :: Word8) Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Builder ()
B.char8 Char
'\"'
                 | Bool
otherwise  = Builder () -> Builder ()
B.quotes (Char -> Builder ()
B.charUTF8 Char
c)


instance JSON Double where
    {-# INLINE fromValue #-}; fromValue :: Value -> Converter Double
fromValue = Text -> (Double -> Converter Double) -> Value -> Converter Double
forall a r.
RealFloat a =>
Text -> (a -> Converter r) -> Value -> Converter r
withRealFloat Text
"Double" Double -> Converter Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure;
    {-# INLINE toValue #-}; toValue :: Double -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Double -> Scientific) -> Double -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scientific
JV.doubleToScientific;
    {-# INLINE encodeJSON #-}; encodeJSON :: Double -> Builder ()
encodeJSON = Double -> Builder ()
B.double;
instance JSON Float  where
    {-# INLINE fromValue #-}; fromValue :: Value -> Converter Float
fromValue = Text -> (Float -> Converter Float) -> Value -> Converter Float
forall a r.
RealFloat a =>
Text -> (a -> Converter r) -> Value -> Converter r
withRealFloat Text
"Float" Float -> Converter Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure;
    {-# INLINE toValue #-}; toValue :: Float -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Float -> Scientific) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Scientific
JV.floatToScientific;
    {-# INLINE encodeJSON #-}; encodeJSON :: Float -> Builder ()
encodeJSON = Float -> Builder ()
B.float;

#define INT_JSON_INSTANCE(typ) \
    instance JSON typ where \
        {-# INLINE fromValue #-}; fromValue = withBoundedIntegral " typ " pure; \
        {-# INLINE toValue #-}; toValue = Number . fromIntegral; \
        {-# INLINE encodeJSON #-}; encodeJSON = B.int;

INT_JSON_INSTANCE(Int)
INT_JSON_INSTANCE(Int8)
INT_JSON_INSTANCE(Int16)
INT_JSON_INSTANCE(Int32)
INT_JSON_INSTANCE(Int64)
INT_JSON_INSTANCE(Word)
INT_JSON_INSTANCE(Word8)
INT_JSON_INSTANCE(Word16)
INT_JSON_INSTANCE(Word32)
INT_JSON_INSTANCE(Word64)

-- | This instance includes a bounds check to prevent maliciously large inputs to fill up the memory of the target system. You can newtype 'Integer' and provide your own instance using 'withScientific' if you want to allow larger inputs.
instance JSON Integer where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter Integer
fromValue = Text
-> (Scientific -> Converter Integer) -> Value -> Converter Integer
forall a.
Text -> (Scientific -> Converter a) -> Value -> Converter a
withBoundedScientific Text
"Integer" ((Scientific -> Converter Integer) -> Value -> Converter Integer)
-> (Scientific -> Converter Integer) -> Value -> Converter Integer
forall a b. (a -> b) -> a -> b
$ \ Scientific
n ->
        case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
n :: Either Double Integer of
            Right Integer
x -> Integer -> Converter Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
x
            Left Double
_  -> Text -> Converter Integer
forall a. Text -> Converter a
fail' (Text -> Converter Integer)
-> (Builder () -> Text) -> Builder () -> Converter Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Text
forall a. Builder a -> Text
B.unsafeBuildText (Builder () -> Converter Integer)
-> Builder () -> Converter Integer
forall a b. (a -> b) -> a -> b
$ do
                Builder ()
"converting Integer failed, unexpected floating number "
                Scientific -> Builder ()
T.scientific Scientific
n
    {-# INLINE toValue #-}
    toValue :: Integer -> Value
toValue = Scientific -> Value
Number (Scientific -> Value)
-> (Integer -> Scientific) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE encodeJSON #-}
    encodeJSON :: Integer -> Builder ()
encodeJSON = Integer -> Builder ()
B.integer

-- | This instance includes a bounds check to prevent maliciously large inputs to fill up the memory of the target system. You can newtype 'Natural' and provide your own instance using 'withScientific' if you want to allow larger inputs.
instance JSON Natural where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter Natural
fromValue = Text
-> (Scientific -> Converter Natural) -> Value -> Converter Natural
forall a.
Text -> (Scientific -> Converter a) -> Value -> Converter a
withBoundedScientific Text
"Natural" ((Scientific -> Converter Natural) -> Value -> Converter Natural)
-> (Scientific -> Converter Natural) -> Value -> Converter Natural
forall a b. (a -> b) -> a -> b
$ \ Scientific
n ->
        if Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
0
        then Text -> Converter Natural
forall a. Text -> Converter a
fail' (Text -> Converter Natural)
-> (Builder () -> Text) -> Builder () -> Converter Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Text
forall a. Builder a -> Text
B.unsafeBuildText (Builder () -> Converter Natural)
-> Builder () -> Converter Natural
forall a b. (a -> b) -> a -> b
$ do
                Builder ()
"converting Natural failed, unexpected negative number "
                Scientific -> Builder ()
T.scientific Scientific
n
        else case Scientific -> Either Double Natural
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
n :: Either Double Natural of
            Right Natural
x -> Natural -> Converter Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
x
            Left Double
_  -> Text -> Converter Natural
forall a. Text -> Converter a
fail' (Text -> Converter Natural)
-> (Builder () -> Text) -> Builder () -> Converter Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Text
forall a. Builder a -> Text
B.unsafeBuildText (Builder () -> Converter Natural)
-> Builder () -> Converter Natural
forall a b. (a -> b) -> a -> b
$ do
                Builder ()
"converting Natural failed, unexpected floating number "
                Scientific -> Builder ()
T.scientific Scientific
n
    {-# INLINE toValue #-}
    toValue :: Natural -> Value
toValue = Scientific -> Value
Number (Scientific -> Value)
-> (Natural -> Scientific) -> Natural -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE encodeJSON #-}
    encodeJSON :: Natural -> Builder ()
encodeJSON = Integer -> Builder ()
B.integer (Integer -> Builder ())
-> (Natural -> Integer) -> Natural -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance JSON Ordering where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter Ordering
fromValue = Text -> (Text -> Converter Ordering) -> Value -> Converter Ordering
forall a. Text -> (Text -> Converter a) -> Value -> Converter a
withText Text
"Ordering" ((Text -> Converter Ordering) -> Value -> Converter Ordering)
-> (Text -> Converter Ordering) -> Value -> Converter Ordering
forall a b. (a -> b) -> a -> b
$ \ Text
s ->
        case Text
s of
            Text
"LT" -> Ordering -> Converter Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
LT
            Text
"EQ" -> Ordering -> Converter Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ
            Text
"GT" -> Ordering -> Converter Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT
            Text
_ -> Text -> Converter Ordering
forall a. Text -> Converter a
fail' (Text -> Converter Ordering)
-> (ParseError -> Text) -> ParseError -> Converter Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Text
T.concat (ParseError -> Converter Ordering)
-> ParseError -> Converter Ordering
forall a b. (a -> b) -> a -> b
$ [Text
"converting Ordering failed, unexpected ",
                                        Text
s, Text
" expected \"LT\", \"EQ\", or \"GT\""]
    {-# INLINE toValue #-}
    toValue :: Ordering -> Value
toValue Ordering
LT = Text -> Value
String Text
"LT"
    toValue Ordering
EQ = Text -> Value
String Text
"EQ"
    toValue Ordering
GT = Text -> Value
String Text
"GT"
    {-# INLINE encodeJSON #-}
    encodeJSON :: Ordering -> Builder ()
encodeJSON Ordering
LT = Builder ()
"\"LT\""
    encodeJSON Ordering
EQ = Builder ()
"\"EQ\""
    encodeJSON Ordering
GT = Builder ()
"\"GT\""

instance JSON () where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter ()
fromValue = Text -> (Vector Value -> Converter ()) -> Value -> Converter ()
forall a.
Text -> (Vector Value -> Converter a) -> Value -> Converter a
withArray Text
"()" ((Vector Value -> Converter ()) -> Value -> Converter ())
-> (Vector Value -> Converter ()) -> Value -> Converter ()
forall a b. (a -> b) -> a -> b
$ \ Vector Value
v ->
        if Vector Value -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Vector Value
v
        then () -> Converter ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        else Text -> Converter ()
forall a. Text -> Converter a
fail' Text
"converting () failed, expected an empty array"
    {-# INLINE toValue #-}
    toValue :: () -> Value
toValue () = Vector Value -> Value
Array Vector Value
forall (v :: * -> *) a. Vec v a => v a
V.empty
    {-# INLINE encodeJSON #-}
    encodeJSON :: () -> Builder ()
encodeJSON () = Builder ()
"[]"

instance JSON a => JSON (Maybe a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (Maybe a)
fromValue Value
Null = Maybe a -> Converter (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    fromValue Value
v    = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Converter a -> Converter (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Converter a
forall a. JSON a => Value -> Converter a
fromValue Value
v
    {-# INLINE toValue #-}
    toValue :: Maybe a -> Value
toValue Maybe a
Nothing  = Value
Null
    toValue (Just a
x) = a -> Value
forall a. JSON a => a -> Value
toValue a
x
    {-# INLINE encodeJSON #-}
    encodeJSON :: Maybe a -> Builder ()
encodeJSON Maybe a
Nothing  = Builder ()
"null"
    encodeJSON (Just a
x) = a -> Builder ()
forall a. JSON a => a -> Builder ()
encodeJSON a
x

-- | This instance includes a bounds check to prevent maliciously large inputs to fill up the memory of the target system. You can newtype Ratio and provide your own instance using 'withScientific' if you want to allow larger inputs.
instance (JSON a, Integral a) => JSON (Ratio a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (Ratio a)
fromValue = Text
-> (FlatMap Text Value -> Converter (Ratio a))
-> Value
-> Converter (Ratio a)
forall a.
Text -> (FlatMap Text Value -> Converter a) -> Value -> Converter a
withFlatMapR Text
"Rational" ((FlatMap Text Value -> Converter (Ratio a))
 -> Value -> Converter (Ratio a))
-> (FlatMap Text Value -> Converter (Ratio a))
-> Value
-> Converter (Ratio a)
forall a b. (a -> b) -> a -> b
$ \FlatMap Text Value
obj -> do
        !a
n <- FlatMap Text Value
obj FlatMap Text Value -> Text -> Converter a
forall a. JSON a => FlatMap Text Value -> Text -> Converter a
.: Text
"numerator"
        !a
d <- FlatMap Text Value
obj FlatMap Text Value -> Text -> Converter a
forall a. JSON a => FlatMap Text Value -> Text -> Converter a
.: Text
"denominator"
        if a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
        then Text -> Converter (Ratio a)
forall a. Text -> Converter a
fail' Text
"Ratio denominator was 0"
        else Ratio a -> Converter (Ratio a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
n a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
d)
    {-# INLINE toValue #-}
    toValue :: Ratio a -> Value
toValue Ratio a
x = [(Text, Value)] -> Value
object [ Text
"numerator" Text -> a -> (Text, Value)
forall v. JSON v => Text -> v -> (Text, Value)
.= (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
x) , Text
"denominator" Text -> a -> (Text, Value)
forall v. JSON v => Text -> v -> (Text, Value)
.= (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
x) ]
    {-# INLINE encodeJSON #-}
    encodeJSON :: Ratio a -> Builder ()
encodeJSON Ratio a
x = KVItem -> Builder ()
object' ( Text
"numerator" Text -> a -> KVItem
forall v. JSON v => Text -> v -> KVItem
.! (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
x) KVItem -> KVItem -> KVItem
forall a. Semigroup a => a -> a -> a
<> Text
"denominator" Text -> a -> KVItem
forall v. JSON v => Text -> v -> KVItem
.! (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
x) )

-- | This instance includes a bounds check to prevent maliciously large inputs to fill up the memory of the target system. You can newtype Fixed and provide your own instance using 'withScientific' if you want to allow larger inputs.
instance HasResolution a => JSON (Fixed a) where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter (Fixed a)
fromValue = Text
-> (Scientific -> Converter (Fixed a))
-> Value
-> Converter (Fixed a)
forall a.
Text -> (Scientific -> Converter a) -> Value -> Converter a
withBoundedScientific Text
"Fixed" (Fixed a -> Converter (Fixed a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fixed a -> Converter (Fixed a))
-> (Scientific -> Fixed a) -> Scientific -> Converter (Fixed a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Fixed a
forall a b. (Real a, Fractional b) => a -> b
realToFrac)
    {-# INLINE toValue #-}
    toValue :: Fixed a -> Value
toValue = Scientific -> Value
Number (Scientific -> Value)
-> (Fixed a -> Scientific) -> Fixed a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed a -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac
    {-# INLINE encodeJSON #-}
    encodeJSON :: Fixed a -> Builder ()
encodeJSON = Scientific -> Builder ()
B.scientific' (Scientific -> Builder ())
-> (Fixed a -> Scientific) -> Fixed a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed a -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac