{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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 where
import qualified Capnp.Repr as R
import qualified Capnp.Repr.Parsed as RP
import qualified Capnp.Basics as Basics
import qualified GHC.OverloadedLabels as OL
import qualified Capnp.GenHelpers as GH
import qualified Capnp.Classes as C
import qualified GHC.Generics as Generics
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.HasTypeId Value) where
    typeId :: Word64
typeId  = Word64
11815888814287216003
instance (C.TypedStruct Value) where
    numStructWords :: Word16
numStructWords  = Word16
2
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Value) where
    type AllocHint Value = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Value -> Message ('Mut s) -> m (Raw Value ('Mut s))
new AllocHint Value
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Value (C.Parsed Value))
instance (C.AllocateList Value) where
    type ListAllocHint Value = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Value
-> Message ('Mut s) -> m (Raw (List Value) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Value 'Const -> m (Parsed Value)
parse Raw Value 'Const
raw_ = (Parsed (Which Value) -> Parsed Value
Value forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Value 'Const
raw_)))
instance (C.Marshal Value (C.Parsed Value)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Value ('Mut s) -> Parsed Value -> m ()
marshalInto Raw Value ('Mut s)
raw_ Value{Parsed (Which Value)
union' :: Parsed (Which Value)
$sel:union':Value :: Parsed Value -> Parsed (Which Value)
..} = (do
        (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Value ('Mut s)
raw_) Parsed (Which Value)
union')
        )
instance (GH.HasUnion Value) where
    unionField :: Field 'Slot Value Word16
unionField  = (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 Value mut_
        = RW_Value'null (R.Raw () mut_)
        | RW_Value'boolean (R.Raw Std_.Bool mut_)
        | RW_Value'number (R.Raw Std_.Double mut_)
        | RW_Value'string (R.Raw Basics.Text mut_)
        | RW_Value'array (R.Raw (R.List Value) mut_)
        | RW_Value'object (R.Raw (R.List Value'Field) mut_)
        | RW_Value'call (R.Raw Value'Call mut_)
        | RW_Value'unknown' Std_.Word16
    internalWhich :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Word16 -> Raw Value mut -> m (RawWhich Value mut)
internalWhich Word16
tag_ Raw Value mut
struct_ = case Word16
tag_ of
        Word16
0 ->
            (forall (mut_ :: Mutability). Raw () mut_ -> RawWhich Value mut_
RW_Value'null forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "null" a => a
#null Raw Value mut
struct_))
        Word16
1 ->
            (forall (mut_ :: Mutability). Raw Bool mut_ -> RawWhich Value mut_
RW_Value'boolean forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "boolean" a => a
#boolean Raw Value mut
struct_))
        Word16
2 ->
            (forall (mut_ :: Mutability). Raw Double mut_ -> RawWhich Value mut_
RW_Value'number forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "number" a => a
#number Raw Value mut
struct_))
        Word16
3 ->
            (forall (mut_ :: Mutability). Raw Text mut_ -> RawWhich Value mut_
RW_Value'string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "string" a => a
#string Raw Value mut
struct_))
        Word16
4 ->
            (forall (mut_ :: Mutability).
Raw (List Value) mut_ -> RawWhich Value mut_
RW_Value'array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "array" a => a
#array Raw Value mut
struct_))
        Word16
5 ->
            (forall (mut_ :: Mutability).
Raw (List Value'Field) mut_ -> RawWhich Value mut_
RW_Value'object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "object" a => a
#object Raw Value mut
struct_))
        Word16
6 ->
            (forall (mut_ :: Mutability).
Raw Value'Call mut_ -> RawWhich Value mut_
RW_Value'call forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "call" a => a
#call Raw Value mut
struct_))
        Word16
_ ->
            (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (forall (mut_ :: Mutability). Word16 -> RawWhich Value mut_
RW_Value'unknown' Word16
tag_))
    data Which Value
