-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/CUDA/Driver/Graph/Capture.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# LANGUAGE EmptyCase                #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Graph.Capture
-- Copyright : [2018] Trevor L. McDonell
-- License   : BSD
--
-- Requires CUDA-10
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Graph.Capture (

  Status(..),
  start, stop, status,

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





{-# LINE 27 "src/Foreign/CUDA/Driver/Graph/Capture.chs" #-}


import Foreign.CUDA.Driver.Error                          hiding ( Status )
import Foreign.CUDA.Driver.Graph.Base
import Foreign.CUDA.Driver.Stream
import Foreign.CUDA.Internal.C2HS

import Control.Monad                                      ( liftM )

import Foreign
import Foreign.C


data Status = None
            | Active
            | Invalidated
  deriving (Eq,Show,Bounded)
instance Enum Status where
  succ None = Active
  succ Active = Invalidated
  succ Invalidated = error "Status.succ: Invalidated has no successor"

  pred Active = None
  pred Invalidated = Active
  pred None = error "Status.pred: None has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Invalidated

  fromEnum None = 0
  fromEnum Active = 1
  fromEnum Invalidated = 2

  toEnum 0 = None
  toEnum 1 = Active
  toEnum 2 = Invalidated
  toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)

{-# LINE 53 "src/Foreign/CUDA/Driver/Graph/Capture.chs" #-}



--------------------------------------------------------------------------------
-- Graph capture
--------------------------------------------------------------------------------

-- | Begin graph capture on a stream
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1gea22d4496b1c8d02d0607bb05743532f>
--
-- @since 0.10.0.0
--
start :: (Stream) -> IO ()
start a1 =
  let {a1' = useStream a1} in
  start'_ a1' >>= \res ->
  checkStatus res >>
  return ()

{-# LINE 76 "src/Foreign/CUDA/Driver/Graph/Capture.chs" #-}



-- | End graph capture on a stream
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g03dab8b2ba76b00718955177a929970c>
--
-- @since 0.10.0.0
--
stop :: (Stream) -> IO ((Graph))
stop a1 =
  let {a1' = useStream a1} in
  alloca $ \a2' ->
  stop'_ a1' a2' >>= \res ->
  checkStatus res >>
  peekGraph  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 96 "src/Foreign/CUDA/Driver/Graph/Capture.chs" #-}



-- | Return a stream's capture status
--
-- Requires CUDA-10.0
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g37823c49206e3704ae23c7ad78560bca>
--
-- @since 0.10.0.0
--
status :: (Stream) -> IO ((Status))
status a1 =
  let {a1' = useStream a1} in
  alloca $ \a2' ->
  status'_ a1' a2' >>= \res ->
  checkStatus res >>
  peekEnum  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 116 "src/Foreign/CUDA/Driver/Graph/Capture.chs" #-}



--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

{-# INLINE peekGraph #-}
peekGraph :: Ptr ((C2HSImp.Ptr ())) -> IO Graph
peekGraph = liftM Graph . peek


foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Capture.chs.h cuStreamBeginCapture"
  start'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Capture.chs.h cuStreamEndCapture"
  stop'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Graph/Capture.chs.h cuStreamIsCapturing"
  status'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))