{-# 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.Stream.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 StreamResult 
type instance (R.ReprFor StreamResult) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct StreamResult) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate StreamResult) where
    type AllocHint StreamResult = ()
    new :: AllocHint StreamResult
-> Message ('Mut s) -> m (Raw ('Mut s) StreamResult)
new AllocHint StreamResult
_ = Message ('Mut s) -> m (Raw ('Mut s) StreamResult)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc StreamResult (C.Parsed StreamResult))
instance (C.AllocateList StreamResult) where
    type ListAllocHint StreamResult = Std_.Int
    newList :: ListAllocHint StreamResult
-> Message ('Mut s) -> m (Raw ('Mut s) (List StreamResult))
newList  = ListAllocHint StreamResult
-> Message ('Mut s) -> m (Raw ('Mut s) (List StreamResult))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc StreamResult (C.Parsed StreamResult))
data instance C.Parsed StreamResult
    = StreamResult 
        {}
    deriving((forall x. Parsed StreamResult -> Rep (Parsed StreamResult) x)
-> (forall x. Rep (Parsed StreamResult) x -> Parsed StreamResult)
-> Generic (Parsed StreamResult)
forall x. Rep (Parsed StreamResult) x -> Parsed StreamResult
forall x. Parsed StreamResult -> Rep (Parsed StreamResult) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed StreamResult) x -> Parsed StreamResult
$cfrom :: forall x. Parsed StreamResult -> Rep (Parsed StreamResult) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed StreamResult))
deriving instance (Std_.Eq (C.Parsed StreamResult))
instance (C.Parse StreamResult (C.Parsed StreamResult)) where
    parse :: Raw 'Const StreamResult -> m (Parsed StreamResult)
parse Raw 'Const StreamResult
raw_ = (Parsed StreamResult -> m (Parsed StreamResult)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed StreamResult
StreamResult)
instance (C.Marshal StreamResult (C.Parsed StreamResult)) where
    marshalInto :: Raw ('Mut s) StreamResult -> Parsed StreamResult -> m ()
marshalInto Raw ('Mut s) StreamResult
_raw (Parsed StreamResult
StreamResult) = (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())