{-# LINE 1 "FreeType/Exception/Internal.hsc" #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module FreeType.Exception.Internal where
import FreeType.Exception.Types
import Control.Monad (unless)
import Control.Exception
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable
ftError :: String -> IO FT_Error -> IO ()
ftError name action = do
code <- action
unless (code == 0)
. throwIO $ FtError name code
class AutoError a b where
autoError :: String -> a -> b
instance AutoError (a -> IO FT_Error)
(a -> IO ()) where
autoError name f = ftError name . f
instance AutoError (b -> c) (b -> d) => AutoError (a -> b -> c)
(a -> b -> d) where
autoError name f = autoError name . f
class AutoAllocaError a b where
autoAllocaError :: String -> a -> b
instance Storable a
=> AutoAllocaError (Ptr a -> IO FT_Error)
(IO a) where
autoAllocaError name f =
alloca $ \ptr -> do
ftError name $ f ptr
peek ptr
instance Storable b
=> AutoAllocaError (a -> Ptr b -> IO FT_Error)
(a -> IO b) where
autoAllocaError name f = \a ->
alloca $ \ptr -> do
ftError name $ f a ptr
peek ptr
instance AutoAllocaError (b -> c) (b -> d)
=> AutoAllocaError (a -> b -> c)
(a -> b -> d) where
autoAllocaError name f = autoAllocaError name . f