module System.Hardware.Blink1.Linux
( Blink1Raw
, openRawDev
, openRawHID
, openRawHIDs
, closeRaw
) where
import Control.Exception (onException, bracket)
import Control.Monad
import Data.List (isPrefixOf, genericLength)
import Foreign.C.Error (errnoToIOError, eFTYPE)
import Numeric (readHex)
import System.IO.Error (ioError, mkIOError, fullErrorType, doesNotExistErrorType)
import System.Posix.IO
import System.Posix.IOCtl
import System.Posix.Directory (openDirStream, readDirStream, closeDirStream)
import System.Posix.Types (Fd)
import Foreign.Marshal.Array
import System.Linux.HIDRaw
import System.Hardware.Blink1.Types
import System.Hardware.Blink1.Class
newtype Blink1Raw = Blink1Raw Fd
openRawDev :: FilePath -> IO Blink1Raw
openRawDev f = do
d <- openFd df ReadWrite Nothing defaultFileFlags
i <- devInfo d `onException` closeFd d
when (devVendor i /= blink1Vendor || devProduct i /= blink1Product) $ do
closeFd d
ioError $ errnoToIOError "not Blink1" eFTYPE Nothing (Just f)
return $ Blink1Raw d
where df = case f of { '/':_ -> f ; _ -> "/dev/" ++ f }
findRawDev :: MonadPlus m => IO (m String)
findRawDev = pds dp hiddir where
hiddir = "/sys/bus/hid/devices"
pds f d = bracket (openDirStream d) closeDirStream r where
r d = do
e <- readDirStream d
if null e then return mzero else liftM2 mplus (f e) (r d)
dp f | null (do
(_,':':vs) <- readHex f
(v,':':ps) <- readHex vs
guard (v == blink1Vendor)
(p,'.':_) <- readHex ps
guard (p == blink1Product)) = return mzero
| otherwise = pds fp (hiddir ++ '/' : f ++ "/hidraw")
fp f = return $ guard ("hidraw" `isPrefixOf` f) >> return f
openRawHID :: IO Blink1Raw
openRawHID = maybe
(ioError $ mkIOError doesNotExistErrorType "Blink1.openRawHID" Nothing Nothing)
openRawDev =<< findRawDev
openRawHIDs :: IO [Blink1Raw]
openRawHIDs = mapM openRawDev =<< findRawDev
writeRaw :: Blink1Raw -> [Word8] -> IO ()
writeRaw (Blink1Raw d) x = do
let l = genericLength x
r <- withArray x $ \p -> fdWriteBuf d p l
when (r /= l) $ ioError $ mkIOError fullErrorType "Blink1Raw: short write" Nothing Nothing
readRaw :: Blink1Raw -> Int -> IO [Word8]
readRaw (Blink1Raw d) n = tail `liftM` getFeature d n
closeRaw :: Blink1Raw -> IO ()
closeRaw (Blink1Raw d) = closeFd d
instance Blink1 Blink1Raw where
writeBlink1 = writeRaw
readBlink1 = readRaw
closeBlink1 = closeRaw