{-# 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 :: forall (m :: Type -> Type). MonadIO m => m Text
getError = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  CString
cstr <- forall (m :: Type -> Type). MonadIO m => m CString
Raw.getError
  ByteString -> Text
Text.decodeUtf8 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 :: 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 = do
  a
a <- m a
m
  forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (a -> Bool
f a
a) forall a b. (a -> b) -> a -> b
$
    (Text -> Text -> Text -> SDLException
SDLCallFailed Text
caller Text
funName forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Type -> Type). MonadIO m => m Text
getError) forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e a. Exception e => e -> IO a
throwIO
  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_ :: forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m ()
throwIf_ a -> Bool
f Text
caller Text
funName m a
m = 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 forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> 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 :: forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg = forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m a
throwIf (forall a. Ord a => a -> a -> Bool
< a
0)

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

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

{-# INLINE throwIf0 #-}
throwIf0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a
throwIf0 :: forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m a
throwIf0 = forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m a
throwIf (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 :: forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m a
throwIfNot0 = forall (m :: Type -> Type) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m a
throwIf (forall a. Eq a => a -> a -> Bool
/= a
0)

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

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