{-# LANGUAGE CPP                   #-}
{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE PartialTypeSignatures #-}

{-|
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 'FromValue', 'ToValue' and 'EncodeJSON' instance.

-}

module Z.Data.JSON.Base
  ( -- * Encode & Decode
    DecodeError
  , decode, decode', decodeChunks, decodeChunks', encodeBytes, encodeText, encodeTextBuilder
  -- * Re-export 'Value' type
  , Value(..)
    -- * parse into JSON Value
  , JV.parseValue, JV.parseValue', JV.parseValueChunks, JV.parseValueChunks'
  -- * Convert 'Value' to Haskell data
  , convert, convert', Converter(..), fail', (<?>), prependContext
  , PathElement(..), ConvertError
  , typeMismatch, fromNull, withBool, withScientific, withBoundedScientific, withRealFloat
  , withBoundedIntegral, withText, withArray, withKeyValues, withFlatMap, withFlatMapR
  , withHashMap, withHashMapR, withEmbeddedJSON
  , (.:), (.:?), (.:!), convertField, convertFieldMaybe, convertFieldMaybe'
  -- * FromValue, ToValue & EncodeJSON
  , defaultSettings, Settings(..)
  , ToValue(..), GToValue(..)
  , FromValue(..), GFromValue(..)
  , EncodeJSON(..), GEncodeJSON(..)
  -- * Helper classes for generics
  , Field, GWriteFields(..), GMergeFields(..), GConstrToValue(..)
  , LookupTable, GFromFields(..), GBuildLookup(..), GConstrFromValue(..)
  , GAddPunctuation(..), GConstrEncodeJSON(..)
  ) where

import           Control.Applicative
import           Control.DeepSeq
import           Control.Monad
import qualified Control.Monad.Fail           as Fail
import           Control.Monad.ST
import           Data.Char                    (ord)
import           Data.Data
import           Data.Fixed
import           Data.Functor.Compose
import           Data.Functor.Const
import           Data.Functor.Identity
import           Data.Functor.Product
import           Data.Functor.Sum
import           Data.Hashable
import qualified Data.HashMap.Strict          as HM
import qualified Data.HashSet                 as HS
import           Data.Int
import           Data.List.NonEmpty           (NonEmpty (..))
import qualified Data.List.NonEmpty           as NonEmpty
import qualified Data.Monoid                  as Monoid
import           Data.Primitive.Types         (Prim)
import qualified Data.Primitive.SmallArray    as A
import           Data.Proxy                   (Proxy (..))
import           Data.Ratio                   (Ratio, (%), numerator, denominator)
import           Data.Scientific              (Scientific, base10Exponent, toBoundedInteger)
import qualified Data.Scientific              as Scientific
import qualified Data.Semigroup               as Semigroup
import           Data.Tagged                  (Tagged (..))
import           Data.Version                 (Version, parseVersion)
import           Data.Word
import           GHC.Exts                     (Proxy#, proxy#)
import           GHC.Generics
import           GHC.Natural
import qualified Z.Data.Builder             as B
import           Z.Data.Generics.Utils
import           Z.Data.JSON.Value          (Value(..))
import qualified Z.Data.JSON.Value          as JV
import qualified Z.Data.JSON.Builder        as JB
import qualified Z.Data.Parser              as P
import qualified Z.Data.Parser.Numeric      as P
import qualified Z.Data.Text                as T
import qualified Z.Data.Text.Builder        as TB
import qualified Z.Data.Vector.Base         as V
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
import           Text.ParserCombinators.ReadP (readP_to_S)

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

-- 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.
--
decode' :: FromValue 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 -> Converter a) -> Value -> Either ConvertError a
forall a r. (a -> Converter r) -> a -> Either ConvertError r
convert Value -> Converter a
forall a. FromValue a => Value -> Converter a
fromValue 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 :: FromValue 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 -> Converter a) -> Value -> Either ConvertError a
forall a r. (a -> Converter r) -> a -> Either ConvertError r
convert Value -> Converter a
forall a. FromValue a => Value -> Converter a
fromValue 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 JSON doc chunks, return trailing bytes.
decodeChunks :: (FromValue a, Monad m) => m V.Bytes -> V.Bytes -> m (V.Bytes, Either DecodeError a)
{-# INLINE decodeChunks #-}
decodeChunks :: m Bytes -> Bytes -> m (Bytes, Either DecodeError a)
decodeChunks m Bytes
mb Bytes
bs = do
    (Bytes, Either ParseError Value)
mr <- (Parser Value
-> m Bytes -> Bytes -> m (Bytes, Either ParseError Value)
forall (m :: * -> *) a.
Monad m =>
Parser a -> m Bytes -> Bytes -> m (Bytes, Either ParseError a)
P.parseChunks Parser Value
JV.value m Bytes
mb Bytes
bs)
    case (Bytes, Either ParseError Value)
mr of
        (Bytes
bs', Left ParseError
pErr) -> (Bytes, Either DecodeError a) -> m (Bytes, Either DecodeError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 -> Converter a) -> Value -> Either ConvertError a
forall a r. (a -> Converter r) -> a -> Either ConvertError r
convert Value -> Converter a
forall a. FromValue a => Value -> Converter a
fromValue Value
v of
            Left ConvertError
cErr -> (Bytes, Either DecodeError a) -> m (Bytes, Either DecodeError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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, Either DecodeError a) -> m (Bytes, Either DecodeError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes
bs', a -> Either DecodeError a
forall a b. b -> Either a b
Right a
r)

-- | Decode JSON doc chunks, consuming trailing JSON whitespaces (other trailing bytes are not allowed).
decodeChunks' :: (FromValue a, Monad m) => m V.Bytes -> V.Bytes -> m (Either DecodeError a)
{-# INLINE decodeChunks' #-}
decodeChunks' :: m Bytes -> Bytes -> m (Either DecodeError a)
decodeChunks' m Bytes
mb Bytes
bs = do
    (Bytes, Either ParseError Value)
mr <- (Parser Value
-> m Bytes -> Bytes -> m (Bytes, Either ParseError Value)
forall (m :: * -> *) a.
Monad m =>
Parser a -> m Bytes -> Bytes -> m (Bytes, Either ParseError a)
P.parseChunks (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) m Bytes
mb Bytes
bs)
    case (Bytes, Either ParseError Value)
mr of
        (Bytes
_, Left ParseError
pErr) -> Either DecodeError a -> m (Either DecodeError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
_, Right Value
v) -> case (Value -> Converter a) -> Value -> Either ConvertError a
forall a r. (a -> Converter r) -> a -> Either ConvertError r
convert Value -> Converter a
forall a. FromValue a => Value -> Converter a
fromValue Value
v of
            Left ConvertError
cErr -> Either DecodeError a -> m (Either DecodeError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 -> Either DecodeError a -> m (Either DecodeError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either DecodeError a
forall a b. b -> Either a b
Right a
r)

-- | Directly encode data to JSON bytes.
encodeBytes :: EncodeJSON a => a -> V.Bytes
{-# INLINE encodeBytes #-}
encodeBytes :: a -> Bytes
encodeBytes = Builder () -> Bytes
forall a. Builder a -> Bytes
B.buildBytes (Builder () -> Bytes) -> (a -> Builder ()) -> a -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder ()
forall a. EncodeJSON a => a -> Builder ()
encodeJSON

-- | Text version 'encodeBytes'.
encodeText :: EncodeJSON a => a -> T.Text
{-# INLINE encodeText #-}
encodeText :: a -> Text
encodeText = TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (TextBuilder () -> Text) -> (a -> TextBuilder ()) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TextBuilder ()
forall a. EncodeJSON a => a -> TextBuilder ()
encodeTextBuilder

-- | JSON Docs are guaranteed to be valid UTF-8 texts, so we provide this.
encodeTextBuilder :: EncodeJSON a => a -> TB.TextBuilder ()
{-# INLINE encodeTextBuilder #-}
encodeTextBuilder :: a -> TextBuilder ()
encodeTextBuilder = Builder () -> TextBuilder ()
forall a. Builder a -> TextBuilder a
TB.unsafeFromBuilder (Builder () -> TextBuilder ())
-> (a -> Builder ()) -> a -> TextBuilder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder ()
forall a. EncodeJSON a => a -> Builder ()
encodeJSON

-- | Run a 'Converter' with input value.
convert :: (a -> Converter r) -> a -> Either ConvertError r
{-# INLINE convert #-}
convert :: (a -> Converter r) -> a -> Either ConvertError r
convert a -> Converter r
m a
v = Converter r
-> ([PathElement] -> Text -> Either ConvertError r)
-> (r -> Either ConvertError r)
-> Either ConvertError r
forall a.
Converter a
-> forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
runConverter (a -> Converter r
m a
v) (\ [PathElement]
paths Text
msg -> (ConvertError -> Either ConvertError r
forall a b. a -> Either a b
Left ([PathElement] -> Text -> ConvertError
ConvertError [PathElement]
paths Text
msg))) r -> Either ConvertError r
forall a b. b -> Either a b
Right

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

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

-- | Elements of a (JSON) Value path used to describe the location of an error.
data PathElement
    = Key {-# UNPACK #-} !T.Text
        -- ^ Path element of a key into an object,
        -- \"object.key\".
    | Index {-# UNPACK #-} !Int
        -- ^ Path element of an index into an
        -- array, \"array[index]\".
    | Embedded
        -- ^ path of a embedded (JSON) String
  deriving (PathElement -> PathElement -> Bool
(PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> Bool) -> Eq PathElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathElement -> PathElement -> Bool
$c/= :: PathElement -> PathElement -> Bool
== :: PathElement -> PathElement -> Bool
$c== :: PathElement -> PathElement -> Bool
Eq, Int -> PathElement -> ShowS
[PathElement] -> ShowS
PathElement -> String
(Int -> PathElement -> ShowS)
-> (PathElement -> String)
-> ([PathElement] -> ShowS)
-> Show PathElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathElement] -> ShowS
$cshowList :: [PathElement] -> ShowS
show :: PathElement -> String
$cshow :: PathElement -> String
showsPrec :: Int -> PathElement -> ShowS
$cshowsPrec :: Int -> PathElement -> ShowS
Show, Typeable, Eq PathElement
Eq PathElement
-> (PathElement -> PathElement -> Ordering)
-> (PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> PathElement)
-> (PathElement -> PathElement -> PathElement)
-> Ord PathElement
PathElement -> PathElement -> Bool
PathElement -> PathElement -> Ordering
PathElement -> PathElement -> PathElement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PathElement -> PathElement -> PathElement
$cmin :: PathElement -> PathElement -> PathElement
max :: PathElement -> PathElement -> PathElement
$cmax :: PathElement -> PathElement -> PathElement
>= :: PathElement -> PathElement -> Bool
$c>= :: PathElement -> PathElement -> Bool
> :: PathElement -> PathElement -> Bool
$c> :: PathElement -> PathElement -> Bool
<= :: PathElement -> PathElement -> Bool
$c<= :: PathElement -> PathElement -> Bool
< :: PathElement -> PathElement -> Bool
$c< :: PathElement -> PathElement -> Bool
compare :: PathElement -> PathElement -> Ordering
$ccompare :: PathElement -> PathElement -> Ordering
$cp1Ord :: Eq PathElement
Ord, (forall x. PathElement -> Rep PathElement x)
-> (forall x. Rep PathElement x -> PathElement)
-> Generic PathElement
forall x. Rep PathElement x -> PathElement
forall x. PathElement -> Rep PathElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathElement x -> PathElement
$cfrom :: forall x. PathElement -> Rep PathElement x
Generic, PathElement -> ()
(PathElement -> ()) -> NFData PathElement
forall a. (a -> ()) -> NFData a
rnf :: PathElement -> ()
$crnf :: PathElement -> ()
NFData)

data ConvertError = ConvertError { ConvertError -> [PathElement]
errPath :: [PathElement], ConvertError -> Text
errMsg :: T.Text } deriving (ConvertError -> ConvertError -> Bool
(ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> Bool) -> Eq ConvertError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConvertError -> ConvertError -> Bool
$c/= :: ConvertError -> ConvertError -> Bool
== :: ConvertError -> ConvertError -> Bool
$c== :: ConvertError -> ConvertError -> Bool
Eq, Eq ConvertError
Eq ConvertError
-> (ConvertError -> ConvertError -> Ordering)
-> (ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> ConvertError)
-> (ConvertError -> ConvertError -> ConvertError)
-> Ord ConvertError
ConvertError -> ConvertError -> Bool
ConvertError -> ConvertError -> Ordering
ConvertError -> ConvertError -> ConvertError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConvertError -> ConvertError -> ConvertError
$cmin :: ConvertError -> ConvertError -> ConvertError
max :: ConvertError -> ConvertError -> ConvertError
$cmax :: ConvertError -> ConvertError -> ConvertError
>= :: ConvertError -> ConvertError -> Bool
$c>= :: ConvertError -> ConvertError -> Bool
> :: ConvertError -> ConvertError -> Bool
$c> :: ConvertError -> ConvertError -> Bool
<= :: ConvertError -> ConvertError -> Bool
$c<= :: ConvertError -> ConvertError -> Bool
< :: ConvertError -> ConvertError -> Bool
$c< :: ConvertError -> ConvertError -> Bool
compare :: ConvertError -> ConvertError -> Ordering
$ccompare :: ConvertError -> ConvertError -> Ordering
$cp1Ord :: Eq ConvertError
Ord, (forall x. ConvertError -> Rep ConvertError x)
-> (forall x. Rep ConvertError x -> ConvertError)
-> Generic ConvertError
forall x. Rep ConvertError x -> ConvertError
forall x. ConvertError -> Rep ConvertError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConvertError x -> ConvertError
$cfrom :: forall x. ConvertError -> Rep ConvertError x
Generic, ConvertError -> ()
(ConvertError -> ()) -> NFData ConvertError
forall a. (a -> ()) -> NFData a
rnf :: ConvertError -> ()
$crnf :: ConvertError -> ()
NFData)

instance Show ConvertError where
    -- TODO use standard format
    show :: ConvertError -> String
show (ConvertError [PathElement]
paths Text
msg) = Text -> String
T.unpack (Text -> String)
-> (TextBuilder () -> Text) -> TextBuilder () -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (TextBuilder () -> String) -> TextBuilder () -> String
forall a b. (a -> b) -> a -> b
$ do
        TextBuilder ()
"<"
        (PathElement -> TextBuilder ()) -> [PathElement] -> TextBuilder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PathElement -> TextBuilder ()
renderPath ([PathElement] -> [PathElement]
forall a. [a] -> [a]
reverse [PathElement]
paths)
        TextBuilder ()
"> "
        Text -> TextBuilder ()
TB.text Text
msg
      where
        renderPath :: PathElement -> TextBuilder ()
renderPath (Index Int
ix) = Char -> TextBuilder ()
TB.char7 Char
'[' TextBuilder () -> TextBuilder () -> TextBuilder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> TextBuilder ()
forall a. (Integral a, Bounded a) => a -> TextBuilder ()
TB.int Int
ix TextBuilder () -> TextBuilder () -> TextBuilder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> TextBuilder ()
TB.char7 Char
']'
        renderPath (Key Text
k) = Char -> TextBuilder ()
TB.char7 Char
'.' TextBuilder () -> TextBuilder () -> TextBuilder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Builder () -> TextBuilder ()
forall a. Builder a -> TextBuilder a
TB.unsafeFromBuilder (Builder () -> TextBuilder ()) -> Builder () -> TextBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
JB.string Text
k)
        renderPath PathElement
Embedded = TextBuilder ()
"<Embedded>"

-- | 'Converter' for convert result from JSON 'Value'.
--
-- This is intended to be named differently from 'P.Parser' to clear confusions.
newtype Converter a = Converter { Converter a
-> forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
runConverter :: forall r. ([PathElement] -> T.Text -> r) -> (a -> r) -> r }

instance Functor Converter where
    fmap :: (a -> b) -> Converter a -> Converter b
fmap a -> b
f Converter a
m = (forall r. ([PathElement] -> Text -> r) -> (b -> r) -> r)
-> Converter b
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf b -> r
k -> Converter a -> ([PathElement] -> Text -> r) -> (a -> r) -> r
forall a.
Converter a
-> forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
runConverter Converter a
m [PathElement] -> Text -> r
kf (b -> r
k (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
    {-# INLINE fmap #-}

instance Applicative Converter where
    pure :: a -> Converter a
pure a
a = (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
_ a -> r
k -> a -> r
k a
a)
    {-# INLINE pure #-}
    (Converter forall r. ([PathElement] -> Text -> r) -> ((a -> b) -> r) -> r
f) <*> :: Converter (a -> b) -> Converter a -> Converter b
<*> (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
g) = (forall r. ([PathElement] -> Text -> r) -> (b -> r) -> r)
-> Converter b
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf b -> r
k ->
        ([PathElement] -> Text -> r) -> ((a -> b) -> r) -> r
forall r. ([PathElement] -> Text -> r) -> ((a -> b) -> r) -> r
f [PathElement] -> Text -> r
kf (\ a -> b
f' ->  ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
g [PathElement] -> Text -> r
kf (b -> r
k (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f')))
    {-# INLINE (<*>) #-}

instance Alternative Converter where
    {-# INLINE (<|>) #-}
    (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
f) <|> :: Converter a -> Converter a -> Converter a
<|> (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
g) = (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 -> ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
f (\ [PathElement]
_ Text
_ -> ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
g [PathElement] -> Text -> r
kf a -> r
k) a -> r
k)
    {-# INLINE empty #-}
    empty :: Converter a
empty = Text -> Converter a
forall a. Text -> Converter a
fail' Text
"Z.Data.JSON.Base(Alternative).empty"

instance MonadPlus Converter where
    mzero :: Converter a
mzero = Converter a
forall (f :: * -> *) a. Alternative f => f a
empty
    {-# INLINE mzero #-}
    mplus :: Converter a -> Converter a -> Converter a
mplus = Converter a -> Converter a -> Converter a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
    {-# INLINE mplus #-}

instance Monad Converter where
    (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
f) >>= :: Converter a -> (a -> Converter b) -> Converter b
>>= a -> Converter b
g = (forall r. ([PathElement] -> Text -> r) -> (b -> r) -> r)
-> Converter b
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf b -> r
k ->
        ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
f [PathElement] -> Text -> r
kf (\ a
a -> Converter b -> ([PathElement] -> Text -> r) -> (b -> r) -> r
forall a.
Converter a
-> forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
runConverter (a -> Converter b
g a
a) [PathElement] -> Text -> r
kf b -> r
k))
    {-# INLINE (>>=) #-}
    return :: a -> Converter a
return = a -> Converter a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}

instance Fail.MonadFail Converter where
    {-# INLINE fail #-}
    fail :: String -> Converter a
fail = Text -> Converter a
forall a. Text -> Converter a
fail' (Text -> Converter a) -> (String -> Text) -> String -> Converter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | 'T.Text' version of 'fail'.
fail' :: T.Text -> Converter a
{-# INLINE fail' #-}
fail' :: Text -> Converter a
fail' Text
msg = (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
_ -> [PathElement] -> Text -> r
kf [] Text
msg)

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

-- | 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"

-- | Add JSON Path context to a converter
--
-- When converting a complex structure, it helps to annotate (sub)converters
-- with context, so that if an error occurs, you can find its location.
--
-- > withFlatMapR "Person" $ \o ->
-- >   Person
-- >     <$> o .: "name" <?> Key "name"
-- >     <*> o .: "age" <?> Key "age"
--
-- (Standard methods like '(.:)' already do this.)
--
-- With such annotations, if an error occurs, you will get a JSON Path
-- location of that error.
(<?>) :: Converter a -> PathElement -> Converter a
{-# INLINE (<?>) #-}
(Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
p) <?> :: Converter a -> PathElement -> Converter a
<?> PathElement
path = (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 -> ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
p ([PathElement] -> Text -> r
kf ([PathElement] -> Text -> r)
-> ([PathElement] -> [PathElement]) -> [PathElement] -> Text -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathElement
pathPathElement -> [PathElement] -> [PathElement]
forall a. a -> [a] -> [a]
:)) a -> r
k)
infixl 9 <?>

-- | Add context to a failure message, indicating the name of the structure
-- being converted.
--
-- > prependContext "MyType" (fail "[error message]")
-- > -- Error: "converting MyType failed, [error message]"
prependContext :: T.Text -> Converter a -> Converter a
{-# INLINE prependContext #-}
prependContext :: Text -> Converter a -> Converter a
prependContext Text
name (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
p) = (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 ->
    ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
p (\ [PathElement]
paths Text
msg -> [PathElement] -> Text -> r
kf [PathElement]
paths (ParseError -> Text
T.concat [Text
"converting ", Text
name, Text
" failed, ", Text
msg])) a -> r
k)

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 'Data.Aeson.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)
-> (TextBuilder () -> Text) -> TextBuilder () -> Converter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (TextBuilder () -> Converter a) -> TextBuilder () -> Converter a
forall a b. (a -> b) -> a -> b
$ do
        TextBuilder ()
"converting "
        Text -> TextBuilder ()
TB.text Text
name
        TextBuilder ()
" failed, found a number with exponent "
        Int -> TextBuilder ()
forall a. (Integral a, Bounded a) => a -> TextBuilder ()
TB.int Int
e
        TextBuilder ()
", 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)
-> (TextBuilder () -> Text) -> TextBuilder () -> Converter r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (TextBuilder () -> Converter r) -> TextBuilder () -> Converter r
forall a b. (a -> b) -> a -> b
$ do
            TextBuilder ()
"converting "
            Text -> TextBuilder ()
TB.text Text
name
            TextBuilder ()
"failed, value is either floating or will cause over or underflow "
            Scientific -> TextBuilder ()
TB.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. FromValue 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
_                -> String -> r
forall a. HasCallStack => String -> a
error String
"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.
(.:) :: (FromValue 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. FromValue 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 'empty' 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.
(.:?) :: (FromValue 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. FromValue 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 'empty' 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'.
(.:!) :: (FromValue 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. FromValue 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.
commaList' :: EncodeJSON a => [a] -> B.Builder ()
{-# INLINE commaList' #-}
commaList' :: [a] -> Builder ()
commaList' = Builder () -> (a -> Builder ()) -> [a] -> Builder ()
forall a. Builder () -> (a -> Builder ()) -> [a] -> Builder ()
B.intercalateList Builder ()
B.comma a -> Builder ()
forall a. EncodeJSON a => a -> Builder ()
encodeJSON

-- | Use @,@ as separator to connect a vector of builders.
commaVec' :: (EncodeJSON a, V.Vec v a) => v a ->  B.Builder ()
{-# INLINE commaVec' #-}
commaVec' :: v a -> Builder ()
commaVec' = 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. EncodeJSON a => a -> Builder ()
encodeJSON

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

-- | Generic encode/decode Settings
--
-- There should be no control charactors 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 -> String -> Text
fieldFmt :: String -> T.Text  -- ^ format field labels
    , Settings -> String -> Text
constrFmt :: String -> T.Text -- ^ format constructor names.
    }

defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings = (String -> Text) -> (String -> Text) -> Settings
Settings String -> Text
T.pack String -> Text
T.pack

--------------------------------------------------------------------------------
-- ToValue
--------------------------------------------------------------------------------

-- | Typeclass for converting to JSON 'Value'.
class ToValue a where
    toValue :: a -> Value
    default toValue :: (Generic a, GToValue (Rep a)) => a -> Value
    toValue = Settings -> Rep a Any -> Value
forall (f :: * -> *) a. 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

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 (f :: * -> *) s a.
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 (f :: * -> *) s a.
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 (f :: * -> *) a. 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 -> String -> Text
fieldFmt Settings
s) (S1 ('MetaSel ('Just l) u ss ds) f a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName S1 ('MetaSel ('Just l) u ss ds) f a
m1), Settings -> f a -> Value
forall (f :: * -> *) a. 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 -> String -> Text
fieldFmt Settings
s (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ S1 ('MetaSel ('Just l) u ss ds) f a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName S1 ('MetaSel ('Just l) u ss ds) f a
m1
            v :: Value
v = Settings -> f a -> Value
forall (f :: * -> *) a. 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 (f :: * -> *) a. GToValue f => Settings -> f a -> Value
gToValue Settings
s f a
x

instance ToValue a => GToValue (K1 i a) where
    {-# INLINE gToValue #-}
    gToValue :: Settings -> K1 i a a -> Value
gToValue Settings
_ (K1 a
x) = a -> Value
forall a. ToValue 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 (f :: * -> *) 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
_ = String -> Value
forall a. HasCallStack => String -> a
error String
"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 (f :: * -> *) a.
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 (f :: * -> *) a.
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) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> String -> Text
constrFmt Settings
s (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
forall (t :: Meta -> (* -> *) -> * -> *) a. t c U1 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 (f :: * -> *) a. 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 -> String -> Text
constrFmt Settings
s (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
            v :: Value
v = Settings -> S1 sc f a -> Value
forall (f :: * -> *) a. 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 (f :: * -> *) s a.
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 (f :: * -> *) 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 -> String -> Text
constrFmt Settings
s (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
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 (f :: * -> *) s a.
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 (f :: * -> *) 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 (f :: * -> *) a.
GConstrToValue f =>
Bool -> Settings -> f a -> Value
gConstrToValue Bool
False Settings
s f a
x

--------------------------------------------------------------------------------
-- EncodeJSON
--------------------------------------------------------------------------------

class EncodeJSON a where
    encodeJSON :: a -> B.Builder ()
    default encodeJSON :: (Generic a, GEncodeJSON (Rep a)) => a -> B.Builder ()
    encodeJSON = Settings -> Rep a Any -> Builder ()
forall (f :: * -> *) a.
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

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 -> String -> Text
fieldFmt Settings
s (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ S1 ('MetaSel ('Just l) u ss ds) f a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName S1 ('MetaSel ('Just l) u ss ds) f a
m1) Text -> Builder () -> Builder ()
`JB.kv` Settings -> f a -> Builder ()
forall (f :: * -> *) a.
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 (f :: * -> *) a.
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 (f :: * -> *) a.
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 (f :: * -> *) a.
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s b a
b

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

class GAddPunctuation (f :: * -> *) 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
_ = String -> Builder ()
forall a. HasCallStack => String -> a
error String
"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 (f :: * -> *) a.
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 (f :: * -> *) a.
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 ()) -> (String -> Text) -> String -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> String -> Text
constrFmt Settings
s (String -> Builder ()) -> String -> Builder ()
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
forall (t :: Meta -> (* -> *) -> * -> *) a. t c U1 a
undefined :: t c U1 a)

-- | Constructor with a single payload
instance (Constructor c, GEncodeJSON (S1 sc f)) => GConstrEncodeJSON (C1 c (S1 sc f)) where
    {-# INLINE gConstrEncodeJSON #-}
    gConstrEncodeJSON :: Bool -> Settings -> C1 c (S1 sc f) a -> Builder ()
gConstrEncodeJSON Bool
False Settings
s (M1 S1 sc f a
x) = Settings -> S1 sc f a -> Builder ()
forall (f :: * -> *) a.
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s S1 sc f a
x
    gConstrEncodeJSON Bool
True Settings
s (M1 S1 sc f a
x) = Builder () -> Builder ()
B.curly (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        (Settings -> String -> Text
constrFmt Settings
s (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName @c Any c Any Any
forall a. HasCallStack => a
undefined) Text -> Builder () -> Builder ()
`JB.kv` Settings -> S1 sc f a -> Builder ()
forall (f :: * -> *) a.
GEncodeJSON f =>
Settings -> f a -> Builder ()
gEncodeJSON Settings
s S1 sc 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 (f :: * -> *) a.
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 -> String -> Text
constrFmt Settings
s (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
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 (f :: * -> *) a.
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 (f :: * -> *) a.
GConstrEncodeJSON f =>
Bool -> Settings -> f a -> Builder ()
gConstrEncodeJSON Bool
False Settings
s f a
x

--------------------------------------------------------------------------------
-- FromValue
--------------------------------------------------------------------------------

class FromValue 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 (f :: * -> *) a.
GFromValue f =>
Settings -> Value -> Converter (f a)
gFromValue Settings
defaultSettings Value
v

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 (f :: * -> *) a.
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 (f :: * -> *) a.
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 (f :: * -> *) a.
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 (f :: * -> *) a.
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
_       -> 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 -> String -> Text
fieldFmt Settings
s) (M1 S ('MetaSel ('Just l) u ss ds) f Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall a. 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 (f :: * -> *) a.
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 (f :: * -> *) a.
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
_       -> 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 -> String -> Text
fieldFmt Settings
s) (M1 S ('MetaSel ('Just l) u ss ds) f Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall a. 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 -> String -> Text
fieldFmt Settings
s) (M1 S ('MetaSel ('Just l) u ss ds) f Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall a. 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 FromValue 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. FromValue 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 (f :: * -> *).
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)
        | 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))
-> (TextBuilder () -> Text)
-> TextBuilder ()
-> Converter (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (TextBuilder () -> Converter (Vector Value))
-> TextBuilder () -> Converter (Vector Value)
forall a b. (a -> b) -> a -> b
$ do
            TextBuilder ()
"converting "
            Text -> TextBuilder ()
TB.text Text
name
            TextBuilder ()
" failed, product size mismatch, expected "
            Int -> TextBuilder ()
forall a. (Integral a, Bounded a) => a -> TextBuilder ()
TB.int Int
siz
            TextBuilder ()
", get"
            Int -> TextBuilder ()
forall a. (Integral a, Bounded a) => a -> TextBuilder ()
TB.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 #-}
    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
siz Text
name (Object Vector (Text, Value)
v)
        | Int
siz' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
siz = Text -> Converter (FlatMap Text Value)
forall a. Text -> Converter a
fail' (Text -> Converter (FlatMap Text Value))
-> (TextBuilder () -> Text)
-> TextBuilder ()
-> Converter (FlatMap Text Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (TextBuilder () -> Converter (FlatMap Text Value))
-> TextBuilder () -> Converter (FlatMap Text Value)
forall a b. (a -> b) -> a -> b
$ do
            TextBuilder ()
"converting "
            Text -> TextBuilder ()
TB.text Text
name
            TextBuilder ()
" failed, product size mismatch, expected "
            Int -> TextBuilder ()
forall a. (Integral a, Bounded a) => a -> TextBuilder ()
TB.int Int
siz
            TextBuilder ()
", get"
            Int -> TextBuilder ()
forall a. (Integral a, Bounded a) => a -> TextBuilder ()
TB.int Int
siz'
        | Bool
otherwise = FlatMap Text Value -> Converter (FlatMap Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlatMap Text Value
m
      where siz' :: Int
siz' = FlatMap Text Value -> Int
forall k v. FlatMap k v -> Int
FM.size FlatMap Text Value
m
            m :: FlatMap Text Value
m = 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 -> Settings -> Value -> Converter (f a)

instance GConstrFromValue V1 where
    {-# INLINE gConstrFromValue #-}
    gConstrFromValue :: Bool -> Settings -> Value -> Converter (V1 a)
gConstrFromValue Bool
_ Settings
_ Value
_ = String -> Converter (V1 a)
forall a. HasCallStack => String -> a
error String
"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 (f :: * -> *) a.
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 (f :: * -> *) a.
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 -> String -> Text
constrFmt Settings
s (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
forall (t :: Meta -> (* -> *) -> * -> *) a. t c U1 a
undefined :: t c U1 a)
            cn' :: Text
cn' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
forall (t :: Meta -> (* -> *) -> * -> *) a. t c U1 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' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
forall (t :: Meta -> (* -> *) -> * -> *) a. t c U1 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 #-}
    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 (f :: * -> *) a.
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 (f :: * -> *) a.
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 -> String -> Text
constrFmt Settings
s (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
            cn' :: Text
cn' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
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 (f :: * -> *).
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 (f :: * -> *) a.
GFromFields f =>
Settings -> LookupTable f -> Int -> Converter (f a)
gFromFields Settings
s LookupTable a
LookupTable (a :*: b)
t Int
0
      where cn' :: Text
cn' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
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 (f :: * -> *).
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 (f :: * -> *) a.
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 -> String -> Text
constrFmt Settings
s (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
            cn' :: Text
cn' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any c Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
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 (f :: * -> *) a.
GConstrFromValue f =>
Bool -> Settings -> Value -> Converter (f a)
gConstrFromValue Bool
False Settings
s Value
x

--------------------------------------------------------------------------------
-- Built-in Instances
--------------------------------------------------------------------------------
-- | Use 'Null' as @Proxy a@
instance FromValue (Proxy a)   where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter (Proxy a)
fromValue = Text -> Proxy a -> Value -> Converter (Proxy a)
forall a. Text -> a -> Value -> Converter a
fromNull Text
"Proxy" Proxy a
forall k (t :: k). Proxy t
Proxy;}
instance ToValue (Proxy a)     where {{-# INLINE toValue #-}; toValue :: Proxy a -> Value
toValue Proxy a
_ = Value
Null;}
instance EncodeJSON (Proxy a) where {{-# INLINE encodeJSON #-}; encodeJSON :: Proxy a -> Builder ()
encodeJSON Proxy a
_ = Builder ()
"null";}

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

instance FromValue 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;}
instance ToValue T.Text     where {{-# INLINE toValue #-}; toValue :: Text -> Value
toValue = Text -> Value
String;}
instance EncodeJSON T.Text where {{-# INLINE encodeJSON #-}; encodeJSON :: Text -> Builder ()
encodeJSON = Text -> Builder ()
JB.string;}

instance FromValue TB.Str where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter Str
fromValue = Text -> (Text -> Converter Str) -> Value -> Converter Str
forall a. Text -> (Text -> Converter a) -> Value -> Converter a
withText Text
"Str" (Str -> Converter Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Str -> Converter Str) -> (Text -> Str) -> Text -> Converter Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Str
TB.Str (String -> Str) -> (Text -> String) -> Text -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
instance ToValue TB.Str where
    {-# INLINE toValue #-}
    toValue :: Str -> Value
toValue = Text -> Value
String (Text -> Value) -> (Str -> Text) -> Str -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Str -> String) -> Str -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> String
TB.chrs
instance EncodeJSON TB.Str where
    {-# INLINE encodeJSON #-}
    encodeJSON :: Str -> Builder ()
encodeJSON = Text -> Builder ()
JB.string (Text -> Builder ()) -> (Str -> Text) -> Str -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Str -> String) -> Str -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> String
TB.chrs

instance FromValue 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;}
instance ToValue Scientific where {{-# INLINE toValue #-}; toValue :: Scientific -> Value
toValue = Scientific -> Value
Number;}
instance EncodeJSON Scientific where {{-# INLINE encodeJSON #-}; encodeJSON :: Scientific -> Builder ()
encodeJSON = Scientific -> Builder ()
B.scientific;}

-- | default instance prefer later key
instance FromValue a => FromValue (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. FromValue a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
k)
instance ToValue a => ToValue (FM.FlatMap T.Text a) where
    {-# 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. ToValue a => a -> Value
toValue
instance EncodeJSON a => EncodeJSON (FM.FlatMap T.Text a) where
    {-# 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. EncodeJSON 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, FromValue a) => FromValue (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. FromValue 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))
instance ToValue a => ToValue (FS.FlatSet a) where
    {-# 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. ToValue 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
instance EncodeJSON a => EncodeJSON (FS.FlatSet a) where
    {-# 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. EncodeJSON 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 FromValue a => FromValue (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. FromValue a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Text -> PathElement
Key Text
k)
instance ToValue a => ToValue (HM.HashMap T.Text a) where
    {-# 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. ToValue a => a -> Value
toValue
instance EncodeJSON a => EncodeJSON (HM.HashMap T.Text a) where
    {-# 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. EncodeJSON 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 FromValue a => FromValue (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 => Parser a
P.int (Text -> Bytes
T.getUTF8Bytes Text
k) of
                Right Int
k' -> do
                    a
v' <- Value -> Converter a
forall a. FromValue 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))
instance ToValue a => ToValue (FIM.FlatIntMap a) where
    {-# 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. ToValue 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 = TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (Int -> TextBuilder ()
forall a. (Integral a, Bounded a) => a -> TextBuilder ()
TB.int Int
i)
                                     !v :: Value
v = a -> Value
forall a. ToValue a => a -> Value
toValue a
x
                                 in (Text
k, Value
v)
instance EncodeJSON a => EncodeJSON (FIM.FlatIntMap a) where
    {-# 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. EncodeJSON 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 FromValue 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. FromValue 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)
instance ToValue FIS.FlatIntSet where
    {-# INLINE toValue #-}
    toValue :: FlatIntSet -> Value
toValue = PrimVector Int -> Value
forall a. ToValue 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
instance EncodeJSON FIS.FlatIntSet where
    {-# INLINE encodeJSON #-}
    encodeJSON :: FlatIntSet -> Builder ()
encodeJSON = PrimVector Int -> Builder ()
forall a. EncodeJSON 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 FromValue a => FromValue (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. FromValue a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k)
instance ToValue a => ToValue (V.Vector a) where
    {-# 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. ToValue a => a -> Value
toValue
instance EncodeJSON a => EncodeJSON (V.Vector a) where
    {-# 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 :: * -> *).
(EncodeJSON a, Vec v a) =>
v a -> Builder ()
commaVec'

instance (Prim a, FromValue a) => FromValue (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. FromValue a => Value -> Converter a
fromValue Value
v Converter a -> PathElement -> Converter a
forall a. Converter a -> PathElement -> Converter a
<?> Int -> PathElement
Index Int
k)
instance (Prim a, ToValue a) => ToValue (V.PrimVector a) where
    {-# 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. ToValue a => a -> Value
toValue
instance (Prim a, EncodeJSON a) => EncodeJSON (V.PrimVector a) where
    {-# 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 :: * -> *).
(EncodeJSON a, Vec v a) =>
v a -> Builder ()
commaVec'

instance (Eq a, Hashable a, FromValue a) => FromValue (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. FromValue 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))
instance (ToValue a) => ToValue (HS.HashSet a) where
    {-# INLINE toValue #-}
    toValue :: HashSet a -> Value
toValue = [a] -> Value
forall a. ToValue 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
instance (EncodeJSON a) => EncodeJSON (HS.HashSet a) where
    {-# INLINE encodeJSON #-}
    encodeJSON :: HashSet a -> Builder ()
encodeJSON = [a] -> Builder ()
forall a. EncodeJSON 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 FromValue a => FromValue [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. FromValue 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)
instance ToValue a => ToValue [a] where
    {-# 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. ToValue a => a -> Value
toValue
instance EncodeJSON a => EncodeJSON [a] where
    {-# 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. EncodeJSON a => [a] -> Builder ()
commaList'

instance FromValue a => FromValue (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. FromValue 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"
instance (ToValue a) => ToValue (NonEmpty a) where
    {-# INLINE toValue #-}
    toValue :: NonEmpty a -> Value
toValue = [a] -> Value
forall a. ToValue 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
instance (EncodeJSON a) => EncodeJSON (NonEmpty a) where
    {-# INLINE encodeJSON #-}
    encodeJSON :: NonEmpty a -> Builder ()
encodeJSON = [a] -> Builder ()
forall a. EncodeJSON 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 FromValue 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;}
instance ToValue Bool where {{-# INLINE toValue #-}; toValue :: Bool -> Value
toValue = Bool -> Value
Bool; }
instance EncodeJSON Bool where {{-# INLINE encodeJSON #-}; encodeJSON :: Bool -> Builder ()
encodeJSON Bool
True = Builder ()
"true"; encodeJSON Bool
_ = Builder ()
"false";}

instance FromValue 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 ->
        case Text -> Maybe Char
T.headMaybe Text
t of
            Just Char
c -> Char -> Converter Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
            Maybe Char
_      -> Text -> Converter Char
forall a. Text -> Converter a
fail' (ParseError -> Text
T.concat [Text
"converting Char failed, expected a string of length 1"])
instance ToValue Char where
    {-# 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
instance EncodeJSON Char where
-- @
--    \'\\b\':  \"\\b\"
--    \'\\f\':  \"\\f\"
--    \'\\n\':  \"\\n\"
--    \'\\r\':  \"\\r\"
--    \'\\t\':  \"\\t\"
--    \'\"\':  \"\\\"\"
--    \'\\\':  \"\\\\\"
--    \'\/\':  \"\\/\"
--    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
'/'  = 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 FromValue 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;}
instance FromValue 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
"Double" Float -> Converter Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance ToValue Float  where {{-# 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
P.floatToScientific;}
instance ToValue Double where {{-# 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
P.doubleToScientific;}
instance EncodeJSON Float  where {{-# INLINE encodeJSON #-}; encodeJSON :: Float -> Builder ()
encodeJSON = Float -> Builder ()
B.float;}
instance EncodeJSON Double where {{-# INLINE encodeJSON #-}; encodeJSON :: Double -> Builder ()
encodeJSON = Double -> Builder ()
B.double;}

instance FromValue Int    where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Int
fromValue = Text -> (Int -> Converter Int) -> Value -> Converter Int
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Int" Int -> Converter Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance FromValue Int8   where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Int8
fromValue = Text -> (Int8 -> Converter Int8) -> Value -> Converter Int8
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Int8" Int8 -> Converter Int8
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance FromValue Int16  where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Int16
fromValue = Text -> (Int16 -> Converter Int16) -> Value -> Converter Int16
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Int16" Int16 -> Converter Int16
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance FromValue Int32  where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Int32
fromValue = Text -> (Int32 -> Converter Int32) -> Value -> Converter Int32
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Int32" Int32 -> Converter Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance FromValue Int64  where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Int64
fromValue = Text -> (Int64 -> Converter Int64) -> Value -> Converter Int64
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Int64" Int64 -> Converter Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance FromValue Word   where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Word
fromValue = Text -> (Word -> Converter Word) -> Value -> Converter Word
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Word" Word -> Converter Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance FromValue Word8  where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Word8
fromValue = Text -> (Word8 -> Converter Word8) -> Value -> Converter Word8
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Word8" Word8 -> Converter Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance FromValue Word16 where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Word16
fromValue = Text -> (Word16 -> Converter Word16) -> Value -> Converter Word16
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Word16" Word16 -> Converter Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance FromValue Word32 where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Word32
fromValue = Text -> (Word32 -> Converter Word32) -> Value -> Converter Word32
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Word32" Word32 -> Converter Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance FromValue Word64 where {{-# INLINE fromValue #-}; fromValue :: Value -> Converter Word64
fromValue = Text -> (Word64 -> Converter Word64) -> Value -> Converter Word64
forall a r.
(Bounded a, Integral a) =>
Text -> (a -> Converter r) -> Value -> Converter r
withBoundedIntegral Text
"Word64" Word64 -> Converter Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure;}
instance ToValue Int    where {{-# INLINE toValue #-}; toValue :: Int -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Int -> Scientific) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance ToValue Int8   where {{-# INLINE toValue #-}; toValue :: Int8 -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Int8 -> Scientific) -> Int8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance ToValue Int16  where {{-# INLINE toValue #-}; toValue :: Int16 -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Int16 -> Scientific) -> Int16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance ToValue Int32  where {{-# INLINE toValue #-}; toValue :: Int32 -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Int32 -> Scientific) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance ToValue Int64  where {{-# INLINE toValue #-}; toValue :: Int64 -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Int64 -> Scientific) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance ToValue Word   where {{-# INLINE toValue #-}; toValue :: Word -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Word -> Scientific) -> Word -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance ToValue Word8  where {{-# INLINE toValue #-}; toValue :: Word8 -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Word8 -> Scientific) -> Word8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance ToValue Word16 where {{-# INLINE toValue #-}; toValue :: Word16 -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Word16 -> Scientific) -> Word16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance ToValue Word32 where {{-# INLINE toValue #-}; toValue :: Word32 -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Word32 -> Scientific) -> Word32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance ToValue Word64 where {{-# INLINE toValue #-}; toValue :: Word64 -> Value
toValue = Scientific -> Value
Number (Scientific -> Value) -> (Word64 -> Scientific) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral;}
instance EncodeJSON Int   where {{-# INLINE encodeJSON #-}; encodeJSON :: Int -> Builder ()
encodeJSON = Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}
instance EncodeJSON Int8  where {{-# INLINE encodeJSON #-}; encodeJSON :: Int8 -> Builder ()
encodeJSON = Int8 -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}
instance EncodeJSON Int16 where {{-# INLINE encodeJSON #-}; encodeJSON :: Int16 -> Builder ()
encodeJSON = Int16 -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}
instance EncodeJSON Int32 where {{-# INLINE encodeJSON #-}; encodeJSON :: Int32 -> Builder ()
encodeJSON = Int32 -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}
instance EncodeJSON Int64 where {{-# INLINE encodeJSON #-}; encodeJSON :: Int64 -> Builder ()
encodeJSON = Int64 -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}
instance EncodeJSON Word   where {{-# INLINE encodeJSON #-}; encodeJSON :: Word -> Builder ()
encodeJSON = Word -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}
instance EncodeJSON Word8  where {{-# INLINE encodeJSON #-}; encodeJSON :: Word8 -> Builder ()
encodeJSON = Word8 -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}
instance EncodeJSON Word16 where {{-# INLINE encodeJSON #-}; encodeJSON :: Word16 -> Builder ()
encodeJSON = Word16 -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}
instance EncodeJSON Word32 where {{-# INLINE encodeJSON #-}; encodeJSON :: Word32 -> Builder ()
encodeJSON = Word32 -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}
instance EncodeJSON Word64 where {{-# INLINE encodeJSON #-}; encodeJSON :: Word64 -> Builder ()
encodeJSON = Word64 -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int;}

-- | This instance includes a bounds check to prevent maliciously large inputs to fill up the memory of the target system. You can newtype Scientific and provide your own instance using 'withScientific' if you want to allow larger inputs.
instance FromValue 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)
-> (TextBuilder () -> Text) -> TextBuilder () -> Converter Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (TextBuilder () -> Converter Integer)
-> TextBuilder () -> Converter Integer
forall a b. (a -> b) -> a -> b
$ do
                TextBuilder ()
"converting Integer failed, unexpected floating number "
                Scientific -> TextBuilder ()
TB.scientific Scientific
n
instance ToValue Integer where
    {-# 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
instance EncodeJSON Integer where
    {-# INLINE encodeJSON #-}
    encodeJSON :: Integer -> Builder ()
encodeJSON = Integer -> Builder ()
B.integer

instance FromValue 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)
-> (TextBuilder () -> Text) -> TextBuilder () -> Converter Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (TextBuilder () -> Converter Natural)
-> TextBuilder () -> Converter Natural
forall a b. (a -> b) -> a -> b
$ do
                TextBuilder ()
"converting Natural failed, unexpected negative number "
                Scientific -> TextBuilder ()
TB.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)
-> (TextBuilder () -> Text) -> TextBuilder () -> Converter Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuilder () -> Text
forall a. TextBuilder a -> Text
TB.buildText (TextBuilder () -> Converter Natural)
-> TextBuilder () -> Converter Natural
forall a b. (a -> b) -> a -> b
$ do
                TextBuilder ()
"converting Natural failed, unexpected floating number "
                Scientific -> TextBuilder ()
TB.scientific Scientific
n
instance ToValue Natural where
    {-# 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
instance EncodeJSON Natural where
    {-# 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 FromValue Ordering where
    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\""]
instance ToValue Ordering where
    {-# 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"
instance EncodeJSON Ordering where
    {-# INLINE encodeJSON #-}
    encodeJSON :: Ordering -> Builder ()
encodeJSON Ordering
LT = Builder ()
"LT"
    encodeJSON Ordering
EQ = Builder ()
"EQ"
    encodeJSON Ordering
GT = Builder ()
"GT"

instance FromValue () 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"
instance ToValue () where
    {-# INLINE toValue #-}
    toValue :: () -> Value
toValue () = Vector Value -> Value
Array Vector Value
forall (v :: * -> *) a. Vec v a => v a
V.empty
instance EncodeJSON () where
    {-# INLINE encodeJSON #-}
    encodeJSON :: () -> Builder ()
encodeJSON () = Builder ()
"[]"

instance FromValue Version where
    {-# INLINE fromValue #-}
    fromValue :: Value -> Converter Version
fromValue = Text -> (Text -> Converter Version) -> Value -> Converter Version
forall a. Text -> (Text -> Converter a) -> Value -> Converter a
withText Text
"Version" ([(Version, String)] -> Converter Version
forall (f :: * -> *) a a. MonadFail f => [(a, [a])] -> f a
go ([(Version, String)] -> Converter Version)
-> (Text -> [(Version, String)]) -> Text -> Converter Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion ReadS Version -> (Text -> String) -> Text -> [(Version, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
      where
        go :: [(a, [a])] -> f a
go [(a
v,[])] = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
        go ((a, [a])
_ : [(a, [a])]
xs) = [(a, [a])] -> f a
go [(a, [a])]
xs
        go [(a, [a])]
_        = String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"converting Version failed"
instance ToValue Version where
    {-# INLINE toValue #-}
    toValue :: Version -> Value
toValue = Text -> Value
String (Text -> Value) -> (Version -> Text) -> Version -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Version -> String) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
forall a. Show a => a -> String
show
instance EncodeJSON Version where
    {-# INLINE encodeJSON #-}
    encodeJSON :: Version -> Builder ()
encodeJSON = String -> Builder ()
B.string7 (String -> Builder ())
-> (Version -> String) -> Version -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
forall a. Show a => a -> String
show

instance FromValue a => FromValue (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. FromValue a => Value -> Converter a
fromValue Value
v
instance ToValue a => ToValue (Maybe a) where
    {-# INLINE toValue #-}
    toValue :: Maybe a -> Value
toValue Maybe a
Nothing = Value
Null
    toValue (Just a
x) = a -> Value
forall a. ToValue a => a -> Value
toValue a
x
instance EncodeJSON a => EncodeJSON (Maybe a) where
    {-# INLINE encodeJSON #-}
    encodeJSON :: Maybe a -> Builder ()
encodeJSON Maybe a
Nothing = Builder ()
"null"
    encodeJSON (Just a
x) = a -> Builder ()
forall a. EncodeJSON 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 (FromValue a, Integral a) => FromValue (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. FromValue a => FlatMap Text Value -> Text -> Converter a
.: Text
"numerator"
        a
d <- FlatMap Text Value
obj FlatMap Text Value -> Text -> Converter a
forall a. FromValue 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)
instance (ToValue a, Integral a) => ToValue (Ratio a) where
    {-# INLINE toValue #-}
    toValue :: Ratio a -> Value
toValue Ratio a
x = Vector (Text, Value) -> Value
Object ([(Text, Value)] -> Vector (Text, Value)
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack [(Text
"numerator", Value
n), (Text
"denominator", Value
d)])
      where !n :: Value
n = a -> Value
forall a. ToValue a => a -> Value
toValue (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
x)
            !d :: Value
d = a -> Value
forall a. ToValue a => a -> Value
toValue (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
x)
instance (EncodeJSON a, Integral a) => EncodeJSON (Ratio a) where
    {-# INLINE encodeJSON #-}
    encodeJSON :: Ratio a -> Builder ()
encodeJSON Ratio a
x =
        Builder () -> Builder ()
B.curly (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ (Builder ()
"\"numerator\""   Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
B.colon Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Builder ()
forall a. EncodeJSON a => a -> Builder ()
encodeJSON (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
x))
            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 ()
"\"denominator\"" Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
B.colon Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Builder ()
forall a. EncodeJSON a => a -> Builder ()
encodeJSON (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 => FromValue (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)
instance HasResolution a => ToValue (Fixed a) where
    {-# 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
instance HasResolution a => EncodeJSON (Fixed a) where
    {-# 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

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

deriving newtype instance FromValue (f (g a)) => FromValue (Compose f g a)
deriving newtype instance FromValue a => FromValue (Semigroup.Min a)
deriving newtype instance FromValue a => FromValue (Semigroup.Max a)
deriving newtype instance FromValue a => FromValue (Semigroup.First a)
deriving newtype instance FromValue a => FromValue (Semigroup.Last a)
deriving newtype instance FromValue a => FromValue (Semigroup.WrappedMonoid a)
deriving newtype instance FromValue a => FromValue (Semigroup.Dual a)
deriving newtype instance FromValue a => FromValue (Monoid.First a)
deriving newtype instance FromValue a => FromValue (Monoid.Last a)
deriving newtype instance FromValue a => FromValue (Identity a)
deriving newtype instance FromValue a => FromValue (Const a b)
deriving newtype instance FromValue b => FromValue (Tagged a b)

deriving newtype instance ToValue (f (g a)) => ToValue (Compose f g a)
deriving newtype instance ToValue a => ToValue (Semigroup.Min a)
deriving newtype instance ToValue a => ToValue (Semigroup.Max a)
deriving newtype instance ToValue a => ToValue (Semigroup.First a)
deriving newtype instance ToValue a => ToValue (Semigroup.Last a)
deriving newtype instance ToValue a => ToValue (Semigroup.WrappedMonoid a)
deriving newtype instance ToValue a => ToValue (Semigroup.Dual a)
deriving newtype instance ToValue a => ToValue (Monoid.First a)
deriving newtype instance ToValue a => ToValue (Monoid.Last a)
deriving newtype instance ToValue a => ToValue (Identity a)
deriving newtype instance ToValue a => ToValue (Const a b)
deriving newtype instance ToValue b => ToValue (Tagged a b)

deriving newtype instance EncodeJSON (f (g a)) => EncodeJSON (Compose f g a)
deriving newtype instance EncodeJSON a => EncodeJSON (Semigroup.Min a)
deriving newtype instance EncodeJSON a => EncodeJSON (Semigroup.Max a)
deriving newtype instance EncodeJSON a => EncodeJSON (Semigroup.First a)
deriving newtype instance EncodeJSON a => EncodeJSON (Semigroup.Last a)
deriving newtype instance EncodeJSON a => EncodeJSON (Semigroup.WrappedMonoid a)
deriving newtype instance EncodeJSON a => EncodeJSON (Semigroup.Dual a)
deriving newtype instance EncodeJSON a => EncodeJSON (Monoid.First a)
deriving newtype instance EncodeJSON a => EncodeJSON (Monoid.Last a)
deriving newtype instance EncodeJSON a => EncodeJSON (Identity a)
deriving newtype instance EncodeJSON a => EncodeJSON (Const a b)
deriving newtype instance EncodeJSON b => EncodeJSON (Tagged a b)

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

deriving anyclass instance (FromValue (f a), FromValue (g a), FromValue a) => FromValue (Sum f g a)
deriving anyclass instance (FromValue a, FromValue b) => FromValue (Either a b)
deriving anyclass instance (FromValue (f a), FromValue (g a)) => FromValue (Product f g a)
deriving anyclass instance (FromValue a, FromValue b) => FromValue (a, b)
deriving anyclass instance (FromValue a, FromValue b, FromValue c) => FromValue (a, b, c)
deriving anyclass instance (FromValue a, FromValue b, FromValue c, FromValue d) => FromValue (a, b, c, d)
deriving anyclass instance (FromValue a, FromValue b, FromValue c, FromValue d, FromValue e) => FromValue (a, b, c, d, e)
deriving anyclass instance (FromValue a, FromValue b, FromValue c, FromValue d, FromValue e, FromValue f) => FromValue (a, b, c, d, e, f)
deriving anyclass instance (FromValue a, FromValue b, FromValue c, FromValue d, FromValue e, FromValue f, FromValue g) => FromValue (a, b, c, d, e, f, g)

deriving anyclass instance (ToValue (f a), ToValue (g a), ToValue a) => ToValue (Sum f g a)
deriving anyclass instance (ToValue a, ToValue b) => ToValue (Either a b)
deriving anyclass instance (ToValue (f a), ToValue (g a)) => ToValue (Product f g a)
deriving anyclass instance (ToValue a, ToValue b) => ToValue (a, b)
deriving anyclass instance (ToValue a, ToValue b, ToValue c) => ToValue (a, b, c)
deriving anyclass instance (ToValue a, ToValue b, ToValue c, ToValue d) => ToValue (a, b, c, d)
deriving anyclass instance (ToValue a, ToValue b, ToValue c, ToValue d, ToValue e) => ToValue (a, b, c, d, e)
deriving anyclass instance (ToValue a, ToValue b, ToValue c, ToValue d, ToValue e, ToValue f) => ToValue (a, b, c, d, e, f)
deriving anyclass instance (ToValue a, ToValue b, ToValue c, ToValue d, ToValue e, ToValue f, ToValue g) => ToValue (a, b, c, d, e, f, g)

deriving anyclass instance (EncodeJSON (f a), EncodeJSON (g a), EncodeJSON a) => EncodeJSON (Sum f g a)
deriving anyclass instance (EncodeJSON a, EncodeJSON b) => EncodeJSON (Either a b)
deriving anyclass instance (EncodeJSON (f a), EncodeJSON (g a)) => EncodeJSON (Product f g a)
deriving anyclass instance (EncodeJSON a, EncodeJSON b) => EncodeJSON (a, b)
deriving anyclass instance (EncodeJSON a, EncodeJSON b, EncodeJSON c) => EncodeJSON (a, b, c)
deriving anyclass instance (EncodeJSON a, EncodeJSON b, EncodeJSON c, EncodeJSON d) => EncodeJSON (a, b, c, d)
deriving anyclass instance (EncodeJSON a, EncodeJSON b, EncodeJSON c, EncodeJSON d, EncodeJSON e) => EncodeJSON (a, b, c, d, e)
deriving anyclass instance (EncodeJSON a, EncodeJSON b, EncodeJSON c, EncodeJSON d, EncodeJSON e, EncodeJSON f) => EncodeJSON (a, b, c, d, e, f)
deriving anyclass instance (EncodeJSON a, EncodeJSON b, EncodeJSON c, EncodeJSON d, EncodeJSON e, EncodeJSON f, EncodeJSON g) => EncodeJSON (a, b, c, d, e, f, g)