udev 0.1.0.0 → 0.1.1.0
raw patch · 11 files changed
+110/−123 lines, 11 filesdep −selectnew-uploader
Dependencies removed: select
Files
- README.md +4/−4
- examples/hidraw.hs +1/−1
- examples/monitor.hs +13/−23
- src/System/UDev.hs +0/−13
- src/System/UDev/Context.hs +8/−3
- src/System/UDev/Device.hs +16/−15
- src/System/UDev/Enumerate.hs +34/−32
- src/System/UDev/List.hs +0/−2
- src/System/UDev/Monitor.hs +25/−21
- src/System/UDev/Queue.hs +1/−1
- udev.cabal +8/−8
README.md view
@@ -13,7 +13,7 @@ ### Build Status [![Build Status][status-img]][status-link] -### Maintainer <pxqr.sta@gmail.com>+### Maintainer <abimelech@gmail.com> Feel free to report bugs and suggestions via github [issue tracker][issues] or the mail.@@ -23,6 +23,6 @@ [tutor]: http://www.signal11.us/oss/udev [hackage-docs]: http://hackage.haskell.org/package/udev [github-docs]: http://pxqr.github.io/udev/-[status-img]: https://travis-ci.org/pxqr/udev.png-[status-link]: https://travis-ci.org/pxqr/udev-[issues]: https://github.com/pxqr/udev/issues+[status-img]: https://github.com/leifw/udev/workflows/Haskell%20CI/badge.svg+[status-link]: https://github.com/LeifW/udev/actions?query=workflow%3A%22Haskell+CI%22+[issues]: https://github.com/LeifW/udev/issues
examples/hidraw.hs view
@@ -16,7 +16,7 @@ e <- newEnumerate udev addMatchSubsystem e "hidraw" scanDevices e- ls <- getListEntry e+ Just ls <- getListEntry e path <- getName ls print path dev <- newFromSysPath udev path
examples/monitor.hs view
@@ -1,18 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Prelude as P--import Control.Monad-import Data.ByteString.Char8 as BC+import Control.Monad (forever)+import Control.Concurrent (threadWaitRead) import System.UDev.Context import System.UDev.Device import System.UDev.Monitor-import System.Posix.IO.Select-import System.Posix.IO.Select.Types - dumpDeviceInfo :: Device -> IO () dumpDeviceInfo dev = do print $ getSubsystem dev@@ -22,21 +17,16 @@ print $ getSysnum dev print $ getDevnode dev print $ getAction dev- P.putStrLn $ "device number: " ++ show (getDevnum dev)+ putStrLn $ "device number: " ++ show (getDevnum dev) main :: IO ()-main = do- withUDev $ \ udev -> do- setLogPriority udev LogDebug- setLogger udev defaultLogger- monitor <- newFromNetlink udev UDevId- enableReceiving monitor- fd <- getFd monitor- forever $ do- res <- select' [fd] [] [] Never- case res of- Just ([_], [], []) -> do- dev <- receiveDevice monitor- dumpDeviceInfo dev- Nothing -> return ()- return ()+main = withUDev $ \ udev -> do+ setLogPriority udev LogDebug+ setLogger udev defaultLogger+ monitor <- newFromNetlink udev UDevId+ enableReceiving monitor+ fd <- getFd monitor+ forever $ do+ threadWaitRead fd+ dev <- receiveDevice monitor+ dumpDeviceInfo dev
src/System/UDev.hs view
@@ -16,8 +16,6 @@ , module System.UDev.Util ) where -import Data.Monoid- import System.UDev.Context import System.UDev.Device import System.UDev.Enumerate@@ -26,14 +24,3 @@ import System.UDev.Monitor import System.UDev.Queue import System.UDev.Util---type Devtype = ()-type Tag = ()--data Filter = Filter (Maybe (Subsystem, Devtype)) (Maybe Tag)--instance Monoid Filter where- mempty = Filter Nothing Nothing- Filter sda ta `mappend` Filter sdb tb- = Filter (sda `mappend` sdb) (ta `mappend` tb)
src/System/UDev/Context.hs view
@@ -15,6 +15,7 @@ UDev , UDevChild (..) , newUDev+ , freeUDev , withUDev -- * Logging@@ -31,10 +32,11 @@ ) where import Control.Applicative+import Control.Monad (void) import Control.Exception import Data.ByteString as BS import Data.ByteString.Char8 as BC-import Foreign+import Foreign (Ptr, FunPtr) import Foreign.C.String import Foreign.C.Types import Unsafe.Coerce@@ -51,9 +53,12 @@ newUDev :: IO UDev newUDev = c_new +freeUDev :: UDev -> IO ()+freeUDev = void . unref+ -- | Like 'newUDev' but context will be released at exit. withUDev :: (UDev -> IO a) -> IO a-withUDev = bracket c_new unref+withUDev = bracket newUDev freeUDev {----------------------------------------------------------------------- -- Logging@@ -130,7 +135,7 @@ -- | Default logger will just print @%PRIO %FILE:%LINE:\n%FN: %FORMAT@ -- to stdout. defaultLogger :: Logger-defaultLogger _ priority file line fn format = do+defaultLogger _ priority file line fn format = BC.putStrLn $ BS.concat [ BC.pack (show priority), " " , file, ":", BC.pack (show line), ":\n"
src/System/UDev/Device.hs view
@@ -15,6 +15,7 @@ module System.UDev.Device ( Device , Devnum+ , Action (..) -- * Create , newFromSysPath@@ -76,9 +77,9 @@ -- path to the device, including the sys mount point. -- newFromSysPath :: UDev -> RawFilePath -> IO Device-newFromSysPath udev sysPath = do- Device <$> (throwErrnoIfNull "newFromSysPath" $ do- useAsCString sysPath $ \ c_sysPath -> do+newFromSysPath udev sysPath =+ Device <$> throwErrnoIfNull "newFromSysPath"+ (useAsCString sysPath $ \ c_sysPath -> getDevice <$> c_newFromSysPath udev c_sysPath) type Dev_t = CULong@@ -122,7 +123,7 @@ -- device, like \"mem\" \/ \"zero\", or \"block\" \/ \"sda\". -- newFromSubsystemSysname :: UDev -> ByteString -> ByteString -> IO Device-newFromSubsystemSysname udev subsystem sysname = do+newFromSubsystemSysname udev subsystem sysname = useAsCString subsystem $ \ c_subsystem -> useAsCString sysname $ \ c_sysname -> c_newFromSubsystemSysname udev c_subsystem c_sysname@@ -141,7 +142,7 @@ -- * +sound:card29 - kernel driver core subsystem:device name -- newFromDeviceId :: UDev -> ByteString -> IO Device-newFromDeviceId udev devId = do+newFromDeviceId udev devId = useAsCString devId $ \ c_devId -> c_newFromDeviceId udev c_devId @@ -197,7 +198,7 @@ -- does not contain the sys mount point, and starts with a \'/\'. -- getDevpath :: Device -> RawFilePath-getDevpath dev = unsafePerformIO $ do+getDevpath dev = unsafePerformIO $ packCString =<< c_getDevpath dev foreign import ccall unsafe "udev_device_get_subsystem"@@ -323,7 +324,7 @@ -- | Get the kernel driver name. getDriver :: Device -> ByteString-getDriver dev = unsafePerformIO $ do+getDriver dev = unsafePerformIO $ packCString =<< c_getDriver dev foreign import ccall unsafe "udev_device_get_devnum"@@ -359,7 +360,7 @@ getAction :: Device -> Maybe Action getAction dev | c_action == nullPtr = Nothing- | otherwise = Just $ unsafePerformIO $ do+ | otherwise = Just $ unsafePerformIO $ marshalAction <$> packCString c_action where c_action = c_getAction dev@@ -375,7 +376,7 @@ -- return the same value and not open the attribute again. -- getSysattrValue :: Device -> ByteString -> IO ByteString-getSysattrValue dev sysattr = do+getSysattrValue dev sysattr = packCString =<< useAsCString sysattr (return . c_getSysattrValue dev) foreign import ccall unsafe "udev_device_set_sysattr_value"@@ -388,8 +389,8 @@ -> ByteString -- ^ attribute name -> ByteString -- ^ new value to be set -> IO ()-setSysattrValue dev sysattr value = do- throwErrnoIf_ (0 <) "setSysattrValue" $ do+setSysattrValue dev sysattr value =+ throwErrnoIf_ (0 <) "setSysattrValue" $ useAsCString sysattr $ \ c_sysattr -> useAsCString value $ \ c_value -> c_setSysattrValue dev c_sysattr c_value@@ -438,7 +439,7 @@ -- | Check if a given device has a certain tag associated. hasTag :: Device -> ByteString -> IO Bool-hasTag dev tag = do- (1 ==) <$> do- useAsCString tag $ \ c_tag ->- c_hasTag dev c_tag+hasTag dev tag =+ (1 ==) <$>+ useAsCString tag (\ c_tag ->+ c_hasTag dev c_tag)
src/System/UDev/Enumerate.hs view
@@ -75,8 +75,8 @@ -> Subsystem -- ^ filter for a subsystem of the -- device to include in the list -> IO () -- ^ can throw exception-addMatchSubsystem enumerate subsystem = do- throwErrnoIfMinus1_ "addMatchSubsystem" $ do+addMatchSubsystem enumerate subsystem =+ throwErrnoIfMinus1_ "addMatchSubsystem" $ useAsCString subsystem $ c_addMatchSubsystem enumerate @@ -88,8 +88,8 @@ -> Subsystem -- ^ filter for a subsystem of the -- device to exclude from the list -> IO () -- ^ can throw exception-addNoMatchSubsystem enumerate subsystem = do- throwErrnoIfMinus1_ "addNoMatchSubsystem" $ do+addNoMatchSubsystem enumerate subsystem =+ throwErrnoIfMinus1_ "addNoMatchSubsystem" $ useAsCString subsystem $ c_addNoMatchSubsystem enumerate @@ -109,13 +109,13 @@ -- the device to include in the list -> Maybe SysValue -- ^ optional value of the sys attribute -> IO () -- ^ can throw exception-addMatchSysattr enumerate sysattr mvalue = do- throwErrnoIf_ (< 0) "addMatchSysattr" $ do- useAsCString sysattr $ \ c_sysattr -> do+addMatchSysattr enumerate sysattr mvalue =+ throwErrnoIf_ (< 0) "addMatchSysattr" $+ useAsCString sysattr $ \ c_sysattr -> case mvalue of Nothing -> c_addMatchSysattr enumerate c_sysattr nullPtr- Just value -> do- useAsCString value $ \ c_value -> do+ Just value ->+ useAsCString value $ \ c_value -> c_addMatchSysattr enumerate c_sysattr c_value foreign import ccall unsafe "udev_enumerate_add_nomatch_sysattr"@@ -128,13 +128,13 @@ -> Maybe ByteString -- ^ optional value of the sys -- attribute -> IO ()-addNoMatchSysattr enumerate sysattr mvalue = do- throwErrnoIf_ (< 0) "addNoMatchSysattr" $ do- useAsCString sysattr $ \ c_sysattr -> do+addNoMatchSysattr enumerate sysattr mvalue =+ throwErrnoIf_ (< 0) "addNoMatchSysattr" $+ useAsCString sysattr $ \ c_sysattr -> case mvalue of Nothing -> c_addNoMatchSysattr enumerate c_sysattr nullPtr- Just value -> do- useAsCString value $ \ c_value -> do+ Just value ->+ useAsCString value $ \ c_value -> c_addNoMatchSysattr enumerate c_sysattr c_value foreign import ccall unsafe "udev_enumerate_add_match_property"@@ -146,10 +146,10 @@ -- device to include in the list -> ByteString -- ^ value of the property -> IO ()-addMatchProperty enumerate prop value = do- throwErrnoIf_ (< 0) "addMatchProperty" $ do- useAsCString prop $ \ c_prop -> do- useAsCString value $ \ c_value -> do+addMatchProperty enumerate prop value =+ throwErrnoIf_ (< 0) "addMatchProperty" $+ useAsCString prop $ \ c_prop ->+ useAsCString value $ \ c_value -> c_addMatchProperty enumerate c_prop c_value foreign import ccall unsafe "udev_enumerate_add_match_tag"@@ -161,9 +161,9 @@ -> ByteString -- ^ filter for a tag of the device to -- include in the list -> IO ()-addMatchTag enumerate tag = do- throwErrnoIf_ (< 0) "addMatchTag" $ do- useAsCString tag $ \ c_tag -> do+addMatchTag enumerate tag =+ throwErrnoIf_ (< 0) "addMatchTag" $+ useAsCString tag $ \ c_tag -> c_addMatchTag enumerate c_tag foreign import ccall unsafe "udev_enumerate_add_match_parent"@@ -178,8 +178,8 @@ addMatchParent :: Enumerate -- ^ context -> Device -- ^ parent device where to start searching -> IO () -- ^ can throw exception-addMatchParent enumerate dev = do- throwErrnoIf_ (< 0) "addMatchParent" $ do+addMatchParent enumerate dev =+ throwErrnoIf_ (< 0) "addMatchParent" $ c_addMatchParent enumerate dev foreign import ccall unsafe "udev_enumerate_add_match_is_initialized"@@ -187,8 +187,8 @@ -- | Match only devices which udev has set up already. addMatchIsInitialized :: Enumerate -> IO ()-addMatchIsInitialized enumerate = do- throwErrnoIfMinus1_ "addMatchIsInitialized" $ do+addMatchIsInitialized enumerate =+ throwErrnoIfMinus1_ "addMatchIsInitialized" $ c_addMatchIsInitialized enumerate foreign import ccall unsafe "udev_enumerate_add_match_sysname"@@ -199,8 +199,8 @@ -> ByteString -- ^ filter for the name of the device -- to include in the list -> IO () -- ^ can throw exception-addMatchSysname enumerate sysName = do- throwErrnoIfMinus1_ "addMatchSysname" $ do+addMatchSysname enumerate sysName =+ throwErrnoIfMinus1_ "addMatchSysname" $ useAsCString sysName $ c_addMatchSysname enumerate @@ -213,9 +213,9 @@ addSyspath :: Enumerate -- ^ context -> RawFilePath -- ^ path of a device -> IO () -- ^ can throw exception-addSyspath enumerate syspath = do- throwErrnoIf_ (< 0) "addSyspath" $ do- useAsCString syspath $ \ c_syspath -> do+addSyspath enumerate syspath =+ throwErrnoIf_ (< 0) "addSyspath" $+ useAsCString syspath $ \ c_syspath -> c_addSyspath enumerate c_syspath {-----------------------------------------------------------------------@@ -244,6 +244,8 @@ c_getListEntry :: Enumerate -> IO List -- | Get the first entry of the sorted list of device paths.-getListEntry :: Enumerate -> IO List-getListEntry = c_getListEntry+getListEntry :: Enumerate -> IO (Maybe List)+getListEntry enumerate = do+ xs <- c_getListEntry enumerate+ return $ if xs == nil then Nothing else Just xs {-# INLINE getListEntry #-}
src/System/UDev/List.hs view
@@ -20,10 +20,8 @@ import Control.Monad import Data.ByteString import Foreign.C.String-import Foreign.C.Types import System.UDev.Types- foreign import ccall unsafe "udev_list_entry_get_next" c_getNext :: List -> IO List
src/System/UDev/Monitor.hs view
@@ -96,8 +96,8 @@ newFromNetlink :: UDev -> SourceId -> IO Monitor newFromNetlink udev sid = Monitor <$> do- throwErrnoIfNull "newFromNetlink" $ do- useAsCString (unmarshalSourceId sid) $ \ c_name -> do+ throwErrnoIfNull "newFromNetlink" $+ useAsCString (unmarshalSourceId sid) $ \ c_name -> getMonitor <$> c_newFromNetlink udev c_name @@ -106,8 +106,8 @@ -- | Binds the 'Monitor' socket to the event source. enableReceiving :: Monitor -> IO ()-enableReceiving monitor = do- throwErrnoIfMinus1_ "enableReceiving" $ do+enableReceiving monitor =+ throwErrnoIfMinus1_ "enableReceiving" $ c_enableReceiving monitor foreign import ccall unsafe "udev_monitor_set_receive_buffer_size"@@ -115,8 +115,8 @@ -- | Set the size of the kernel socket buffer. setReceiveBufferSize :: Monitor -> Int -> IO ()-setReceiveBufferSize monitor size = do- throwErrnoIfMinus1_ "setReceiveBufferSize" $ do+setReceiveBufferSize monitor size =+ throwErrnoIfMinus1_ "setReceiveBufferSize" $ c_setReceiveBufferSize monitor (fromIntegral size) foreign import ccall unsafe "udev_monitor_get_fd"@@ -138,10 +138,10 @@ -- device, fill in the received data, and return the device. -- receiveDevice :: Monitor -> IO Device-receiveDevice monitor = do- Device <$> do- throwErrnoIfNull "receiveDevice" $ do- getDevice <$> c_receiveDevice monitor+receiveDevice monitor =+ Device <$>+ throwErrnoIfNull "receiveDevice"+ (getDevice <$> c_receiveDevice monitor) foreign import ccall unsafe "udev_monitor_filter_add_match_subsystem_devtype" c_filterAddMatchSubsystemDevtype :: Monitor -> CString -> CString -> IO CInt@@ -151,12 +151,16 @@ -- The filter /must be/ installed before the monitor is switched to -- listening mode. ---filterAddMatchSubsystemDevtype :: Monitor -> ByteString -> ByteString -> IO ()-filterAddMatchSubsystemDevtype monitor subsystem devtype = do+filterAddMatchSubsystemDevtype :: Monitor -> ByteString -> Maybe ByteString -> IO ()+filterAddMatchSubsystemDevtype monitor subsystem mbDevtype = throwErrnoIfMinus1_ "filterAddMatchSubsystemDevtype" $ useAsCString subsystem $ \ c_subsystem ->- useAsCString devtype $ \ c_devtype ->- c_filterAddMatchSubsystemDevtype monitor c_subsystem c_devtype+ case mbDevtype of+ Just devtype ->+ useAsCString devtype $ \ c_devtype ->+ c_filterAddMatchSubsystemDevtype monitor c_subsystem c_devtype+ Nothing ->+ c_filterAddMatchSubsystemDevtype monitor c_subsystem nullPtr foreign import ccall unsafe "udev_monitor_filter_add_match_tag" c_filterAddMatchTag :: Monitor -> CString -> IO CInt@@ -165,9 +169,9 @@ -- listening mode. -- filterAddMatchTag :: Monitor -> ByteString -> IO ()-filterAddMatchTag monitor tag = do- throwErrnoIfMinus1_ "filterAddMatchTag" $ do- useAsCString tag $ \ c_tag -> do+filterAddMatchTag monitor tag =+ throwErrnoIfMinus1_ "filterAddMatchTag" $+ useAsCString tag $ \ c_tag -> c_filterAddMatchTag monitor c_tag foreign import ccall unsafe "udev_monitor_filter_update"@@ -177,8 +181,8 @@ -- filter was removed or changed. -- filterUpdate :: Monitor -> IO ()-filterUpdate monitor = do- throwErrnoIfMinus1_ "filterUpdate" $ do+filterUpdate monitor =+ throwErrnoIfMinus1_ "filterUpdate" $ c_filterUpdate monitor @@ -187,6 +191,6 @@ -- | Remove all filters from monitor. filterRemove :: Monitor -> IO ()-filterRemove monitor = do- throwErrnoIfMinus1_ "filterRemove" $ do+filterRemove monitor =+ throwErrnoIfMinus1_ "filterRemove" $ c_filterRemove monitor
src/System/UDev/Queue.hs view
@@ -82,7 +82,7 @@ -> Seqnum -- ^ last event sequence number -> IO Bool -- ^ if any of the sequence numbers in -- the given range is currently active-sequenceIsFinished queue start end = do+sequenceIsFinished queue start end = (> 0) <$> c_sequenceIsFinished queue (fromIntegral start) (fromIntegral end) {-# INLINE sequenceIsFinished #-}
udev.cabal view
@@ -1,17 +1,17 @@ name: udev-version: 0.1.0.0+version: 0.1.1.0 license: BSD3 license-file: LICENSE author: Sam Truzjan-maintainer: pxqr.sta@gmail.com+maintainer: abimelech@gmail.com copyright: (c) 2013, Sam Truzjan category: System stability: Experimental build-type: Simple cabal-version: >= 1.10 tested-with: GHC == 7.6.3-homepage: https://github.com/pxqr/udev-bug-reports: https://github.com/pxqr/udev/issues+homepage: https://github.com/LeifW/udev+bug-reports: https://github.com/LeifW/udev/issues synopsis: libudev bindings description: libudev bindings @@ -20,14 +20,14 @@ source-repository head type: git- location: git://github.com/pxqr/udev.git+ location: git://github.com/LeifW/udev.git branch: master source-repository this type: git- location: git://github.com/pxqr/udev.git+ location: git://github.com/LeifW/udev.git branch: master- tag: v0.1.0.0+ tag: v0.1.1.0 flag examples description: whether to build examples@@ -67,6 +67,6 @@ default-language: Haskell2010 hs-source-dirs: examples main-is: monitor.hs- build-depends: base, bytestring, udev, select+ build-depends: base, bytestring, udev if !flag(examples) buildable: False