{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StrictData                 #-}
module Foreign.C.Enum where

import           Foreign.C.Types       (CInt)
import           Foreign.Marshal.Alloc (alloca)
import           Foreign.Ptr           (Ptr)
import           Foreign.Storable      (Storable (..))


newtype CEnum a = CEnum { CEnum a -> CInt
unCEnum :: CInt }
  deriving (Ptr b -> Int -> IO (CEnum a)
Ptr b -> Int -> CEnum a -> IO ()
Ptr (CEnum a) -> IO (CEnum a)
Ptr (CEnum a) -> Int -> IO (CEnum a)
Ptr (CEnum a) -> Int -> CEnum a -> IO ()
Ptr (CEnum a) -> CEnum a -> IO ()
CEnum a -> Int
(CEnum a -> Int)
-> (CEnum a -> Int)
-> (Ptr (CEnum a) -> Int -> IO (CEnum a))
-> (Ptr (CEnum a) -> Int -> CEnum a -> IO ())
-> (forall b. Ptr b -> Int -> IO (CEnum a))
-> (forall b. Ptr b -> Int -> CEnum a -> IO ())
-> (Ptr (CEnum a) -> IO (CEnum a))
-> (Ptr (CEnum a) -> CEnum a -> IO ())
-> Storable (CEnum a)
forall b. Ptr b -> Int -> IO (CEnum a)
forall b. Ptr b -> Int -> CEnum a -> IO ()
forall a. Ptr (CEnum a) -> IO (CEnum a)
forall a. Ptr (CEnum a) -> Int -> IO (CEnum a)
forall a. Ptr (CEnum a) -> Int -> CEnum a -> IO ()
forall a. Ptr (CEnum a) -> CEnum a -> IO ()
forall a. CEnum a -> Int
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall a b. Ptr b -> Int -> IO (CEnum a)
forall a b. Ptr b -> Int -> CEnum a -> IO ()
poke :: Ptr (CEnum a) -> CEnum a -> IO ()
$cpoke :: forall a. Ptr (CEnum a) -> CEnum a -> IO ()
peek :: Ptr (CEnum a) -> IO (CEnum a)
$cpeek :: forall a. Ptr (CEnum a) -> IO (CEnum a)
pokeByteOff :: Ptr b -> Int -> CEnum a -> IO ()
$cpokeByteOff :: forall a b. Ptr b -> Int -> CEnum a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (CEnum a)
$cpeekByteOff :: forall a b. Ptr b -> Int -> IO (CEnum a)
pokeElemOff :: Ptr (CEnum a) -> Int -> CEnum a -> IO ()
$cpokeElemOff :: forall a. Ptr (CEnum a) -> Int -> CEnum a -> IO ()
peekElemOff :: Ptr (CEnum a) -> Int -> IO (CEnum a)
$cpeekElemOff :: forall a. Ptr (CEnum a) -> Int -> IO (CEnum a)
alignment :: CEnum a -> Int
$calignment :: forall a. CEnum a -> Int
sizeOf :: CEnum a -> Int
$csizeOf :: forall a. CEnum a -> Int
Storable)

instance (Enum a, Show a) => Show (CEnum a) where
  show :: CEnum a -> String
show CEnum a
cen = a -> String
forall a. Show a => a -> String
show (Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ CEnum a -> CInt
forall a. CEnum a -> CInt
unCEnum CEnum a
cen :: a)


toCEnum :: Enum a => a -> CEnum a
toCEnum :: a -> CEnum a
toCEnum = CInt -> CEnum a
forall a. CInt -> CEnum a
CEnum (CInt -> CEnum a) -> (a -> CInt) -> a -> CEnum a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (a -> Int) -> a -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum


fromCEnum :: Enum a => CEnum a -> a
fromCEnum :: CEnum a -> a
fromCEnum = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (CEnum a -> Int) -> CEnum a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> (CEnum a -> CInt) -> CEnum a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEnum a -> CInt
forall a. CEnum a -> CInt
unCEnum


type CErr err = Ptr (CEnum err)

callErrFun :: (Eq err, Enum err, Bounded err)
           => (CErr err -> IO r) -> IO (Either err r)
callErrFun :: (CErr err -> IO r) -> IO (Either err r)
callErrFun CErr err -> IO r
f = (CErr err -> IO (Either err r)) -> IO (Either err r)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((CErr err -> IO (Either err r)) -> IO (Either err r))
-> (CErr err -> IO (Either err r)) -> IO (Either err r)
forall a b. (a -> b) -> a -> b
$ \CErr err
errPtr -> do
  r
res <- CErr err -> IO r
f CErr err
errPtr
  CInt
err <- CEnum err -> CInt
forall a. CEnum a -> CInt
unCEnum (CEnum err -> CInt) -> IO (CEnum err) -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CErr err -> IO (CEnum err)
forall a. Storable a => Ptr a -> IO a
peek CErr err
errPtr
  Either err r -> IO (Either err r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either err r -> IO (Either err r))
-> Either err r -> IO (Either err r)
forall a b. (a -> b) -> a -> b
$ if CInt
err CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0
    then err -> Either err r
forall a b. a -> Either a b
Left (err -> Either err r) -> (CInt -> err) -> CInt -> Either err r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> err
forall a. Enum a => Int -> a
toEnum (Int -> err) -> (CInt -> Int) -> CInt -> err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Either err r) -> CInt -> Either err r
forall a b. (a -> b) -> a -> b
$ CInt
err CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
    else r -> Either err r
forall a b. b -> Either a b
Right r
res