-- |
--   Copyright   :  (c) Sam Truzjan 2013
--   License     :  BSD3
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  stable
--   Portability :  portable
--
-- Representation of kernel sys devices. Devices are uniquely
-- identified by their syspath, every device has exactly one path in
-- the kernel sys filesystem. Devices usually belong to a kernel
-- subsystem, and have a unique name inside that subsystem.
--
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module System.UDev.Device
       ( Device
       , Devnum
       , Action (..)

         -- * Create
       , newFromSysPath
       , newFromDevnum
       , newFromSubsystemSysname
       , newFromDeviceId
       , newFromEnvironment

       , getParent
       , getParentWithSubsystemDevtype

         -- * Query
       , getDevpath
       , getSubsystem
       , getDevtype
       , getSyspath
       , getSysname
       , getSysnum
       , getDevnode
       , isInitialized
       , getDevlinksListEntry
       , getPropertiesListEntry
       , getTagsListEntry
       , getPropertyValue
       , getDriver
       , getDevnum
       , getAction

         -- * Sysattrs
       , getSysattrValue
       , setSysattrValue
       , getSysattrListEntry

         -- * Misc
       , getSeqnum
       , getUsecSinceInitialized
       , hasTag
       ) where

import Control.Applicative
import Data.Bits
import Data.ByteString as BS
import Foreign hiding (unsafePerformIO)
import Foreign.C
import System.IO.Unsafe
import System.Posix.FilePath

import System.UDev.Context
import System.UDev.List
import System.UDev.Types


foreign import ccall unsafe "udev_device_new_from_syspath"
  c_newFromSysPath :: UDev -> CString -> IO Device


-- | Create new udev device, and fill in information from the sys
-- device and the udev database entry. The syspath is the absolute
-- path to the device, including the sys mount point.
--
newFromSysPath :: UDev -> RawFilePath -> IO Device
newFromSysPath :: UDev -> RawFilePath -> IO Device
newFromSysPath UDev
udev RawFilePath
sysPath =
  Ptr Device -> Device
Device (Ptr Device -> Device) -> IO (Ptr Device) -> IO Device
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Ptr Device) -> IO (Ptr Device)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull String
"newFromSysPath"
    (RawFilePath -> (CString -> IO (Ptr Device)) -> IO (Ptr Device)
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
sysPath ((CString -> IO (Ptr Device)) -> IO (Ptr Device))
-> (CString -> IO (Ptr Device)) -> IO (Ptr Device)
forall a b. (a -> b) -> a -> b
$ \ CString
c_sysPath ->
      Device -> Ptr Device
getDevice (Device -> Ptr Device) -> IO Device -> IO (Ptr Device)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UDev -> CString -> IO Device
c_newFromSysPath UDev
udev CString
c_sysPath)

type Dev_t = CULong

foreign import ccall unsafe "udev_device_new_from_devnum"
  c_newFromDevnum :: UDev -> CChar -> Dev_t -> IO Device

