{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
module System.UDev.Context
(
UDev
, UDevChild (..)
, newUDev
, freeUDev
, withUDev
, Priority (..)
, Logger
, getLogPriority
, setLogPriority
, setLogger
, defaultLogger
, getUserdata
, setUserdata
) where
import Control.Applicative
import Control.Monad (void)
import Control.Exception
import Data.ByteString as BS
import Data.ByteString.Char8 as BC
import Foreign (Ptr, FunPtr)
import Foreign.C.String
import Foreign.C.Types
import Unsafe.Coerce
import System.UDev.Types
foreign import ccall unsafe "udev_new"
c_new :: IO UDev
newUDev :: IO UDev
newUDev :: IO UDev
newUDev = IO UDev
c_new
freeUDev :: UDev -> IO ()
freeUDev :: UDev -> IO ()
freeUDev = IO UDev -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO UDev -> IO ()) -> (UDev -> IO UDev) -> UDev -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UDev -> IO UDev
forall a. Ref a => a -> IO a
unref
withUDev :: (UDev -> IO a) -> IO a
withUDev :: (UDev -> IO a) -> IO a
withUDev = IO UDev -> (UDev -> IO ()) -> (UDev -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO UDev
newUDev UDev -> IO ()
freeUDev
data Priority = LogError
| LogInfo
| LogDebug
deriving (Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
(Int -> Priority -> ShowS)
-> (Priority -> String) -> ([Priority] -> ShowS) -> Show Priority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Priority] -> ShowS
$cshowList :: [Priority] -> ShowS
show :: Priority -> String
$cshow :: Priority -> String
showsPrec :: Int -> Priority -> ShowS
$cshowsPrec :: Int -> Priority -> ShowS
Show, ReadPrec [Priority]
ReadPrec Priority
Int -> ReadS Priority
ReadS [Priority]
(Int -> ReadS Priority)
-> ReadS [Priority]
-> ReadPrec Priority
-> ReadPrec [Priority]
-> Read Priority
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Priority]
$creadListPrec :: ReadPrec [Priority]
readPrec :: ReadPrec Priority
$creadPrec :: ReadPrec Priority
readList :: ReadS [Priority]
$creadList :: ReadS [Priority]
readsPrec :: Int -> ReadS Priority
$creadsPrec :: Int -> ReadS Priority
Read, Priority -> Priority -> Bool
(Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool) -> Eq Priority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c== :: Priority -> Priority -> Bool
Eq, Eq Priority
Eq Priority
-> (Priority -> Priority -> Ordering)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Priority)
-> (Priority -> Priority -> Priority)
-> Ord Priority
Priority -> Priority -> Bool
Priority -> Priority -> Ordering
Priority -> Priority -> Priority
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 :: Priority -> Priority -> Priority
$cmin :: Priority -> Priority -> Priority
max :: Priority -> Priority -> Priority
$cmax :: Priority -> Priority -> Priority
>= :: Priority -> Priority -> Bool
$c>= :: Priority -> Priority -> Bool
> :: Priority -> Priority -> Bool
$c> :: Priority -> Priority -> Bool
<= :: Priority -> Priority -> Bool
$c<= :: Priority -> Priority -> Bool
< :: Priority -> Priority -> Bool
$c< :: Priority -> Priority -> Bool
compare :: Priority -> Priority -> Ordering
$ccompare :: Priority -> Priority -> Ordering
$cp1Ord :: Eq Priority
Ord, Int -> Priority
Priority -> Int
Priority -> [Priority]
Priority -> Priority
Priority -> Priority -> [Priority]
Priority -> Priority -> Priority -> [Priority]
(Priority -> Priority)
-> (Priority -> Priority)
-> (Int -> Priority)
-> (Priority -> Int)
-> (Priority -> [Priority])
-> (Priority -> Priority -> [Priority])
-> (Priority -> Priority -> [Priority])
-> (Priority -> Priority -> Priority -> [Priority])
-> Enum Priority
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Priority -> Priority -> Priority -> [Priority]
$cenumFromThenTo :: Priority -> Priority -> Priority -> [Priority]
enumFromTo :: Priority -> Priority -> [Priority]
$cenumFromTo :: Priority -> Priority -> [Priority]
enumFromThen :: Priority -> Priority -> [Priority]
$cenumFromThen :: Priority -> Priority -> [Priority]
enumFrom :: Priority -> [Priority]
$cenumFrom :: Priority -> [Priority]
fromEnum :: Priority -> Int
$cfromEnum :: Priority -> Int
toEnum :: Int -> Priority
$ctoEnum :: Int -> Priority
pred :: Priority -> Priority
$cpred :: Priority -> Priority
succ :: Priority -> Priority
$csucc :: Priority -> Priority
Enum, Priority
Priority -> Priority -> Bounded Priority
forall a. a -> a -> Bounded a
maxBound :: Priority
$cmaxBound :: Priority
minBound :: Priority
$cminBound :: Priority
Bounded)
prioToNr :: Priority -> CInt
prioToNr :: Priority -> CInt
prioToNr Priority
LogError = CInt
3
prioToNr Priority
LogInfo = CInt
6
prioToNr Priority
LogDebug = CInt
7
nrToPrio :: CInt -> IO Priority
nrToPrio :: CInt -> IO Priority
nrToPrio CInt
3 = Priority -> IO Priority
forall (f :: * -> *) a. Applicative f => a -> f a
pure Priority
LogError
nrToPrio CInt
6 = Priority -> IO Priority
forall (f :: * -> *) a. Applicative f => a -> f a
pure Priority
LogInfo
nrToPrio CInt
7 = Priority -> IO Priority
forall (f :: * -> *) a. Applicative f => a -> f a
pure Priority
LogDebug
nrToPrio CInt
n = PatternMatchFail -> IO Priority
forall e a. Exception e => e -> IO a
throwIO (PatternMatchFail -> IO Priority)
-> PatternMatchFail -> IO Priority
forall a b. (a -> b) -> a -> b
$ String -> PatternMatchFail
PatternMatchFail String
msg
where
msg :: String
msg = String
"unknown priority number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
n
foreign import ccall unsafe "udev_get_log_priority"
c_getLogPriority :: UDev -> IO CInt
getLogPriority :: UDev -> IO Priority
getLogPriority :: UDev -> IO Priority
getLogPriority UDev
udev = CInt -> IO Priority
nrToPrio (CInt -> IO Priority) -> IO CInt -> IO Priority
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UDev -> IO CInt
c_getLogPriority UDev
udev
foreign import ccall unsafe "udev_set_log_priority"
c_setLogPriority :: UDev -> CInt -> IO ()
setLogPriority :: UDev -> Priority -> IO ()
setLogPriority :: UDev -> Priority -> IO ()
setLogPriority UDev
udev Priority
prio = UDev -> CInt -> IO ()
c_setLogPriority UDev
udev (Priority -> CInt
prioToNr Priority
prio)
type CLogger = UDev -> CInt -> CString -> CInt -> CString -> CString -> IO ()
type Logger = UDev
-> Priority
-> ByteString
-> Int
-> ByteString
-> ByteString
-> IO ()
marshLogger :: Logger -> CLogger
marshLogger :: Logger -> CLogger
marshLogger Logger
logger UDev
udev CInt
c_priority CString
c_file CInt
c_line CString
c_fn CString
c_format = do
ByteString
file <- CString -> IO ByteString
packCString CString
c_file
ByteString
fn <- CString -> IO ByteString
packCString CString
c_fn
ByteString
format <- CString -> IO ByteString
packCString CString
c_format
Priority
prio <- CInt -> IO Priority
nrToPrio CInt
c_priority
Logger
logger UDev
udev Priority
prio ByteString
file (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_line) ByteString
fn ByteString
format
foreign import ccall "wrapper"
mkLogger :: CLogger -> IO (FunPtr CLogger)
foreign import ccall "udev_set_log_fn"
c_setLogger :: UDev -> FunPtr CLogger -> IO ()
setLogger :: UDev -> Logger -> IO ()
setLogger :: UDev -> Logger -> IO ()
setLogger UDev
udev Logger
logger = UDev -> FunPtr CLogger -> IO ()
c_setLogger UDev
udev (FunPtr CLogger -> IO ()) -> IO (FunPtr CLogger) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CLogger -> IO (FunPtr CLogger)
mkLogger (Logger -> CLogger
marshLogger Logger
logger)
defaultLogger :: Logger
defaultLogger :: Logger
defaultLogger UDev
_ Priority
priority ByteString
file Int
line ByteString
fn ByteString
format =
ByteString -> IO ()
BC.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat
[ String -> ByteString
BC.pack (Priority -> String
forall a. Show a => a -> String
show Priority
priority), ByteString
" "
, ByteString
file, ByteString
":", String -> ByteString
BC.pack (Int -> String
forall a. Show a => a -> String
show Int
line), ByteString
":\n"
, ByteString
" ", ByteString
fn, ByteString
": ", ByteString
format
]
foreign import ccall unsafe "udev_get_userdata"
c_getUserdata :: UDev -> IO (Ptr ())
getUserdata :: UDev -> IO a
getUserdata :: UDev -> IO a
getUserdata UDev
udev = Ptr () -> a
forall a b. a -> b
unsafeCoerce (Ptr () -> a) -> IO (Ptr ()) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UDev -> IO (Ptr ())
c_getUserdata UDev
udev
foreign import ccall unsafe "udev_set_userdata"
c_setUserdata :: UDev -> Ptr () -> IO ()
setUserdata :: UDev -> a -> IO ()
setUserdata :: UDev -> a -> IO ()
setUserdata UDev
udev a
ud = UDev -> Ptr () -> IO ()
c_setUserdata UDev
udev (a -> Ptr ()
forall a b. a -> b
unsafeCoerce a
ud)