evdev 1.2.0.1 → 1.3.0.0

raw patch · 6 files changed

+82/−62 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• evdev.cabal +3/−2
• src-c/evdev-hs.c +9/−0
• src/Evdev.hs +24/−14
• src/Evdev/LowLevel.chs +40/−46
• src/Evdev/Stream.hs +1/−0

@@ -20,3 +20,8 @@  * Add `newDevices` stream. * More robust error handling when reading from multiple devices.++## 1.3.0.0 -- 2020-03-03++* Fix memory management issues and file descriptor leaks.+* Rename 'ReadFlags' to 'ReadFlag' as the type clearly represents just one flag.

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                evdev-version:             1.2.0.1+version:             1.3.0.0 author:              George Thomas maintainer:          George Thomas description:         Provides access to the Linux event device interface, with an optional high-level Streamly-based API.@@ -44,6 +44,7 @@   default-extensions:  FlexibleContexts                        GeneralizedNewtypeDeriving                        LambdaCase+                       NumericUnderscores                        OverloadedLists                        OverloadedStrings                        PatternSynonyms@@ -52,5 +53,5 @@   includes:            libevdev-1.0/libevdev/libevdev.h                        linux/input.h                        errno.h-  extra-libraries:     evdev+  c-sources:           src-c/evdev-hs.c   pkgconfig-depends:   libevdev

@@ -0,0 +1,9 @@+#include <libevdev-1.0/libevdev/libevdev.h>+#include <stdio.h>+#include <unistd.h>++void libevdev_hs_close(struct libevdev *dev) {+    int fd = libevdev_get_fd(dev);+    libevdev_free(dev);+    close(fd);+}

@@ -27,26 +27,27 @@     EventCode(..),     EventValue(..),     KeyEventType(..),-    ReadFlags (..),+    ReadFlag(..), ) where  import Control.Arrow (second)-import Control.Monad (filterM)+import Control.Monad (filterM,join) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS-import Data.Int (Int16,Int32)+import Data.Int (Int32) import Data.List.Extra (enumerate) import Data.Set (Set)-import Data.Time.Clock (DiffTime)+import Data.Time.Clock (DiffTime,picosecondsToDiffTime)+import Data.Word (Word16) import Foreign ((.|.))-import Foreign.C (CUInt)+import Foreign.C (CInt(..),CUInt(..),CUShort(..)) import Foreign.C.Error (Errno(Errno),errnoToIOError) import Safe (initSafe,tailSafe) import System.Posix.ByteString (Fd,RawFilePath) import System.Posix.IO.ByteString (fdToHandle)  import qualified Evdev.LowLevel as LL-import Evdev.LowLevel (ReadFlags(..))+import Evdev.LowLevel (ReadFlag(..)) import Evdev.Codes  -- stores path that was originally used, as it seems impossible to recover this later@@ -122,7 +123,7 @@ pattern ForceFeedbackStatusEvent :: EventCode -> EventValue -> Event pattern ForceFeedbackStatusEvent c v <- Event EvFfStatus c v _ -newtype EventCode = EventCode Int16 deriving (Enum, Eq, Ord, Read, Show)+newtype EventCode = EventCode Word16 deriving (Enum, Eq, Ord, Read, Show) newtype EventValue = EventValue Int32 deriving (Enum, Eq, Ord, Read, Show)  data KeyEventType@@ -131,10 +132,10 @@     | Repeated     deriving (Enum, Eq, Ord, Read, Show) -convertFlags :: Set ReadFlags -> CUInt+convertFlags :: Set ReadFlag -> CUInt convertFlags = fromIntegral . foldr ((.|.) . fromEnum) 0 -defaultReadFlags :: Set ReadFlags+defaultReadFlags :: Set ReadFlag defaultReadFlags = [Normal,Blocking]  grabDevice :: Device -> IO ()@@ -142,11 +143,12 @@ ungrabDevice :: Device -> IO () ungrabDevice = grabDevice' LL.LibevdevUngrab -nextEvent :: Device -> Set ReadFlags -> IO Event+nextEvent :: Device -> Set ReadFlag -> IO Event nextEvent dev flags = do-    (t,c,v,time) <- LL.convertEvent =<<-        throwCErrors "nextEvent" (Right dev) (LL.nextEvent (cDevice dev) (convertFlags flags))-    return $ Event (toEnum t) (EventCode c) (EventValue v) time+    (CUShort t, CUShort c, CInt v, s, us) <-+        throwCErrors "nextEvent" (Right dev) $ LL.nextEvent (cDevice dev) (convertFlags flags)+    return $ Event (convertEnum t) (EventCode c) (EventValue v) $+        picosecondsToDiffTime $ 1_000_000_000_000 * fromIntegral s + 1_000_000 * fromIntegral us  newDevice :: RawFilePath -> IO Device newDevice path = do@@ -157,7 +159,7 @@ evdevDir = "/dev/input"  deviceName :: Device -> IO ByteString-deviceName = fmap BS.pack . LL.deviceName . cDevice+deviceName = join . LL.deviceName . cDevice  deviceFd :: Device -> IO Fd deviceFd = LL.deviceFd . cDevice@@ -185,6 +187,14 @@ grabDevice' :: LL.GrabMode -> Device -> IO () grabDevice' mode dev = throwCErrors "grabDevice" (Right dev) $ LL.grabDevice (cDevice dev) mode +--TODO ensure all uses are safe+    -- really, fromEnum should be :: e -> Integer+    -- and toEnum :: Integral a => a -> Maybe e+    -- the issues with Enum are great enough that it may be worth considering using something more bespoke than c2hs+    -- or it could be worth a PR+        -- auto-generate safe *toInt/*fromInt based on the current logic+        -- then implement Enum instance in terms of those+    -- note that we also use to/from-Enum in LowLevel -- obviously this isn't safe in general -- we use it only after matching on 'EventType', to get the corresponding 'EventCode' and 'EventValue' convertEnum :: (Enum a, Enum b) => a -> b

