blink1 0.2 → 0.3

raw patch · 5 files changed

+72/−56 lines, 5 filesdep −ioctlPVP ok

version bump matches the API change (PVP)

Dependencies removed: ioctl

API changes (from Hackage documentation)

Files

• System/Hardware/Blink1.hs +26/−23
• System/Hardware/Blink1/Linux.hs +5/−5
• System/Hardware/Blink1/Types.hs +26/−12
• System/Linux/HIDRaw.hsc +11/−13
• blink1.cabal +4/−3

@@ -1,21 +1,22 @@ module System.Hardware.Blink1   ( RGB(..)-  , Delay-  , Pos+  , Delay(..)+  , PatternStep    , getVersion-  , set-  , fade-  , serverDown-  , play+  , setColor+  , fadeToColor+  , setServerDown+  , playPattern   , setPattern   , getPattern   , getSerialNum   , setSerialNum+  , testBlink1   ) where  import Control.Concurrent (threadDelay)-import Control.Monad (guard, liftM)+import Control.Monad (liftM) import Data.Bits (shiftR, shiftL, (.|.)) import Data.Char (chr, ord) import Data.List (foldl')@@ -60,30 +61,30 @@   t = truncate (100 * d) :: Word16   i = fi :: Word16 -> Word8 -pos :: Pos -> [Word8]+pos :: PatternStep -> [Word8] pos p = [fi (fromEnum p)]  -- | set the given color now-set :: Blink1 b => b -> RGB -> IO ()-set b c = command b 'n' $ rgb c+setColor :: Blink1 b => b -> RGB -> IO ()+setColor b c = command b 'n' $ rgb c -fade :: Blink1 b => b -> Delay -> RGB -> IO ()-fade b d c = command b 'c' $ rgb c ++ delay d+fadeToColor :: Blink1 b => b -> Delay -> RGB -> IO ()+fadeToColor b d c = command b 'c' $ rgb c ++ delay d  -- | enable/disable serverdown mode-serverDown :: Blink1 b => b -> Bool -> Delay -> IO ()-serverDown b o d = command b 'D' $ fi (fromEnum o) : delay d+setServerDown :: Blink1 b => b -> Bool -> Delay -> IO ()+setServerDown b o d = command b 'D' $ fi (fromEnum o) : delay d  -- | stop or start playing the sequence at the given position-play :: Blink1 b => b -> Maybe Pos -> IO ()-play b Nothing = command b 'p' [0]-play b (Just p) = command b 'p' $ 1 : pos p+playPattern :: Blink1 b => b -> Maybe PatternStep -> IO ()+playPattern b Nothing = command b 'p' [0]+playPattern b (Just p) = command b 'p' $ 1 : pos p  -- | set the sequence pattern for the given position-setPattern :: Blink1 b => b -> Pos -> Delay -> RGB -> IO ()+setPattern :: Blink1 b => b -> PatternStep -> Delay -> RGB -> IO () setPattern b p d c = command b 'P' $ rgb c ++ delay d ++ pos p -getPattern :: Blink1 b => b -> Pos -> IO (Delay, RGB)+getPattern :: Blink1 b => b -> PatternStep -> IO (Delay, RGB) getPattern b p = do   _:r:g:b:d1:d2:_ <- request b 'R' $ rgb black ++ delay 0 ++ pos p   return (fi (i d1 `shiftL` 8 .|. i d2) / 100, RGB r g b)@@ -109,7 +110,9 @@ 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-  x:y:u:_ <- request b '!' []-  return $ guard (x == 0x55 && y == 0xAA) >> return (u /= 0)+testBlink1 :: Blink1 b => b -> IO (Either [Word8] Bool)+testBlink1 b = do+  r <- request b '!' []+  return $ case r of+    0x55:0xAA:u:_ -> Right (u /= 0)+    _ -> Left r

@@ -11,9 +11,8 @@ import Data.List (isPrefixOf, genericLength) import Foreign.C.Error (errnoToIOError, eFTYPE) -- hack import Numeric (readHex)-import System.IO.Error (ioError, mkIOError, fullErrorType, doesNotExistErrorType)+import System.IO.Error (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@@ -43,13 +42,14 @@       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+      (_,':':vs) <- rh f+      (v,':':ps) <- rh vs       guard (v == blink1Vendor)-      (p,'.':_) <- readHex ps+      (p,'.':_) <- rh ps       guard (p == blink1Product)) = return mzero     | otherwise = pds fp (hiddir ++ '/' : f ++ "/hidraw")   fp f = return $ guard ("hidraw" `isPrefixOf` f) >> return f+  rh = readHex  -- | Search for and open the first blink(1) hidraw device openRawHID :: IO Blink1Raw

@@ -1,17 +1,17 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} module System.Hardware.Blink1.Types   ( Word8   , RGB(..)   , black   , Delay(..)-  , Pos(..)+  , PatternStep(..)   , EEPROMAddr(..)   , serialNumLen   ) where  import Data.Word (Word8) import Data.Fixed (Centi)-import Numeric (showHex)+import Numeric (showHex, readHex)  data RGB = RGB { red, green, blue :: !Word8 } @@ -26,6 +26,19 @@ instance Show RGB where   showsPrec _ (RGB r g b) = showChar '#' . showHex2 r . showHex2 g . showHex2 b +instance Read RGB where+  readsPrec _ ('#':c) = rc2 c ++ rc1 c where+    rc1 (r:g:b:s) = rc (0x11*) [r] [g] [b] s+    rc1 _ = []+    rc2 (r1:r2:g1:g2:b1:b2:s) = rc id [r1,r2] [g1,g2] [b1,b2] s+    rc2 _ = []+    rc f r g b s = do+      (r,"") <- readHex r+      (g,"") <- readHex g+      (b,"") <- readHex b+      return (RGB (f r) (f g) (f b), s)+  readsPrec _ _ = []+ -- | time is counted in centiseconds newtype Delay = Delay { delayCentiseconds :: Centi } deriving (Eq, Ord, Num, Real, Fractional, RealFrac) @@ -35,13 +48,19 @@  instance Show Delay where   showsPrec p (Delay s) = showsPrec p s . showChar 's'+#if MIN_VERSION_base(4,4,0)+instance Read Delay where+  readsPrec p = map f . readsPrec p where+    f (x,'s':s) = (Delay x, s)+    f (x,s) = (Delay x, s)+#endif  -- | positions are counted 0-11-newtype Pos = Pos Word8 deriving (Eq, Ord, Enum, Num)+newtype PatternStep = PatternStep Word8 deriving (Eq, Ord, Enum, Num, Show, Read) -instance Bounded Pos where-  minBound = Pos 0-  maxBound = Pos 11+instance Bounded PatternStep where+  minBound = PatternStep 0+  maxBound = PatternStep 11  data EEPROMAddr   = EEOSCCAL@@ -70,8 +89,3 @@ instance Bounded EEPROMAddr where   minBound = EEOSCCAL   maxBound = EEPatternStart--data BootMode-  = BootNormal-  | BootNightLight-  deriving (Eq, Ord, Enum, Bounded)

