usb 0.6.0.8 → 0.7
raw patch · 3 files changed
+119/−68 lines, 3 files
Files
- System/USB/IO/StandardDeviceRequests.hs +101/−54
- System/USB/Internal.hs +17/−13
- usb.cabal +1/−1
System/USB/IO/StandardDeviceRequests.hs view
@@ -7,12 +7,17 @@ -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> ----- This module provides functionality for performing standard device requests.+-- This module provides functions for performing standard device requests.+-- The functions are primarily used for testing USB devices. --+-- To avoid name clashes with functions from @System.USB@ it is advised to use+-- an explicit import list or a qualified import.+-- -------------------------------------------------------------------------------- module System.USB.IO.StandardDeviceRequests ( setHalt+ , setConfig, getConfig , clearRemoteWakeup , setRemoteWakeup , setStandardTestMode, TestMode(..)@@ -33,7 +38,9 @@ import Data.Bool ( Bool ) import Data.Data ( Data ) import Data.Eq ( Eq )-import Data.Functor ( (<$>) )+import Data.Function ( ($) )+import Data.Functor ( fmap )+import Data.Maybe ( Maybe(Nothing, Just), maybe ) import Data.Typeable ( Typeable ) import Data.Word ( Word8, Word16 ) import Prelude ( (+), fromIntegral, Enum )@@ -43,6 +50,7 @@ #if __GLASGOW_HASKELL__ < 700 import Prelude ( fromInteger )+import Data.Eq ( (==) ) #endif -- from base-unicode-symbols:@@ -51,10 +59,12 @@ import Prelude.Unicode ( (⋅) ) -- from bytestring:-import qualified Data.ByteString as B ( head, unpack )+import qualified Data.ByteString as B ( ByteString, head, unpack ) -- from bindings-libusb: import Bindings.Libusb ( c'LIBUSB_REQUEST_SET_FEATURE+ , c'LIBUSB_REQUEST_SET_CONFIGURATION+ , c'LIBUSB_REQUEST_GET_CONFIGURATION , c'LIBUSB_REQUEST_CLEAR_FEATURE , c'LIBUSB_REQUEST_GET_INTERFACE , c'LIBUSB_REQUEST_GET_STATUS@@ -64,9 +74,14 @@ -- from usb: import System.USB.DeviceHandling ( DeviceHandle+ , ConfigValue , InterfaceNumber , InterfaceAltSetting )+#if __HADDOCK__+import qualified System.USB.DeviceHandling as USB ( setConfig, getConfig )+#endif+ import System.USB.Descriptors ( EndpointAddress , DeviceStatus(..) )@@ -100,14 +115,51 @@ -- | See: USB 2.0 Spec. section 9.4.9 setHalt ∷ DeviceHandle → EndpointAddress → (Timeout → IO ())-setHalt devHndl endpointAddr =- control devHndl- Standard- ToEndpoint- c'LIBUSB_REQUEST_SET_FEATURE- haltFeature- (marshalEndpointAddress endpointAddr)+setHalt devHndl endpointAddr = control devHndl+ Standard+ ToEndpoint+ c'LIBUSB_REQUEST_SET_FEATURE+ haltFeature+ (marshalEndpointAddress endpointAddr) +-- | See: USB 2.0 Spec. section 9.4.7+--+-- /This function is for testing purposes only!/+--+-- You should normally use @System.USB.DeviceHandling.'USB.setConfig'@ because+-- that function notifies the underlying operating system about the changed+-- configuration.+setConfig ∷ DeviceHandle → Maybe ConfigValue → (Timeout → IO ())+setConfig devHndl mbConfigValue = control devHndl+ Standard+ ToDevice+ c'LIBUSB_REQUEST_SET_CONFIGURATION+ (marshal mbConfigValue)+ 0+ where+ marshal ∷ Maybe ConfigValue → Value+ marshal = maybe 0 fromIntegral++-- | See: USB 2.0 Spec. section 9.4.2+--+-- /This function is for testing purposes only!/+--+-- You should normally use @System.USB.DeviceHandling.'USB.getConfig'@ because+-- that functon may exploit operating system caches (no I/O involved).+getConfig ∷ DeviceHandle → (Timeout → IO (Maybe ConfigValue))+getConfig devHndl = fmap (unmarshal ∘ B.head)+ ∘ readControlExact devHndl+ Standard+ ToDevice+ c'LIBUSB_REQUEST_GET_CONFIGURATION+ 0+ 0+ 1+ where+ unmarshal ∷ Word8 → Maybe ConfigValue+ unmarshal 0 = Nothing+ unmarshal n = Just $ fromIntegral n+ -- | See: USB 2.0 Spec. section 9.4.1 clearRemoteWakeup ∷ DeviceHandle → (Timeout → IO ()) clearRemoteWakeup devHndl =@@ -149,45 +201,41 @@ -- | See: USB 2.0 Spec. section 9.4.4 getInterfaceAltSetting ∷ DeviceHandle → InterfaceNumber → (Timeout → IO InterfaceAltSetting)-getInterfaceAltSetting devHndl ifNum = \timeout → do- B.head <$> readControlExact devHndl- Standard- ToInterface- c'LIBUSB_REQUEST_GET_INTERFACE- 0- (fromIntegral ifNum)- 1- timeout+getInterfaceAltSetting devHndl ifNum =+ fmap B.head ∘ readControlExact devHndl+ Standard+ ToInterface+ c'LIBUSB_REQUEST_GET_INTERFACE+ 0+ (fromIntegral ifNum)+ 1 -- | See: USB 2.0 Spec. section 9.4.5 getDeviceStatus ∷ DeviceHandle → (Timeout → IO DeviceStatus)-getDeviceStatus devHndl = \timeout → do- (unmarshalDeviceStatus ∘ B.head) <$> readControlExact devHndl- Standard- ToDevice- c'LIBUSB_REQUEST_GET_STATUS- 0- 0- 2- timeout+getDeviceStatus devHndl =+ fmap (unmarshal ∘ B.head) ∘ readControlExact devHndl+ Standard+ ToDevice+ c'LIBUSB_REQUEST_GET_STATUS+ 0+ 0+ 2 where- unmarshalDeviceStatus ∷ Word8 → DeviceStatus- unmarshalDeviceStatus a =- DeviceStatus { remoteWakeup = testBit a 1- , selfPowered = testBit a 0- }+ unmarshal ∷ Word8 → DeviceStatus+ unmarshal a = DeviceStatus { remoteWakeup = testBit a 1+ , selfPowered = testBit a 0+ } -- | See: USB 2.0 Spec. section 9.4.5 getEndpointStatus ∷ DeviceHandle → EndpointAddress → (Timeout → IO Bool)-getEndpointStatus devHndl endpointAddr = \timeout → do- ((1 ≡) ∘ B.head) <$> readControlExact devHndl- Standard- ToEndpoint- c'LIBUSB_REQUEST_GET_STATUS- 0- (marshalEndpointAddress endpointAddr)- 2- timeout+getEndpointStatus devHndl endpointAddr =+ fmap ((1 ≡) ∘ B.head) ∘ readControlExact devHndl+ Standard+ ToEndpoint+ c'LIBUSB_REQUEST_GET_STATUS+ 0+ (marshalEndpointAddress endpointAddr)+ 2 -- | See: USB 2.0 Spec. section 9.4.6 setDeviceAddress ∷ DeviceHandle → Word16 → (Timeout → IO ())@@ -223,19 +271,18 @@ See: USB 2.0 Spec. section 9.4.11 -} synchFrame ∷ DeviceHandle → EndpointAddress → (Timeout → IO FrameNumber)-synchFrame devHndl endpointAddr = \timeout → do- unmarshallFrameNumber <$> readControlExact- devHndl- Standard- ToEndpoint- c'LIBUSB_REQUEST_SYNCH_FRAME- 0- (marshalEndpointAddress endpointAddr)- 2- timeout+synchFrame devHndl endpointAddr =+ fmap unmarshal ∘ readControlExact devHndl+ Standard+ ToEndpoint+ c'LIBUSB_REQUEST_SYNCH_FRAME+ 0+ (marshalEndpointAddress endpointAddr)+ 2 where- unmarshallFrameNumber bs = let [h, l] = B.unpack bs- in fromIntegral h ⋅ 256 + fromIntegral l+ unmarshal ∷ B.ByteString → FrameNumber+ unmarshal bs = let [h, l] = B.unpack bs+ in fromIntegral h ⋅ 256 + fromIntegral l type FrameNumber = Word16
System/USB/Internal.hs view
@@ -30,7 +30,7 @@ import Data.Functor ( Functor, fmap, (<$>) ) import Data.Data ( Data ) import Data.Typeable ( Typeable )-import Data.Maybe ( Maybe(Nothing, Just), fromMaybe )+import Data.Maybe ( Maybe(Nothing, Just), maybe, fromMaybe ) import Data.List ( lookup, map, (++) ) import Data.Int ( Int ) import Data.Word ( Word8, Word16 )@@ -45,7 +45,7 @@ import Text.Printf ( printf ) #if __GLASGOW_HASKELL__ < 700-import Prelude ( fromInteger )+import Prelude ( fromInteger, negate ) import Control.Monad ( (>>), fail ) #endif @@ -357,7 +357,7 @@ If the OS does not cache this information, then this function will block while a control transfer is submitted to retrieve the information. -This function will return a value of 0 if the device is in unconfigured state.+This function returns 'Nothing' if the device is in unconfigured state. Exceptions: @@ -365,13 +365,17 @@ * Another 'USBException'. -}-getConfig ∷ DeviceHandle → IO ConfigValue+getConfig ∷ DeviceHandle → IO (Maybe ConfigValue) getConfig devHndl = alloca $ \configPtr → do handleUSBException $ c'libusb_get_configuration (getDevHndlPtr devHndl) configPtr- fromIntegral <$> peek configPtr+ unmarshal <$> peek configPtr+ where+ unmarshal 0 = Nothing+ unmarshal n = Just $ fromIntegral n + {-| Set the active configuration for a device. The operating system may or may not have already set an active configuration on@@ -388,9 +392,9 @@ - you should free them with 'releaseInterface' first. You cannot change/reset configuration if other applications or drivers have claimed interfaces. -A configuration value of -1 will put the device in an unconfigured state. The-USB specification states that a configuration value of 0 does this, however-buggy devices exist which actually have a configuration 0.+A configuration value of 'Nothing' will put the device in an unconfigured+state. The USB specification states that a configuration value of 0 does this,+however buggy devices exist which actually have a configuration 0. You should always use this function rather than formulating your own SET_CONFIGURATION control request. This is because the underlying operating@@ -408,11 +412,11 @@ * Another 'USBException'. -}-setConfig ∷ DeviceHandle → ConfigValue → IO ()-setConfig devHndl- = handleUSBException- ∘ c'libusb_set_configuration (getDevHndlPtr devHndl)- ∘ fromIntegral+setConfig ∷ DeviceHandle → Maybe ConfigValue → IO ()+setConfig devHndl = handleUSBException+ ∘ c'libusb_set_configuration (getDevHndlPtr devHndl)+ ∘ marshal+ where marshal = maybe (-1) fromIntegral -------------------------------------------------------------------------------- -- ** Claiming & releasing interfaces
usb.cabal view
@@ -1,5 +1,5 @@ name: usb-version: 0.6.0.8+version: 0.7 cabal-version: >=1.6 build-type: Custom license: BSD3