@@ -1,13 +1,10 @@ module Evdev.LowLevel where  import Control.Monad.Loops (iterateWhile)-import Data.Int (Int16,Int32)-import Data.Time.Clock (DiffTime,picosecondsToDiffTime)-import Foreign (Ptr)-import Foreign.C (CInt,CUInt,CLong)+import Data.ByteString (ByteString,packCString)+import Foreign (Ptr,allocaBytes)+import Foreign.C (CInt(..),CUInt(..),CUShort(..),CLong) import Foreign.C.Error (Errno(Errno))-import Foreign.ForeignPtr (mallocForeignPtrBytes,withForeignPtr)-import Foreign.Storable (peekByteOff) import System.Posix.ByteString (RawFilePath) import System.Posix.IO.ByteString (OpenMode(ReadOnly),defaultFileFlags,openFd) import System.Posix.Types (Fd(Fd))@@ -18,7 +15,7 @@ #include <libevdev-1.0/libevdev/libevdev.h> #include <linux/input.h> -{#enum libevdev_read_flag as ReadFlags {+{#enum libevdev_read_flag as ReadFlag {     LIBEVDEV_READ_FLAG_SYNC as Sync,     LIBEVDEV_READ_FLAG_NORMAL as Normal,     LIBEVDEV_READ_FLAG_FORCE_SYNC as ForceSync,@@ -27,61 +24,58 @@  {#enum libevdev_grab_mode as GrabMode { underscoreToCase } deriving (Show) #} -{#pointer *input_event as Event foreign newtype#}--{#pointer *timeval as Time foreign newtype#}--{#pointer *libevdev as Device newtype #}+{#pointer *libevdev as Device foreign finalizer libevdev_hs_close newtype #}+--TODO any reason c2hs doesn't allow a haskell function as the finalizer?+    -- failing that, any reason not to have actual inline c?+--TODO expose this directly, seeing as the GC makes no guarantees of promptness+#c+void libevdev_hs_close(struct libevdev *dev);+#endc   {- Conversions -} -convertEvent :: Event -> IO (Int,Int16,Int32,DiffTime)-convertEvent ev = (,,,)-    <$> getIntField {#get input_event->type #}-    <*> getIntField {#get input_event->code #}-    <*> getIntField {#get input_event->value #}-    <*> withEvent ev getTime-    where-        convertTime s us = picosecondsToDiffTime $ 1000000000000 * fromIntegral s + 1000000 * fromIntegral us-        getIntField :: (Integral a,Integral b) => (Ptr Event -> IO a) -> IO b-        getIntField f = withEvent ev (fmap fromIntegral . f)-        getTime :: Ptr Event -> IO DiffTime-        getTime ptr =-            let sec, usec :: IO CLong-                sec = peekByteOff ptr 0-                usec = peekByteOff ptr {#sizeof __kernel_time_t #}-            in  convertTime <$> sec <*> usec--nextEvent :: Device -> CUInt -> IO (Errno, Event)-nextEvent dev flags = iterateWhile ((== Errno (-{#const EAGAIN #})) . fst) $ do-    ptr <- mallocForeignPtrBytes {#sizeof input_event #}-    err <- withForeignPtr ptr $ {#call libevdev_next_event #} dev flags-    return (Errno err, Event ptr)+{#fun libevdev_next_event { `Device', `CUInt', `Ptr ()' } -> `Errno' Errno #}+nextEvent :: Device -> CUInt -> IO (Errno, (CUShort,CUShort,CInt,CLong,CLong)) --TODO not CLong on all platforms+nextEvent dev flags = allocaBytes {#sizeof input_event #} $ \evPtr ->+    (,) <$> iterateWhile (== Errno (-{#const EAGAIN #})) (libevdev_next_event dev flags evPtr)+        <*> (+            (,,,,)+            <$> {#get input_event->type #} evPtr+            <*> {#get input_event->code #} evPtr+            <*> {#get input_event->value #} evPtr+            <*> {#get input_event->time.tv_sec #} evPtr+            <*> {#get input_event->time.tv_usec #} evPtr+        ) -{#fun libevdev_grab { `Device', `GrabMode' } -> `CInt' #}+{#fun libevdev_grab { `Device', `GrabMode' } -> `Errno' Errno #} grabDevice :: Device -> GrabMode -> IO (Errno, ())-grabDevice dev mode = do-    err <- libevdev_grab dev mode-    return (Errno err, ())+grabDevice = fmap (,()) .: libevdev_grab +--TODO use 'libevdev_new_from_fd' when https://github.com/haskell/c2hs/issues/236 fixed+{#fun libevdev_new {} -> `Device' #}+{#fun libevdev_set_fd { `Device', unFd `Fd' } -> `Errno' Errno #} newDevice :: RawFilePath -> IO (Errno, Device) newDevice path = do-    Fd n <- openFd path ReadOnly Nothing $ defaultFileFlags-    dev <- {#call libevdev_new #}-    err <- {#call libevdev_set_fd #} dev n-    return (Errno err, dev)+    fd <- openFd path ReadOnly Nothing defaultFileFlags+    dev <- libevdev_new+    err <- libevdev_set_fd dev fd+    return (err, dev)   {- Simpler functions -}  {#fun libevdev_has_property as hasProperty { `Device', convertEnum `DeviceProperty' } -> `Bool' #} {#fun libevdev_get_fd as deviceFd { `Device' } -> `Fd' Fd #}-{#fun libevdev_get_name as deviceName { `Device' } -> `String' #}---TODO should really be ByteString-+{#fun libevdev_get_name as deviceName { `Device' } -> `IO ByteString' packCString #}  {- Util -} -convertEnum :: (Enum a, Integral b) => a -> b+convertEnum :: DeviceProperty -> CUInt convertEnum = fromIntegral . fromEnum++(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d+(.:) = (.) . (.)++unFd :: Fd -> CInt+unFd (Fd n) = n

@@ -52,6 +52,7 @@  -- | All events on all valid devices (in /\/dev\/input/). -- Prints any exceptions.+-- -- > allEvents == readEventsMany allDevices allEvents :: IsStream t => t IO (Device, Event) allEvents = readEventsMany allDevices