@@ -11,16 +11,22 @@ import Data.Word (Word8, Word16, Word32) import Foreign.C.Error import Foreign.C.Types-import Foreign.Ptr (Ptr, castPtr)+import Foreign.Ptr (Ptr)+import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Array import Foreign.Storable-import System.IO.Error (ioError) import System.Posix.Types (Fd)-import System.Posix.IOCtl  #include <sys/ioctl.h> #include <linux/hidraw.h> +-- the ioctl package doesn't support variable-length data, so we call them directly++foreign import ccall unsafe "ioctl" c_ioctl :: CInt -> CInt -> Ptr a -> IO CInt++ioctl :: Storable p => Fd -> CInt -> Ptr p -> IO ()+ioctl f r p = throwErrnoIfMinus1_ "ioctl" $ c_ioctl (fromIntegral f) r p+ data DevInfo = DevInfo    { devBustype :: Word32   , devVendor :: Word16@@ -40,21 +46,13 @@     #{poke struct hidraw_devinfo, vendor} p v     #{poke struct hidraw_devinfo, product} p i -data HIDIOCGRAWINFO = HIDIOCGRAWINFO-instance IOControl HIDIOCGRAWINFO DevInfo where-  ioctlReq _ = #const HIDIOCGRAWINFO- devInfo :: Fd -> IO DevInfo-devInfo d = ioctl' d HIDIOCGRAWINFO---- 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+devInfo d = alloca $ \p -> ioctl d #{const HIDIOCGRAWINFO} p >> peek p  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)+  | otherwise = ioctl f (r .|. (len `shiftL` shift)) p   where      len = fromIntegral $ l * sizeOf (ptrType p)     ptrType :: Ptr p -> p

@@ -1,5 +1,5 @@ Name:		blink1-Version:	0.2+Version:	0.3 Author:		Dylan Simon Maintainer:     dylan@dylex.net License:        BSD3@@ -16,15 +16,16 @@     Location:   http://github.com/dylex/blink  Flag usb-    Description:        Enable libusb-based usb interface+    Description:        Enable libusb-based usb backend  Library     Build-Depends:	base == 4.*     Exposed-Modules:    System.Hardware.Blink1     Other-Modules:      System.Hardware.Blink1.Types, System.Hardware.Blink1.Class+    ghc-options:        -Wall -fno-warn-name-shadowing      if os(linux)-        Build-Depends:	unix, ioctl+        Build-Depends:	unix         Exposed-Modules: System.Hardware.Blink1.Linux         Other-Modules:	System.Linux.HIDRaw