large portion
[hsv4l2:phischus-v4l2.git] / Graphics / V4L2 / Device.hs
1 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
2 {- |
3 Module      : Graphics.V4L2.Device
4 Maintainer  : claudiusmaximus@goto10.org
5 Stability   : no
6 Portability : no
7 -}
8 module Graphics.V4L2.Device
9   ( Device()
10   , openDevice
11   , closeDevice
12   , withDevice
13   ) where
14
15 import Control.Exception (bracket)
16 import Data.Bits (Bits)
17 import Data.Typeable (Typeable)
18 import Foreign.C.Error (throwErrnoIfMinus1, throwErrnoIfMinus1_)
19 import Foreign.C.String (withCString)
20 import Foreign.Storable (Storable)
21 import System.Posix.Types (Fd)
22
23 import Bindings.LibV4L2 (c'v4l2_open, c'v4l2_close)
24 import Bindings.Posix.Fcntl (c'O_RDWR)
25
26 {- |  Device handle. -}
27 newtype Device = Device Fd
28   deriving (Bits, Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show, Storable, Typeable)
29
30 {- |  Open a device.
31       Fails with invalid argument when the device is not a V4L2 device.
32 -}
33 openDevice :: FilePath {- ^ device name -} -> IO Device
34 openDevice f = withCString f $ \s -> do
35   h <- throwErrnoIfMinus1 "Graphics.V4L2.Device.openDevice" (c'v4l2_open s c'O_RDWR 0)
36   return (fromIntegral h)
37
38 {- |  Close a device. -}
39 closeDevice :: Device {- ^ device handle -} -> IO ()
40 closeDevice d = throwErrnoIfMinus1_ "Graphics.V4L2.Device.closeDevice" (c'v4l2_close (fromIntegral d))
41
42 {- |  Perform an action with a device.
43       The device will be close on exit from withDevice, whether by
44       normal termination or by raising an exception.  If closing the
45       device raises an exception, then this exception will be raised by
46       'withDevice' rather than any exception raised by the action.
47 -}
48 withDevice :: FilePath {- ^ device name -} -> (Device -> IO a) {- ^ action -} -> IO a
49 withDevice f = bracket (openDevice f) closeDevice