-- |
--   Copyright   :  (c) Sam Truzjan 2013
--   License     :  BSD3
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  experimental
--   Portability :  portable
--
--   Libudev list operations.
--
module System.UDev.List
       ( List

       , getNext
       , getByName

       , getName
       , getValue
       ) where

import Control.Monad
import Data.ByteString
import Foreign.C.String

import System.UDev.Types

foreign import ccall unsafe "udev_list_entry_get_next"
  c_getNext :: List -> IO List

foreign import ccall unsafe "udev_list_entry_get_by_name"
  c_getByName :: List -> IO List

foreign import ccall unsafe "udev_list_entry_get_name"
  c_getName :: List -> IO CString

foreign import ccall unsafe "udev_list_entry_get_value"
  c_getValue :: List -> IO CString

-- | Get the next entry from the list.
getNext :: List -> IO (Maybe List)
getNext :: List -> IO (Maybe List)
getNext List
xxs = do
  List
xs <- List -> IO List
c_getNext List
xxs
  Maybe List -> IO (Maybe List)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe List -> IO (Maybe List)) -> Maybe List -> IO (Maybe List)
forall a b. (a -> b) -> a -> b
$ if List
xs List -> List -> Bool
forall a. Eq a => a -> a -> Bool
== List
nil then Maybe List
forall a. Maybe a
Nothing else List -> Maybe List
forall a. a -> Maybe a
Just List
xs

-- | Lookup an entry in the list with a certain name.
getByName :: List -> IO (Maybe List)
getByName :: List -> IO (Maybe List)
getByName List
xs = do
  List
ys <- List -> IO List
c_getByName List
xs
  Maybe List -> IO (Maybe List)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe List -> IO (Maybe List)) -> Maybe List -> IO (Maybe List)
forall a b. (a -> b) -> a -> b
$ if List
ys List -> List -> Bool
forall a. Eq a => a -> a -> Bool
== List
nil then Maybe List
forall a. Maybe a
Nothing else List -> Maybe List
forall a. a -> Maybe a
Just List
ys

-- TODO avoid copying?
-- | Get the name of a list entry.
getName :: List -> IO ByteString
getName :: List -> IO ByteString
getName = List -> IO CString
c_getName (List -> IO CString)
-> (CString -> IO ByteString) -> List -> IO ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CString -> IO ByteString
packCString

-- | Get the value of list entry.
getValue :: List -> IO ByteString
getValue :: List -> IO ByteString
getValue = List -> IO CString
c_getValue (List -> IO CString)
-> (CString -> IO ByteString) -> List -> IO ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CString -> IO ByteString
packCString