instance (GH.HasVariant "null" GH.Slot Value ()) where
    variantByLabel :: Variant 'Slot Value ()
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant 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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw (Which Value) 'Const -> m (Parsed (Which Value))
parse Raw (Which Value) 'Const
raw_ = (do
        RawWhich Value 'Const
rawWhich_ <- (forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
GH.unionWhich Raw (Which Value) 'Const
raw_)
        case RawWhich Value 'Const
rawWhich_ of
            (RW_Value'null Raw () 'Const
_) ->
                (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Value)
Value'null)
            (RW_Value'boolean Raw Bool 'Const
rawArg_) ->
                (Parsed Bool -> Parsed (Which Value)
Value'boolean forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Bool 'Const
rawArg_))
            (RW_Value'number Raw Double 'Const
rawArg_) ->
                (Parsed Double -> Parsed (Which Value)
Value'number forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Double 'Const
rawArg_))
            (RW_Value'string Raw Text 'Const
rawArg_) ->
                (Parsed Text -> Parsed (Which Value)
Value'string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Text 'Const
rawArg_))
            (RW_Value'array Raw (List Value) 'Const
rawArg_) ->
                (Parsed (List Value) -> Parsed (Which Value)
Value'array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw (List Value) 'Const
rawArg_))
            (RW_Value'object Raw (List Value'Field) 'Const
rawArg_) ->
                (Parsed (List Value'Field) -> Parsed (Which Value)
Value'object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw (List Value'Field) 'Const
rawArg_))
            (RW_Value'call Raw Value'Call 'Const
rawArg_) ->
                (Parsed Value'Call -> Parsed (Which Value)
Value'call forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Value'Call 'Const
rawArg_))
            (RW_Value'unknown' Word16
tag_) ->
                (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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw (Which Value) ('Mut s) -> Parsed (Which Value) -> m ()
marshalInto Raw (Which Value) ('Mut s)
raw_ Parsed (Which Value)
parsed_ = case Parsed (Which Value)
parsed_ of
        (Parsed (Which Value)
R:ParsedWhich
Value'null) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "null" a => a
#null () (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Value) ('Mut s)
raw_))
        (Value'boolean Parsed Bool
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "boolean" a => a
#boolean Parsed Bool
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Value) ('Mut s)
raw_))
        (Value'number Parsed Double
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "number" a => a
#number Parsed Double
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Value) ('Mut s)
raw_))
        (Value'string Parsed Text
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "string" a => a
#string Parsed Text
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Value) ('Mut s)
raw_))
        (Value'array Parsed (List Value)
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "array" a => a
#array Parsed (List Value)
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Value) ('Mut s)
raw_))
        (Value'object Parsed (List Value'Field)
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "object" a => a
#object Parsed (List Value'Field)
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Value) ('Mut s)
raw_))
        (Value'call Parsed Value'Call
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "call" a => a
#call Parsed Value'Call
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Value) ('Mut s)
raw_))
        (Value'unknown' Word16
tag_) ->
            (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Value) ('Mut s)
raw_))
data Value'Field 
type instance (R.ReprFor Value'Field) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId Value'Field) where
    typeId :: Word64
typeId  = Word64
16361620220719570399
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 :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Value'Field
-> Message ('Mut s) -> m (Raw Value'Field ('Mut s))
new AllocHint Value'Field
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Value'Field (C.Parsed Value'Field))
instance (C.AllocateList Value'Field) where
    type ListAllocHint Value'Field = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Value'Field
-> Message ('Mut s) -> m (Raw (List Value'Field) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Value'Field 'Const -> m (Parsed Value'Field)
parse Raw Value'Field 'Const
raw_ = (Parsed Text -> Parsed Value -> Parsed Value'Field
Value'Field forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "name" a => a
#name Raw Value'Field 'Const
raw_)
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "value" a => a
#value Raw Value'Field 'Const
raw_))
instance (C.Marshal Value'Field (C.Parsed Value'Field)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Value'Field ('Mut s) -> Parsed Value'Field -> m ()
marshalInto Raw Value'Field ('Mut s)
raw_ Value'Field{Parsed Text
Parsed Value
value :: Parsed Value
name :: Parsed Text
$sel:value:Value'Field :: Parsed Value'Field -> Parsed Value
$sel:name:Value'Field :: Parsed Value'Field -> Parsed Text
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "name" a => a
#name Parsed Text
name Raw Value'Field ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "value" a => a
#value Parsed Value
value Raw Value'Field ('Mut s)
raw_)
        (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  = (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  = (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.HasTypeId Value'Call) where
    typeId :: Word64
typeId  = Word64
11590566612201717064
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 :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Value'Call
-> Message ('Mut s) -> m (Raw Value'Call ('Mut s))
new AllocHint Value'Call
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Value'Call (C.Parsed Value'Call))
instance (C.AllocateList Value'Call) where
    type ListAllocHint Value'Call = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Value'Call
-> Message ('Mut s) -> m (Raw (List Value'Call) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Value'Call 'Const -> m (Parsed Value'Call)
parse Raw Value'Call 'Const
raw_ = (Parsed Text -> Parsed (List Value) -> Parsed Value'Call
Value'Call forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "function" a => a
#function Raw Value'Call 'Const
raw_)
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "params" a => a
#params Raw Value'Call 'Const
raw_))
instance (C.Marshal Value'Call (C.Parsed Value'Call)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Value'Call ('Mut s) -> Parsed Value'Call -> m ()
marshalInto Raw Value'Call ('Mut s)
raw_ Value'Call{Parsed (List Value)
Parsed Text
params :: Parsed (List Value)
function :: Parsed Text
$sel:params:Value'Call :: Parsed Value'Call -> Parsed (List Value)
$sel:function:Value'Call :: Parsed Value'Call -> Parsed Text
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "function" a => a
#function Parsed Text
function Raw Value'Call ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "params" a => a
#params Parsed (List Value)
params Raw Value'Call ('Mut s)
raw_)
        (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  = (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  = (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.HasTypeId FlattenOptions) where
    typeId :: Word64
typeId  = Word64
14186078402951440993
instance (C.TypedStruct FlattenOptions) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate FlattenOptions) where
    type AllocHint FlattenOptions = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint FlattenOptions
-> Message ('Mut s) -> m (Raw FlattenOptions ('Mut s))
new AllocHint FlattenOptions
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc FlattenOptions (C.Parsed FlattenOptions))
instance (C.AllocateList FlattenOptions) where
    type ListAllocHint FlattenOptions = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint FlattenOptions
