{-# language CPP #-}
-- | = Name
--
-- XR_KHR_convert_timespec_time - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_convert_timespec_time  XR_KHR_convert_timespec_time>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 37
--
-- = Revision
--
-- 1
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'convertTimeToTimespecTimeKHR', 'convertTimespecTimeToTimeKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_convert_timespec_time OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_KHR_convert_timespec_time  ( convertTimeToTimespecTimeKHR
                                                       , convertTimespecTimeToTimeKHR
                                                       , KHR_convert_timespec_time_SPEC_VERSION
                                                       , pattern KHR_convert_timespec_time_SPEC_VERSION
                                                       , KHR_CONVERT_TIMESPEC_TIME_EXTENSION_NAME
                                                       , pattern KHR_CONVERT_TIMESPEC_TIME_EXTENSION_NAME
                                                       , Timespec(..)
                                                       ) where

import OpenXR.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (with)
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 Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CTime)
import Foreign.Storable (Storable(..))
import Foreign.Storable (Storable(peek))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int64)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Control.Monad.Trans.Cont (ContT(..))
import OpenXR.NamedType ((:::))
import OpenXR.Core10.Handles (Instance)
import OpenXR.Core10.Handles (Instance(..))
import OpenXR.Dynamic (InstanceCmds(pXrConvertTimeToTimespecTimeKHR))
import OpenXR.Dynamic (InstanceCmds(pXrConvertTimespecTimeToTimeKHR))
import OpenXR.Core10.Handles (Instance_T)
import OpenXR.Exception (OpenXrException(..))
import OpenXR.Core10.Enums.Result (Result)
import OpenXR.Core10.Enums.Result (Result(..))
import OpenXR.Core10.FundamentalTypes (Time)
import OpenXR.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrConvertTimeToTimespecTimeKHR
  :: FunPtr (Ptr Instance_T -> Time -> Ptr Timespec -> IO Result) -> Ptr Instance_T -> Time -> Ptr Timespec -> IO Result

-- | xrConvertTimeToTimespecTimeKHR - Convert XrTime to timespec monotonic
-- time
--
-- == Parameter Descriptions
--
-- = Description
--
-- The 'convertTimeToTimespecTimeKHR' function converts an
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
-- to time as if generated by @clock_gettime@.
--
-- If the output @unixTime@ cannot represent the input @time@, the runtime
-- /must/ return 'OpenXR.Core10.Enums.Result.ERROR_TIME_INVALID'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrConvertTimeToTimespecTimeKHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to calling
--     'convertTimeToTimespecTimeKHR'
--
-- -   #VUID-xrConvertTimeToTimespecTimeKHR-instance-parameter# @instance@
--     /must/ be a valid 'OpenXR.Core10.Handles.Instance' handle
--
-- -   #VUID-xrConvertTimeToTimespecTimeKHR-timespecTime-parameter#
--     @timespecTime@ /must/ be a pointer to a @timespec@ value
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_TIME_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_FUNCTION_UNSUPPORTED'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Instance',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
convertTimeToTimespecTimeKHR :: forall io
                              . (MonadIO io)
                             => -- | @instance@ is an 'OpenXR.Core10.Handles.Instance' handle previously
                                -- created with 'OpenXR.Core10.Instance.createInstance'.
                                Instance
                             -> -- | @time@ is an
                                -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >.
                                Time
                             -> io (("timespecTime" ::: Timespec))
convertTimeToTimespecTimeKHR :: Instance -> Time -> io ("timespecTime" ::: Timespec)
convertTimeToTimespecTimeKHR instance' :: Instance
instance' time :: Time
time = IO ("timespecTime" ::: Timespec)
-> io ("timespecTime" ::: Timespec)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("timespecTime" ::: Timespec)
 -> io ("timespecTime" ::: Timespec))
-> (ContT
      ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec)
    -> IO ("timespecTime" ::: Timespec))
-> ContT
     ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec)
-> io ("timespecTime" ::: Timespec)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec)
-> IO ("timespecTime" ::: Timespec)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec)
 -> io ("timespecTime" ::: Timespec))
-> ContT
     ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec)
