{-# language CPP #-}
-- | = Name
--
-- XR_KHR_win32_convert_performance_counter_time - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_win32_convert_performance_counter_time  XR_KHR_win32_convert_performance_counter_time>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 36
--
-- = Revision
--
-- 1
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'convertTimeToWin32PerformanceCounterKHR',
-- 'convertWin32PerformanceCounterToTimeKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_win32_convert_performance_counter_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_win32_convert_performance_counter_time  ( convertTimeToWin32PerformanceCounterKHR
                                                                        , convertWin32PerformanceCounterToTimeKHR
                                                                        , KHR_win32_convert_performance_counter_time_SPEC_VERSION
                                                                        , pattern KHR_win32_convert_performance_counter_time_SPEC_VERSION
                                                                        , KHR_WIN32_CONVERT_PERFORMANCE_COUNTER_TIME_EXTENSION_NAME
                                                                        , pattern KHR_WIN32_CONVERT_PERFORMANCE_COUNTER_TIME_EXTENSION_NAME
                                                                        , LARGE_INTEGER
                                                                        ) 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 (nullFunPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Foreign.Storable (Storable(peek))
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word64)
import Control.Monad.Trans.Cont (ContT(..))
import OpenXR.NamedType ((:::))
import OpenXR.Core10.Handles (Instance)
import OpenXR.Core10.Handles (Instance(..))
import OpenXR.Dynamic (InstanceCmds(pXrConvertTimeToWin32PerformanceCounterKHR))
import OpenXR.Dynamic (InstanceCmds(pXrConvertWin32PerformanceCounterToTimeKHR))
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" mkXrConvertTimeToWin32PerformanceCounterKHR
  :: FunPtr (Ptr Instance_T -> Time -> Ptr LARGE_INTEGER -> IO Result) -> Ptr Instance_T -> Time -> Ptr LARGE_INTEGER -> IO Result

-- | xrConvertTimeToWin32PerformanceCounterKHR - Convert XrTime to Win32
-- @QueryPerformanceCounter@ time
--
-- == Parameter Descriptions
--
-- = Description
--
-- The 'convertTimeToWin32PerformanceCounterKHR' function converts an
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
-- to time as if generated by the @QueryPerformanceCounter@ Windows
-- function.
--
-- If the output @performanceCounter@ cannot represent the input @time@,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_TIME_INVALID'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrConvertTimeToWin32PerformanceCounterKHR-extension-notenabled#
--     The @@ extension /must/ be enabled prior to calling
--     'convertTimeToWin32PerformanceCounterKHR'
--
-- -   #VUID-xrConvertTimeToWin32PerformanceCounterKHR-instance-parameter#
--     @instance@ /must/ be a valid 'OpenXR.Core10.Handles.Instance' handle
--
-- -   #VUID-xrConvertTimeToWin32PerformanceCounterKHR-performanceCounter-parameter#
--     @performanceCounter@ /must/ be a pointer to a 'LARGE_INTEGER' 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 >
convertTimeToWin32PerformanceCounterKHR :: 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 (("performanceCounter" ::: LARGE_INTEGER))
convertTimeToWin32PerformanceCounterKHR :: Instance -> Time -> io ("performanceCounter" ::: LARGE_INTEGER)
convertTimeToWin32PerformanceCounterKHR instance' :: Instance
instance' time :: Time
time = IO ("performanceCounter" ::: LARGE_INTEGER)
-> io ("performanceCounter" ::: LARGE_INTEGER)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("performanceCounter" ::: LARGE_INTEGER)
 -> io ("performanceCounter" ::: LARGE_INTEGER))
-> (ContT
      ("performanceCounter" ::: LARGE_INTEGER)
      IO
      ("performanceCounter" ::: LARGE_INTEGER)
    -> IO ("performanceCounter" ::: LARGE_INTEGER))
-> ContT
     ("performanceCounter" ::: LARGE_INTEGER)
     IO
     ("performanceCounter" ::: LARGE_INTEGER)
-> io ("performanceCounter" ::: LARGE_INTEGER)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  ("performanceCounter" ::: LARGE_INTEGER)
  IO
  ("performanceCounter" ::: LARGE_INTEGER)
