simplify enums, incl. dropping weird and unnecessary Enum instances that we previously got free from c2hs

Author: georgefst

evdev/src/Evdev.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# OPTIONS_GHC -fno-state-hack #-}
 
 -- | The main module for working with devices and events.
@@ -36,7 +37,7 @@ module Evdev (
     -- * Lower-level
     newDeviceFromFd,
     nextEventMay,
-    LL.LEDValue(..),
+    LEDValue(..),
     setDeviceLED,
     -- ** C-style types
     -- | These correspond more directly to C's /input_event/ and /timeval/.
@@ -66,13 +67,14 @@ import Data.Time.Clock (DiffTime)
 import Data.Tuple.Extra (uncurry3)
 import Data.Word (Word16)
 import Foreign ((.|.))
-import Foreign.C (CUInt)
+import Foreign.C (CUInt, Errno (Errno))
 import System.Posix.Process (getProcessID)
 import System.Posix.Files (readSymbolicLink)
 import System.Posix.ByteString (Fd, RawFilePath)
 import System.Posix.IO.ByteString (OpenMode (..), defaultFileFlags, openFd)
 
 import qualified Evdev.LowLevel as LL
+import qualified Evdev.Raw as Raw
 import Evdev.Codes
 import Util
 
@@ -126,21 +128,30 @@ data KeyEvent
     | Repeated
     deriving (Bounded, Enum, Eq, Ord, Read, Show)
 
-convertFlags :: Set LL.ReadFlag -> CUInt
-convertFlags = fromIntegral . foldr ((.|.) . fromEnum) 0
+data ReadFlag = Sync | Normal | ForceSync | Blocking
+    deriving (Eq, Ord, Show)
 
-defaultReadFlags :: Set LL.ReadFlag
-defaultReadFlags = Set.fromList [LL.Normal, LL.Blocking]
+convertFlags :: Set ReadFlag -> CUInt
+convertFlags = foldr ((.|.) . (.unwrap) . convert) 0
+  where
+    convert = \case
+        Sync -> Raw.LIBEVDEV_READ_FLAG_SYNC
+        Normal -> Raw.LIBEVDEV_READ_FLAG_NORMAL
+        ForceSync -> Raw.LIBEVDEV_READ_FLAG_FORCE_SYNC
+        Blocking -> Raw.LIBEVDEV_READ_FLAG_BLOCKING
+
+defaultReadFlags :: Set ReadFlag
+defaultReadFlags = Set.fromList [Normal, Blocking]
 
-nonBlockingReadFlags :: Set LL.ReadFlag
-nonBlockingReadFlags = Set.fromList [LL.Normal]
+nonBlockingReadFlags :: Set ReadFlag
+nonBlockingReadFlags = Set.fromList [Normal]
 
 -- | Prevent other clients (including kernel-internal ones) from receiving events. Often a bad idea.
 grabDevice :: Device -> IO ()
-grabDevice = grabDevice' LL.LibevdevGrab
+grabDevice = grabDevice' Raw.LIBEVDEV_GRAB
 -- | Release a grabbed device.
 ungrabDevice :: Device -> IO ()
-ungrabDevice = grabDevice' LL.LibevdevUngrab
+ungrabDevice = grabDevice' Raw.LIBEVDEV_UNGRAB
 
 -- | Get the next event from the device.
 nextEvent :: Device -> IO Event
@@ -258,15 +269,21 @@ deviceHasEvent dev e = LL.hasEventCode (cDevice dev) typ code
 deviceAbsAxis :: Device -> AbsoluteAxis -> IO (Maybe LL.AbsInfo)
 deviceAbsAxis dev = LL.getAbsInfo (cDevice dev) . fromEnum'
 
+data LEDValue = LedOn | LedOff
+    deriving (Bounded, Eq, Ord, Read, Show)
+
 -- | Set the state of a LED on a device.
-setDeviceLED :: Device -> LEDEvent -> LL.LEDValue -> IO ()
-setDeviceLED dev led val = cErrCall "setDeviceLED" dev (LL.libevdev_kernel_set_led_value (cDevice dev) led val)
+setDeviceLED :: Device -> LEDEvent -> LEDValue -> IO ()
+setDeviceLED dev led val = cErrCall "setDeviceLED" dev $ LL.withDevice (cDevice dev) \devPtr ->
+    Errno <$> Raw.libevdev_kernel_set_led_value devPtr (LL.convertEnum led) case val of
+        LedOn -> Raw.LIBEVDEV_LED_ON
+        LedOff -> Raw.LIBEVDEV_LED_OFF
 
 {- Util -}
 
-grabDevice' :: LL.GrabMode -> Device -> IO ()
+grabDevice' :: Raw.Libevdev_grab_mode -> Device -> IO ()
 grabDevice' mode dev = cErrCall "grabDevice" dev $
-    LL.grabDevice (cDevice dev) mode
+    LL.withDevice (cDevice dev) $ fmap Errno . flip Raw.libevdev_grab mode
 
 {-
 TODO this is a workaround until c2hs has a better story for enum conversions

evdev/src/Evdev/LowLevel.hs

@@ -13,64 +13,6 @@ import System.Posix.Types (Fd (Fd))
 import Evdev.Codes
 import Evdev.Raw qualified as Raw
 
--- * Enums
-
--- | Extract an Int from an hs-bindgen enum newtype
-rawEnum :: (Integral a) => a -> Int
-rawEnum = fromIntegral
-
-data ReadFlag = Sync | Normal | ForceSync | Blocking
-    deriving (Eq, Ord, Show)
-instance Enum ReadFlag where
-    fromEnum Sync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_SYNC in rawEnum n
-    fromEnum Normal = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_NORMAL in rawEnum n
-    fromEnum ForceSync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_FORCE_SYNC in rawEnum n
-    fromEnum Blocking = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_BLOCKING in rawEnum n
-    toEnum n
-        | n == fromEnum Sync = Sync
-        | n == fromEnum Normal = Normal
-        | n == fromEnum ForceSync = ForceSync
-        | n == fromEnum Blocking = Blocking
-        | otherwise = error $ "ReadFlag.toEnum: Cannot match " ++ show n
-
-data GrabMode = LibevdevGrab | LibevdevUngrab
-    deriving (Show)
-instance Enum GrabMode where
-    fromEnum LibevdevGrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_GRAB in rawEnum n
-    fromEnum LibevdevUngrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_UNGRAB in rawEnum n
-    toEnum n
-        | n == fromEnum LibevdevGrab = LibevdevGrab
-        | n == fromEnum LibevdevUngrab = LibevdevUngrab
-        | otherwise = error $ "GrabMode.toEnum: Cannot match " ++ show n
-
-data LEDValue = LedOn | LedOff
-    deriving (Bounded, Eq, Ord, Read, Show)
-instance Enum LEDValue where
-    fromEnum LedOn = let Raw.Libevdev_led_value n = Raw.LIBEVDEV_LED_ON in rawEnum n
-    fromEnum LedOff = let Raw.Libevdev_led_value n = Raw.LIBEVDEV_LED_OFF in rawEnum n
-    toEnum n
-        | n == fromEnum LedOn = LedOn
-        | n == fromEnum LedOff = LedOff
-        | otherwise = error $ "LEDValue.toEnum: Cannot match " ++ show n
-
-data UInputOpenMode = UOMManaged
-    deriving (Show)
-instance Enum UInputOpenMode where
-    fromEnum UOMManaged = let Raw.Libevdev_uinput_open_mode n = Raw.LIBEVDEV_UINPUT_OPEN_MANAGED in rawEnum n
-    toEnum n
-        | n == fromEnum UOMManaged = UOMManaged
-        | otherwise = error $ "UInputOpenMode.toEnum: Cannot match " ++ show n
-
-grabModeToRaw :: GrabMode -> Raw.Libevdev_grab_mode
-grabModeToRaw = \case
-    LibevdevGrab -> Raw.LIBEVDEV_GRAB
-    LibevdevUngrab -> Raw.LIBEVDEV_UNGRAB
-
-ledValueToRaw :: LEDValue -> Raw.Libevdev_led_value
-ledValueToRaw = \case
-    LedOn -> Raw.LIBEVDEV_LED_ON
-    LedOff -> Raw.LIBEVDEV_LED_OFF
-
 -- * Opaque device types
 
 newtype Device = Device (ForeignPtr Raw.Libevdev)
@@ -180,12 +122,6 @@ getEvent evPtr = do
             , cEventTime = CTimeVal (fromIntegral sec) (fromIntegral usec)
             }
 
--- * Grabbing
-
-grabDevice :: Device -> GrabMode -> IO Errno
-grabDevice dev mode = withDevice dev $ \devPtr ->
-    Errno <$> Raw.libevdev_grab devPtr (grabModeToRaw mode)
-
 -- * Device properties (getters)
 
 deviceFd :: Device -> IO Fd
@@ -344,12 +280,6 @@ writeEvent :: UDevice -> Word16 -> Word16 -> Int32 -> IO Errno
 writeEvent dev t c v = withUDevice dev $ \devPtr ->
     Errno <$> Raw.libevdev_uinput_write_event (constPtr devPtr) (fromIntegral t) (fromIntegral c) (fromIntegral v)
 
--- * LEDs
-
-libevdev_kernel_set_led_value :: Device -> LEDEvent -> LEDValue -> IO Errno
-libevdev_kernel_set_led_value dev led val = withDevice dev $ \devPtr ->
-    Errno <$> Raw.libevdev_kernel_set_led_value devPtr (convertEnum led) (ledValueToRaw val)
-
 -- * Util
 
 convertEnum :: (Enum a, Integral b) => a -> b

evdev/src/Evdev/Uinput.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
 -- | Create virtual input devices.
 module Evdev.Uinput (
     Device,
@@ -30,6 +32,7 @@ import Data.ByteString.Char8 (ByteString)
 import Evdev hiding (Device, newDevice)
 import Evdev.Codes
 import qualified Evdev.LowLevel as LL
+import qualified Evdev.Raw as Raw
 import Util
 
 -- | A `uinput` device.
@@ -84,7 +87,7 @@ newDevice name DeviceOpts{..} = do
         LL.withAbsInfo absInfo $ \ptr ->
             enable ptr EvAbs [fromEnum' axis]
 
-    fmap Device $ cec $ LL.createFromDevice dev $ fromEnum' LL.UOMManaged
+    fmap Device $ cec $ LL.createFromDevice dev $ fromIntegral (Raw.LIBEVDEV_UINPUT_OPEN_MANAGED).unwrap
   where
     cec :: CErrCall a => IO a -> IO (CErrCallRes a)
     cec = cErrCall "newDevice" ()