blink1 0.3.1 → 0.4

raw patch · 9 files changed

+265/−37 lines, 9 filesdep +blink1dep −bindings-libusbdep ~basedep ~textnew-component:exe:blink1PVP ok

version bump matches the API change (PVP)

Dependencies added: blink1

Dependencies removed: bindings-libusb

Dependency ranges changed: base, text

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• System/Hardware/Blink1.hs +69/−13
• System/Hardware/Blink1/Class.hs +0/−1
• System/Hardware/Blink1/Dummy.hs +22/−0
• System/Hardware/Blink1/Linux.hs +10/−4
• System/Hardware/Blink1/Types.hs +12/−3
• System/Hardware/Blink1/USB.hs +12/−6
• blink1.cabal +18/−9
• blink1.hs +121/−0

@@ -1,4 +1,4 @@-Copyright (c) 2012-2013, Dylan Simon+Copyright (c) 2012-2014, Dylan Simon All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,15 +1,33 @@+{-|++  To use any of these functions, you first must open a blink(1) device (providing the 'System.Hardware.Blink1.Class.Blink' interface).+  Currently "System.Hardware.Blink1.Linux" and "System.Hardware.Blink1.USB" are provided.++  The functions ending with 2 provide functionality available on the blink(1) mk2, so are only likely to work if 'getVersion' returns @('2',_)@++-}+ module System.Hardware.Blink1   ( RGB(..), RGB8   , Delay(..)   , PatternStep+  , LED +  , closeBlink1   , getVersion+  , getColor2   , setColor+  , setColor2   , fadeToColor+  , fadeToColor2   , setServerDown+  , setServerDown2   , playPattern+  , playPattern2+  , getPlaying2   , setPattern   , getPattern+  , savePatterns2   , getSerialNum   , setSerialNum   , testBlink1@@ -50,46 +68,82 @@  getVersion :: Blink1 b => b -> IO (Char,Char) getVersion b = do-  _:_:maj:min:_ <- request b 'v' []-  return (chr (fi maj), chr (fi min))+  _:_:mj:mn:_ <- request b 'v' []+  return (chr (fi mj), chr (fi mn))  rgb :: RGB8 -> [Word8] rgb (RGB r g b) = [r,g,b]  delay :: Delay -> [Word8] delay d = [i $ t `shiftR` 8, i t] where -  t = truncate (100 * d) :: Word16+  t = delayCentiseconds d   i = fi :: Word16 -> Word8 -pos :: PatternStep -> [Word8]-pos p = [fi (fromEnum p)]+bool :: Bool -> Word8+bool = fi . fromEnum +pos :: PatternStep -> Word8+pos = patternStep++led :: Maybe LED -> Word8+led = maybe 0 whichLED++-- | query the current color.+getColor2 :: Blink1 b => b -> LED -> IO RGB8+getColor2 dev n = do+  _:r:g:b:_ <- request dev 'r' [0,0,0,0,0,led (Just n)]+  return $ RGB r g b+ -- | set the given color now setColor :: Blink1 b => b -> RGB8 -> IO ()-setColor b c = command b 'n' $ rgb c+setColor b = setColor2 b Nothing +-- | Although documented, this does not appear to work correctly.+setColor2 :: Blink1 b => b -> Maybe LED -> RGB8 -> IO ()+setColor2 b n c = command b 'n' $ rgb c ++ [0,0,led n]+ fadeToColor :: Blink1 b => b -> Delay -> RGB8 -> IO ()-fadeToColor b d c = command b 'c' $ rgb c ++ delay d+fadeToColor b = fadeToColor2 b Nothing --- | enable/disable serverdown mode+fadeToColor2 :: Blink1 b => b -> Maybe LED -> Delay -> RGB8 -> IO ()+fadeToColor2 b n d c = command b 'c' $ rgb c ++ delay d ++ [led n]++-- | enable/disable serverdown mode with the given timeout setServerDown :: Blink1 b => b -> Bool -> Delay -> IO ()-setServerDown b o d = command b 'D' $ fi (fromEnum o) : delay d+setServerDown b o d = setServerDown2 b o d False (PatternStep 0, PatternStep 0) +-- | enable/disable serverdown mode with the given timeout, optionally staying on afterwards, over the given pattern range+setServerDown2 :: Blink1 b => b -> Bool -> Delay -> Bool -> (PatternStep, PatternStep) -> IO ()+setServerDown2 b o d s (sp,ep) = command b 'D' $ bool o : delay d ++ [bool s, pos sp, pos ep]+ -- | stop or start playing the sequence at the given position playPattern :: Blink1 b => b -> Maybe PatternStep -> IO () playPattern b Nothing = command b 'p' [0]-playPattern b (Just p) = command b 'p' $ 1 : pos p+playPattern b (Just p) = command b 'p' [1, pos p] +-- | loop the sequence over a range some number of times.+playPattern2 :: Blink1 b => b -> (PatternStep, PatternStep) -> Word8 -> IO ()+playPattern2 b (sp, ep) n = command b 'p' [1, pos sp, pos ep, n]++-- | query the current play state.+getPlaying2 :: Blink1 b => b -> IO (Maybe (PatternStep, PatternStep, Word8, Word8))+getPlaying2 b = do+  _:a:sp:ep:n:i:_ <- request b 'S' []+  return $ if a > 0 then Just (PatternStep sp, PatternStep ep, n, i) else Nothing+ -- | set the sequence pattern for the given position setPattern :: Blink1 b => b -> PatternStep -> Delay -> RGB8 -> IO ()-setPattern b p d c = command b 'P' $ rgb c ++ delay d ++ pos p+setPattern b p d c = command b 'P' $ rgb c ++ delay d ++ [pos p]  getPattern :: Blink1 b => b -> PatternStep -> IO (Delay, RGB8)-getPattern b p = do-  _:r:g:b:d1:d2:_ <- request b 'R' $ rgb black ++ delay 0 ++ pos p+getPattern dev p = do+  _:r:g:b:d1:d2:_ <- request dev 'R' $ rgb black ++ delay 0 ++ [pos p]   return (fi (i d1 `shiftL` 8 .|. i d2) / 100, RGB r g b)   where i = fi :: Word8 -> Word16 +savePatterns2 :: Blink1 b => b -> IO ()+savePatterns2 b = command b 'W' [0xBE,0xEF,0xCA,0xFE]+ eeaddr :: EEPROMAddr -> Word8 eeaddr = fi . fromEnum @@ -101,11 +155,13 @@ writeEEPROM :: Blink1 b => b -> EEPROMAddr -> Word8 -> IO () writeEEPROM b a v = command b 'E' [eeaddr a, v] +-- | This is only supported on mk1 devices. getSerialNum :: Blink1 b => b -> IO Word32 getSerialNum b =   foldl' (\l -> (l `shiftL` 8 .|.) . fi) 0 `liftM`      mapM (readEEPROM b . EESerialNum) [0..pred serialNumLen] +-- | This is only supported on mk1 devices. 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))

@@ -1,6 +1,5 @@ module System.Hardware.Blink1.Class   ( Blink1(..)-  , Word8   , blink1Vendor, blink1Product   ) where 

@@ -0,0 +1,22 @@+module System.Hardware.Blink1.Dummy+  ( Blink1Dummy+  , openDummy+  ) where++import Data.Char (chr)+import Data.List (intercalate)+import System.Hardware.Blink1.Class++data Blink1Dummy = Blink1Dummy+  { _verbose :: Bool+  }++openDummy :: Bool -> Blink1Dummy+openDummy = Blink1Dummy++instance Blink1 Blink1Dummy where+  writeBlink1 (Blink1Dummy False) _ = return ()+  writeBlink1 (Blink1Dummy True) (1:c:l) = putStrLn (chr (fromIntegral c):':':intercalate "," (map show l))+  writeBlink1 (Blink1Dummy True) l = print l+  readBlink1 _ n = return (replicate n 0)+  closeBlink1 _ = return ()

@@ -1,14 +1,20 @@+{-|++  Blink(1) hardware interface using Linux's /dev/hidraw* devices.++-}+ 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 Data.Word (Word8) import Foreign.C.Error (errnoToIOError, eFTYPE) -- hack import Numeric (readHex) import System.IO.Error (mkIOError, fullErrorType, doesNotExistErrorType)@@ -37,9 +43,9 @@ 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)+    r ds = do+      e <- readDirStream ds+      if null e then return mzero else liftM2 mplus (f e) (r ds)   dp f | null (do       (_,':':vs) <- rh f       (v,':':ps) <- rh vs

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-} module System.Hardware.Blink1.Types   ( RGB(..), RGB8   , black@@ -7,6 +8,7 @@   , PatternStep(..)   , EEPROMAddr(..)   , serialNumLen+  , LED(..)   ) where  import Control.Applicative@@ -120,12 +122,12 @@       ), s)  --- | positions are counted 0-11-newtype PatternStep = PatternStep Word8 deriving (Eq, Ord, Enum, Num, Show, Read)+-- | positions are counted 0-11 on mk1, 0-31 on mk2+newtype PatternStep = PatternStep { patternStep :: Word8 } deriving (Eq, Ord, Enum, Num, Show, Read)  instance Bounded PatternStep where   minBound = PatternStep 0-  maxBound = PatternStep 11+  maxBound = PatternStep 31 -- 11 on mk1  data EEPROMAddr   = EEOSCCAL@@ -154,3 +156,10 @@ instance Bounded EEPROMAddr where   minBound = EEOSCCAL   maxBound = EEPatternStart++-- | LEDs are 1-based (0 means "all")+newtype LED = LED { whichLED :: Word8 } deriving (Eq, Ord, Enum, Num, Show, Read)++instance Bounded LED where+  minBound = LED 1+  maxBound = LED maxBound