-> io ("timespecTime" ::: Timespec)
forall a b. (a -> b) -> a -> b
$ do
  let xrConvertTimeToTimespecTimeKHRPtr :: FunPtr
  (Ptr Instance_T
   -> Time
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> IO Result)
xrConvertTimeToTimespecTimeKHRPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> Time
      -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
      -> IO Result)
pXrConvertTimeToTimespecTimeKHR (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT ("timespecTime" ::: Timespec) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("timespecTime" ::: Timespec) IO ())
-> IO () -> ContT ("timespecTime" ::: Timespec) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> Time
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> IO Result)
xrConvertTimeToTimespecTimeKHRPtr FunPtr
  (Ptr Instance_T
   -> Time
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> Time
      -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> Time
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> 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 xrConvertTimeToTimespecTimeKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrConvertTimeToTimespecTimeKHR' :: Ptr Instance_T
-> Time
-> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> IO Result
xrConvertTimeToTimespecTimeKHR' = FunPtr
  (Ptr Instance_T
   -> Time
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> IO Result)
-> Ptr Instance_T
-> Time
-> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> IO Result
mkXrConvertTimeToTimespecTimeKHR FunPtr
  (Ptr Instance_T
   -> Time
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> IO Result)
xrConvertTimeToTimespecTimeKHRPtr
  "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
pTimespecTime <- ((("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
  -> IO ("timespecTime" ::: Timespec))
 -> IO ("timespecTime" ::: Timespec))
-> ContT
     ("timespecTime" ::: Timespec)
     IO
     ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> IO ("timespecTime" ::: Timespec))
  -> IO ("timespecTime" ::: Timespec))
 -> ContT
      ("timespecTime" ::: Timespec)
      IO
      ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec)))
-> ((("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
     -> IO ("timespecTime" ::: Timespec))
    -> IO ("timespecTime" ::: Timespec))
-> ContT
     ("timespecTime" ::: Timespec)
     IO
     ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
forall a b. (a -> b) -> a -> b
$ IO ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> (("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
    -> IO ())
-> (("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
    -> IO ("timespecTime" ::: Timespec))
-> IO ("timespecTime" ::: Timespec)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
forall a. Int -> IO (Ptr a)
callocBytes @Timespec 16) ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT ("timespecTime" ::: Timespec) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ("timespecTime" ::: Timespec) IO Result)
-> IO Result -> ContT ("timespecTime" ::: Timespec) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrConvertTimeToTimespecTimeKHR" (Ptr Instance_T
-> Time
-> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> IO Result
xrConvertTimeToTimespecTimeKHR' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (Time
time) ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
pTimespecTime))
  IO () -> ContT ("timespecTime" ::: Timespec) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("timespecTime" ::: Timespec) IO ())
-> IO () -> ContT ("timespecTime" ::: Timespec) 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))
  "timespecTime" ::: Timespec
timespecTime <- IO ("timespecTime" ::: Timespec)
-> ContT
     ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("timespecTime" ::: Timespec)
 -> ContT
      ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec))
-> IO ("timespecTime" ::: Timespec)
-> ContT
     ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec)
forall a b. (a -> b) -> a -> b
$ ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> IO ("timespecTime" ::: Timespec)
forall a. Storable a => Ptr a -> IO a
peek @Timespec "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
pTimespecTime
  ("timespecTime" ::: Timespec)
-> ContT
     ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("timespecTime" ::: Timespec)
 -> ContT
      ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec))
-> ("timespecTime" ::: Timespec)
-> ContT
     ("timespecTime" ::: Timespec) IO ("timespecTime" ::: Timespec)
forall a b. (a -> b) -> a -> b
$ ("timespecTime" ::: Timespec
timespecTime)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrConvertTimespecTimeToTimeKHR
  :: FunPtr (Ptr Instance_T -> Ptr Timespec -> Ptr Time -> IO Result) -> Ptr Instance_T -> Ptr Timespec -> Ptr Time -> IO Result

