{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-dodgy-exports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Capnp.Gen.Capnp.Compat.Json.New where
import qualified Capnp.Repr as R
import qualified Capnp.Repr.Parsed as RP
import qualified Capnp.New.Basics as Basics
import qualified GHC.OverloadedLabels as OL
import qualified Capnp.GenHelpers.New as GH
import qualified Capnp.New.Classes as C
import qualified GHC.Generics as Generics
import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
import qualified Prelude as Std_
import qualified Data.Word as Std_
import qualified Data.Int as Std_
import Prelude ((<$>), (<*>), (>>=))
data Value 
type instance (R.ReprFor Value) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Value) where
    numStructWords :: Word16
numStructWords  = Word16
2
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Value) where
    type AllocHint Value = ()
    new :: AllocHint Value -> Message ('Mut s) -> m (Raw ('Mut s) Value)
new AllocHint Value
_ = Message ('Mut s) -> m (Raw ('Mut s) Value)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Value (C.Parsed Value))
instance (C.AllocateList Value) where
    type ListAllocHint Value = Std_.Int
    newList :: ListAllocHint Value
-> Message ('Mut s) -> m (Raw ('Mut s) (List Value))
newList  = ListAllocHint Value
-> Message ('Mut s) -> m (Raw ('Mut s) (List Value))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Value (C.Parsed Value))
data instance C.Parsed Value
    = Value 
        {Parsed Value -> Parsed (Which Value)
union' :: (C.Parsed (GH.Which Value))}
    deriving((forall x. Parsed Value -> Rep (Parsed Value) x)
-> (forall x. Rep (Parsed Value) x -> Parsed Value)
-> Generic (Parsed Value)
forall x. Rep (Parsed Value) x -> Parsed Value
forall x. Parsed Value -> Rep (Parsed Value) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Value) x -> Parsed Value
$cfrom :: forall x. Parsed Value -> Rep (Parsed Value) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Value))
deriving instance (Std_.Eq (C.Parsed Value))
instance (C.Parse Value (C.Parsed Value)) where
    parse :: Raw 'Const Value -> m (Parsed Value)
parse Raw 'Const Value
raw_ = (Parsed (Which Value) -> Parsed Value
Value (Parsed (Which Value) -> Parsed Value)
-> m (Parsed (Which Value)) -> m (Parsed Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Value) -> m (Parsed (Which Value))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Value -> Raw 'Const (Which Value)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Value
raw_)))
instance (C.Marshal Value (C.Parsed Value)) where
    marshalInto :: Raw ('Mut s) Value -> Parsed Value -> m ()
marshalInto Raw ('Mut s) Value
raw_ Value{..} = (do
        (Raw ('Mut s) (Which Value) -> Parsed (Which Value) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Value -> Raw ('Mut s) (Which Value)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Value
raw_) Parsed (Which Value)
union')
        )
instance (GH.HasUnion Value) where
    unionField :: Field 'Slot Value Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Value Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
16 Word64
0)
    data RawWhich mut_ Value
        = RW_Value'null (R.Raw mut_ ())
        | RW_Value'boolean (R.Raw mut_ Std_.Bool)
        | RW_Value'number (R.Raw mut_ Std_.Double)
        | RW_Value'string (R.Raw mut_ Basics.Text)
        | RW_Value'array (R.Raw mut_ (R.List Value))
        | RW_Value'object (R.Raw mut_ (R.List Value'Field))
        | RW_Value'call (R.Raw mut_ Value'Call)
        | RW_Value'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Value -> m (RawWhich mut Value)
internalWhich Word16
tag_ Raw mut Value
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Value
RW_Value'null (Raw mut () -> RawWhich mut Value)
-> m (Raw mut ()) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value () -> Raw mut Value -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "null" (Variant 'Slot Value ())
Variant 'Slot Value ()
#null Raw mut Value
struct_))
        Word16
1 ->
            (Raw mut Bool -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Bool -> RawWhich mut_ Value
RW_Value'boolean (Raw mut Bool -> RawWhich mut Value)
-> m (Raw mut Bool) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Bool -> Raw mut Value -> m (Raw mut Bool)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "boolean" (Variant 'Slot Value Bool)
Variant 'Slot Value Bool
#boolean Raw mut Value
struct_))
        Word16
