-- |
--   Copyright   :  (c) Sam Truzjan 2013
--   License     :  BSD3
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  stable
--   Portability :  portable
--
--   The context contains the default values read from the udev config
--   file, and is passed to all library operations.
--
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings        #-}
module System.UDev.Context
       ( -- * Context
         UDev
       , UDevChild (..)
       , newUDev
       , freeUDev
       , withUDev

         -- * Logging
       , Priority (..)
       , Logger
       , getLogPriority
       , setLogPriority
       , setLogger
       , defaultLogger

         -- * User data
       , 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

-- | Create udev library context. This reads the udev configuration
--   file, and fills in the default values.
--
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

-- | Like 'newUDev' but context will be released at exit.
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

{-----------------------------------------------------------------------
--  Logging
-----------------------------------------------------------------------}

-- | Log message priority.
data Priority = LogError -- ^ error conditions
              | LogInfo  -- ^ informational
              | LogDebug -- ^ debug-level messages
                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)

-- | Convert priority to priority code.
prioToNr :: Priority -> CInt
prioToNr :: Priority -> CInt
prioToNr Priority
LogError = CInt
3
prioToNr Priority
LogInfo  = CInt
6
prioToNr Priority
LogDebug = CInt
7

-- | Convert priority code to priority.
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

-- | The initial logging priority is read from the udev config file at
-- startup.
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 ()

-- | Set the current logging priority. The value controls which
-- messages are logged.
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 ()

-- | Logger function will called by udev on events.
type Logger  = UDev
            -> Priority   -- ^ message priority;
            -> ByteString -- ^ position: file
            -> Int        -- ^ position: line
            -> ByteString -- ^ position: function
            -> ByteString -- ^ message body
            -> 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 ()

-- | The built-in logging writes to stderr. It can be overridden by a
-- custom function, to plug log messages into the users' logging
-- functionality.
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)

-- | Default logger will just print @%PRIO %FILE:%LINE:\n%FN: %FORMAT@
-- to stdout.
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
    ]

{-----------------------------------------------------------------------
--  Userdata
-----------------------------------------------------------------------}

foreign import ccall unsafe "udev_get_userdata"
  c_getUserdata :: UDev -> IO (Ptr ())

-- | Retrieve stored data pointer from library context. This might be
-- useful to access from callbacks like a custom logging function.
--
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 ()

-- | Store custom userdata in the library context.
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)