-- | xrConvertTimespecTimeToTimeKHR - Convert timespec monotonic time to
-- XrTime
--
-- == Parameter Descriptions
--
-- = Description
--
-- The 'convertTimespecTimeToTimeKHR' function converts a time obtained by
-- the @clock_gettime@ function to the equivalent
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >.
--
-- If the output @time@ cannot represent the input @unixTime@, the runtime
-- /must/ return 'OpenXR.Core10.Enums.Result.ERROR_TIME_INVALID'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrConvertTimespecTimeToTimeKHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to calling
--     'convertTimespecTimeToTimeKHR'
--
-- -   #VUID-xrConvertTimespecTimeToTimeKHR-instance-parameter# @instance@
--     /must/ be a valid 'OpenXR.Core10.Handles.Instance' handle
--
-- -   #VUID-xrConvertTimespecTimeToTimeKHR-timespecTime-parameter#
--     @timespecTime@ /must/ be a pointer to a valid @timespec@ value
--
-- -   #VUID-xrConvertTimespecTimeToTimeKHR-time-parameter# @time@ /must/
--     be a pointer to an
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
--     value
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_TIME_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_FUNCTION_UNSUPPORTED'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Instance',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
convertTimespecTimeToTimeKHR :: forall io
                              . (MonadIO io)
                             => -- | @instance@ is an 'OpenXR.Core10.Handles.Instance' handle previously
                                -- created with 'OpenXR.Core10.Instance.createInstance'.
                                Instance
                             -> -- No documentation found for Nested "xrConvertTimespecTimeToTimeKHR" "timespecTime"
                                ("timespecTime" ::: Timespec)
                             -> io (Time)
convertTimespecTimeToTimeKHR :: Instance -> ("timespecTime" ::: Timespec) -> io Time
convertTimespecTimeToTimeKHR instance' :: Instance
instance' timespecTime :: "timespecTime" ::: Timespec
timespecTime = IO Time -> io Time
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Time -> io Time)
-> (ContT Time IO Time -> IO Time) -> ContT Time IO Time -> io Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Time IO Time -> IO Time
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Time IO Time -> io Time) -> ContT Time IO Time -> io Time
forall a b. (a -> b) -> a -> b
$ do
  let xrConvertTimespecTimeToTimeKHRPtr :: FunPtr
  (Ptr Instance_T
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> Ptr Time
   -> IO Result)
xrConvertTimespecTimeToTimeKHRPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
      -> Ptr Time
      -> IO Result)
pXrConvertTimespecTimeToTimeKHR (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT Time IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Time IO ()) -> IO () -> ContT Time IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> Ptr Time
   -> IO Result)
xrConvertTimespecTimeToTimeKHRPtr FunPtr
  (Ptr Instance_T
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> Ptr Time
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
      -> Ptr Time
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> Ptr Time
   -> 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 xrConvertTimespecTimeToTimeKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrConvertTimespecTimeToTimeKHR' :: Ptr Instance_T
-> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> Ptr Time
-> IO Result
xrConvertTimespecTimeToTimeKHR' = FunPtr
  (Ptr Instance_T
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> Ptr Time
   -> IO Result)
-> Ptr Instance_T
-> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> Ptr Time
-> IO Result
mkXrConvertTimespecTimeToTimeKHR FunPtr
  (Ptr Instance_T
   -> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> Ptr Time
   -> IO Result)
xrConvertTimespecTimeToTimeKHRPtr
  "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
timespecTime' <- ((("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
  -> IO Time)
 -> IO Time)
-> ContT
     Time IO ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
   -> IO Time)
  -> IO Time)
 -> ContT
      Time IO ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec)))
-> ((("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
     -> IO Time)
    -> IO Time)
-> ContT
     Time IO ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
forall a b. (a -> b) -> a -> b
$ ("timespecTime" ::: Timespec)
-> (("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
    -> IO Time)
-> IO Time
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ("timespecTime" ::: Timespec
timespecTime)
  Ptr Time
pTime <- ((Ptr Time -> IO Time) -> IO Time) -> ContT Time IO (Ptr Time)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Time -> IO Time) -> IO Time) -> ContT Time IO (Ptr Time))
-> ((Ptr Time -> IO Time) -> IO Time) -> ContT Time IO (Ptr Time)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Time)
-> (Ptr Time -> IO ()) -> (Ptr Time -> IO Time) -> IO Time
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Time)
forall a. Int -> IO (Ptr a)
callocBytes @Time 8) Ptr Time -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT Time IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Time IO Result)
-> IO Result -> ContT Time IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrConvertTimespecTimeToTimeKHR" (Ptr Instance_T
-> ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> Ptr Time
-> IO Result
xrConvertTimespecTimeToTimeKHR' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
timespecTime' (Ptr Time
pTime))
  IO () -> ContT Time IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Time IO ()) -> IO () -> ContT Time 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))
  Time