@@ -1,12 +1,18 @@+{-|++  Blink(1) hardware interface using libusb.++-}+ module System.Hardware.Blink1.USB   ( Blink1USB   , openUSB   , openUSBs-  , closeUSB   , getSerialNumber   ) where  import Control.Monad+import Data.Word (Word8) import System.IO.Error (mkIOError, doesNotExistErrorType) import System.USB import qualified Data.Vector as V@@ -28,11 +34,11 @@  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+  dev <- openDevice d+  kda <- kernelDriverActive dev interface+  when kda $ detachKernelDriver dev interface+  claimInterface dev interface+  return $ Blink1USB dev  openUSB :: IO Blink1USB openUSB = do

@@ -1,5 +1,5 @@ Name:		blink1-Version:	0.3.1+Version:	0.4 Author:		Dylan Simon Maintainer:     dylan@dylex.net License:        BSD3@@ -8,8 +8,8 @@ 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-tested-with:	GHC == 7.6.1+Cabal-Version:	>= 1.8+tested-with:	GHC == 7.8.3  Source-Repository head     Type:	git@@ -20,15 +20,24 @@  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+    Exposed-Modules:    System.Hardware.Blink1, System.Hardware.Blink1.Types, System.Hardware.Blink1.Class, System.Hardware.Blink1.Dummy+    ghc-options: -Wall      if os(linux)         Build-Depends:	unix-        Exposed-Modules: System.Hardware.Blink1.Linux-        Other-Modules:	System.Linux.HIDRaw+        Exposed-Modules: System.Hardware.Blink1.Linux, System.Linux.HIDRaw      if flag(usb)-        Build-Depends:  usb, bindings-libusb, vector, text, bytestring+        Build-Depends:  usb, vector, text < 1.2, bytestring         Exposed-Modules: System.Hardware.Blink1.USB++Executable blink1+    main-is: blink1.hs+    build-depends: base, blink1+    if os(linux)+        build-depends: unix+        CPP-options: -DUSE_LINUX+    if flag(usb)+        Build-Depends: usb, vector, text < 1.2, bytestring+        CPP-options: -DUSE_USB+    ghc-options: -Wall