-- | Device number.
data Devnum = Devnum
  { Devnum -> Int
major :: {-# UNPACK #-} !Int
  , Devnum -> Int
minor :: {-# UNPACK #-} !Int
  } deriving (Int -> Devnum -> ShowS
[Devnum] -> ShowS
Devnum -> String
(Int -> Devnum -> ShowS)
-> (Devnum -> String) -> ([Devnum] -> ShowS) -> Show Devnum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Devnum] -> ShowS
$cshowList :: [Devnum] -> ShowS
show :: Devnum -> String
$cshow :: Devnum -> String
showsPrec :: Int -> Devnum -> ShowS
$cshowsPrec :: Int -> Devnum -> ShowS
Show, ReadPrec [Devnum]
ReadPrec Devnum
Int -> ReadS Devnum
ReadS [Devnum]
(Int -> ReadS Devnum)
-> ReadS [Devnum]
-> ReadPrec Devnum
-> ReadPrec [Devnum]
-> Read Devnum
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Devnum]
$creadListPrec :: ReadPrec [Devnum]
readPrec :: ReadPrec Devnum
$creadPrec :: ReadPrec Devnum
readList :: ReadS [Devnum]
$creadList :: ReadS [Devnum]
readsPrec :: Int -> ReadS Devnum
$creadsPrec :: Int -> ReadS Devnum
Read, Devnum -> Devnum -> Bool
(Devnum -> Devnum -> Bool)
-> (Devnum -> Devnum -> Bool) -> Eq Devnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Devnum -> Devnum -> Bool
$c/= :: Devnum -> Devnum -> Bool
== :: Devnum -> Devnum -> Bool
$c== :: Devnum -> Devnum -> Bool
Eq, Eq Devnum
Eq Devnum
-> (Devnum -> Devnum -> Ordering)
-> (Devnum -> Devnum -> Bool)
-> (Devnum -> Devnum -> Bool)
-> (Devnum -> Devnum -> Bool)
-> (Devnum -> Devnum -> Bool)
-> (Devnum -> Devnum -> Devnum)
-> (Devnum -> Devnum -> Devnum)
-> Ord Devnum
Devnum -> Devnum -> Bool
Devnum -> Devnum -> Ordering
Devnum -> Devnum -> Devnum
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Devnum -> Devnum -> Devnum
$cmin :: Devnum -> Devnum -> Devnum
max :: Devnum -> Devnum -> Devnum
$cmax :: Devnum -> Devnum -> Devnum
>= :: Devnum -> Devnum -> Bool
$c>= :: Devnum -> Devnum -> Bool
> :: Devnum -> Devnum -> Bool
$c> :: Devnum -> Devnum -> Bool
<= :: Devnum -> Devnum -> Bool
$c<= :: Devnum -> Devnum -> Bool
< :: Devnum -> Devnum -> Bool
$c< :: Devnum -> Devnum -> Bool
compare :: Devnum -> Devnum -> Ordering
$ccompare :: Devnum -> Devnum -> Ordering
$cp1Ord :: Eq Devnum
Ord)

nrToDevnum :: Dev_t -> Devnum
nrToDevnum :: Dev_t -> Devnum
nrToDevnum Dev_t
x = Devnum :: Int -> Int -> Devnum
Devnum
  { major :: Int
major = Dev_t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Dev_t
x Dev_t -> Int -> Dev_t
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8) Dev_t -> Dev_t -> Dev_t
forall a. Bits a => a -> a -> a
.&. Dev_t
0xff)
  , minor :: Int