time <- IO Time -> ContT Time IO Time
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Time -> ContT Time IO Time) -> IO Time -> ContT Time IO Time
forall a b. (a -> b) -> a -> b
$ Ptr Time -> IO Time
forall a. Storable a => Ptr a -> IO a
peek @Time Ptr Time
pTime
  Time -> ContT Time IO Time
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time -> ContT Time IO Time) -> Time -> ContT Time IO Time
forall a b. (a -> b) -> a -> b
$ (Time
time)


type KHR_convert_timespec_time_SPEC_VERSION = 1

-- No documentation found for TopLevel "XR_KHR_convert_timespec_time_SPEC_VERSION"
pattern KHR_convert_timespec_time_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_convert_timespec_time_SPEC_VERSION :: a
$mKHR_convert_timespec_time_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_convert_timespec_time_SPEC_VERSION = 1


type KHR_CONVERT_TIMESPEC_TIME_EXTENSION_NAME = "XR_KHR_convert_timespec_time"

-- No documentation found for TopLevel "XR_KHR_CONVERT_TIMESPEC_TIME_EXTENSION_NAME"
pattern KHR_CONVERT_TIMESPEC_TIME_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_CONVERT_TIMESPEC_TIME_EXTENSION_NAME :: a
$mKHR_CONVERT_TIMESPEC_TIME_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_CONVERT_TIMESPEC_TIME_EXTENSION_NAME = "XR_KHR_convert_timespec_time"


