diff --git a/System/USB/IO/StandardDeviceRequests.hs b/System/USB/IO/StandardDeviceRequests.hs --- a/System/USB/IO/StandardDeviceRequests.hs +++ b/System/USB/IO/StandardDeviceRequests.hs @@ -7,12 +7,17 @@ -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk -- --- 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 diff --git a/System/USB/Internal.hs b/System/USB/Internal.hs --- a/System/USB/Internal.hs +++ b/System/USB/Internal.hs @@ -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 diff --git a/usb.cabal b/usb.cabal --- a/usb.cabal +++ b/usb.cabal @@ -1,5 +1,5 @@ name: usb -version: 0.6.0.8 +version: 0.7 cabal-version: >=1.6 build-type: Custom license: BSD3