blink1 0.1 → 0.2

raw patch · 7 files changed

+179/−26 lines, 7 filesdep +bindings-libusbdep +bytestringdep +textPVP ok

version bump matches the API change (PVP)

Dependencies added: bindings-libusb, bytestring, text, usb, vector

API changes (from Hackage documentation)

Files

• System/Hardware/Blink1.hs +21/−6
• System/Hardware/Blink1/Class.hs +3/−3
• System/Hardware/Blink1/Linux.hs +13/−5
• System/Hardware/Blink1/Types.hs +35/−0
• System/Hardware/Blink1/USB.hs +70/−0
• System/Linux/HIDRaw.hsc +28/−10
• blink1.cabal +9/−2

@@ -10,13 +10,16 @@   , play   , setPattern   , getPattern+  , getSerialNum+  , setSerialNum   ) where  import Control.Concurrent (threadDelay) import Control.Monad (guard, liftM) import Data.Bits (shiftR, shiftL, (.|.)) import Data.Char (chr, ord)-import Data.Word (Word16)+import Data.List (foldl')+import Data.Word (Word16, Word32) import System.Hardware.Blink1.Class import System.Hardware.Blink1.Types @@ -47,7 +50,7 @@ getVersion :: Blink1 b => b -> IO (Char,Char) getVersion b = do   _:_:maj:min:_ <- request b 'v' []-  return $ (chr (fi maj), chr (fi min))+  return (chr (fi maj), chr (fi min))  rgb :: RGB -> [Word8] rgb (RGB r g b) = [r,g,b]@@ -86,13 +89,25 @@   return (fi (i d1 `shiftL` 8 .|. i d2) / 100, RGB r g b)   where i = fi :: Word8 -> Word16 -readEEPROM :: Blink1 b => b -> Word8 -> IO Word8+eeaddr :: EEPROMAddr -> Word8+eeaddr = fi . fromEnum++readEEPROM :: Blink1 b => b -> EEPROMAddr -> IO Word8 readEEPROM b a = do-  _:_:v:_ <- request b 'e' [a]+  _:_:v:_ <- request b 'e' [eeaddr a]   return v -writeEEPROM :: Blink1 b => b -> Word8 -> Word8 -> IO ()-writeEEPROM b a v = command b 'E' [a, v]+writeEEPROM :: Blink1 b => b -> EEPROMAddr -> Word8 -> IO ()+writeEEPROM b a v = command b 'E' [eeaddr a, v]++getSerialNum :: Blink1 b => b -> IO Word32+getSerialNum b =+  foldl' (\l -> (l `shiftL` 8 .|.) . fi) 0 `liftM` +    mapM (readEEPROM b . EESerialNum) [0..pred serialNumLen]++setSerialNum :: Blink1 b => b -> Word32 -> IO ()+setSerialNum b s = mapM_ w [0..pred serialNumLen] where+  w i = writeEEPROM b (EESerialNum i) $ fi $ s `shiftR` (8*(3-fi i))  test :: Blink1 b => b -> IO (Maybe Bool) test b = do

@@ -3,14 +3,14 @@   , blink1Vendor, blink1Product   ) where -import Data.Int (Int16)-import Data.Word (Word8)+import Data.Word (Word8, Word16)  -- we could parameterize on monad too, if it comes to that class Blink1 b where   writeBlink1 :: b -> [Word8] -> IO ()   readBlink1 :: b -> Int -> IO [Word8]+  closeBlink1 :: b -> IO () -blink1Vendor, blink1Product :: Int16+blink1Vendor, blink1Product :: Word16 blink1Vendor = 0x27B8 blink1Product = 0x1ED

@@ -3,6 +3,7 @@   , openRawDev   , openRawHID   , openRawHIDs+  , closeRaw   ) where  import Control.Exception (onException, bracket)@@ -59,13 +60,20 @@ -- | Search for and open all blink(1) hidraw devices openRawHIDs :: IO [Blink1Raw] openRawHIDs = mapM openRawDev =<< findRawDev++writeRaw :: Blink1Raw -> [Word8] -> IO ()+writeRaw (Blink1Raw d) x = do -- setFeature d x+  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 (Blink1Raw d) x = do -- setFeature d x-    let l = genericLength x-    r <- withArray x $ \p -> fdWriteBuf d p l-    when (r /= l) $ ioError $ mkIOError fullErrorType "Blink1Raw: short write" Nothing Nothing-  readBlink1 (Blink1Raw d) n = getFeature d n+  writeBlink1 = writeRaw+  readBlink1 = readRaw+  closeBlink1 = closeRaw