@@ -0,0 +1,121 @@+{-# LANGUAGE CPP, RankNTypes #-}++import Control.Applicative ((<$>), (<|>))+import Control.Monad (foldM)+import Data.Maybe (fromMaybe)+import System.Environment (getArgs)+import System.Exit (exitFailure)+import qualified System.Console.GetOpt as Opt++import System.Hardware.Blink1+import System.Hardware.Blink1.Class (Blink1)+import System.Hardware.Blink1.Dummy (Blink1Dummy, openDummy)+#ifdef USE_LINUX+import System.Hardware.Blink1.Linux (Blink1Raw, openRawHID, openRawDev)+#endif+#ifdef USE_USB+import System.Hardware.Blink1.USB (Blink1USB, openUSB)+#endif++data Dev+  = NoDev+  | DummyDev Blink1Dummy+#ifdef USE_LINUX+  | LinuxRawDev Blink1Raw+#endif+#ifdef USE_USB+  | USBDev Blink1USB+#endif++withDev :: Dev -> (forall b . Blink1 b => b -> a) -> a+withDev NoDev _ = error "No device opened"+withDev (DummyDev b) f = f b+#ifdef USE_LINUX+withDev (LinuxRawDev b) f = f b+#endif+#ifdef USE_USB+withDev (USBDev b) f = f b+#endif++withDev_ :: Dev -> (forall b . Blink1 b => b -> IO ()) -> IO ()+withDev_ NoDev _ = return ()+withDev_ d f = withDev d f++data State = State +  { dev :: !Dev+  , led :: Maybe LED+  , time :: Delay+  }++opening :: IO Dev -> State -> IO State+opening o s = do+  withDev_ (dev s) closeBlink1+  d <- o+  return s{ dev = d }++close :: State -> IO State+close = opening (return NoDev)++run :: (forall b . Blink1 b => b -> IO a) -> (a -> IO ()) -> State -> IO State+run f g s = withDev (dev s) f >>= g >> return s++options :: [Opt.OptDescr (State -> IO State)]+options =+  [ Opt.Option "D" ["dummy"]+      (Opt.NoArg $ opening (return $ DummyDev $ openDummy True))+      "open a dummy blink(1) device"+#ifdef USE_LINUX+  , Opt.Option "L" ["hidraw"]+      (Opt.OptArg (\f -> opening (LinuxRawDev <$> maybe openRawHID openRawDev f)) "DEVICE")+      "open a linux hidraw device"+#endif+#ifdef USE_USB+  , Opt.Option "U" ["usb"]+      (Opt.NoArg $ opening (USBDev <$> openUSB))+      "open a libusb device"+#endif+  , Opt.Option "V" ["version"]+      (Opt.NoArg $ run getVersion (\(a, b) -> putStrLn [a,'.',b]))+      "get the version number"+  , Opt.Option "T" ["test"]+      (Opt.NoArg $ run testBlink1 (putStrLn . either (\r -> "unexpected: " ++ show r) (\r -> if r then "pass" else "fail")))+      "issue the test command"+  , Opt.Option "S" ["serial"]+      (Opt.NoArg $ run getSerialNum print)+      "get the serial number (only works on mk1)"+  , Opt.Option "l" ["led"]+      (Opt.OptArg (\l s -> return s{ led = fmap (toEnum . read) l }) "INDEX")+      "apply the next actions only to LED INDEX [all]"+  , Opt.Option "g" ["get"]+      (Opt.OptArg (\l s -> do+        withDev (dev s) getColor2 (fromMaybe 0 (fmap (toEnum . read) l <|> led s)) >>= print+        return s) "LED")+      "get the current color of the LED"+  , Opt.Option "s" ["set"]+      (Opt.ReqArg (\c s -> do+        withDev (dev s) setColor2 (led s) (read c)+        return s) "RGB")+      "set the color immediately"+  , Opt.Option "t" ["time"]+      (Opt.ReqArg (\t s -> return s{ time = read t }) "DELAY")+      "set the delay/fade time for the next actions"+  , Opt.Option "f" ["fade"]+      (Opt.ReqArg (\c s -> do+        withDev (dev s) fadeToColor2 (led s) (time s) (read c)+        return s) "RGB")+      "fade to color over DELAY"+  ]++usage :: String+usage = Opt.usageInfo "Usage: blink1 [OPTIONS]" options++main :: IO State+main = do+  args <- getArgs+  r <- case Opt.getOpt Opt.RequireOrder options args of+    (r, [], []) -> return r+    (_, _, err) -> do+      mapM_ putStrLn err+      putStrLn usage+      exitFailure+  foldM (flip ($)) (State NoDev Nothing 0) r >>= close