{-# LANGUAGE CPP #-}

module SDL.Internal.Exception
  ( fromC
  , getError
  , throwIf
  , throwIf_
  , throwIf0
  , throwIfNeg
  , throwIfNeg_
  , throwIfNot0
  , throwIfNot0_
  , throwIfNull
  ) where

import Control.Exception
import Data.Maybe (fromMaybe)
import Control.Monad
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import Foreign (Ptr, nullPtr)
import SDL.Exception
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as Text
import qualified SDL.Raw as Raw

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

getError :: MonadIO m => m Text
getError :: m Text
getError = IO Text -> m Text
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
  CString
cstr <- IO CString
forall (m :: Type -> Type). MonadIO m => m CString
Raw.getError
  ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
BS.packCString CString
cstr

{-# INLINE throwIf #-}
throwIf :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m a
throwIf :: (a -> Bool) -> Text -> Text -> m a -> m a
throwIf a -> Bool
f Text
caller Text
funName m a
m = do
  a
a <- m a
m
  IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (a -> Bool
f a
a) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    (Text -> Text -> Text -> SDLException
SDLCallFailed Text
caller Text
funName (Text -> SDLException) -> IO Text -> IO SDLException
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
forall (m :: Type -> Type). MonadIO m => m Text
getError) IO SDLException -> (SDLException -> IO ()) -> IO ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= SDLException -> IO ()
forall e a. Exception e => e -> IO a
throwIO
  a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a

{-# INLINE throwIf_ #-}
throwIf_ :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m ()
throwIf_ :: (a -> Bool) -> Text -> Text -> m a -> m ()
throwIf_ a -> Bool
f Text
caller Text
funName m a
m = (a -> Bool) -> Text -> Text -> m a -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m a
throwIf a -> Bool
f Text
caller Text
funName m a
m m a -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

{-# INLINE throwIfNeg #-}
throwIfNeg :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m a
throwIfNeg :: Text -> Text -> m a -> m a
throwIfNeg = (a -> Bool) -> Text -> Text -> m a -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m a
throwIf (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)

{-# INLINE throwIfNeg_ #-}
throwIfNeg_ :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m ()
throwIfNeg_ :: Text -> Text -> m a -> m ()
throwIfNeg_ = (a -> Bool) -> Text -> Text -> m a -> m ()
forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m ()
throwIf_ (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)

{-# INLINE throwIfNull #-}
throwIfNull :: (MonadIO m) => Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull :: Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull = (Ptr a -> Bool) -> Text -> Text -> m (Ptr a) -> m (Ptr a)
forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m a
throwIf (Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr)

{-# INLINE throwIf0 #-}
throwIf0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a
throwIf0 :: Text -> Text -> m a -> m a
throwIf0 = (a -> Bool) -> Text -> Text -> m a -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m a
throwIf (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0)

{-# INLINE throwIfNot0 #-}
throwIfNot0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a
throwIfNot0 :: Text -> Text -> m a -> m a
throwIfNot0 = (a -> Bool) -> Text -> Text -> m a -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m a
throwIf (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0)

{-# INLINE throwIfNot0_ #-}
throwIfNot0_ :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m ()
throwIfNot0_ :: Text -> Text -> m a -> m ()
throwIfNot0_ = (a -> Bool) -> Text -> Text -> m a -> m ()
forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m ()
throwIf_ (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0)

fromC :: Show a => Text -> Text -> (a -> Maybe b) -> a -> b
fromC :: Text -> Text -> (a -> Maybe b) -> a -> b
fromC Text
caller Text
funName a -> Maybe b
f a
x =
  b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe (SDLException -> b
forall a e. Exception e => e -> a
throw (Text -> Text -> String -> SDLException
SDLUnexpectedArgument Text
caller
                                          Text
funName
                                          (a -> String
forall a. Show a => a -> String
show a
x)))
            (a -> Maybe b
f a
x)