2 ->
            (Raw mut Double -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Double -> RawWhich mut_ Value
RW_Value'number (Raw mut Double -> RawWhich mut Value)
-> m (Raw mut Double) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Double -> Raw mut Value -> m (Raw mut Double)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "number" (Variant 'Slot Value Double)
Variant 'Slot Value Double
#number Raw mut Value
struct_))
        Word16
3 ->
            (Raw mut Text -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Text -> RawWhich mut_ Value
RW_Value'string (Raw mut Text -> RawWhich mut Value)
-> m (Raw mut Text) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Text -> Raw mut Value -> m (Raw mut Text)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "string" (Variant 'Slot Value Text)
Variant 'Slot Value Text
#string Raw mut Value
struct_))
        Word16
4 ->
            (Raw mut (List Value) -> RawWhich mut Value
forall (mut_ :: Mutability).
Raw mut_ (List Value) -> RawWhich mut_ Value
RW_Value'array (Raw mut (List Value) -> RawWhich mut Value)
-> m (Raw mut (List Value)) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value (List Value)
-> Raw mut Value -> m (Raw mut (List Value))
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "array" (Variant 'Slot Value (List Value))
Variant 'Slot Value (List Value)
#array Raw mut Value
struct_))
        Word16
5 ->
            (Raw mut (List Value'Field) -> RawWhich mut Value
forall (mut_ :: Mutability).
Raw mut_ (List Value'Field) -> RawWhich mut_ Value
RW_Value'object (Raw mut (List Value'Field) -> RawWhich mut Value)
-> m (Raw mut (List Value'Field)) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value (List Value'Field)
-> Raw mut Value -> m (Raw mut (List Value'Field))
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "object" (Variant 'Slot Value (List Value'Field))
Variant 'Slot Value (List Value'Field)
#object Raw mut Value
struct_))
        Word16
6 ->
            (Raw mut Value'Call -> RawWhich mut Value
forall (mut_ :: Mutability).
Raw mut_ Value'Call -> RawWhich mut_ Value
RW_Value'call (Raw mut Value'Call -> RawWhich mut Value)
-> m (Raw mut Value'Call) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Value'Call
-> Raw mut Value -> m (Raw mut Value'Call)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "call" (Variant 'Slot Value Value'Call)
Variant 'Slot Value Value'Call
#call Raw mut Value
struct_))
        Word16
_ ->
            (RawWhich mut Value -> m (RawWhich mut Value)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Value
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Value
RW_Value'unknown' Word16
tag_))
    data Which Value
instance (GH.HasVariant "null" GH.Slot Value ()) where
    variantByLabel :: Variant 'Slot Value ()
variantByLabel  = (Field 'Slot Value () -> Word16 -> Variant 'Slot Value ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Value ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "boolean" GH.Slot Value Std_.Bool) where
    variantByLabel :: Variant 'Slot Value Bool
variantByLabel  = (Field 'Slot Value Bool -> Word16 -> Variant 'Slot Value Bool
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Value Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
0 BitCount
1 Word64
0) Word16
1)
instance (GH.HasVariant "number" GH.Slot Value Std_.Double) where
    variantByLabel :: Variant 'Slot Value Double
variantByLabel  = (Field 'Slot Value Double -> Word16 -> Variant 'Slot Value Double
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Value Double
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
64 Word64
0) Word16
2)
instance (GH.HasVariant "string" GH.Slot Value Basics.Text) where
    variantByLabel :: Variant 'Slot Value Text
variantByLabel  = (Field 'Slot Value Text -> Word16 -> Variant 'Slot Value Text
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Value Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
3)
instance (GH.HasVariant "array" GH.Slot Value (R.List Value)) where
    variantByLabel :: Variant 'Slot Value (List Value)