-> IO ("performanceCounter" ::: LARGE_INTEGER)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   ("performanceCounter" ::: LARGE_INTEGER)
   IO
   ("performanceCounter" ::: LARGE_INTEGER)
 -> io ("performanceCounter" ::: LARGE_INTEGER))
-> ContT
     ("performanceCounter" ::: LARGE_INTEGER)
     IO
     ("performanceCounter" ::: LARGE_INTEGER)
-> io ("performanceCounter" ::: LARGE_INTEGER)
forall a b. (a -> b) -> a -> b
$ do
  let xrConvertTimeToWin32PerformanceCounterKHRPtr :: FunPtr
  (Ptr Instance_T
   -> Time
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> IO Result)
xrConvertTimeToWin32PerformanceCounterKHRPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> Time
      -> ("performanceCounter"
          ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
      -> IO Result)
pXrConvertTimeToWin32PerformanceCounterKHR (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT ("performanceCounter" ::: LARGE_INTEGER) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("performanceCounter" ::: LARGE_INTEGER) IO ())
-> IO () -> ContT ("performanceCounter" ::: LARGE_INTEGER) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> Time
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> IO Result)
xrConvertTimeToWin32PerformanceCounterKHRPtr FunPtr
  (Ptr Instance_T
   -> Time
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> Time
      -> ("performanceCounter"
          ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> Time
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> 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 xrConvertTimeToWin32PerformanceCounterKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrConvertTimeToWin32PerformanceCounterKHR' :: Ptr Instance_T
-> Time
-> ("performanceCounter"
    ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
-> IO Result
xrConvertTimeToWin32PerformanceCounterKHR' = FunPtr
  (Ptr Instance_T
   -> Time
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> IO Result)
-> Ptr Instance_T
-> Time
-> ("performanceCounter"
    ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
-> IO Result
mkXrConvertTimeToWin32PerformanceCounterKHR FunPtr
  (Ptr Instance_T
   -> Time
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> IO Result)
xrConvertTimeToWin32PerformanceCounterKHRPtr
  "performanceCounter"
::: Ptr ("performanceCounter" ::: LARGE_INTEGER)
pPerformanceCounter <- ((("performanceCounter"
   ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
  -> IO ("performanceCounter" ::: LARGE_INTEGER))
 -> IO ("performanceCounter" ::: LARGE_INTEGER))
-> ContT
     ("performanceCounter" ::: LARGE_INTEGER)
     IO
     ("performanceCounter"
      ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("performanceCounter"
    ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> IO ("performanceCounter" ::: LARGE_INTEGER))
  -> IO ("performanceCounter" ::: LARGE_INTEGER))
 -> ContT
      ("performanceCounter" ::: LARGE_INTEGER)
      IO
      ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER)))
-> ((("performanceCounter"
      ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
     -> IO ("performanceCounter" ::: LARGE_INTEGER))
    -> IO ("performanceCounter" ::: LARGE_INTEGER))
-> ContT
     ("performanceCounter" ::: LARGE_INTEGER)
     IO
     ("performanceCounter"
      ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
forall a b. (a -> b) -> a -> b
$ IO
  ("performanceCounter"
   ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
-> (("performanceCounter"
     ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
    -> IO ())
-> (("performanceCounter"
     ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
    -> IO ("performanceCounter" ::: LARGE_INTEGER))
-> IO ("performanceCounter" ::: LARGE_INTEGER)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO
     ("performanceCounter"
      ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
forall a. Int -> IO (Ptr a)
callocBytes @LARGE_INTEGER 8) ("performanceCounter"
 ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
-> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT ("performanceCounter" ::: LARGE_INTEGER) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT ("performanceCounter" ::: LARGE_INTEGER) IO Result)
-> IO Result
-> ContT ("performanceCounter" ::: LARGE_INTEGER) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrConvertTimeToWin32PerformanceCounterKHR" (Ptr Instance_T
-> Time
-> ("performanceCounter"
    ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
-> IO Result
xrConvertTimeToWin32PerformanceCounterKHR' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (Time
time) ("performanceCounter"
::: Ptr ("performanceCounter" ::: LARGE_INTEGER)
pPerformanceCounter))
  IO () -> ContT ("performanceCounter" ::: LARGE_INTEGER) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("performanceCounter" ::: LARGE_INTEGER) IO ())
-> IO () -> ContT ("performanceCounter" ::: LARGE_INTEGER) 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))
  "performanceCounter" ::: LARGE_INTEGER
performanceCounter <- IO ("performanceCounter" ::: LARGE_INTEGER)
-> ContT
     ("performanceCounter" ::: LARGE_INTEGER)
     IO
     ("performanceCounter" ::: LARGE_INTEGER)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("performanceCounter" ::: LARGE_INTEGER)
 -> ContT
      ("performanceCounter" ::: LARGE_INTEGER)
      IO
      ("performanceCounter" ::: LARGE_INTEGER))
-> IO ("performanceCounter" ::: LARGE_INTEGER)
-> ContT
     ("performanceCounter" ::: LARGE_INTEGER)
     IO
     ("performanceCounter" ::: LARGE_INTEGER)
forall a b. (a -> b) -> a -> b
$ ("performanceCounter"
 ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
-> IO ("performanceCounter" ::: LARGE_INTEGER)
forall a. Storable a => Ptr a -> IO a
peek @LARGE_INTEGER "performanceCounter"
::: Ptr ("performanceCounter" ::: LARGE_INTEGER)
pPerformanceCounter
  ("performanceCounter" ::: LARGE_INTEGER)
-> ContT
     ("performanceCounter" ::: LARGE_INTEGER)
     IO
     ("performanceCounter" ::: LARGE_INTEGER)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("performanceCounter" ::: LARGE_INTEGER)
 -> ContT
      ("performanceCounter" ::: LARGE_INTEGER)
      IO
      ("performanceCounter" ::: LARGE_INTEGER))
-> ("performanceCounter" ::: LARGE_INTEGER)
-> ContT
     ("performanceCounter" ::: LARGE_INTEGER)
     IO
     ("performanceCounter" ::: LARGE_INTEGER)
forall a b. (a -> b) -> a -> b
$ ("performanceCounter" ::: LARGE_INTEGER
performanceCounter)


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

-- | xrConvertWin32PerformanceCounterToTimeKHR - Convert Win32
-- @QueryPerformanceCounter@ time to XrTime
--
-- == Parameter Descriptions
--
-- = Description
--
-- The 'convertWin32PerformanceCounterToTimeKHR' function converts a time
-- stamp obtained by the @QueryPerformanceCounter@ Windows 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 @performanceCounter@,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_TIME_INVALID'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrConvertWin32PerformanceCounterToTimeKHR-extension-notenabled#
--     The @@ extension /must/ be enabled prior to calling
--     'convertWin32PerformanceCounterToTimeKHR'
--
-- -   #VUID-xrConvertWin32PerformanceCounterToTimeKHR-instance-parameter#
--     @instance@ /must/ be a valid 'OpenXR.Core10.Handles.Instance' handle
--
-- -   #VUID-xrConvertWin32PerformanceCounterToTimeKHR-performanceCounter-parameter#
--     @performanceCounter@ /must/ be a pointer to a valid 'LARGE_INTEGER'
--     value
--
-- -   #VUID-xrConvertWin32PerformanceCounterToTimeKHR-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 >
convertWin32PerformanceCounterToTimeKHR :: forall io
                                         . (MonadIO io)
                                        => -- | @instance@ is an 'OpenXR.Core10.Handles.Instance' handle previously
                                           -- created with 'OpenXR.Core10.Instance.createInstance'.
                                           Instance
                                        -> -- | @performanceCounter@ is a time returned by @QueryPerformanceCounter@.
                                           ("performanceCounter" ::: LARGE_INTEGER)
                                        -> io (Time)
convertWin32PerformanceCounterToTimeKHR :: Instance -> ("performanceCounter" ::: LARGE_INTEGER) -> io Time
convertWin32PerformanceCounterToTimeKHR instance' :: Instance
instance' performanceCounter :: "performanceCounter" ::: LARGE_INTEGER
performanceCounter = 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 xrConvertWin32PerformanceCounterToTimeKHRPtr :: FunPtr
  (Ptr Instance_T
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> Ptr Time
   -> IO Result)
xrConvertWin32PerformanceCounterToTimeKHRPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("performanceCounter"
          ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
      -> Ptr Time
      -> IO Result)
pXrConvertWin32PerformanceCounterToTimeKHR (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
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> Ptr Time
   -> IO Result)
xrConvertWin32PerformanceCounterToTimeKHRPtr FunPtr
  (Ptr Instance_T
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> Ptr Time
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> ("performanceCounter"
          ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
      -> Ptr Time
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> 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 xrConvertWin32PerformanceCounterToTimeKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrConvertWin32PerformanceCounterToTimeKHR' :: Ptr Instance_T
-> ("performanceCounter"
    ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
-> Ptr Time
-> IO Result
xrConvertWin32PerformanceCounterToTimeKHR' = FunPtr
  (Ptr Instance_T
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> Ptr Time
   -> IO Result)
-> Ptr Instance_T
-> ("performanceCounter"
    ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
-> Ptr Time
-> IO Result
mkXrConvertWin32PerformanceCounterToTimeKHR FunPtr
  (Ptr Instance_T
   -> ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> Ptr Time
   -> IO Result)
xrConvertWin32PerformanceCounterToTimeKHRPtr
  "performanceCounter"
::: Ptr ("performanceCounter" ::: LARGE_INTEGER)
performanceCounter' <- ((("performanceCounter"
   ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
  -> IO Time)
 -> IO Time)
-> ContT
     Time
     IO
     ("performanceCounter"
      ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("performanceCounter"
    ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
   -> IO Time)
  -> IO Time)
 -> ContT
      Time
      IO
      ("performanceCounter"
       ::: Ptr ("performanceCounter" ::: LARGE_INTEGER)))
-> ((("performanceCounter"
      ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
     -> IO Time)
    -> IO Time)
-> ContT
     Time
     IO
     ("performanceCounter"
      ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
forall a b. (a -> b) -> a -> b
$ ("performanceCounter" ::: LARGE_INTEGER)
-> (("performanceCounter"
     ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
    -> IO Time)
-> IO Time
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ("performanceCounter" ::: LARGE_INTEGER
performanceCounter)
  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 "xrConvertWin32PerformanceCounterToTimeKHR" (Ptr Instance_T
-> ("performanceCounter"
    ::: Ptr ("performanceCounter" ::: LARGE_INTEGER))
-> Ptr Time
-> IO Result
xrConvertWin32PerformanceCounterToTimeKHR' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) "performanceCounter"
::: Ptr ("performanceCounter" ::: LARGE_INTEGER)
performanceCounter' (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_win32_convert_performance_counter_time_SPEC_VERSION = 1

-- No documentation found for TopLevel "XR_KHR_win32_convert_performance_counter_time_SPEC_VERSION"
pattern KHR_win32_convert_performance_counter_time_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_win32_convert_performance_counter_time_SPEC_VERSION :: a
$mKHR_win32_convert_performance_counter_time_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_win32_convert_performance_counter_time_SPEC_VERSION = 1


type KHR_WIN32_CONVERT_PERFORMANCE_COUNTER_TIME_EXTENSION_NAME = "XR_KHR_win32_convert_performance_counter_time"

-- No documentation found for TopLevel "XR_KHR_WIN32_CONVERT_PERFORMANCE_COUNTER_TIME_EXTENSION_NAME"
pattern KHR_WIN32_CONVERT_PERFORMANCE_COUNTER_TIME_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_WIN32_CONVERT_PERFORMANCE_COUNTER_TIME_EXTENSION_NAME :: a
$mKHR_WIN32_CONVERT_PERFORMANCE_COUNTER_TIME_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_WIN32_CONVERT_PERFORMANCE_COUNTER_TIME_EXTENSION_NAME = "XR_KHR_win32_convert_performance_counter_time"


type LARGE_INTEGER = Word64