module Util where

import qualified Data.ByteString.Char8 as BS
import Foreign.C.Error (Errno (Errno), errnoToIOError)
import System.Posix.ByteString (RawFilePath)

import qualified Evdev.LowLevel as LL

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

--TODO careful - for some C calls (eg. libevdev_enable_event_code),
-- int returned doesn't necessarily correspond to a particular error number
--TODO this kinda seems like overkill, but things were getting ugly without it...
class CErrInfo a where
    cErrInfo :: a -> IO (Maybe RawFilePath)
instance CErrInfo () where
    cErrInfo :: () -> IO (Maybe RawFilePath)
cErrInfo () = Maybe RawFilePath -> IO (Maybe RawFilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RawFilePath
forall a. Maybe a
Nothing
instance CErrInfo RawFilePath where
    cErrInfo :: RawFilePath -> IO (Maybe RawFilePath)
cErrInfo = Maybe RawFilePath -> IO (Maybe RawFilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RawFilePath -> IO (Maybe RawFilePath))
-> (RawFilePath -> Maybe RawFilePath)
-> RawFilePath
-> IO (Maybe RawFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> Maybe RawFilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance CErrInfo LL.UDevice where
    cErrInfo :: UDevice -> IO (Maybe RawFilePath)
cErrInfo = UDevice -> IO (Maybe RawFilePath)
LL.getSyspath

-- for c actions which return an error value (0 for success)
-- run the action, throwing a relevant exception if the C errno is not 0
class CErrCall a where
    type CErrCallRes a
    cErrCall :: CErrInfo info => String -> info -> IO a -> IO (CErrCallRes a)
instance CErrCall Errno where
    type CErrCallRes Errno = ()
    cErrCall :: String -> info -> IO Errno -> IO (CErrCallRes Errno)
cErrCall String
func info
path IO Errno
x = String -> info -> IO (Errno, ()) -> IO (CErrCallRes (Errno, ()))
forall a info.
(CErrCall a, CErrInfo info) =>
String -> info -> IO a -> IO (CErrCallRes a)
cErrCall String
func info
path (IO (Errno, ()) -> IO (CErrCallRes (Errno, ())))
-> IO (Errno, ()) -> IO (CErrCallRes (Errno, ()))
forall a b. (a -> b) -> a -> b
$ (,()) (Errno -> (Errno, ())) -> IO Errno -> IO (Errno, ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Errno
x
instance CErrCall (Errno, a) where
    type CErrCallRes (Errno, a) = a
    cErrCall :: String -> info -> IO (Errno, a) -> IO (CErrCallRes (Errno, a))
cErrCall String
func info
info IO (Errno, a)
x = do
        (Errno
errno, a
res) <- IO (Errno, a)
x
        case Errno
errno of
            Errno CInt
0 -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
            Errno CInt
n -> do
                Maybe RawFilePath
path' <- info -> IO (Maybe RawFilePath)
forall a. CErrInfo a => a -> IO (Maybe RawFilePath)
cErrInfo info
info
                IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
func (CInt -> Errno
Errno (CInt -> Errno) -> CInt -> Errno
forall a b. (a -> b) -> a -> b
$ CInt -> CInt
forall a. Num a => a -> a
abs CInt
n) Maybe Handle
forall a. Maybe a
Nothing (Maybe String -> IOError) -> Maybe String -> IOError
forall a b. (a -> b) -> a -> b
$ RawFilePath -> String
BS.unpack (RawFilePath -> String) -> Maybe RawFilePath -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RawFilePath
path'