variantByLabel  = (Field 'Slot Value (List Value)
-> Word16 -> Variant 'Slot Value (List Value)
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Value (List Value)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
4)
instance (GH.HasVariant "object" GH.Slot Value (R.List Value'Field)) where
    variantByLabel :: Variant 'Slot Value (List Value'Field)
variantByLabel  = (Field 'Slot Value (List Value'Field)
-> Word16 -> Variant 'Slot Value (List Value'Field)
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Value (List Value'Field)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
5)
instance (GH.HasVariant "call" GH.Slot Value Value'Call) where
    variantByLabel :: Variant 'Slot Value Value'Call
variantByLabel  = (Field 'Slot Value Value'Call
-> Word16 -> Variant 'Slot Value Value'Call
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Value Value'Call
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
6)
data instance C.Parsed (GH.Which Value)
    = Value'null 
    | Value'boolean (RP.Parsed Std_.Bool)
    | Value'number (RP.Parsed Std_.Double)
    | Value'string (RP.Parsed Basics.Text)
    | Value'array (RP.Parsed (R.List Value))
    | Value'object (RP.Parsed (R.List Value'Field))
    | Value'call (RP.Parsed Value'Call)
    | Value'unknown' Std_.Word16
    deriving((forall x. Parsed (Which Value) -> Rep (Parsed (Which Value)) x)
-> (forall x. Rep (Parsed (Which Value)) x -> Parsed (Which Value))
-> Generic (Parsed (Which Value))
forall x. Rep (Parsed (Which Value)) x -> Parsed (Which Value)
forall x. Parsed (Which Value) -> Rep (Parsed (Which Value)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed (Which Value)) x -> Parsed (Which Value)
$cfrom :: forall x. Parsed (Which Value) -> Rep (Parsed (Which Value)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Value)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Value)))
instance (C.Parse (GH.Which Value) (C.Parsed (GH.Which Value))) where
    parse :: Raw 'Const (Which Value) -> m (Parsed (Which Value))
parse Raw 'Const (Which Value)
raw_ = (do
        RawWhich 'Const Value
rawWhich_ <- (Raw 'Const (Which Value) -> m (RawWhich 'Const Value)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Value)
raw_)
        case RawWhich 'Const Value