-> Message ('Mut s) -> m (Raw (List FlattenOptions) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw FlattenOptions 'Const -> m (Parsed FlattenOptions)
parse Raw FlattenOptions 'Const
raw_ = (Parsed Text -> Parsed FlattenOptions
FlattenOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "prefix" a => a
#prefix Raw FlattenOptions 'Const
raw_))
instance (C.Marshal FlattenOptions (C.Parsed FlattenOptions)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw FlattenOptions ('Mut s) -> Parsed FlattenOptions -> m ()
marshalInto Raw FlattenOptions ('Mut s)
raw_ FlattenOptions{Parsed Text
prefix :: Parsed Text
$sel:prefix:FlattenOptions :: Parsed FlattenOptions -> Parsed Text
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "prefix" a => a
#prefix Parsed Text
prefix Raw FlattenOptions ('Mut s)
raw_)
        (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  = (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.HasTypeId DiscriminatorOptions) where
    typeId :: Word64
typeId  = Word64
14049192395069608729
instance (C.TypedStruct DiscriminatorOptions) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate DiscriminatorOptions) where
    type AllocHint DiscriminatorOptions = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint DiscriminatorOptions
-> Message ('Mut s) -> m (Raw DiscriminatorOptions ('Mut s))
new AllocHint DiscriminatorOptions
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc DiscriminatorOptions (C.Parsed DiscriminatorOptions))
instance (C.AllocateList DiscriminatorOptions) where
    type ListAllocHint DiscriminatorOptions = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint DiscriminatorOptions
-> Message ('Mut s) -> m (Raw (List DiscriminatorOptions) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
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.
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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw DiscriminatorOptions 'Const -> m (Parsed DiscriminatorOptions)
parse Raw DiscriminatorOptions 'Const
raw_ = (Parsed Text -> Parsed Text -> Parsed DiscriminatorOptions
DiscriminatorOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "name" a => a
#name Raw DiscriminatorOptions 'Const
raw_)
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "valueName" a => a
#valueName Raw DiscriminatorOptions 'Const
raw_))
instance (C.Marshal DiscriminatorOptions (C.Parsed DiscriminatorOptions)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw DiscriminatorOptions ('Mut s)
-> Parsed DiscriminatorOptions -> m ()
marshalInto Raw DiscriminatorOptions ('Mut s)
raw_ DiscriminatorOptions{Parsed Text
valueName :: Parsed Text
name :: Parsed Text
$sel:valueName:DiscriminatorOptions :: Parsed DiscriminatorOptions -> Parsed Text
$sel:name:DiscriminatorOptions :: Parsed DiscriminatorOptions -> Parsed Text
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "name" a => a
#name Parsed Text
name Raw DiscriminatorOptions ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "valueName" a => a
#valueName Parsed Text
valueName Raw DiscriminatorOptions ('Mut s)
raw_)
        (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  = (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  = (forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)