{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-dodgy-exports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Capnp.Gen.Capnp.Stream where
import qualified Capnp.Message as Message
import qualified Capnp.Untyped as Untyped
import qualified Capnp.Basics as Basics
import qualified Capnp.GenHelpers as GenHelpers
import qualified Capnp.Classes as Classes
import qualified GHC.Generics as Generics
import qualified Capnp.Bits as Std_
import qualified Data.Maybe as Std_
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 ((<$>), (<*>), (>>=))
newtype StreamResult msg
    = StreamResult'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (StreamResult msg)) where
    fromStruct :: Struct msg -> m (StreamResult msg)
fromStruct Struct msg
struct = (StreamResult msg -> m (StreamResult msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> StreamResult msg
forall msg. Struct msg -> StreamResult msg
StreamResult'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (StreamResult msg)) where
    toStruct :: StreamResult msg -> Struct msg
toStruct (StreamResult'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (StreamResult msg)) where
    type InMessage (StreamResult msg) = msg
    message :: StreamResult msg -> InMessage (StreamResult msg)
message (StreamResult'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (StreamResult msg)) where
    messageDefault :: InMessage (StreamResult msg) -> StreamResult msg
messageDefault InMessage (StreamResult msg)
msg = (Struct msg -> StreamResult msg
forall msg. Struct msg -> StreamResult msg
StreamResult'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (StreamResult msg)
msg))
instance (Classes.FromPtr msg (StreamResult msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (StreamResult msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> StreamResult msg
forall msg. Struct msg -> StreamResult msg
StreamResult'newtype_ (Struct msg -> StreamResult msg)
-> m (Struct msg) -> m (StreamResult msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (StreamResult (Message.MutMsg s))) where
    toPtr :: MutMsg s -> StreamResult (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (StreamResult'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (StreamResult (Message.MutMsg s))) where
    new :: MutMsg s -> m (StreamResult (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> StreamResult (MutMsg s)
forall msg. Struct msg -> StreamResult msg
StreamResult'newtype_ (Struct (MutMsg s) -> StreamResult (MutMsg s))
-> m (Struct (MutMsg s)) -> m (StreamResult (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
0 Word16
0))
instance (Basics.ListElem msg (StreamResult msg)) where
    newtype List msg (StreamResult msg)
        = StreamResult'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (StreamResult msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (StreamResult msg)
forall msg. ListOf msg (Struct msg) -> List msg (StreamResult msg)
StreamResult'List_ (ListOf msg (Struct msg) -> List msg (StreamResult msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (StreamResult msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (StreamResult msg) -> List msg
toUntypedList (StreamResult'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (StreamResult msg) -> Int
length (StreamResult'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (StreamResult msg) -> m (StreamResult msg)
index Int
i (StreamResult'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (StreamResult msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (StreamResult (Message.MutMsg s))) where
    setIndex :: StreamResult (MutMsg s)
-> Int -> List (MutMsg s) (StreamResult (MutMsg s)) -> m ()
setIndex (StreamResult'newtype_ Struct (MutMsg s)
elt) Int
i (StreamResult'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (StreamResult (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (StreamResult (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (StreamResult msg)
StreamResult'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (StreamResult (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (StreamResult (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
0 Word16
0 Int
len))