rawWhich_ of
            (RW_Value'null _) ->
                (Parsed (Which Value) -> m (Parsed (Which Value))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Value)
Value'null)
            (RW_Value'boolean rawArg_) ->
                (Bool -> Parsed (Which Value)
Parsed Bool -> Parsed (Which Value)
Value'boolean (Bool -> Parsed (Which Value))
-> m Bool -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Bool -> m Bool
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Bool
rawArg_))
            (RW_Value'number rawArg_) ->
                (Double -> Parsed (Which Value)
Parsed Double -> Parsed (Which Value)
Value'number (Double -> Parsed (Which Value))
-> m Double -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Double -> m Double
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Double
rawArg_))
            (RW_Value'string rawArg_) ->
                (Text -> Parsed (Which Value)
Parsed Text -> Parsed (Which Value)
Value'string (Text -> Parsed (Which Value))
-> m Text -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Text -> m Text
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Text
rawArg_))
            (RW_Value'array rawArg_) ->
                (Vector (Parsed Value) -> Parsed (Which Value)
Parsed (List Value) -> Parsed (Which Value)
Value'array (Vector (Parsed Value) -> Parsed (Which Value))
-> m (Vector (Parsed Value)) -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (List Value) -> m (Vector (Parsed Value))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const (List Value)
rawArg_))
            (RW_Value'object rawArg_) ->
                (Vector (Parsed Value'Field) -> Parsed (Which Value)
Parsed (List Value'Field) -> Parsed (Which Value)
Value'object (Vector (Parsed Value'Field) -> Parsed (Which Value))
-> m (Vector (Parsed Value'Field)) -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (List Value'Field) -> m (Vector (Parsed Value'Field))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const (List Value'Field)
rawArg_))
            (RW_Value'call rawArg_) ->
                (Parsed Value'Call -> Parsed (Which Value)
Parsed Value'Call -> Parsed (Which Value)
Value'call (Parsed Value'Call -> Parsed (Which Value))
-> m (Parsed Value'Call) -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Value'Call -> m (Parsed Value'Call)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Value'Call
rawArg_))
            (RW_Value'unknown' tag_) ->
                (Parsed (Which Value) -> m (Parsed (Which Value))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Value)
Value'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Value) (C.Parsed (GH.Which Value))) where
    marshalInto :: Raw ('Mut s) (Which Value) -> Parsed (Which Value) -> m ()
marshalInto Raw ('Mut s) (Which Value)
raw_ Parsed (Which Value)
parsed_ = case Parsed (Which Value)
parsed_ of
        (Parsed (Which Value)
Value'null) ->
            (Variant 'Slot Value () -> () -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "null" (Variant 'Slot Value ())
Variant 'Slot Value ()
#null () (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'boolean arg_) ->
            (Variant 'Slot Value Bool -> Bool -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "boolean" (Variant 'Slot Value Bool)
Variant 'Slot Value Bool
#boolean Bool
Parsed Bool
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'number arg_) ->
            (Variant 'Slot Value Double -> Double -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "number" (Variant 'Slot Value Double)
Variant 'Slot Value Double
#number Double
Parsed Double
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'string arg_) ->
            (Variant 'Slot Value Text -> Text -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "string" (Variant 'Slot Value Text)
Variant 'Slot Value Text
#string Text
Parsed Text
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'array arg_) ->
            (Variant 'Slot Value (List Value)
-> Vector (Parsed Value) -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "array" (Variant 'Slot Value (List Value))
Variant 'Slot Value (List Value)
#array Vector (Parsed Value)
Parsed (List Value)
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'object arg_) ->
            (Variant 'Slot Value (List Value'Field)
-> Vector (Parsed Value'Field) -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "object" (Variant 'Slot Value (List Value'Field))
Variant 'Slot Value (List Value'Field)
#object Vector (Parsed Value'Field)
Parsed (List Value'Field)
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'call arg_) ->
            (Variant 'Slot Value Value'Call
-> Parsed Value'Call -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "call" (Variant 'Slot Value Value'Call)
Variant 'Slot Value Value'Call
#call Parsed Value'Call
Parsed Value'Call
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'unknown' tag_) ->
            (Field 'Slot Value Word16 -> Word16 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Value Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
data Value'Field 
type instance (R.ReprFor Value'Field) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Value'Field) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Value'Field) where
    type AllocHint Value'Field = ()
    new :: AllocHint Value'Field
-> Message ('Mut s) -> m (Raw ('Mut s) Value'Field)
new AllocHint Value'Field
_ = Message ('Mut s) -> m (Raw ('Mut s) Value'Field)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Value'Field (C.Parsed Value'Field))
instance (C.AllocateList Value'Field) where
    type ListAllocHint Value'Field = Std_.Int
    newList :: ListAllocHint Value'Field
-> Message ('Mut s) -> m (Raw ('Mut s) (List Value'Field))
newList  = ListAllocHint Value'Field
-> Message ('Mut s) -> m (Raw ('Mut s) (List Value'Field))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Value'Field (C.Parsed Value'Field))
data instance C.Parsed Value'Field
    = Value'Field 
        {Parsed Value'Field -> Parsed Text
name :: (RP.Parsed Basics.Text)
        ,Parsed Value'Field -> Parsed Value
value :: (RP.Parsed Value)}
    deriving((forall x. Parsed Value'Field -> Rep (Parsed Value'Field) x)
-> (forall x. Rep (Parsed Value'Field) x -> Parsed Value'Field)
-> Generic (Parsed Value'Field)
forall x. Rep (Parsed Value'Field) x -> Parsed Value'Field
forall x. Parsed Value'Field -> Rep (Parsed Value'Field) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Value'Field) x -> Parsed Value'Field
$cfrom :: forall x. Parsed Value'Field -> Rep (Parsed Value'Field) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Value'Field))
deriving instance (Std_.Eq (C.Parsed Value'Field))
instance (C.Parse Value'Field (C.Parsed Value'Field)) where
    parse :: Raw 'Const Value'Field -> m (Parsed Value'Field)
parse Raw 'Const Value'Field
raw_ = (Text -> Parsed Value -> Parsed Value'Field
Parsed Text -> Parsed Value -> Parsed Value'Field
Value'Field (Text -> Parsed Value -> Parsed Value'Field)
-> m Text -> m (Parsed Value -> Parsed Value'Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Value'Field Text -> Raw 'Const Value'Field -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "name" (Field 'Slot Value'Field Text)
Field 'Slot Value'Field Text
#name Raw 'Const Value'Field
raw_)
                              m (Parsed Value -> Parsed Value'Field)
-> m (Parsed Value) -> m (Parsed Value'Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Value'Field Value
-> Raw 'Const Value'Field -> m (Parsed Value)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "value" (Field 'Slot Value'Field Value)
Field 'Slot Value'Field Value
#value Raw 'Const Value'Field
raw_))
instance (C.Marshal Value'Field (C.Parsed Value'Field)) where
    marshalInto :: Raw ('Mut s) Value'Field -> Parsed Value'Field -> m ()
marshalInto Raw ('Mut s) Value'Field
raw_ Value'Field{..} = (do
        (Field 'Slot Value'Field Text
-> Text -> Raw ('Mut s) Value'Field -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "name" (Field 'Slot Value'Field Text)
Field 'Slot Value'Field Text
#name Text
Parsed Text
name Raw ('Mut s) Value'Field
raw_)
        (Field 'Slot Value'Field Value
-> Parsed Value -> Raw ('Mut s) Value'Field -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "value" (Field 'Slot Value'Field Value)
Field 'Slot Value'Field Value
#value Parsed Value
Parsed Value
value Raw ('Mut s) Value'Field
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "name" GH.Slot Value'Field Basics.Text) where
    fieldByLabel :: Field 'Slot Value'Field Text
fieldByLabel  = (Word16 -> Field 'Slot Value'Field Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "value" GH.Slot Value'Field Value) where
    fieldByLabel :: Field 'Slot Value'Field Value
fieldByLabel  = (Word16 -> Field 'Slot Value'Field Value
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
data Value'Call 
type instance (R.ReprFor Value'Call) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Value'Call) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Value'Call) where
    type AllocHint Value'Call = ()
    new :: AllocHint Value'Call
-> Message ('Mut s) -> m (Raw ('Mut s) Value'Call)
new AllocHint Value'Call
_ = Message ('Mut s) -> m (Raw ('Mut s) Value'Call)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Value'Call (C.Parsed Value'Call))
instance (C.AllocateList Value'Call) where
    type ListAllocHint Value'Call = Std_.Int
    newList :: ListAllocHint Value'Call
-> Message ('Mut s) -> m (Raw ('Mut s) (List Value'Call))
newList  = ListAllocHint Value'Call
-> Message ('Mut s) -> m (Raw ('Mut s) (List Value'Call))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Value'Call (C.Parsed Value'Call))
data instance C.Parsed Value'Call
    = Value'Call 
        {Parsed Value'Call -> Parsed Text
function :: (RP.Parsed Basics.Text)
        ,Parsed Value'Call -> Parsed (List Value)
params :: (RP.Parsed (R.List Value))}
    deriving((forall x. Parsed Value'Call -> Rep (Parsed Value'Call) x)
-> (forall x. Rep (Parsed Value'Call) x -> Parsed Value'Call)
-> Generic (Parsed Value'Call)
forall x. Rep (Parsed Value'Call) x -> Parsed Value'Call
forall x. Parsed Value'Call -> Rep (Parsed Value'Call) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Value'Call) x -> Parsed Value'Call
$cfrom :: forall x. Parsed Value'Call -> Rep (Parsed Value'Call) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Value'Call))
deriving instance (Std_.Eq (C.Parsed Value'Call))
instance (C.Parse Value'Call (C.Parsed Value'Call)) where
    parse :: Raw 'Const Value'Call -> m (Parsed Value'Call)
parse Raw 'Const Value'Call
raw_ = (Text -> Vector (Parsed Value) -> Parsed Value'Call
Parsed Text -> Parsed (List Value) -> Parsed Value'Call
Value'Call (Text -> Vector (Parsed Value) -> Parsed Value'Call)
-> m Text -> m (Vector (Parsed Value) -> Parsed Value'Call)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Value'Call Text -> Raw 'Const Value'Call -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "function" (Field 'Slot Value'Call Text)
Field 'Slot Value'Call Text
#function Raw 'Const Value'Call
raw_)
                             m (Vector (Parsed Value) -> Parsed Value'Call)
-> m (Vector (Parsed Value)) -> m (Parsed Value'Call)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Value'Call (List Value)
-> Raw 'Const Value'Call -> m (Vector (Parsed Value))
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "params" (Field 'Slot Value'Call (List Value))
Field 'Slot Value'Call (List Value)
#params Raw 'Const Value'Call
raw_))
instance (C.Marshal Value'Call (C.Parsed Value'Call)) where
    marshalInto :: Raw ('Mut s) Value'Call -> Parsed Value'Call -> m ()
marshalInto Raw ('Mut s) Value'Call
raw_ Value'Call{..} = (do
        (Field 'Slot Value'Call Text
-> Text -> Raw ('Mut s) Value'Call -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "function" (Field 'Slot Value'Call Text)
Field 'Slot Value'Call Text
#function Text
Parsed Text
function Raw ('Mut s) Value'Call
raw_)
        (Field 'Slot Value'Call (List Value)
-> Vector (Parsed Value) -> Raw ('Mut s) Value'Call -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "params" (Field 'Slot Value'Call (List Value))
Field 'Slot Value'Call (List Value)
#params Vector (Parsed Value)
Parsed (List Value)
params Raw ('Mut s) Value'Call
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "function" GH.Slot Value'Call Basics.Text) where
    fieldByLabel :: Field 'Slot Value'Call Text
fieldByLabel  = (Word16 -> Field 'Slot Value'Call Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "params" GH.Slot Value'Call (R.List Value)) where
    fieldByLabel :: Field 'Slot Value'Call (List Value)
fieldByLabel  = (Word16 -> Field 'Slot Value'Call (List Value)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
data FlattenOptions 
type instance (R.ReprFor FlattenOptions) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct FlattenOptions) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate FlattenOptions) where
    type AllocHint FlattenOptions = ()
    new :: AllocHint FlattenOptions
-> Message ('Mut s) -> m (Raw ('Mut s) FlattenOptions)
new AllocHint FlattenOptions
_ = Message ('Mut s) -> m (Raw ('Mut s) FlattenOptions)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc FlattenOptions (C.Parsed FlattenOptions))
instance (C.AllocateList FlattenOptions) where
    type ListAllocHint FlattenOptions = Std_.Int
    newList :: ListAllocHint FlattenOptions
-> Message ('Mut s) -> m (Raw ('Mut s) (List FlattenOptions))
newList  = ListAllocHint FlattenOptions
-> Message ('Mut s) -> m (Raw ('Mut s) (List FlattenOptions))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc FlattenOptions (C.Parsed FlattenOptions))
data instance C.Parsed FlattenOptions
    = FlattenOptions 
        {Parsed FlattenOptions -> Parsed Text
prefix :: (RP.Parsed Basics.Text)}
    deriving((forall x. Parsed FlattenOptions -> Rep (Parsed FlattenOptions) x)
-> (forall x.
    Rep (Parsed FlattenOptions) x -> Parsed FlattenOptions)
-> Generic (Parsed FlattenOptions)
forall x. Rep (Parsed FlattenOptions) x -> Parsed FlattenOptions
forall x. Parsed FlattenOptions -> Rep (Parsed FlattenOptions) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed FlattenOptions) x -> Parsed FlattenOptions
$cfrom :: forall x. Parsed FlattenOptions -> Rep (Parsed FlattenOptions) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed FlattenOptions))
deriving instance (Std_.Eq (C.Parsed FlattenOptions))
instance (C.Parse FlattenOptions (C.Parsed FlattenOptions)) where
    parse :: Raw 'Const FlattenOptions -> m (Parsed FlattenOptions)
parse Raw 'Const FlattenOptions
raw_ = (Text -> Parsed FlattenOptions
Parsed Text -> Parsed FlattenOptions
FlattenOptions (Text -> Parsed FlattenOptions)
-> m Text -> m (Parsed FlattenOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot FlattenOptions Text
-> Raw 'Const FlattenOptions -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "prefix" (Field 'Slot FlattenOptions Text)
Field 'Slot FlattenOptions Text
#prefix Raw 'Const FlattenOptions
raw_))
instance (C.Marshal FlattenOptions (C.Parsed FlattenOptions)) where
    marshalInto :: Raw ('Mut s) FlattenOptions -> Parsed FlattenOptions -> m ()
marshalInto Raw ('Mut s) FlattenOptions
raw_ FlattenOptions{..} = (do
        (Field 'Slot FlattenOptions Text
-> Text -> Raw ('Mut s) FlattenOptions -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "prefix" (Field 'Slot FlattenOptions Text)
Field 'Slot FlattenOptions Text
#prefix Text
Parsed Text
prefix Raw ('Mut s) FlattenOptions
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "prefix" GH.Slot FlattenOptions Basics.Text) where
    fieldByLabel :: Field 'Slot FlattenOptions Text
fieldByLabel  = (Word16 -> Field 'Slot FlattenOptions Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data DiscriminatorOptions 
type instance (R.ReprFor DiscriminatorOptions) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct DiscriminatorOptions) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate DiscriminatorOptions) where
    type AllocHint DiscriminatorOptions = ()
    new :: AllocHint DiscriminatorOptions
-> Message ('Mut s) -> m (Raw ('Mut s) DiscriminatorOptions)
new AllocHint DiscriminatorOptions
_ = Message ('Mut s) -> m (Raw ('Mut s) DiscriminatorOptions)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc DiscriminatorOptions (C.Parsed DiscriminatorOptions))
instance (C.AllocateList DiscriminatorOptions) where
    type ListAllocHint DiscriminatorOptions = Std_.Int
    newList :: ListAllocHint DiscriminatorOptions
-> Message ('Mut s) -> m (Raw ('Mut s) (List DiscriminatorOptions))
newList  = ListAllocHint DiscriminatorOptions
-> Message ('Mut s) -> m (Raw ('Mut s) (List DiscriminatorOptions))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc DiscriminatorOptions (C.Parsed DiscriminatorOptions))
data instance C.Parsed DiscriminatorOptions
    = DiscriminatorOptions 
        {Parsed DiscriminatorOptions -> Parsed Text
name :: (RP.Parsed Basics.Text)
        ,Parsed DiscriminatorOptions -> Parsed Text
valueName :: (RP.Parsed Basics.Text)}
    deriving((forall x.
 Parsed DiscriminatorOptions -> Rep (Parsed DiscriminatorOptions) x)
-> (forall x.
    Rep (Parsed DiscriminatorOptions) x -> Parsed DiscriminatorOptions)
-> Generic (Parsed DiscriminatorOptions)
forall x.
Rep (Parsed DiscriminatorOptions) x -> Parsed DiscriminatorOptions
forall x.
Parsed DiscriminatorOptions -> Rep (Parsed DiscriminatorOptions) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed DiscriminatorOptions) x -> Parsed DiscriminatorOptions
$cfrom :: forall x.
Parsed DiscriminatorOptions -> Rep (Parsed DiscriminatorOptions) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed DiscriminatorOptions))
deriving instance (Std_.Eq (C.Parsed DiscriminatorOptions))
instance (C.Parse DiscriminatorOptions (C.Parsed DiscriminatorOptions)) where
    parse :: Raw 'Const DiscriminatorOptions -> m (Parsed DiscriminatorOptions)
parse Raw 'Const DiscriminatorOptions
raw_ = (Text -> Text -> Parsed DiscriminatorOptions
Parsed Text -> Parsed Text -> Parsed DiscriminatorOptions
DiscriminatorOptions (Text -> Text -> Parsed DiscriminatorOptions)
-> m Text -> m (Text -> Parsed DiscriminatorOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot DiscriminatorOptions Text
-> Raw 'Const DiscriminatorOptions -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "name" (Field 'Slot DiscriminatorOptions Text)
Field 'Slot DiscriminatorOptions Text
#name Raw 'Const DiscriminatorOptions
raw_)
                                       m (Text -> Parsed DiscriminatorOptions)
-> m Text -> m (Parsed DiscriminatorOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot DiscriminatorOptions Text
-> Raw 'Const DiscriminatorOptions -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "valueName" (Field 'Slot DiscriminatorOptions Text)
Field 'Slot DiscriminatorOptions Text
#valueName Raw 'Const DiscriminatorOptions
raw_))
instance (C.Marshal DiscriminatorOptions (C.Parsed DiscriminatorOptions)) where
    marshalInto :: Raw ('Mut s) DiscriminatorOptions
-> Parsed DiscriminatorOptions -> m ()
marshalInto Raw ('Mut s) DiscriminatorOptions
raw_ DiscriminatorOptions{..} = (do
        (Field 'Slot DiscriminatorOptions Text
-> Text -> Raw ('Mut s) DiscriminatorOptions -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "name" (Field 'Slot DiscriminatorOptions Text)
Field 'Slot DiscriminatorOptions Text
#name Text
Parsed Text
name Raw ('Mut s) DiscriminatorOptions
raw_)
        (Field 'Slot DiscriminatorOptions Text
-> Text -> Raw ('Mut s) DiscriminatorOptions -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "valueName" (Field 'Slot DiscriminatorOptions Text)
Field 'Slot DiscriminatorOptions Text
#valueName Text
Parsed Text
valueName Raw ('Mut s) DiscriminatorOptions
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "name" GH.Slot DiscriminatorOptions Basics.Text) where
    fieldByLabel :: Field 'Slot DiscriminatorOptions Text
fieldByLabel  = (Word16 -> Field 'Slot DiscriminatorOptions Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "valueName" GH.Slot DiscriminatorOptions Basics.Text) where
    fieldByLabel :: Field 'Slot DiscriminatorOptions Text
fieldByLabel  = (Word16 -> Field 'Slot DiscriminatorOptions Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)