@@ -5,6 +5,8 @@   , black   , Delay(..)   , Pos(..)+  , EEPROMAddr(..)+  , serialNumLen   ) where  import Data.Word (Word8)@@ -40,3 +42,36 @@ instance Bounded Pos where   minBound = Pos 0   maxBound = Pos 11++data EEPROMAddr+  = EEOSCCAL+  | EEBootMode+  | EESerialNum Word8+  | EEPatternStart+  deriving (Eq, Ord)++serialNumLen :: Word8+serialNumLen = 4++instance Enum EEPROMAddr where+  fromEnum EEOSCCAL = 0+  fromEnum EEBootMode = 1+  fromEnum (EESerialNum i) +    | i < serialNumLen = 2 + fromIntegral i+    | otherwise = error "EEPROMAddr.fromEnum: invalid EESerialNum"+  fromEnum EEPatternStart = 6+  toEnum 0 = EEOSCCAL+  toEnum 1 = EEBootMode+  toEnum 6 = EEPatternStart+  toEnum x +    | x >= 2 && x < 6 = EESerialNum (fromIntegral x-2)+    | otherwise = error "EEPROMAddr.toEnum: invalid address"++instance Bounded EEPROMAddr where+  minBound = EEOSCCAL+  maxBound = EEPatternStart++data BootMode+  = BootNormal+  | BootNightLight+  deriving (Eq, Ord, Enum, Bounded)

