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


{-# LINE 1 "src/Foreign/CUDA/Driver/Profiler.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Profiler
-- Copyright : [2009..2023] Trevor L. McDonell
-- License   : BSD
--
-- Profiler control for low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Profiler (

  OutputMode(..),
  initialise,
  start, stop,

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





{-# LINE 21 "src/Foreign/CUDA/Driver/Profiler.chs" #-}


-- friends
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS

-- system
import Foreign
import Foreign.C


-- | Profiler output mode
--
data OutputMode = KeyValuePair
                | CSV
  deriving (OutputMode -> OutputMode -> Bool
(OutputMode -> OutputMode -> Bool)
-> (OutputMode -> OutputMode -> Bool) -> Eq OutputMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputMode -> OutputMode -> Bool
== :: OutputMode -> OutputMode -> Bool
$c/= :: OutputMode -> OutputMode -> Bool
/= :: OutputMode -> OutputMode -> Bool
Eq,Int -> OutputMode -> ShowS
[OutputMode] -> ShowS
OutputMode -> String
(Int -> OutputMode -> ShowS)
-> (OutputMode -> String)
-> ([OutputMode] -> ShowS)
-> Show OutputMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputMode -> ShowS
showsPrec :: Int -> OutputMode -> ShowS
$cshow :: OutputMode -> String
show :: OutputMode -> String
$cshowList :: [OutputMode] -> ShowS
showList :: [OutputMode] -> ShowS
Show)
instance Enum OutputMode where
  succ :: OutputMode -> OutputMode
succ OutputMode
KeyValuePair = OutputMode
CSV
  succ OutputMode
CSV = String -> OutputMode
forall a. HasCallStack => String -> a
error String
"OutputMode.succ: CSV has no successor"

  pred CSV = KeyValuePair
  pred KeyValuePair = error "OutputMode.pred: KeyValuePair 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 CSV

  fromEnum KeyValuePair = 0
  fromEnum CSV = 1

  toEnum 0 = KeyValuePair
  toEnum 1 = CSV
  toEnum unmatched = error ("OutputMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 37 "src/Foreign/CUDA/Driver/Profiler.chs" #-}



-- | Initialise the CUDA profiler.
--
-- The configuration file is used to specify profiling options and profiling
-- counters. Refer to the "Compute Command Line Profiler User Guide" for
-- supported profiler options and counters.
--
-- Note that the CUDA profiler can not be initialised with this function if
-- another profiling tool is already active.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PROFILER.html#group__CUDA__PROFILER>
--
{-# INLINEABLE initialise #-}
initialise
    :: FilePath     -- ^ configuration file that itemises which counters and/or options to profile
    -> FilePath     -- ^ output file where profiling results will be stored
    -> OutputMode
    -> IO ()
initialise config output mode
  = nothingIfOk =<< cuProfilerInitialize config output mode

{-# INLINE cuProfilerInitialize #-}
cuProfilerInitialize :: (String) -> (String) -> (OutputMode) -> IO ((Status))
cuProfilerInitialize :: String -> String -> OutputMode -> IO Status
cuProfilerInitialize String
a1 String
a2 OutputMode
a3 =
  String -> (CString -> IO Status) -> IO Status
forall a. String -> (CString -> IO a) -> IO a
C2HSImp.withCString String
a1 ((CString -> IO Status) -> IO Status)
-> (CString -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \CString
a1' -> 
  String -> (CString -> IO Status) -> IO Status
forall a. String -> (CString -> IO a) -> IO a
C2HSImp.withCString String
a2 ((CString -> IO Status) -> IO Status)
-> (CString -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \CString
a2' -> 
  let {a3' :: CInt
a3' = OutputMode -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum OutputMode
a3} in 
  CString -> CString -> CInt -> IO CInt
cuProfilerInitialize'_ CString
a1' CString
a2' CInt
a3' IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Status -> IO Status
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 66 "src/Foreign/CUDA/Driver/Profiler.chs" #-}



-- | Begin profiling collection by the active profiling tool for the current
-- context. If profiling is already enabled, then this has no effect.
--
-- 'start' and 'stop' can be used to programatically control profiling
-- granularity, by allowing profiling to be done only on selected pieces of
-- code.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PROFILER.html#group__CUDA__PROFILER_1g8a5314de2292c2efac83ac7fcfa9190e>
--
{-# INLINEABLE start #-}
start :: IO ()
start :: IO ()
start = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Status
cuProfilerStart

{-# INLINE cuProfilerStart #-}
cuProfilerStart :: IO ((Status))
cuProfilerStart :: IO Status
cuProfilerStart =
  IO CInt
cuProfilerStart'_ IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Status -> IO Status
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 84 "src/Foreign/CUDA/Driver/Profiler.chs" #-}



-- | Stop profiling collection by the active profiling tool for the current
-- context, and force all pending profiler events to be written to the output
-- file. If profiling is already inactive, this has no effect.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__PROFILER.html#group__CUDA__PROFILER_1g4d8edef6174fd90165e6ac838f320a5f>
--
{-# INLINEABLE stop #-}
stop :: IO ()
stop :: IO ()
stop = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Status
cuProfilerStop

{-# INLINE cuProfilerStop #-}
cuProfilerStop :: IO ((Status))
cuProfilerStop :: IO Status
cuProfilerStop =
  IO CInt
cuProfilerStop'_ IO CInt -> (CInt -> IO Status) -> IO Status
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Status -> IO Status
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 99 "src/Foreign/CUDA/Driver/Profiler.chs" #-}



foreign import ccall unsafe "Foreign/CUDA/Driver/Profiler.chs.h cuProfilerInitialize"
  cuProfilerInitialize'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Profiler.chs.h cuProfilerStart"
  cuProfilerStart'_ :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Foreign/CUDA/Driver/Profiler.chs.h cuProfilerStop"
  cuProfilerStop'_ :: (IO C2HSImp.CInt)