-- | Error handling functions.
module Codec.Archive.LibZip.Errors
    ( errFromCInt
    , get_error
    , get_file_error
    , catchZipError
    ) where

import Data.Typeable (Typeable, typeOf)
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (nullPtr)
import Foreign.Storable (peek)
import qualified Control.Exception as E

import Bindings.LibZip
import Codec.Archive.LibZip.Types

errFromCInt :: CInt -> ZipError
errFromCInt :: CInt -> ZipError
errFromCInt = Int -> ZipError
forall a. Enum a => Int -> a
toEnum (Int -> ZipError) -> (CInt -> Int) -> CInt -> ZipError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a. Enum a => a -> Int
fromEnum

get_error :: Zip -> IO ZipError
get_error :: Zip -> IO ZipError
get_error Zip
z | Zip
z Zip -> Zip -> Bool
forall a. Eq a => a -> a -> Bool
== Zip
forall a. Ptr a
nullPtr = ZipError -> IO ZipError
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrINVAL
get_error Zip
z = (Ptr CInt -> IO ZipError) -> IO ZipError
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO ZipError) -> IO ZipError)
-> (Ptr CInt -> IO ZipError) -> IO ZipError
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
zep -> do
   Zip -> Ptr CInt -> Ptr CInt -> IO ()
c'zip_error_get Zip
z Ptr CInt
zep Ptr CInt
forall a. Ptr a
nullPtr
   Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
zep IO CInt -> (CInt -> IO ZipError) -> IO ZipError
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ZipError
forall (m :: * -> *) a. Monad m => a -> m a
return (ZipError -> IO ZipError)
-> (CInt -> ZipError) -> CInt -> IO ZipError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> ZipError
errFromCInt

get_file_error :: ZipFile -> IO ZipError
get_file_error :: ZipFile -> IO ZipError
get_file_error ZipFile
zf
    | ZipFile
zf ZipFile -> ZipFile -> Bool
forall a. Eq a => a -> a -> Bool
== ZipFile
forall a. Ptr a
nullPtr = ZipError -> IO ZipError
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrINVAL
    | Bool
otherwise = (Ptr CInt -> IO ZipError) -> IO ZipError
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO ZipError) -> IO ZipError)
-> (Ptr CInt -> IO ZipError) -> IO ZipError
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
zep -> do
         ZipFile -> Ptr CInt -> Ptr CInt -> IO ()
c'zip_file_error_get ZipFile
zf Ptr CInt
zep Ptr CInt
forall a. Ptr a
nullPtr
         Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
zep IO CInt -> (CInt -> IO ZipError) -> IO ZipError
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ZipError
forall (m :: * -> *) a. Monad m => a -> m a
return (ZipError -> IO ZipError)
-> (CInt -> ZipError) -> CInt -> IO ZipError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> ZipError
errFromCInt

-- | Wrapper to catch library errors.
catchZipError :: IO a -> (ZipError -> IO a) -> IO a
catchZipError :: IO a -> (ZipError -> IO a) -> IO a
catchZipError IO a
f ZipError -> IO a
h = (ZipError -> Maybe ZipError) -> IO a -> (ZipError -> IO a) -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
E.catchJust ZipError -> Maybe ZipError
forall e. (Typeable e, Exception e) => e -> Maybe e
ifZipError IO a
f ZipError -> IO a
h
  where
    ifZipError :: (Typeable e, E.Exception e) => e -> Maybe e
    ifZipError :: e -> Maybe e
ifZipError e
x | e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
x TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== ZipError -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf ZipError
ErrOK = e -> Maybe e
forall a. a -> Maybe a
Just e
x
    ifZipError e
_ | Bool
otherwise = Maybe e
forall a. Maybe a
Nothing