@@ -0,0 +1,70 @@+module System.Hardware.Blink1.USB+  ( Blink1USB+  , openUSB+  , openUSBs+  , closeUSB+  , getSerialNumber+  ) where++import Control.Monad+import System.IO.Error (ioError, mkIOError, doesNotExistErrorType)+import System.USB+import Bindings.Libusb.Descriptors (c'LIBUSB_CLASS_PER_INTERFACE, c'LIBUSB_CLASS_HID)+import qualified Data.Vector as V+import qualified Data.ByteString as BS (pack, unpack)+import qualified Data.Text as Text (unpack)+import System.Hardware.Blink1.Types+import System.Hardware.Blink1.Class++newtype Blink1USB = Blink1USB DeviceHandle++findUSBDev :: Ctx -> IO (V.Vector Device)+findUSBDev ctx = V.filterM (return . f <=< getDeviceDesc) =<< getDevices ctx where+  f d = deviceVendorId d == blink1Vendor +    && deviceProductId d == blink1Product +    && deviceClass d == c'LIBUSB_CLASS_PER_INTERFACE +    && deviceNumConfigs d == 1+    -- ideally we should check the interfaces, but blink(1) only has one++interface :: Num a => a+interface = 0++openDev :: Device -> IO Blink1USB+openDev d = do+  d <- openDevice d+  kda <- kernelDriverActive d interface+  when kda $ detachKernelDriver d interface+  claimInterface d interface+  return $ Blink1USB d++openUSB :: IO Blink1USB+openUSB = do+  ctx <- newCtx+  d <- findUSBDev ctx+  when (V.null d) $ ioError $ mkIOError doesNotExistErrorType "Blink1.openUSB" Nothing Nothing+  openDev (V.head d)++openUSBs :: IO [Blink1USB]+openUSBs = mapM openDev . V.toList =<< findUSBDev =<< newCtx++closeUSB :: Blink1USB -> IO ()+closeUSB (Blink1USB d) = do+  releaseInterface d interface+  -- should really reattach here+  closeDevice d++getSerialNumber :: Blink1USB -> IO String+getSerialNumber (Blink1USB d) = liftM Text.unpack $ maybe +  (ioError $ mkIOError doesNotExistErrorType "Blink1USB.getSerialNumber" Nothing Nothing) +  (\i -> getStrDescFirstLang d i 16) . deviceSerialNumberStrIx =<< getDeviceDesc (getDevice d)++writeUSB :: Blink1USB -> [Word8] -> IO ()+writeUSB (Blink1USB d) x = writeControlExact d Class ToInterface 0x09 0x301 interface (BS.pack x) 1000++readUSB :: Blink1USB -> Int -> IO [Word8]+readUSB (Blink1USB d) n = liftM (BS.unpack . fst) $ readControl d Class ToInterface 0x01 0x301 interface n 1000++instance Blink1 Blink1USB where+  writeBlink1 = writeUSB+  readBlink1 = readUSB+  closeBlink1 = closeUSB

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses, ForeignFunctionInterface #-} -- | Minimal interface to hidraw ioctls, sufficient for blink(1) module System.Linux.HIDRaw   ( DevInfo(..)@@ -7,10 +7,12 @@   , getFeature   ) where -import Data.Int (Int16)-import Data.Word (Word8, Word32)-import Foreign.C.Error (errnoToIOError, eOPNOTSUPP)-import Foreign.C.Types (CInt)+import Data.Bits ((.|.), shiftL)+import Data.Word (Word8, Word16, Word32)+import Foreign.C.Error+import Foreign.C.Types+import Foreign.Ptr (Ptr, castPtr)+import Foreign.Marshal.Array import Foreign.Storable import System.IO.Error (ioError) import System.Posix.Types (Fd)@@ -21,8 +23,8 @@  data DevInfo = DevInfo    { devBustype :: Word32-  , devVendor :: Int16-  , devProduct :: Int16+  , devVendor :: Word16+  , devProduct :: Word16   }  instance Storable DevInfo where@@ -45,9 +47,25 @@ devInfo :: Fd -> IO DevInfo devInfo d = ioctl' d HIDIOCGRAWINFO --- the ioctl package doesn't support these, so they're unimplemented for now+-- the ioctl package doesn't support variable-length data, so we call them directly++foreign import ccall unsafe "ioctl" c_ioctl :: CInt -> CInt -> Ptr () -> IO CInt++ioctlLen :: Storable p => Fd -> CInt -> Int -> Ptr p -> IO ()+ioctlLen f r l p +  | len > mask = ioError $ errnoToIOError "ioctlLen" eMSGSIZE Nothing Nothing+  | otherwise = throwErrnoIfMinus1_ "ioctl" $ c_ioctl (fromIntegral f) (r .|. (len `shiftL` shift)) (castPtr p)+  where +    len = fromIntegral $ l * sizeOf (ptrType p)+    ptrType :: Ptr p -> p+    ptrType _ = undefined+    shift = #const _IOC_SIZESHIFT+    mask = #const _IOC_SIZEMASK+ setFeature :: Fd -> [Word8] -> IO ()-setFeature d _ = ioError $ errnoToIOError "System.Linux.HIDRaw.setFeature" eOPNOTSUPP Nothing Nothing+setFeature d x = withArrayLen x $ ioctlLen d #{const HIDIOCSFEATURE(0)}  getFeature :: Fd -> Int -> IO [Word8]-getFeature d _ = ioError $ errnoToIOError "System.Linux.HIDRaw.getFeature" eOPNOTSUPP Nothing Nothing+getFeature d l = allocaArray l $ \p -> do+  ioctlLen d #{const HIDIOCGFEATURE(0)} l p+  peekArray l p

@@ -1,11 +1,11 @@ Name:		blink1-Version:	0.1+Version:	0.2 Author:		Dylan Simon Maintainer:     dylan@dylex.net License:        BSD3 License-File:	LICENSE Synopsis:	Control library for blink(1) LED from ThingM-Description:    Provides an interface to the ThingM blink(1) LED <http://thingm.com/products/blink-1.html> similar to (but not dependent on) <http://github.com/todbot/blink1>.  Currently only a partially-functional Linux HIDRAW-based interface is defined, but a libusb-based one is planned.+Description:    Provides an interface to the ThingM blink(1) LED <http://thingm.com/products/blink-1.html> similar to (but not dependent on) <http://github.com/todbot/blink1> via Linux hidraw or the libusb-based usb package. Category:	Hardware Build-Type:	Simple Cabal-Version:	>= 1.6@@ -15,6 +15,9 @@     Type:	git     Location:   http://github.com/dylex/blink +Flag usb+    Description:        Enable libusb-based usb interface+ Library     Build-Depends:	base == 4.*     Exposed-Modules:    System.Hardware.Blink1@@ -24,3 +27,7 @@         Build-Depends:	unix, ioctl         Exposed-Modules: System.Hardware.Blink1.Linux         Other-Modules:	System.Linux.HIDRaw++    if flag(usb)+        Build-Depends:  usb, bindings-libusb, vector, text, bytestring+        Exposed-Modules: System.Hardware.Blink1.USB