diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,3 +3,7 @@ ## 0.1.0.0 -- 2019-07-20 * First version. Released on an unsuspecting world. + +## 1.0.0.0 -- 2019-12-15 + +* First stable release. diff --git a/evdev.cabal b/evdev.cabal --- a/evdev.cabal +++ b/evdev.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: evdev -version: 0.2.0.1 +version: 1.0.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. @@ -24,7 +24,6 @@ ghc-options: -Wall build-depends: base ^>= 4.12.0 || ^>= 4.13, bytestring ^>= 0.10, - composition ^>= 1.0, containers ^>= 0.6.2, either ^>= 5.0.1, time ^>= 1.9.3, @@ -36,6 +35,7 @@ rawfilepath ^>= 0.2.4, streamly ^>= 0.6.1 || ^>= 0.7, safe ^>= 0.3.18, + monad-loops ^>= 0.4.3, build-tool-depends: c2hs:c2hs default-language: Haskell2010 default-extensions: FlexibleContexts @@ -48,4 +48,5 @@ ViewPatterns includes: libevdev-1.0/libevdev/libevdev.h linux/input.h + errno.h extra-libraries: evdev diff --git a/src/Evdev.hs b/src/Evdev.hs --- a/src/Evdev.hs +++ b/src/Evdev.hs @@ -17,10 +17,12 @@ ungrabDevice, nextEvent, newDevice, - maybeNewDevice, evdevDir, - getDeviceName, - Device (devicePath), + deviceName, + deviceFd, + devicePath, + deviceProperties, + Device, Event, EventCode(..), EventValue(..), @@ -28,20 +30,20 @@ ReadFlags (..), ) where -import Control.Exception -import Data.Int -import Data.Either.Combinators -import Data.Time.Clock -import Data.Tuple.Extra -import Safe - +import Control.Arrow (second) +import Control.Monad (filterM) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS +import Data.Int (Int16,Int32) +import Data.List.Extra (enumerate) import Data.Set (Set) +import Data.Time.Clock (DiffTime) import Foreign ((.|.)) import Foreign.C (CUInt) import Foreign.C.Error (Errno(Errno),errnoToIOError) -import System.Posix.ByteString (RawFilePath) +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(..)) @@ -85,31 +87,31 @@ in n ++ "." ++ take 6 (r ++ ['0'..]) ++ "s" pattern SyncEvent :: SyncEventType -> Event -pattern SyncEvent c <- Event EvSyn (toEnum . fromEnum -> c) _ _ +pattern SyncEvent c <- Event EvSyn (convertEnum -> c) _ _ pattern KeyEvent :: Key -> KeyEventType -> Event -pattern KeyEvent c v <- Event EvKey (toEnum . fromEnum -> c) (toEnum . fromEnum -> v) _ +pattern KeyEvent c v <- Event EvKey (convertEnum -> c) (convertEnum -> v) _ pattern RelativeEvent :: RelativeAxis -> EventValue -> Event -pattern RelativeEvent c v <- Event EvRel (toEnum . fromEnum -> c) v _ +pattern RelativeEvent c v <- Event EvRel (convertEnum -> c) v _ pattern AbsoluteEvent :: AbsoluteAxis -> EventValue -> Event -pattern AbsoluteEvent c v <- Event EvAbs (toEnum . fromEnum -> c) v _ +pattern AbsoluteEvent c v <- Event EvAbs (convertEnum -> c) v _ pattern MiscEvent :: MiscEventType -> EventValue -> Event -pattern MiscEvent c v <- Event EvMsc (toEnum . fromEnum -> c) v _ +pattern MiscEvent c v <- Event EvMsc (convertEnum -> c) v _ pattern SwitchEvent :: SwitchEventType -> EventValue -> Event -pattern SwitchEvent c v <- Event EvSw (toEnum . fromEnum -> c) v _ +pattern SwitchEvent c v <- Event EvSw (convertEnum -> c) v _ pattern LEDEvent :: LEDEventType -> EventValue -> Event -pattern LEDEvent c v <- Event EvLed (toEnum . fromEnum -> c) v _ +pattern LEDEvent c v <- Event EvLed (convertEnum -> c) v _ pattern SoundEvent :: SoundEventType -> EventValue -> Event -pattern SoundEvent c v <- Event EvSnd (toEnum . fromEnum -> c) v _ +pattern SoundEvent c v <- Event EvSnd (convertEnum -> c) v _ pattern RepeatEvent :: RepeatEventType -> EventValue -> Event -pattern RepeatEvent c v <- Event EvRep (toEnum . fromEnum -> c) v _ +pattern RepeatEvent c v <- Event EvRep (convertEnum -> c) v _ pattern ForceFeedbackEvent :: EventCode -> EventValue -> Event pattern ForceFeedbackEvent c v <- Event EvFf c v _ @@ -143,36 +145,47 @@ nextEvent :: Device -> Set ReadFlags -> IO Event nextEvent dev flags = do (t,c,v,time) <- LL.convertEvent =<< - throwCErrors "nextEvent" (devicePath dev) (LL.nextEvent (cDevice dev) (convertFlags flags)) + throwCErrors "nextEvent" (Right dev) (LL.nextEvent (cDevice dev) (convertFlags flags)) return $ Event (toEnum t) (EventCode c) (EventValue v) time newDevice :: RawFilePath -> IO Device newDevice path = do - dev <- throwCErrors "newDevice" path $ LL.newDevice path + dev <- throwCErrors "newDevice" (Left path) $ LL.newDevice path return $ Device dev path -maybeNewDevice :: RawFilePath -> IO (Maybe Device) -maybeNewDevice = fmap rightToMaybe . tryIO . newDevice - evdevDir :: RawFilePath evdevDir = "/dev/input" -getDeviceName :: Device -> IO ByteString -getDeviceName = fmap BS.pack . LL.deviceName . cDevice +deviceName :: Device -> IO ByteString +deviceName = fmap BS.pack . LL.deviceName . cDevice +deviceFd :: Device -> IO Fd +deviceFd = LL.deviceFd . cDevice -{- Util -} +deviceProperties :: Device -> IO [DeviceProperty] +deviceProperties dev = filterM (LL.hasProperty $ cDevice dev) enumerate -tryIO :: IO a -> IO (Either IOException a) -tryIO = try --- run the action, throwing an error if the C errno is not 0 -throwCErrors :: String -> RawFilePath -> IO (Errno, a) -> IO a -throwCErrors loc path x = do +{- Util -} + +-- run the action, throwing a relevant exception if the C errno is not 0 +throwCErrors :: String -> Either ByteString Device -> IO (Errno, a) -> IO a +throwCErrors func pathOrDev x = do (errno, res) <- x case errno of Errno 0 -> return res - _ -> ioError $ errnoToIOError loc errno Nothing (Just $ BS.unpack path) + Errno n -> do + (handle,path) <- case pathOrDev of + Left path -> return (Nothing,path) + Right dev -> do + h <- fdToHandle =<< deviceFd dev + return (Just h, devicePath dev) + ioError $ errnoToIOError func (Errno $ abs n) handle (Just $ BS.unpack path) grabDevice' :: LL.GrabMode -> Device -> IO () -grabDevice' mode dev = throwCErrors "grabDevice" (devicePath dev) $ LL.grabDevice (cDevice dev) mode +grabDevice' mode dev = throwCErrors "grabDevice" (Right dev) $ LL.grabDevice (cDevice dev) mode + +-- 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 +convertEnum = toEnum . fromEnum diff --git a/src/Evdev/LowLevel.chs b/src/Evdev/LowLevel.chs --- a/src/Evdev/LowLevel.chs +++ b/src/Evdev/LowLevel.chs @@ -1,8 +1,10 @@ -module Evdev.LowLevel where +{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-} -import Data.Int -import Data.Time.Clock +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 Foreign.C.Error (Errno(Errno)) @@ -12,6 +14,9 @@ import System.Posix.IO.ByteString (OpenMode(ReadOnly),defaultFileFlags,openFd) import System.Posix.Types (Fd(Fd)) +import Evdev.Codes + +#include #include #include @@ -51,7 +56,7 @@ in convertTime <$> sec <*> usec nextEvent :: Device -> CUInt -> IO (Errno, Event) -nextEvent dev flags = do +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) @@ -72,6 +77,7 @@ {- 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 diff --git a/src/Evdev/Stream.hs b/src/Evdev/Stream.hs --- a/src/Evdev/Stream.hs +++ b/src/Evdev/Stream.hs @@ -1,13 +1,14 @@ module Evdev.Stream ( - allDevicePaths, + allDevices, allEvents, - filteredEvents, makeDevices, readEvents, readEventsMany, ) where +import Control.Exception import Control.Monad +import System.IO.Error import RawFilePath.Directory (doesFileExist,listDirectory) import System.Posix.ByteString (RawFilePath) @@ -19,32 +20,28 @@ import Evdev -allEvents :: (IsStream t, Monad (t IO)) => t IO (Device, Event) -allEvents = filteredEvents $ const True - -filteredEvents :: (IsStream t, Monad (t IO)) => (Device -> Bool) -> t IO (Device, Event) -filteredEvents p = readEventsMany $ S.filter p $ makeDevices allDevicePaths - -readEvents :: IsStream t => Device -> t IO Event +-- | Read all events from a device. +readEvents :: Device -> SerialT IO Event readEvents dev = S.repeatM $ nextEvent dev defaultReadFlags +-- | Concurrently read events from multiple devices. readEventsMany :: IsStream t => AsyncT IO Device -> t IO (Device, Event) readEventsMany ds = asyncly $ do d <- ds - S.map (d,) $ readEvents d - -makeDevices :: (IsStream t, Functor (t IO)) => t IO RawFilePath -> t IO Device -makeDevices = S.mapMaybeM maybeNewDevice - ---TODO use Streamly directly -allDevicePaths :: (IsStream t, Monad (t IO)) => t IO RawFilePath -allDevicePaths = do - fs <- S.yieldM $ lsFiles evdevDir - S.fromFoldable fs + S.map (d,) $ serially $ readEvents d +-- | Create devices for all paths in the stream. +-- | Will throw an exception if a path doesn't correspond to a valid input device. +makeDevices :: IsStream t => t IO RawFilePath -> t IO Device +makeDevices = S.mapM newDevice -{- Util -} +-- | All events on all valid devices (in /dev/input). +allEvents :: IsStream t => t IO (Device, Event) +allEvents = readEventsMany allDevices --- lists files only, and returns full paths. -lsFiles :: RawFilePath -> IO [RawFilePath] -lsFiles p = filterM doesFileExist =<< (map (p ) <$> listDirectory p) +-- | All valid devices (in /dev/input). +allDevices :: (IsStream t, Monad (t IO)) => t IO Device +allDevices = + let maybeNewDevice path = catchJust (guard . isIllegalOperation) (Just <$> newDevice path) (\() -> return Nothing) + paths = S.filterM doesFileExist $ S.map (evdevDir ) $ S.fromFoldable =<< S.yieldM (listDirectory evdevDir) + in S.mapMaybeM maybeNewDevice paths