{-# LANGUAGE ViewPatterns    #-}
{-# LANGUAGE RecordWildCards #-}
--------------------------------------------------------------------------------
-- |
-- Module      : ArrayFire.Exception
-- Copyright   : David Johnson (c) 2019-2020
-- License     : BSD 3
-- Maintainer  : David Johnson <djohnson.m@gmail.com>
-- Stability   : Experimental
-- Portability : GHC
--
-- @
-- module Main where
--
-- import ArrayFire
--
-- main :: IO ()
-- main = print =<< getAvailableBackends
-- @
--
-- @
-- [nix-shell:~\/arrayfire]$ .\/main
-- [CPU,OpenCL]
-- @
--------------------------------------------------------------------------------
module ArrayFire.Exception where

import Control.Exception hiding (TypeError)
import Data.Typeable
import Control.Monad
import Foreign.C.String
import Foreign.Ptr
import ArrayFire.Internal.Exception
import ArrayFire.Internal.Defines

-- | String representation of ArrayFire exception
errorToString :: AFErr -> IO String
errorToString :: AFErr -> IO String
errorToString = CString -> IO String
peekCString (CString -> IO String)
-> (AFErr -> IO CString) -> AFErr -> IO String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AFErr -> IO CString
af_err_to_string

-- | ArrayFire exception type
data AFExceptionType
  = NoMemoryError
  | DriverError
  | RuntimeError
  | InvalidArrayError
  | ArgError
  | SizeError
  | TypeError
  | DiffTypeError
  | BatchError
  | DeviceError
  | NotSupportedError
  | NotConfiguredError
  | NonFreeError
  | NoDblError
  | NoGfxError
  | LoadLibError
  | LoadSymError
  | BackendMismatchError
  | InternalError
  | UnknownError
  | UnhandledError
  deriving (Int -> AFExceptionType -> ShowS
[AFExceptionType] -> ShowS
AFExceptionType -> String
(Int -> AFExceptionType -> ShowS)
-> (AFExceptionType -> String)
-> ([AFExceptionType] -> ShowS)
-> Show AFExceptionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AFExceptionType] -> ShowS
$cshowList :: [AFExceptionType] -> ShowS
show :: AFExceptionType -> String
$cshow :: AFExceptionType -> String
showsPrec :: Int -> AFExceptionType -> ShowS
$cshowsPrec :: Int -> AFExceptionType -> ShowS
Show, AFExceptionType -> AFExceptionType -> Bool
(AFExceptionType -> AFExceptionType -> Bool)
-> (AFExceptionType -> AFExceptionType -> Bool)
-> Eq AFExceptionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AFExceptionType -> AFExceptionType -> Bool
$c/= :: AFExceptionType -> AFExceptionType -> Bool
== :: AFExceptionType -> AFExceptionType -> Bool
$c== :: AFExceptionType -> AFExceptionType -> Bool
Eq, Typeable)

-- | Exception type for ArrayFire API
data AFException
  = AFException
  { AFException -> AFExceptionType
afExceptionType :: AFExceptionType
  -- ^ The Exception type to throw
  , AFException -> Int
afExceptionCode :: Int
  -- ^ Code representing the exception
  , AFException -> String
afExceptionMsg  :: String
  -- ^ Exception message
  } deriving (Int -> AFException -> ShowS
[AFException] -> ShowS
AFException -> String
(Int -> AFException -> ShowS)
-> (AFException -> String)
-> ([AFException] -> ShowS)
-> Show AFException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AFException] -> ShowS
$cshowList :: [AFException] -> ShowS
show :: AFException -> String
$cshow :: AFException -> String
showsPrec :: Int -> AFException -> ShowS
$cshowsPrec :: Int -> AFException -> ShowS
Show, AFException -> AFException -> Bool
(AFException -> AFException -> Bool)
-> (AFException -> AFException -> Bool) -> Eq AFException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AFException -> AFException -> Bool
$c/= :: AFException -> AFException -> Bool
== :: AFException -> AFException -> Bool
$c== :: AFException -> AFException -> Bool
Eq, Typeable)

instance Exception AFException

-- | Conversion function helper
toAFExceptionType :: AFErr -> AFExceptionType
toAFExceptionType :: AFErr -> AFExceptionType
toAFExceptionType (AFErr CInt
101) = AFExceptionType
NoMemoryError
toAFExceptionType (AFErr CInt
102) = AFExceptionType
DriverError
toAFExceptionType (AFErr CInt
103) = AFExceptionType
RuntimeError
toAFExceptionType (AFErr CInt
201) = AFExceptionType
InvalidArrayError
toAFExceptionType (AFErr CInt
202) = AFExceptionType
ArgError
toAFExceptionType (AFErr CInt
203) = AFExceptionType
SizeError
toAFExceptionType (AFErr CInt
204) = AFExceptionType
TypeError
toAFExceptionType (AFErr CInt
205) = AFExceptionType
DiffTypeError
toAFExceptionType (AFErr CInt
207) = AFExceptionType
BatchError
toAFExceptionType (AFErr CInt
208) = AFExceptionType
DeviceError
toAFExceptionType (AFErr CInt
301) = AFExceptionType
NotSupportedError
toAFExceptionType (AFErr CInt
302) = AFExceptionType
NotConfiguredError
toAFExceptionType (AFErr CInt
303) = AFExceptionType
NonFreeError
toAFExceptionType (AFErr CInt
401) = AFExceptionType
NoDblError
toAFExceptionType (AFErr CInt
402) = AFExceptionType
NoGfxError
toAFExceptionType (AFErr CInt
501) = AFExceptionType
LoadLibError
toAFExceptionType (AFErr CInt
502) = AFExceptionType
LoadSymError
toAFExceptionType (AFErr CInt
503) = AFExceptionType
BackendMismatchError
toAFExceptionType (AFErr CInt
998) = AFExceptionType
InternalError
toAFExceptionType (AFErr CInt
999) = AFExceptionType
UnknownError
toAFExceptionType (AFErr CInt
_) = AFExceptionType
UnhandledError

-- | Throws an ArrayFire Exception
throwAFError :: AFErr -> IO ()
throwAFError :: AFErr -> IO ()
throwAFError AFErr
exitCode =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AFErr
exitCode AFErr -> AFErr -> Bool
forall a. Eq a => a -> a -> Bool
== AFErr
afSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let AFErr (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
afExceptionCode) = AFErr
exitCode
        afExceptionType :: AFExceptionType
afExceptionType = AFErr -> AFExceptionType
toAFExceptionType AFErr
exitCode
    String
afExceptionMsg <- AFErr -> IO String
errorToString AFErr
exitCode
    AFException -> IO ()
forall e a. Exception e => e -> IO a
throwIO AFException :: AFExceptionType -> Int -> String -> AFException
AFException {Int
String
AFExceptionType
afExceptionMsg :: String
afExceptionType :: AFExceptionType
afExceptionCode :: Int
afExceptionMsg :: String
afExceptionCode :: Int
afExceptionType :: AFExceptionType
..}

foreign import ccall unsafe "&af_release_random_engine"
  af_release_random_engine_finalizer :: FunPtr (AFRandomEngine -> IO ())

foreign import ccall unsafe "&af_destroy_window"
  af_release_window_finalizer :: FunPtr (AFWindow -> IO ())

foreign import ccall unsafe "&af_release_array"
  af_release_array_finalizer :: FunPtr (AFArray -> IO ())