{-# language CPP #-}
module OpenXR.Core10.Session ( beginSession
, useSession
, endSession
, requestExitSession
, SessionBeginInfo(..)
) where
import OpenXR.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import OpenXR.CStruct.Extends (forgetExtensions)
import OpenXR.CStruct.Extends (Chain)
import OpenXR.CStruct.Extends (Extends)
import OpenXR.CStruct.Extends (Extendss)
import OpenXR.CStruct.Extends (Extensible(..))
import OpenXR.Dynamic (InstanceCmds(pXrBeginSession))
import OpenXR.Dynamic (InstanceCmds(pXrEndSession))
import OpenXR.Dynamic (InstanceCmds(pXrRequestExitSession))
import OpenXR.Exception (OpenXrException(..))
import OpenXR.CStruct.Extends (PeekChain)
import OpenXR.CStruct.Extends (PeekChain(..))
import OpenXR.CStruct.Extends (PokeChain)
import OpenXR.CStruct.Extends (PokeChain(..))
import OpenXR.Core10.Enums.Result (Result)
import OpenXR.Core10.Enums.Result (Result(..))
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationSessionBeginInfoMSFT)
import OpenXR.Core10.Handles (Session)
import OpenXR.Core10.Handles (Session(..))
import OpenXR.Core10.Handles (Session_T)
import OpenXR.CStruct.Extends (SomeStruct)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Enums.ViewConfigurationType (ViewConfigurationType)
import OpenXR.Core10.Enums.Result (Result(SUCCESS))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SESSION_BEGIN_INFO))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkXrBeginSession
:: FunPtr (Ptr Session_T -> Ptr (SomeStruct SessionBeginInfo) -> IO Result) -> Ptr Session_T -> Ptr (SomeStruct SessionBeginInfo) -> IO Result
beginSession :: forall a io
. (Extendss SessionBeginInfo a, PokeChain a, MonadIO io)
=>
Session
->
(SessionBeginInfo a)
-> io (Result)
beginSession :: Session -> SessionBeginInfo a -> io Result
beginSession session :: Session
session beginInfo :: SessionBeginInfo a
beginInfo = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
let xrBeginSessionPtr :: FunPtr
(Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo))
-> IO Result)
xrBeginSessionPtr = InstanceCmds
-> FunPtr
(Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo))
-> IO Result)
pXrBeginSession (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo))
-> IO Result)
xrBeginSessionPtr FunPtr
(Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo))
-> IO Result)
-> FunPtr
(Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo))
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo))
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrBeginSession is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let xrBeginSession' :: Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo)) -> IO Result
xrBeginSession' = FunPtr
(Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo))
-> IO Result)
-> Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo))
-> IO Result
mkXrBeginSession FunPtr
(Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo))
-> IO Result)
xrBeginSessionPtr
Ptr (SessionBeginInfo a)
beginInfo' <- ((Ptr (SessionBeginInfo a) -> IO Result) -> IO Result)
-> ContT Result IO (Ptr (SessionBeginInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SessionBeginInfo a) -> IO Result) -> IO Result)
-> ContT Result IO (Ptr (SessionBeginInfo a)))
-> ((Ptr (SessionBeginInfo a) -> IO Result) -> IO Result)
-> ContT Result IO (Ptr (SessionBeginInfo a))
forall a b. (a -> b) -> a -> b
$ SessionBeginInfo a
-> (Ptr (SessionBeginInfo a) -> IO Result) -> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SessionBeginInfo a
beginInfo)
Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrBeginSession" (Ptr Session_T
-> ("beginInfo" ::: Ptr (SomeStruct SessionBeginInfo)) -> IO Result
xrBeginSession' (Session -> Ptr Session_T
sessionHandle (Session
session)) (Ptr (SessionBeginInfo a)
-> "beginInfo" ::: Ptr (SomeStruct SessionBeginInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (SessionBeginInfo a)
beginInfo'))
IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)
useSession :: forall a io r . (Extendss SessionBeginInfo a, PokeChain a, MonadIO io) => Session -> SessionBeginInfo a -> (Result -> io r) -> io (Result, r)
useSession :: Session -> SessionBeginInfo a -> (Result -> io r) -> io (Result, r)
useSession session :: Session
session beginInfo :: SessionBeginInfo a
beginInfo a :: Result -> io r
a =
do
Result
x <- Session -> SessionBeginInfo a -> io Result
forall (a :: [*]) (io :: * -> *).
(Extendss SessionBeginInfo a, PokeChain a, MonadIO io) =>
Session -> SessionBeginInfo a -> io Result
beginSession Session
session SessionBeginInfo a
beginInfo
r
r <- Result -> io r
a Result
x
Result
d <- (\(Result
_) -> Session -> io Result
forall (io :: * -> *). MonadIO io => Session -> io Result
endSession Session
session) Result
x
(Result, r) -> io (Result, r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result
d, r
r)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkXrEndSession
:: FunPtr (Ptr Session_T -> IO Result) -> Ptr Session_T -> IO Result
endSession :: forall io
. (MonadIO io)
=>
Session
-> io (Result)
endSession :: Session -> io Result
endSession session :: Session
session = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result) -> IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
let xrEndSessionPtr :: FunPtr (Ptr Session_T -> IO Result)
xrEndSessionPtr = InstanceCmds -> FunPtr (Ptr Session_T -> IO Result)
pXrEndSession (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Session_T -> IO Result)
xrEndSessionPtr FunPtr (Ptr Session_T -> IO Result)
-> FunPtr (Ptr Session_T -> IO Result) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Session_T -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrEndSession is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let xrEndSession' :: Ptr Session_T -> IO Result
xrEndSession' = FunPtr (Ptr Session_T -> IO Result) -> Ptr Session_T -> IO Result
mkXrEndSession FunPtr (Ptr Session_T -> IO Result)
xrEndSessionPtr
Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEndSession" (Ptr Session_T -> IO Result
xrEndSession' (Session -> Ptr Session_T
sessionHandle (Session
session)))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkXrRequestExitSession
:: FunPtr (Ptr Session_T -> IO Result) -> Ptr Session_T -> IO Result
requestExitSession :: forall io
. (MonadIO io)
=>
Session
-> io (Result)
requestExitSession :: Session -> io Result
requestExitSession session :: Session
session = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result) -> IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
let xrRequestExitSessionPtr :: FunPtr (Ptr Session_T -> IO Result)
xrRequestExitSessionPtr = InstanceCmds -> FunPtr (Ptr Session_T -> IO Result)
pXrRequestExitSession (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Session_T -> IO Result)
xrRequestExitSessionPtr FunPtr (Ptr Session_T -> IO Result)
-> FunPtr (Ptr Session_T -> IO Result) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Session_T -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrRequestExitSession is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let xrRequestExitSession' :: Ptr Session_T -> IO Result
xrRequestExitSession' = FunPtr (Ptr Session_T -> IO Result) -> Ptr Session_T -> IO Result
mkXrRequestExitSession FunPtr (Ptr Session_T -> IO Result)
xrRequestExitSessionPtr
Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrRequestExitSession" (Ptr Session_T -> IO Result
xrRequestExitSession' (Session -> Ptr Session_T
sessionHandle (Session
session)))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)
data SessionBeginInfo (es :: [Type]) = SessionBeginInfo
{
SessionBeginInfo es -> Chain es
next :: Chain es
,
SessionBeginInfo es -> ViewConfigurationType
primaryViewConfigurationType :: ViewConfigurationType
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SessionBeginInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SessionBeginInfo es)
instance Extensible SessionBeginInfo where
extensibleTypeName :: String
extensibleTypeName = "SessionBeginInfo"
setNext :: SessionBeginInfo ds -> Chain es -> SessionBeginInfo es
setNext x :: SessionBeginInfo ds
x next :: Chain es
next = SessionBeginInfo ds
x{$sel:next:SessionBeginInfo :: Chain es
next = Chain es
next}
getNext :: SessionBeginInfo es -> Chain es
getNext SessionBeginInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends SessionBeginInfo e => b) -> Maybe b
extends :: proxy e -> (Extends SessionBeginInfo e => b) -> Maybe b
extends _ f :: Extends SessionBeginInfo e => b
f
| Just Refl <- (Typeable e,
Typeable SecondaryViewConfigurationSessionBeginInfoMSFT) =>
Maybe (e :~: SecondaryViewConfigurationSessionBeginInfoMSFT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SecondaryViewConfigurationSessionBeginInfoMSFT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionBeginInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss SessionBeginInfo es, PokeChain es) => ToCStruct (SessionBeginInfo es) where
withCStruct :: SessionBeginInfo es -> (Ptr (SessionBeginInfo es) -> IO b) -> IO b
withCStruct x :: SessionBeginInfo es
x f :: Ptr (SessionBeginInfo es) -> IO b
f = Int -> Int -> (Ptr (SessionBeginInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr (SessionBeginInfo es) -> IO b) -> IO b)
-> (Ptr (SessionBeginInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (SessionBeginInfo es)
p -> Ptr (SessionBeginInfo es) -> SessionBeginInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SessionBeginInfo es)
p SessionBeginInfo es
x (Ptr (SessionBeginInfo es) -> IO b
f Ptr (SessionBeginInfo es)
p)
pokeCStruct :: Ptr (SessionBeginInfo es) -> SessionBeginInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (SessionBeginInfo es)
p SessionBeginInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SessionBeginInfo es)
p Ptr (SessionBeginInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SESSION_BEGIN_INFO)
Ptr ()
next'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SessionBeginInfo es)
p Ptr (SessionBeginInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
next''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ViewConfigurationType -> ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SessionBeginInfo es)
p Ptr (SessionBeginInfo es) -> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
primaryViewConfigurationType)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 24
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr (SessionBeginInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (SessionBeginInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SessionBeginInfo es)
p Ptr (SessionBeginInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SESSION_BEGIN_INFO)
Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SessionBeginInfo es)
p Ptr (SessionBeginInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ViewConfigurationType -> ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SessionBeginInfo es)
p Ptr (SessionBeginInfo es) -> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
forall a. Zero a => a
zero)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance (Extendss SessionBeginInfo es, PeekChain es) => FromCStruct (SessionBeginInfo es) where
peekCStruct :: Ptr (SessionBeginInfo es) -> IO (SessionBeginInfo es)
peekCStruct p :: Ptr (SessionBeginInfo es)
p = do
Ptr ()
next <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SessionBeginInfo es)
p Ptr (SessionBeginInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
Chain es
next' <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
next)
ViewConfigurationType
primaryViewConfigurationType <- Ptr ViewConfigurationType -> IO ViewConfigurationType
forall a. Storable a => Ptr a -> IO a
peek @ViewConfigurationType ((Ptr (SessionBeginInfo es)
p Ptr (SessionBeginInfo es) -> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType))
SessionBeginInfo es -> IO (SessionBeginInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SessionBeginInfo es -> IO (SessionBeginInfo es))
-> SessionBeginInfo es -> IO (SessionBeginInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es -> ViewConfigurationType -> SessionBeginInfo es
forall (es :: [*]).
Chain es -> ViewConfigurationType -> SessionBeginInfo es
SessionBeginInfo
Chain es
next' ViewConfigurationType
primaryViewConfigurationType
instance es ~ '[] => Zero (SessionBeginInfo es) where
zero :: SessionBeginInfo es
zero = Chain es -> ViewConfigurationType -> SessionBeginInfo es
forall (es :: [*]).
Chain es -> ViewConfigurationType -> SessionBeginInfo es
SessionBeginInfo
()
ViewConfigurationType
forall a. Zero a => a
zero