{-# language CPP #-}
-- No documentation found for Chapter "Session"
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

-- | xrBeginSession - Begins an XrSession
--
-- == Parameter Descriptions
--
-- = Description
--
-- When the application receives
-- 'OpenXR.Core10.OtherTypes.EventDataSessionStateChanged' event with the
-- 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_READY' state, the
-- application /should/ then call 'beginSession' to start rendering frames
-- for display to the user.
--
-- After this function successfully returns, the session
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_running is considered to be running>.
-- The application /should/ then start its frame loop consisting of some
-- sequence of
-- 'OpenXR.Core10.DisplayTiming.waitFrame'\/'OpenXR.Core10.DisplayTiming.beginFrame'\/'OpenXR.Core10.DisplayTiming.endFrame'
-- calls.
--
-- If the session
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_running is already running>
-- when the application calls 'beginSession', the runtime /must/ return
-- error 'OpenXR.Core10.Enums.Result.ERROR_SESSION_RUNNING'. If the session
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_not_running is not running>
-- when the application calls 'beginSession', but the session is not yet in
-- the 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_READY' state, the
-- runtime /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_READY'.
--
-- Note that a runtime /may/ decide not to show the user any given frame
-- from a session at any time, for example if the user has switched to a
-- different application’s running session. The application should check
-- whether 'OpenXR.Core10.DisplayTiming.waitFrame' returns an
-- 'OpenXR.Core10.DisplayTiming.FrameState' with @shouldRender@ set to true
-- before rendering a given frame to determine whether that frame will be
-- visible to the user.
--
-- Runtime session frame state /must/ start in a reset state when a session
-- transitions to
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_running running>
-- so that no state is carried over from when the same session was
-- previously running.
--
-- If @primaryViewConfigurationType@ in @beginInfo@ is not supported by the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
-- used to create the @session@, the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_VIEW_CONFIGURATION_TYPE_UNSUPPORTED'.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_READY'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_RUNNING'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VIEW_CONFIGURATION_TYPE_UNSUPPORTED'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Session', 'SessionBeginInfo',
-- 'OpenXR.Core10.Device.createSession',
-- 'OpenXR.Core10.Device.destroySession', 'endSession'
beginSession :: forall a io
              . (Extendss SessionBeginInfo a, PokeChain a, MonadIO io)
             => -- | @session@ is a valid 'OpenXR.Core10.Handles.Session' handle.
                --
                -- #VUID-xrBeginSession-session-parameter# @session@ /must/ be a valid
                -- 'OpenXR.Core10.Handles.Session' handle
                Session
             -> -- | @beginInfo@ is a pointer to an 'SessionBeginInfo' structure.
                --
                -- #VUID-xrBeginSession-beginInfo-parameter# @beginInfo@ /must/ be a
                -- pointer to a valid 'SessionBeginInfo' structure
                (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)

-- | This function will call the supplied action between calls to
-- 'beginSession' and 'endSession'
--
-- Note that 'endSession' is *not* called if an exception is thrown by the
-- inner action.
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

-- | xrEndSession - Ends an XrSession
--
-- == Parameter Descriptions
--
-- = Description
--
-- When the application receives
-- 'OpenXR.Core10.OtherTypes.EventDataSessionStateChanged' event with the
-- 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_STOPPING' state, the
-- application should stop its frame loop and then call 'endSession' to end
-- the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_running running>
-- session. This function signals to the runtime that the application will
-- no longer call 'OpenXR.Core10.DisplayTiming.waitFrame',
-- 'OpenXR.Core10.DisplayTiming.beginFrame' or
-- 'OpenXR.Core10.DisplayTiming.endFrame' from any thread allowing the
-- runtime to safely transition the session to
-- 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_IDLE'. The application
-- /must/ also avoid reading input state or sending haptic output after
-- calling 'endSession'.
--
-- If the session
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_not_running is not running>
-- when the application calls 'endSession', the runtime /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING'. If the session
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_running is still running>
-- when the application calls 'endSession', but the session is not yet in
-- the 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_STOPPING' state, the
-- runtime /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_STOPPING'.
--
-- If the application wishes to exit a running session, the application can
-- call 'requestExitSession' so that the session transitions from
-- 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_IDLE' to
-- 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_EXITING'.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_STOPPING'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Session', 'beginSession',
-- 'OpenXR.Core10.Device.createSession',
-- 'OpenXR.Core10.Device.destroySession'
endSession :: forall io
            . (MonadIO io)
           => -- | @session@ is a handle to a
              -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_running running>
              -- 'OpenXR.Core10.Handles.Session'.
              --
              -- #VUID-xrEndSession-session-parameter# @session@ /must/ be a valid
              -- 'OpenXR.Core10.Handles.Session' handle
              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

-- | xrRequestExitSession - Request to exit a running session.
--
-- == Parameter Descriptions
--
-- = Description
--
-- An application can only call 'endSession' when the session is in the
-- 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_STOPPING' state, which
-- allows runtimes to seamlessly transition from one application’s session
-- to another. When an application wishes to exit a
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_running running>
-- session, the application can call 'requestExitSession', requesting that
-- the runtime transition through the various intermediate session states
-- including 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_STOPPING' to
-- 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_EXITING'.
--
-- If @session@
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_not_running is not running>
-- when 'requestExitSession' is called,
-- 'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING' /must/ be
-- returned.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Session', 'OpenXR.Core10.Device.destroySession',
-- 'endSession'
requestExitSession :: forall io
                    . (MonadIO io)
                   => -- | @session@ is a handle to a running 'OpenXR.Core10.Handles.Session'.
                      --
                      -- #VUID-xrRequestExitSession-session-parameter# @session@ /must/ be a
                      -- valid 'OpenXR.Core10.Handles.Session' handle
                      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)


-- | XrSessionBeginInfo - Struct containing session begin info
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType',
-- 'beginSession'
data SessionBeginInfo (es :: [Type]) = SessionBeginInfo
  { -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    --
    -- #VUID-XrSessionBeginInfo-next-next# @next@ /must/ be @NULL@ or a valid
    -- pointer to the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>.
    -- See also:
    -- 'OpenXR.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationSessionBeginInfoMSFT'
    SessionBeginInfo es -> Chain es
next :: Chain es
  , -- | @primaryViewConfigurationType@ is the
    -- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType' to use
    -- during this session to provide images for the form factor’s primary
    -- displays.
    --
    -- #VUID-XrSessionBeginInfo-primaryViewConfigurationType-parameter#
    -- @primaryViewConfigurationType@ /must/ be a valid
    -- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType' value
    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