data Timespec = Timespec
  { ("timespecTime" ::: Timespec) -> CTime
tv_sec :: CTime
  , ("timespecTime" ::: Timespec) -> Time
tv_nsec :: Int64
  }
  deriving (Typeable, (forall x.
 ("timespecTime" ::: Timespec)
 -> Rep ("timespecTime" ::: Timespec) x)
-> (forall x.
    Rep ("timespecTime" ::: Timespec) x -> "timespecTime" ::: Timespec)
-> Generic ("timespecTime" ::: Timespec)
forall x.
Rep ("timespecTime" ::: Timespec) x -> "timespecTime" ::: Timespec
forall x.
("timespecTime" ::: Timespec)
-> Rep ("timespecTime" ::: Timespec) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ("timespecTime" ::: Timespec) x -> "timespecTime" ::: Timespec
$cfrom :: forall x.
("timespecTime" ::: Timespec)
-> Rep ("timespecTime" ::: Timespec) x
Generic, ReadPrec ["timespecTime" ::: Timespec]
ReadPrec ("timespecTime" ::: Timespec)
Int -> ReadS ("timespecTime" ::: Timespec)
ReadS ["timespecTime" ::: Timespec]
(Int -> ReadS ("timespecTime" ::: Timespec))
-> ReadS ["timespecTime" ::: Timespec]
-> ReadPrec ("timespecTime" ::: Timespec)
-> ReadPrec ["timespecTime" ::: Timespec]
-> Read ("timespecTime" ::: Timespec)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec ["timespecTime" ::: Timespec]
$creadListPrec :: ReadPrec ["timespecTime" ::: Timespec]
readPrec :: ReadPrec ("timespecTime" ::: Timespec)
$creadPrec :: ReadPrec ("timespecTime" ::: Timespec)
readList :: ReadS ["timespecTime" ::: Timespec]
$creadList :: ReadS ["timespecTime" ::: Timespec]
readsPrec :: Int -> ReadS ("timespecTime" ::: Timespec)
$creadsPrec :: Int -> ReadS ("timespecTime" ::: Timespec)
Read, Int -> ("timespecTime" ::: Timespec) -> ShowS
["timespecTime" ::: Timespec] -> ShowS
("timespecTime" ::: Timespec) -> String
(Int -> ("timespecTime" ::: Timespec) -> ShowS)
-> (("timespecTime" ::: Timespec) -> String)
-> (["timespecTime" ::: Timespec] -> ShowS)
-> Show ("timespecTime" ::: Timespec)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: ["timespecTime" ::: Timespec] -> ShowS
$cshowList :: ["timespecTime" ::: Timespec] -> ShowS
show :: ("timespecTime" ::: Timespec) -> String
$cshow :: ("timespecTime" ::: Timespec) -> String
showsPrec :: Int -> ("timespecTime" ::: Timespec) -> ShowS
$cshowsPrec :: Int -> ("timespecTime" ::: Timespec) -> ShowS
Show, ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
(("timespecTime" ::: Timespec)
 -> ("timespecTime" ::: Timespec) -> Bool)
-> (("timespecTime" ::: Timespec)
    -> ("timespecTime" ::: Timespec) -> Bool)
-> Eq ("timespecTime" ::: Timespec)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
$c/= :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
== :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
$c== :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
Eq, Eq ("timespecTime" ::: Timespec)
Eq ("timespecTime" ::: Timespec) =>
(("timespecTime" ::: Timespec)
 -> ("timespecTime" ::: Timespec) -> Ordering)
-> (("timespecTime" ::: Timespec)
    -> ("timespecTime" ::: Timespec) -> Bool)
-> (("timespecTime" ::: Timespec)
    -> ("timespecTime" ::: Timespec) -> Bool)
-> (("timespecTime" ::: Timespec)
    -> ("timespecTime" ::: Timespec) -> Bool)
-> (("timespecTime" ::: Timespec)
    -> ("timespecTime" ::: Timespec) -> Bool)
-> (("timespecTime" ::: Timespec)
    -> ("timespecTime" ::: Timespec) -> "timespecTime" ::: Timespec)
-> (("timespecTime" ::: Timespec)
    -> ("timespecTime" ::: Timespec) -> "timespecTime" ::: Timespec)
-> Ord ("timespecTime" ::: Timespec)
("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Ordering
("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> "timespecTime" ::: Timespec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> "timespecTime" ::: Timespec
$cmin :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> "timespecTime" ::: Timespec
max :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> "timespecTime" ::: Timespec
$cmax :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> "timespecTime" ::: Timespec
>= :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
$c>= :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
> :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
$c> :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
<= :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
$c<= :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
< :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
$c< :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Bool
compare :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Ordering
$ccompare :: ("timespecTime" ::: Timespec)
-> ("timespecTime" ::: Timespec) -> Ordering
$cp1Ord :: Eq ("timespecTime" ::: Timespec)
Ord)

instance Storable Timespec where
  sizeOf :: ("timespecTime" ::: Timespec) -> Int
sizeOf ~"timespecTime" ::: Timespec
_ = 16
  alignment :: ("timespecTime" ::: Timespec) -> Int
alignment ~"timespecTime" ::: Timespec
_ = 8
  peek :: ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> IO ("timespecTime" ::: Timespec)
peek p :: "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
p = CTime -> Time -> "timespecTime" ::: Timespec
Timespec
    (CTime -> Time -> "timespecTime" ::: Timespec)
-> IO CTime -> IO (Time -> "timespecTime" ::: Timespec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CTime -> IO CTime
forall a. Storable a => Ptr a -> IO a
peek (("timespecTime" ::: Ptr ("timespecTime" ::: Timespec)) -> Ptr CTime
forall a b. Ptr a -> Ptr b
castPtr @Timespec @CTime "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
p)
    IO (Time -> "timespecTime" ::: Timespec)
-> IO Time -> IO ("timespecTime" ::: Timespec)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Time -> IO Time
forall a. Storable a => Ptr a -> IO a
peek (("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
plusPtr @Timespec @Int64 "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
p 8)
  poke :: ("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> ("timespecTime" ::: Timespec) -> IO ()
poke p :: "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
p (Timespec s :: CTime
s n :: Time
n) = do
    Ptr CTime -> CTime -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("timespecTime" ::: Ptr ("timespecTime" ::: Timespec)) -> Ptr CTime
forall a b. Ptr a -> Ptr b
castPtr @Timespec @CTime "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
p) CTime
s
    Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("timespecTime" ::: Ptr ("timespecTime" ::: Timespec))
-> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
plusPtr @Timespec @Int64 "timespecTime" ::: Ptr ("timespecTime" ::: Timespec)
p 8) Time
n