minor = Dev_t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dev_t
x Dev_t -> Dev_t -> Dev_t
forall a. Bits a => a -> a -> a
.&. Dev_t
0xff)
  }
{-# INLINE nrToDevnum #-}

devnumToNr :: Devnum -> Dev_t
devnumToNr :: Devnum -> Dev_t
devnumToNr Devnum {Int
minor :: Int
major :: Int
minor :: Devnum -> Int
major :: Devnum -> Int
..}
    = Int -> Dev_t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (((Int
major Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)
                 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
minor Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff))
{-# INLINE devnumToNr #-}

-- | Create new udev device, and fill in information from the sys
-- device and the udev database entry. The device is looked-up by its
-- major/minor number and type. Character and block device numbers are
-- not unique across the two types.
--
newFromDevnum :: UDev -> Char -> Devnum -> IO Device
newFromDevnum :: UDev -> Char -> Devnum -> IO Device
newFromDevnum UDev
udev Char
char Devnum
devnum
  = UDev -> CChar -> Dev_t -> IO Device
c_newFromDevnum UDev
udev (Int -> CChar
forall a. Enum a => Int -> a
toEnum (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
char)) (Devnum -> Dev_t
devnumToNr Devnum
devnum)
{-# INLINE newFromDevnum #-}

foreign import ccall unsafe "udev_device_new_from_subsystem_sysname"
  c_newFromSubsystemSysname :: UDev -> CString -> CString -> IO Device

-- | The device is looked up by the subsystem and name string of the
-- device, like \"mem\" \/ \"zero\", or \"block\" \/ \"sda\".
--
newFromSubsystemSysname :: UDev -> ByteString -> ByteString -> IO Device
newFromSubsystemSysname :: UDev -> RawFilePath -> RawFilePath -> IO Device
newFromSubsystemSysname UDev
udev RawFilePath
subsystem RawFilePath
sysname =
  RawFilePath -> (CString -> IO Device) -> IO Device
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
subsystem ((CString -> IO Device) -> IO Device)
-> (CString -> IO Device) -> IO Device
forall a b. (a -> b) -> a -> b
$ \ CString
c_subsystem ->
    RawFilePath -> (CString -> IO Device) -> IO Device
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
sysname ((CString -> IO Device) -> IO Device)
-> (CString -> IO Device) -> IO Device
forall a b. (a -> b) -> a -> b
$ \ CString
c_sysname   ->
      UDev -> CString -> CString -> IO Device
c_newFromSubsystemSysname UDev
udev CString
c_subsystem CString
c_sysname

foreign import ccall unsafe "udev_device_new_from_device_id"
  c_newFromDeviceId :: UDev -> CString -> IO Device

-- | The device is looked-up by a special string:
--
--     * b8:2 - block device major:minor
--
--     * c128:1 - char device major:minor
--
--     * n3 - network device ifindex
--
--     * +sound:card29 - kernel driver core subsystem:device name
--
newFromDeviceId :: UDev -> ByteString -> IO Device
newFromDeviceId :: UDev -> RawFilePath -> IO Device
newFromDeviceId UDev
udev RawFilePath
devId =
  RawFilePath -> (CString -> IO Device) -> IO Device
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
devId ((CString -> IO Device) -> IO Device)
-> (CString -> IO Device) -> IO Device
forall a b. (a -> b) -> a -> b
$ \ CString
c_devId ->
    UDev -> CString -> IO Device
c_newFromDeviceId UDev
udev CString
c_devId

foreign import ccall unsafe "udev_device_new_from_environment"
  c_newFromEnvironment :: UDev -> IO Device

-- | Create new udev device, and fill in information from the current
-- process environment. This only works reliable if the process is
-- called from a udev rule. It is usually used for tools executed from
-- @IMPORT=@ rules.
--
newFromEnvironment :: UDev -> IO Device
newFromEnvironment :: UDev -> IO Device
newFromEnvironment = UDev -> IO Device
c_newFromEnvironment

foreign import ccall unsafe "udev_device_get_parent"
  c_getParent :: Device -> IO Device

--  TODO: [MEM]: The returned the device is not referenced. It is
-- attached to the child device, and will be cleaned up when the child
-- device is cleaned up.

-- | Find the next parent device, and fill in information from the sys
-- device and the udev database entry.
getParent :: Device -> IO Device
getParent :: Device -> IO Device
getParent = Device -> IO Device
c_getParent

foreign import ccall unsafe "udev_device_get_parent_with_subsystem_devtype"
    c_getParentWithSubsystemDevtype :: Device -> CString -> CString
                                    -> IO Device

-- | Find the next parent device, with a matching subsystem and devtype
-- value, and fill in information from the sys device and the udev
-- database entry.
--
getParentWithSubsystemDevtype :: Device -> ByteString -> ByteString
                              -> IO (Maybe Device)
getParentWithSubsystemDevtype :: Device -> RawFilePath -> RawFilePath -> IO (Maybe Device)
getParentWithSubsystemDevtype Device
udev RawFilePath
subsystem RawFilePath
devtype = do
  Device
mdev <- RawFilePath -> (CString -> IO Device) -> IO Device
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
subsystem ((CString -> IO Device) -> IO Device)
-> (CString -> IO Device) -> IO Device
forall a b. (a -> b) -> a -> b
$ \ CString
c_subsystem ->
              RawFilePath -> (CString -> IO Device) -> IO Device
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
devtype ((CString -> IO Device) -> IO Device)
-> (CString -> IO Device) -> IO Device
forall a b. (a -> b) -> a -> b
$ \ CString
c_devtype ->
                  Device -> CString -> CString -> IO Device
c_getParentWithSubsystemDevtype Device
udev CString
c_subsystem CString
c_devtype
  Maybe Device -> IO (Maybe Device)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Device -> IO (Maybe Device))
-> Maybe Device -> IO (Maybe Device)
forall a b. (a -> b) -> a -> b
$ if Device -> Ptr Device
getDevice Device
mdev Ptr Device -> Ptr Device -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Device
forall a. Ptr a
nullPtr then Maybe Device
forall a. Maybe a
Nothing else Device -> Maybe Device
forall a. a -> Maybe a
Just Device
mdev

foreign import ccall unsafe "udev_device_get_devpath"
  c_getDevpath :: Device -> IO CString

-- TODO use RawFilePath

{-----------------------------------------------------------------------
--  Query
-----------------------------------------------------------------------}

-- | Retrieve the kernel devpath value of the udev device. The path
-- does not contain the sys mount point, and starts with a \'/\'.
--
getDevpath :: Device -> RawFilePath
getDevpath :: Device -> RawFilePath
getDevpath Device
dev = IO RawFilePath -> RawFilePath
forall a. IO a -> a
unsafePerformIO (IO RawFilePath -> RawFilePath) -> IO RawFilePath -> RawFilePath
forall a b. (a -> b) -> a -> b
$
  CString -> IO RawFilePath
packCString (CString -> IO RawFilePath) -> IO CString -> IO RawFilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO CString
c_getDevpath Device
dev

foreign import ccall unsafe "udev_device_get_subsystem"
  c_getSubsystem :: Device -> IO CString

packCStringMaybe :: CString -> IO (Maybe ByteString)
packCStringMaybe :: CString -> IO (Maybe RawFilePath)
packCStringMaybe CString
cstring =
  if CString
cstring CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
  then Maybe RawFilePath -> IO (Maybe RawFilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RawFilePath
forall a. Maybe a
Nothing
  else RawFilePath -> Maybe RawFilePath
forall a. a -> Maybe a
Just (RawFilePath -> Maybe RawFilePath)
-> IO RawFilePath -> IO (Maybe RawFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO RawFilePath
packCString CString
cstring

-- | Retrieve the subsystem string of the udev device. The string does
-- not contain any \"/\".
--
getSubsystem :: Device -> Maybe ByteString
getSubsystem :: Device -> Maybe RawFilePath
getSubsystem Device
dev = IO (Maybe RawFilePath) -> Maybe RawFilePath
forall a. IO a -> a
unsafePerformIO (IO (Maybe RawFilePath) -> Maybe RawFilePath)
-> IO (Maybe RawFilePath) -> Maybe RawFilePath
forall a b. (a -> b) -> a -> b
$ CString -> IO (Maybe RawFilePath)
packCStringMaybe (CString -> IO (Maybe RawFilePath))
-> IO CString -> IO (Maybe RawFilePath)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO CString
c_getSubsystem Device
dev

foreign import ccall unsafe "udev_device_get_devtype"
  c_getDevtype :: Device -> IO CString

-- | Retrieve the devtype string of the udev device.
getDevtype :: Device -> Maybe ByteString
getDevtype :: Device -> Maybe RawFilePath
getDevtype Device
dev = IO (Maybe RawFilePath) -> Maybe RawFilePath
forall a. IO a -> a
unsafePerformIO (IO (Maybe RawFilePath) -> Maybe RawFilePath)
-> IO (Maybe RawFilePath) -> Maybe RawFilePath
forall a b. (a -> b) -> a -> b
$ CString -> IO (Maybe RawFilePath)
packCStringMaybe (CString -> IO (Maybe RawFilePath))
-> IO CString -> IO (Maybe RawFilePath)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO CString
c_getDevtype Device
dev

foreign import ccall unsafe "udev_device_get_syspath"
  c_getSyspath :: Device -> IO CString

-- | Retrieve the sys path of the udev device. The path is an absolute
-- path and starts with the sys mount point.
--
getSyspath :: Device -> RawFilePath
getSyspath :: Device -> RawFilePath
getSyspath Device
dev = IO RawFilePath -> RawFilePath
forall a. IO a -> a
unsafePerformIO (IO RawFilePath -> RawFilePath) -> IO RawFilePath -> RawFilePath
forall a b. (a -> b) -> a -> b
$ CString -> IO RawFilePath
packCString (CString -> IO RawFilePath) -> IO CString -> IO RawFilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO CString
c_getSyspath Device
dev

foreign import ccall unsafe "udev_device_get_sysname"
  c_getSysname :: Device -> IO CString

-- | Get the kernel device name in /sys.
getSysname :: Device -> ByteString
getSysname :: Device -> RawFilePath
getSysname Device
dev = IO RawFilePath -> RawFilePath
forall a. IO a -> a
unsafePerformIO (IO RawFilePath -> RawFilePath) -> IO RawFilePath -> RawFilePath
forall a b. (a -> b) -> a -> b
$ CString -> IO RawFilePath
packCString (CString -> IO RawFilePath) -> IO CString -> IO RawFilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO CString
c_getSysname Device
dev

foreign import ccall unsafe "udev_device_get_sysnum"
  c_getSysnum :: Device -> IO CString

--  TODO :: Device -> Maybe Int ?

-- | Get the instance number of the device.
getSysnum :: Device -> Maybe ByteString
getSysnum :: Device -> Maybe RawFilePath
getSysnum Device
dev = IO (Maybe RawFilePath) -> Maybe RawFilePath
forall a. IO a -> a
unsafePerformIO (IO (Maybe RawFilePath) -> Maybe RawFilePath)
-> IO (Maybe RawFilePath) -> Maybe RawFilePath
forall a b. (a -> b) -> a -> b
$ CString -> IO (Maybe RawFilePath)
packCStringMaybe (CString -> IO (Maybe RawFilePath))
-> IO CString -> IO (Maybe RawFilePath)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO CString
c_getSysnum Device
dev

foreign import ccall unsafe "udev_device_get_devnode"
  c_getDevnode :: Device -> IO CString

-- | Retrieve the device node file name belonging to the udev
-- device. The path is an absolute path, and starts with the device
-- directory.
--
getDevnode :: Device -> Maybe ByteString
getDevnode :: Device -> Maybe RawFilePath
getDevnode Device
udev = IO (Maybe RawFilePath) -> Maybe RawFilePath
forall a. IO a -> a
unsafePerformIO (IO (Maybe RawFilePath) -> Maybe RawFilePath)
-> IO (Maybe RawFilePath) -> Maybe RawFilePath
forall a b. (a -> b) -> a -> b
$ CString -> IO (Maybe RawFilePath)
packCStringMaybe (CString -> IO (Maybe RawFilePath))
-> IO CString -> IO (Maybe RawFilePath)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO CString
c_getDevnode Device
udev

foreign import ccall unsafe "udev_device_get_is_initialized"
  c_isInitialized :: Device -> IO CInt

-- | Check if udev has already handled the device and has set up
-- device node permissions and context, or has renamed a network
-- device.
--
-- This is only implemented for devices with a device node or network
-- interfaces. All other devices return 1 here.
--
isInitialized :: Device -> IO Bool
isInitialized :: Device -> IO Bool
isInitialized Device
dev = (CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0) (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Device -> IO CInt
c_isInitialized Device
dev

foreign import ccall unsafe "udev_device_get_devlinks_list_entry"
  c_getDevlinksListEntry :: Device -> IO List

-- | Retrieve the list of device links pointing to the device file of
-- the udev device. The next list entry can be retrieved with
-- 'getNext', which returns 'Nothing' if no more entries exist. The
-- devlink path can be retrieved from the list entry by 'getName'. The
-- path is an absolute path, and starts with the device directory.
--
getDevlinksListEntry :: Device -> IO List
getDevlinksListEntry :: Device -> IO List
getDevlinksListEntry = Device -> IO List
c_getDevlinksListEntry
{-# INLINE getDevlinksListEntry #-}

foreign import ccall unsafe "udev_device_get_properties_list_entry"
  c_getPropertiesListEntry :: Device -> IO List

-- | Retrieve the list of key/value device properties of the udev
-- device. The next list entry can be retrieved with 'getNext', which
-- returns 'Nothing' if no more entries exist. The property name can
-- be retrieved from the list entry by 'getName', the property value
-- by 'getValue'.
--
getPropertiesListEntry :: Device -> IO List
getPropertiesListEntry :: Device -> IO List
getPropertiesListEntry = Device -> IO List
c_getPropertiesListEntry
{-# INLINE getPropertiesListEntry #-}

foreign import ccall unsafe "udev_device_get_tags_list_entry"
  c_getTagsListEntry :: Device -> IO List

-- | Retrieve the list of tags attached to the udev device. The next
-- list entry can be retrieved with 'getNext', which returns 'Nothing'
-- if no more entries exist. The tag string can be retrieved from the
-- list entry by 'getName'.
--
getTagsListEntry :: Device -> IO List
getTagsListEntry :: Device -> IO List
getTagsListEntry = Device -> IO List
c_getTagsListEntry
{-# INLINE getTagsListEntry #-}

foreign import ccall unsafe "udev_device_get_property_value"
  c_getPropertyValue :: Device -> CString -> IO CString

-- | Get the value of a given property.
getPropertyValue :: Device -> ByteString -> IO (Maybe ByteString)
getPropertyValue :: Device -> RawFilePath -> IO (Maybe RawFilePath)
getPropertyValue Device
dev RawFilePath
prop = do
  CString
res <- RawFilePath -> (CString -> IO CString) -> IO CString
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
prop ((CString -> IO CString) -> IO CString)
-> (CString -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \ CString
c_prop ->
    Device -> CString -> IO CString
c_getPropertyValue Device
dev CString
c_prop
  if CString
res CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr then Maybe RawFilePath -> IO (Maybe RawFilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RawFilePath
forall a. Maybe a
Nothing else RawFilePath -> Maybe RawFilePath
forall a. a -> Maybe a
Just (RawFilePath -> Maybe RawFilePath)
-> IO RawFilePath -> IO (Maybe RawFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO RawFilePath
packCString CString
res

foreign import ccall unsafe "udev_device_get_driver"
  c_getDriver :: Device -> IO CString

-- | Get the kernel driver name.
getDriver :: Device -> ByteString
getDriver :: Device -> RawFilePath
getDriver Device
dev = IO RawFilePath -> RawFilePath
forall a. IO a -> a
unsafePerformIO (IO RawFilePath -> RawFilePath) -> IO RawFilePath -> RawFilePath
forall a b. (a -> b) -> a -> b
$
  CString -> IO RawFilePath
packCString (CString -> IO RawFilePath) -> IO CString -> IO RawFilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO CString
c_getDriver Device
dev

foreign import ccall unsafe "udev_device_get_devnum"
  c_getDevnum :: Device -> Dev_t

-- | Get the device major/minor number.
getDevnum :: Device -> Devnum
getDevnum :: Device -> Devnum
getDevnum = Dev_t -> Devnum
nrToDevnum (Dev_t -> Devnum) -> (Device -> Dev_t) -> Device -> Devnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Dev_t
c_getDevnum
{-# INLINE getDevnum #-}

foreign import ccall unsafe "udev_device_get_action"
  c_getAction :: Device -> CString

data Action = Add
            | Remove
            | Change
            | Online
            | Offline
            | Other ByteString
              deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show, ReadPrec [Action]
ReadPrec Action
Int -> ReadS Action
ReadS [Action]
(Int -> ReadS Action)
-> ReadS [Action]
-> ReadPrec Action
-> ReadPrec [Action]
-> Read Action
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Action]
$creadListPrec :: ReadPrec [Action]
readPrec :: ReadPrec Action
$creadPrec :: ReadPrec Action
readList :: ReadS [Action]
$creadList :: ReadS [Action]
readsPrec :: Int -> ReadS Action
$creadsPrec :: Int -> ReadS Action
Read, Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq, Eq Action
Eq Action
-> (Action -> Action -> Ordering)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Action)
-> (Action -> Action -> Action)
-> Ord Action
Action -> Action -> Bool
Action -> Action -> Ordering
Action -> Action -> Action
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Action -> Action -> Action
$cmin :: Action -> Action -> Action
max :: Action -> Action -> Action
$cmax :: Action -> Action -> Action
>= :: Action -> Action -> Bool
$c>= :: Action -> Action -> Bool
> :: Action -> Action -> Bool
$c> :: Action -> Action -> Bool
<= :: Action -> Action -> Bool
$c<= :: Action -> Action -> Bool
< :: Action -> Action -> Bool
$c< :: Action -> Action -> Bool
compare :: Action -> Action -> Ordering
$ccompare :: Action -> Action -> Ordering
$cp1Ord :: Eq Action
Ord)

marshalAction :: ByteString -> Action
marshalAction :: RawFilePath -> Action
marshalAction RawFilePath
"add"     = Action
Add
marshalAction RawFilePath
"remove"  = Action
Remove
marshalAction RawFilePath
"change"  = Action
Remove
marshalAction RawFilePath
"online"  = Action
Online
marshalAction RawFilePath
"offline" = Action
Offline
marshalAction   RawFilePath
action  = RawFilePath -> Action
Other RawFilePath
action

-- | This is only valid if the device was received through a
-- monitor. Devices read from sys do not have an action string.
--
getAction :: Device -> Maybe Action
getAction :: Device -> Maybe Action
getAction Device
dev
    | CString
c_action CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr = Maybe Action
forall a. Maybe a
Nothing
    |      Bool
otherwise      = Action -> Maybe Action
forall a. a -> Maybe a
Just (Action -> Maybe Action) -> Action -> Maybe Action
forall a b. (a -> b) -> a -> b
$ IO Action -> Action
forall a. IO a -> a
unsafePerformIO (IO Action -> Action) -> IO Action -> Action
forall a b. (a -> b) -> a -> b
$
      RawFilePath -> Action
marshalAction (RawFilePath -> Action) -> IO RawFilePath -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO RawFilePath
packCString CString
c_action
  where
    c_action :: CString
c_action = Device -> CString
c_getAction Device
dev


foreign import ccall unsafe "udev_device_get_sysattr_value"
  c_getSysattrValue :: Device -> CString -> CString

-- NOTE: getSysattrValue is not pure since we can alter some attr
-- using setSysattrValue

-- | The retrieved value is cached in the device. Repeated calls will
-- return the same value and not open the attribute again.
--
getSysattrValue :: Device -> ByteString -> IO ByteString
getSysattrValue :: Device -> RawFilePath -> IO RawFilePath
getSysattrValue Device
dev RawFilePath
sysattr =
    CString -> IO RawFilePath
packCString (CString -> IO RawFilePath) -> IO CString -> IO RawFilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RawFilePath -> (CString -> IO CString) -> IO CString
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
sysattr (CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return (CString -> IO CString)
-> (CString -> CString) -> CString -> IO CString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> CString -> CString
c_getSysattrValue Device
dev)

foreign import ccall unsafe "udev_device_set_sysattr_value"
  c_setSysattrValue :: Device -> CString -> CString -> IO CInt

-- | Update the contents of the sys attribute and the cached value of
-- the device.
--
setSysattrValue :: Device
                -> ByteString -- ^ attribute name
                -> ByteString -- ^ new value to be set
                -> IO ()
setSysattrValue :: Device -> RawFilePath -> RawFilePath -> IO ()
setSysattrValue Device
dev RawFilePath
sysattr RawFilePath
value =
  (CInt -> Bool) -> String -> IO CInt -> IO ()
forall a. (a -> Bool) -> String -> IO a -> IO ()
throwErrnoIf_ (CInt
0 CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<) String
"setSysattrValue" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    RawFilePath -> (CString -> IO CInt) -> IO CInt
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
sysattr ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ CString
c_sysattr ->
      RawFilePath -> (CString -> IO CInt) -> IO CInt
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
value ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ CString
c_value   ->
        Device -> CString -> CString -> IO CInt
c_setSysattrValue Device
dev CString
c_sysattr CString
c_value

foreign import ccall unsafe "udev_device_get_sysattr_list_entry"
  c_getSysAttrListEntry :: Device -> IO List

-- | Retrieve the list of available sysattrs, with value being empty;
-- This just return all available sysfs attributes for a particular
-- device without reading their values.
--
getSysattrListEntry :: Device -> IO List
getSysattrListEntry :: Device -> IO List
getSysattrListEntry = Device -> IO List
c_getSysAttrListEntry
{-# INLINE getSysattrListEntry #-}

toMaybe :: CULLong -> Maybe Int
toMaybe :: CULLong -> Maybe Int
toMaybe CULLong
0 = Maybe Int
forall a. Maybe a
Nothing
toMaybe CULLong
n = Int -> Maybe Int
forall a. a -> Maybe a
Just (CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
n)
{-# INLINE toMaybe #-}

foreign import ccall unsafe "udev_device_get_seqnum"
  c_getSeqnum :: Device -> IO CULLong

-- | This is only valid if the device was received through a
-- monitor. Devices read from sys do not have a sequence number.
--
getSeqnum :: Device -> IO (Maybe Int)
getSeqnum :: Device -> IO (Maybe Int)
getSeqnum Device
dev = CULLong -> Maybe Int
toMaybe (CULLong -> Maybe Int) -> IO CULLong -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Device -> IO CULLong
c_getSeqnum Device
dev
{-# INLINE getSeqnum #-}

foreign import ccall unsafe "udev_device_get_usec_since_initialized"
  c_getUsecSinceInitialized :: Device -> IO CULLong

-- | Return the number of microseconds passed since udev set up the
-- device for the first time.
--
--   This is only implemented for devices with need to store
--   properties in the udev database. All other devices return
--   'Nothing' here.
--
getUsecSinceInitialized :: Device -> IO (Maybe Int)
getUsecSinceInitialized :: Device -> IO (Maybe Int)
getUsecSinceInitialized Device
dev = CULLong -> Maybe Int
toMaybe (CULLong -> Maybe Int) -> IO CULLong -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Device -> IO CULLong
c_getUsecSinceInitialized Device
dev

foreign import ccall unsafe "udev_device_has_tag"
  c_hasTag :: Device -> CString -> IO CInt

-- | Check if a given device has a certain tag associated.
hasTag :: Device -> ByteString -> IO Bool
hasTag :: Device -> RawFilePath -> IO Bool
hasTag Device
dev RawFilePath
tag =
  (CInt
1 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
==) (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    RawFilePath -> (CString -> IO CInt) -> IO CInt
forall a. RawFilePath -> (CString -> IO a) -> IO a
useAsCString RawFilePath
tag (\ CString
c_tag ->
      Device -> CString -> IO CInt
c_hasTag Device
dev CString
c_tag)