usb 0.3.0.1 → 0.3.1
raw patch · 11 files changed
+502/−542 lines, 11 filesdep ~MonadCatchIO-transformersdep ~base-unicode-symbolsdep ~iteratee
Dependency ranges changed: MonadCatchIO-transformers, base-unicode-symbols, iteratee, transformers
Files
- LICENSE +1/−1
- System/USB.hs +2/−2
- System/USB/Descriptors.hs +7/−49
- System/USB/DeviceHandling.hs +1/−1
- System/USB/Enumeration.hs +1/−1
- System/USB/Exceptions.hs +1/−1
- System/USB/IO/Synchronous.hs +1/−1
- System/USB/IO/Synchronous/Enumerator.hs +99/−84
- System/USB/Initialization.hs +1/−1
- System/USB/Internal.hs +375/−381
- usb.cabal +13/−20
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009 Bas van Dijk+Copyright (c) 2009–2010 Bas van Dijk All rights reserved.
System/USB.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : System.USB--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009–2010 Bas van Dijk -- License : BSD-style (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --@@ -18,7 +18,7 @@ -- -- <http://hackage.haskell.org/package/ls-usb> ----- Also see the @usb-safe@ package which wraps this packages and provides some+-- Also see the @usb-safe@ package which wraps this package and provides some -- strong safety guarantees for working with USB devices. -- -- <http://hackage.haskell.org/package/usb-safe>
System/USB/Descriptors.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Descriptors--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009–2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --@@ -22,40 +22,16 @@ module System.USB.Descriptors ( -- * Device descriptor- DeviceDesc-- -- ** Querying device descriptors- , deviceUSBSpecReleaseNumber- , deviceClass- , deviceSubClass- , deviceProtocol- , deviceMaxPacketSize0- , deviceVendorId- , deviceProductId- , deviceReleaseNumber- , deviceManufacturerStrIx- , deviceProductStrIx- , deviceSerialNumberStrIx- , deviceNumConfigs- , deviceConfigs+ DeviceDesc(..) , BCD4 - -- | For a database of USB vendors and products see the /usb-id-database/+ -- | For a database of USB vendors and products see the @usb-id-database@ -- package at: <http://hackage.haskell.org/package/usb-id-database> , VendorId, ProductId -- * Configuration descriptor- , ConfigDesc-- -- ** Querying configuration descriptors- , configValue- , configStrIx- , configAttribs- , configMaxPower- , configNumInterfaces- , configInterfaces- , configExtra+ , ConfigDesc(..) , Interface @@ -64,29 +40,10 @@ , DeviceStatus(..) -- * Interface descriptor- , InterfaceDesc-- -- ** Querying interface descriptors- , interfaceNumber- , interfaceAltSetting- , interfaceClass- , interfaceSubClass- , interfaceProtocol- , interfaceStrIx- , interfaceEndpoints- , interfaceExtra+ , InterfaceDesc(..) -- * Endpoint descriptor- , EndpointDesc-- -- ** Querying endpoint descriptors- , endpointAddress- , endpointAttribs- , endpointMaxPacketSize- , endpointInterval- , endpointRefresh- , endpointSynchAddress- , endpointExtra+ , EndpointDesc(..) -- *** Endpoint address , EndpointAddress(..)@@ -95,6 +52,7 @@ -- *** Endpoint attributes , EndpointAttribs , TransferType(..)+ -- **** Isochronous transfer attributes , Synchronization(..) , Usage(..)
System/USB/DeviceHandling.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Devices--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009–2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --
System/USB/Enumeration.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Devices--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009–2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --
System/USB/Exceptions.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Exceptions--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009–2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --
System/USB/IO/Synchronous.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : System.USB.IO.Synchronous--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009–2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --
System/USB/IO/Synchronous/Enumerator.hs view
@@ -1,14 +1,13 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, ScopedTypeVariables #-} -------------------------------------------------------------------------------- -- | -- Module : System.USB.IO.Synchronous.Enumerator--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009–2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> ----- /Experimental/ enumerators for endpoints.+-- /Untested/ /experimental/ enumerators for endpoints. -- -------------------------------------------------------------------------------- @@ -19,15 +18,12 @@ ------------------------------------------------------------------------------------ from myself:-import System.USB.Internal+-- Imports+-------------------------------------------------------------------------------- -- from base:-import Prelude ( (*), fromIntegral, undefined )-import Data.Function ( ($), (.) )-import Data.Eq ( (/=) )-import Data.Bool ( (&&) )+import Prelude ( fromIntegral )+import Data.Function ( ($) ) import Data.Int ( Int ) import Data.Maybe ( Maybe(Nothing, Just) ) import Control.Monad ( Monad, return, (>>=), fail )@@ -37,113 +33,132 @@ import Foreign.Storable ( Storable, peek, sizeOf ) import Foreign.Ptr ( Ptr, castPtr ) +-- from base-unicode-symbols:+import Prelude.Unicode ( (⋅), (⊥) )+import Data.Function.Unicode ( (∘) )+import Data.Eq.Unicode ( (≢) )+import Data.Bool.Unicode ( (∧) )+ -- from bindings-libusb:-import Bindings.Libusb+import Bindings.Libusb ( c'libusb_bulk_transfer, c'libusb_interrupt_transfer+ , c'LIBUSB_SUCCESS, c'LIBUSB_ERROR_TIMEOUT+ ) -- from transformers:-import Control.Monad.Trans ( liftIO )+import Control.Monad.IO.Class ( liftIO ) -- from MonadCatchIO-transformers:-import Control.Monad.CatchIO ( MonadCatchIO, bracket )+import Control.Monad.CatchIO ( MonadCatchIO, bracket ) -- from iteratee:-import Data.Iteratee.Base ( EnumeratorGM- , StreamG( Chunk )- , IterGV( Done, Cont )- , runIter- , enumErr- , throwErr- )-import Data.Iteratee.Base.StreamChunk ( ReadableChunk (readFromPtr) )+import Data.Iteratee.Base ( EnumeratorGM+ , StreamG(Chunk)+ , IterGV(Done, Cont)+ , runIter+ , enumErr+ , throwErr+ )+import Data.Iteratee.Base.StreamChunk ( ReadableChunk (readFromPtr) ) +-- from myself:+import System.USB.DeviceHandling ( DeviceHandle )+import System.USB.Descriptors ( EndpointAddress )+import System.USB.IO.Synchronous ( Timeout, Size )+import System.USB.Internal ( C'TransferFunc+ , getDevHndlPtr+ , marshalEndpointAddress+ , convertUSBException+ ) + --------------------------------------------------------------------------------+-- Enumerators+-------------------------------------------------------------------------------- -enumReadBulk :: (ReadableChunk s el, MonadCatchIO m)- => DeviceHandle -- ^ A handle for the device to communicate- -- with.- -> EndpointAddress -- ^ The address of a valid 'In' and 'Bulk'- -- endpoint to communicate with. Make sure- -- the endpoint belongs to the current- -- alternate setting of a claimed interface- -- which belongs to the device.- -> Timeout -- ^ Timeout (in milliseconds) that this- -- function should wait for each chunk- -- before giving up due to no response- -- being received. For no timeout, use- -- value 0.- -> Size -- ^ Chunk size. A good value for this would- -- be the 'endpointMaxPacketSize'.- -> EnumeratorGM s el m a+enumReadBulk ∷ (ReadableChunk s el, MonadCatchIO m)+ ⇒ DeviceHandle -- ^ A handle for the device to communicate with.+ → EndpointAddress -- ^ The address of a valid 'In' and 'Bulk'+ -- endpoint to communicate with. Make sure the+ -- endpoint belongs to the current alternate+ -- setting of a claimed interface which belongs+ -- to the device.+ → Timeout -- ^ Timeout (in milliseconds) that this function+ -- should wait for each chunk before giving up+ -- due to no response being received. For no+ -- timeout, use value 0.+ → Size -- ^ Chunk size. A good value for this would be+ -- the 'endpointMaxPacketSize'.+ → EnumeratorGM s el m α enumReadBulk = enumRead c'libusb_bulk_transfer -enumReadInterrupt :: (ReadableChunk s el, MonadCatchIO m)- => DeviceHandle -- ^ A handle for the device to- -- communicate with.- -> EndpointAddress -- ^ The address of a valid 'In' and- -- 'Interrupt' endpoint to communicate- -- with. Make sure the endpoint- -- belongs to the current alternate- -- setting of a claimed interface- -- which belongs to the device.- -> Timeout -- ^ Timeout (in milliseconds) that this- -- function should wait for each chunk- -- before giving up due to no response- -- being received. For no timeout,- -- use value 0.- -> Size -- ^ Chunk size. A good value for this- -- would be the 'endpointMaxPacketSize'.- -> EnumeratorGM s el m a+enumReadInterrupt ∷ (ReadableChunk s el, MonadCatchIO m)+ ⇒ DeviceHandle -- ^ A handle for the device to communicate+ -- with.+ → EndpointAddress -- ^ The address of a valid 'In' and+ -- 'Interrupt' endpoint to communicate+ -- with. Make sure the endpoint belongs to+ -- the current alternate setting of a+ -- claimed interface which belongs to the+ -- device.+ → Timeout -- ^ Timeout (in milliseconds) that this+ -- function should wait for each chunk+ -- before giving up due to no response+ -- being received. For no timeout, use+ -- value 0.+ → Size -- ^ Chunk size. A good value for this would+ -- be the 'endpointMaxPacketSize'.+ → EnumeratorGM s el m α enumReadInterrupt = enumRead c'libusb_interrupt_transfer -------------------------------------------------------------------------------- -enumRead :: forall s el m a. (ReadableChunk s el, MonadCatchIO m)- => C'TransferFunc -> DeviceHandle- -> EndpointAddress- -> Timeout- -> Size- -> EnumeratorGM s el m a+enumRead ∷ ∀ s el m α. (ReadableChunk s el, MonadCatchIO m)+ ⇒ C'TransferFunc → DeviceHandle+ → EndpointAddress+ → Timeout+ → Size+ → EnumeratorGM s el m α enumRead c'transfer devHndl endpoint timeout- chunkSize- iter =- genAlloca $ \transferredPtr ->- let bufferSize = chunkSize * sizeOf (undefined :: el)- in genAllocaBytes bufferSize $ \dataPtr ->+ chunkSize = \iter ->+ genAlloca $ \transferredPtr →+ let bufferSize = chunkSize ⋅ sizeOf ((⊥) ∷ el)+ in genAllocaBytes bufferSize $ \dataPtr → let loop i1 = do- err <- liftIO $ c'transfer (getDevHndlPtr devHndl)- (marshalEndpointAddress endpoint)- (castPtr dataPtr)- (fromIntegral bufferSize)- transferredPtr- (fromIntegral timeout)- if err /= c'LIBUSB_SUCCESS &&- err /= c'LIBUSB_ERROR_TIMEOUT+ err ← liftIO $ c'transfer (getDevHndlPtr devHndl)+ (marshalEndpointAddress endpoint)+ (castPtr dataPtr)+ (fromIntegral bufferSize)+ transferredPtr+ (fromIntegral timeout)+ if err ≢ c'LIBUSB_SUCCESS ∧+ err ≢ c'LIBUSB_ERROR_TIMEOUT then enumErr (show $ convertUSBException err) i1 else do- t <- liftIO $ peek transferredPtr- s <- liftIO $ readFromPtr dataPtr $ fromIntegral t- r <- runIter i1 $ Chunk s+ t ← liftIO $ peek transferredPtr+ s ← liftIO $ readFromPtr dataPtr $ fromIntegral t+ r ← runIter i1 $ Chunk s case r of- Done x _ -> return $ return x- Cont i2 Nothing -> loop i2- Cont _ (Just e) -> return $ throwErr e+ Done x _ → return $ return x+ Cont i2 Nothing → loop i2+ Cont _ (Just e) → return $ throwErr e in loop iter --------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------- -genAlloca :: (Storable a, MonadCatchIO m) => (Ptr a -> m b) -> m b+genAlloca ∷ (Storable α, MonadCatchIO m) ⇒ (Ptr α → m β) → m β genAlloca = bracketIO malloc free -genAllocaBytes :: (Storable a, MonadCatchIO m) => Int -> (Ptr a -> m b) -> m b+genAllocaBytes ∷ (Storable α, MonadCatchIO m) ⇒ Int → (Ptr α → m β) → m β genAllocaBytes n = bracketIO (mallocBytes n) free -bracketIO :: MonadCatchIO m => IO a -> (a -> IO c) -> (a -> m b) -> m b-bracketIO before after = bracket (liftIO before) (liftIO . after)+bracketIO ∷ MonadCatchIO m ⇒ IO α → (α → IO γ) → (α → m β) → m β+bracketIO before after = bracket (liftIO before) (liftIO ∘ after) -- The End ---------------------------------------------------------------------
System/USB/Initialization.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Init--- Copyright : (c) 2009 Bas van Dijk+-- Copyright : (c) 2009–2010 Bas van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> --
System/USB/Internal.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE UnicodeSyntax #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, DeriveDataTypeable #-} module System.USB.Internal where @@ -19,33 +17,32 @@ import Foreign.C.Types ( CUChar, CInt, CUInt ) import Foreign.Marshal.Alloc ( alloca ) import Foreign.Marshal.Array ( peekArray, allocaArray )-import Foreign.Storable ( peek, peekElemOff )+import Foreign.Storable ( Storable, peek, peekElemOff ) import Foreign.Ptr ( Ptr, castPtr, plusPtr, nullPtr ) import Foreign.ForeignPtr ( ForeignPtr, newForeignPtr, withForeignPtr)+import Control.Applicative ( liftA2 ) import Control.Exception ( Exception , throwIO , bracket, bracket_ , block, unblock , onException )-import Control.Monad ( Monad, return, (>>=), fail- , (>>), (=<<), when, forM, liftM, mapM- , fmap+import Control.Monad ( Monad, return, (>>=), (>>), (=<<), fail+ , when, forM, mapM ) import Control.Arrow ( (&&&) ) import Data.Function ( ($), flip )+import Data.Functor ( Functor, fmap, (<$), (<$>) ) import Data.Data ( Data ) import Data.Typeable ( Typeable ) import Data.Maybe ( fromMaybe )-import Data.List ( lookup )+import Data.List ( lookup, map ) import Data.Int ( Int ) import Data.Word ( Word8, Word16 ) import Data.Char ( String ) import Data.Eq ( Eq, (==) ) import Data.Ord ( Ord, (<), (>) )-import Data.Bool ( Bool(False, True)- , not, otherwise- )+import Data.Bool ( Bool(False, True), not, otherwise ) import Data.Bits ( Bits , (.|.), (.&.) , setBit, testBit@@ -93,7 +90,7 @@ that can independently use this library without interfering with eachother. Sessions are created and initialized by 'newCtx' and are automatically closed-when garbage collected.+when they are garbage collected. The only functions that receive a @Ctx@ are 'setDebug' and 'getDevices'. -}@@ -112,22 +109,23 @@ {-| Set message verbosity. -The default level is 'PrintNothing', which means no messages are ever-printed. If you choose to increase the message verbosity level, ensure that your-application does not close the stdout/stderr file descriptors.+The default level is 'PrintNothing'. This means no messages are ever+printed. If you choose to increase the message verbosity level you must ensure+that your application does not close the @stdout@/@stderr@ file descriptors. -You are advised to set level 'PrintWarnings'. libusb is conservative with its-message logging and most of the time, will only log messages that explain error-conditions and other oddities. This will help you debug your software.+You are advised to set the debug level to 'PrintWarnings'. Libusb is+conservative with its message logging. Most of the time it will only log+messages that explain error conditions and other oddities. This will help you+debug your software. -If the LIBUSB_DEBUG environment variable was set when libusb was initialized,-this function does nothing: the message verbosity is fixed to the value in the-environment variable.+The LIBUSB_DEBUG environment variable overrules the debug level set by this+function. The message verbosity is fixed to the value in the environment+variable if it is defined. -If libusb was compiled without any message logging, this function does nothing:+If @libusb@ was compiled without any message logging, this function does nothing: you'll never get any messages. -If libusb was compiled with verbose debug message logging, this function does+If @libusb@ was compiled with verbose debug message logging, this function does nothing: you'll always get messages from all levels. -} setDebug ∷ Ctx → Verbosity → IO ()@@ -149,9 +147,10 @@ -- * Enumeration -------------------------------------------------------------------------------- -{-| Abstract type representing a USB device detected on the system, usually-originating from 'getDevices'.+{-| Abstract type representing a USB device detected on the system. +You can only obtain a USB device from the 'getDevices' function.+ Certain operations can be performed on a device, but in order to do any I/O you will have to first obtain a 'DeviceHandle' using 'openDevice'. Alternatively you can use the /usb-safe/ package which provides type-safe device handling. See:@@ -160,20 +159,19 @@ Just because you have a reference to a device does not mean it is necessarily usable. The device may have been unplugged, you may not have permission to-operate such device, or another program or driver may be using the device.+operate such device or another process or driver may be using the device. To get additional information about a device you can retrieve its descriptor using 'deviceDesc'. -} data Device = Device- { _ctx ∷ Ctx -- ^ This reference to the 'Ctx' is needed so that it won't get- -- garbage collected so the finalizer "p'libusb_exit" only- -- gets run when all references to 'Devices' are gone.+ { _ctx ∷ Ctx -- ^ This reference to the 'Ctx' is needed so that it won't+ -- get garbage collected. The finalizer "p'libusb_exit" is+ -- run only when all references to 'Devices' are gone. , getDevFrgnPtr ∷ ForeignPtr C'libusb_device - , deviceDesc ∷ DeviceDesc -- ^ Get the USB device descriptor for a given- -- device.+ , deviceDesc ∷ DeviceDesc -- ^ Get the descriptor of the device. } withDevicePtr ∷ Device → (Ptr C'libusb_device → IO α) → IO α@@ -181,7 +179,7 @@ {-| Returns a list of USB devices currently attached to the system. -This is your entry point into finding a USB device to operate.+This is your entry point into finding a USB device. Exceptions: @@ -189,12 +187,12 @@ -} -{- +{- Visual description of the 'devPtrArrayPtr': D ^ D- D │ ^ + D │ ^ ^ │ │ │ │ │ devPtrArrayPtr: ┏━┷━┳━┷━┳━━━┳━━━┳━┷━┓@@ -220,38 +218,30 @@ case numDevs of n | n ≡ c'LIBUSB_ERROR_NO_MEM → throwIO NoMemException | n < 0 → unknownLibUsbError- | otherwise → alloca $ \devDescPtr → do+ | otherwise → do devPtrs ← peekArray (fromIntegral numDevs) devPtrArray- forM devPtrs $ \devPtr → do- devFrgnPtr ← newForeignPtr p'libusb_unref_device devPtr-- handleUSBException $ c'libusb_get_device_descriptor- devPtr- devDescPtr- devDesc ← convertDeviceDesc devPtr =<< peek devDescPtr-- return $ Device ctx devFrgnPtr devDesc-+ forM devPtrs $ \devPtr →+ liftA2 (Device ctx)+ (newForeignPtr p'libusb_unref_device devPtr)+ (getDeviceDesc devPtr) freeDevPtrArray return devs --- | Get the number of the bus that a device is connected to.+-- | The number of the bus that a device is connected to. busNumber ∷ Device → Word8 busNumber dev = -- Getting the bus number from libusb is a side-effect free -- operation. The bus number is a static variable in the device -- structure. That's why it's safe to use: unsafePerformIO- $ withDevicePtr dev- $ c'libusb_get_bus_number+ $ withDevicePtr dev c'libusb_get_bus_number --- | Get the address of the device on the bus it is connected to.+-- | The address of the device on the bus it is connected to. deviceAddress ∷ Device → Word8 deviceAddress dev = -- Getting the device address from libusb is a side-effect -- free operation. The device address is a static variable -- in the device structure. That's why it's safe to use: unsafePerformIO- $ withDevicePtr dev- $ c'libusb_get_device_address+ $ withDevicePtr dev c'libusb_get_device_address --------------------------------------------------------------------------------@@ -262,11 +252,12 @@ -- ** Opening & closing devices -------------------------------------------------------------------------------- -{-| Abstract type representing a handle on a USB device, usually originating-from 'openDevice'.+{-| Abstract type representing a handle of a USB device. +You can acquire a handle from 'openDevice'.+ A device handle is used to perform I/O and other operations. When finished with-a device handle, you should close it by applying 'closeDevice' to it.+a device handle you should close it by applying 'closeDevice' to it. -} data DeviceHandle = DeviceHandle { getDevice ∷ Device -- This reference is needed for keeping the 'Device'@@ -281,7 +272,7 @@ This is a non-blocking function; no requests are sent over the bus. -It is advised to use 'withDeviceHandle' because it automatically closes the+It is advisable to use 'withDeviceHandle' because it automatically closes the device when the computation terminates. Exceptions:@@ -298,8 +289,7 @@ openDevice dev = withDevicePtr dev $ \devPtr → alloca $ \devHndlPtrPtr → do handleUSBException $ c'libusb_open devPtr devHndlPtrPtr- liftM (DeviceHandle dev) $ peek devHndlPtrPtr-+ DeviceHandle dev <$> peek devHndlPtrPtr {-| Close a device handle. @@ -327,15 +317,14 @@ -- Can be retrieved by 'getConfig' or by 'configValue'. type ConfigValue = Word8 -{-| Determine the bConfigurationValue of the currently active-configuration.+{-| Determine the value of the currently active configuration. You could formulate your own control request to obtain this information, but this function has the advantage that it may be able to retrieve the information from operating system caches (no I/O involved). -If the OS does not cache this information, then this function will block while a-control transfer is submitted to retrieve the information.+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. @@ -343,14 +332,14 @@ * 'NoDeviceException' if the device has been disconnected. - * Aanother 'USBException'.+ * Another 'USBException'. -} getConfig ∷ DeviceHandle → IO ConfigValue getConfig devHndl = alloca $ \configPtr → do- handleUSBException $ c'libusb_get_configuration (getDevHndlPtr devHndl)- configPtr- fmap fromIntegral $ peek configPtr+ handleUSBException $ c'libusb_get_configuration (getDevHndlPtr devHndl)+ configPtr+ fromIntegral <$> peek configPtr {-| Set the active configuration for a device. @@ -368,9 +357,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 unconfigured state. The USB-specifications state that a configuration value of 0 does this, however buggy-devices exist which actually have a configuration 0.+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. You should always use this function rather than formulating your own SET_CONFIGURATION control request. This is because the underlying operating@@ -525,10 +514,9 @@ * Another 'USBException'. -} clearHalt ∷ DeviceHandle → EndpointAddress → IO ()-clearHalt devHndl- = handleUSBException- ∘ c'libusb_clear_halt (getDevHndlPtr devHndl)- ∘ marshalEndpointAddress+clearHalt devHndl = handleUSBException+ ∘ c'libusb_clear_halt (getDevHndlPtr devHndl)+ ∘ marshalEndpointAddress {-| Perform a USB port reset to reinitialize a device. @@ -571,7 +559,7 @@ kernelDriverActive ∷ DeviceHandle → InterfaceNumber → IO Bool kernelDriverActive devHndl ifNum = do r ← c'libusb_kernel_driver_active (getDevHndlPtr devHndl)- (fromIntegral ifNum)+ (fromIntegral ifNum) case r of 0 → return False 1 → return True@@ -653,74 +641,51 @@ This structure can be retrieved by 'deviceDesc'. -} data DeviceDesc = DeviceDesc- { deviceUSBSpecReleaseNumber ∷ BCD4 -- ^ USB specification release- -- number in binary-coded- -- decimal.+ { -- | USB specification release number in binary-coded decimal.+ deviceUSBSpecReleaseNumber ∷ BCD4 - , deviceClass ∷ Word8 -- ^ USB-IF class code for the- -- device.- , deviceSubClass ∷ Word8 -- ^ USB-IF subclass code for the- -- device, qualified by the- -- 'deviceClass' value.+ -- | USB-IF class code for the device.+ , deviceClass ∷ Word8 - , deviceProtocol ∷ Word8 -- ^ USB-IF protocol code for the- -- device, qualified by the- -- 'deviceClass' and- -- 'deviceSubClass' values.+ -- | USB-IF subclass code for the device, qualified by the 'deviceClass'+ -- value.+ , deviceSubClass ∷ Word8 - , deviceMaxPacketSize0 ∷ Word8 -- ^ Maximum packet size for- -- endpoint 0.+ -- | USB-IF protocol code for the device, qualified by the 'deviceClass'+ -- and 'deviceSubClass' values.+ , deviceProtocol ∷ Word8 - , deviceVendorId ∷ VendorId -- ^ USB-IF vendor ID.- , deviceProductId ∷ ProductId -- ^ USB-IF product ID.+ -- | Maximum packet size for endpoint 0.+ , deviceMaxPacketSize0 ∷ Word8 - , deviceReleaseNumber ∷ BCD4 -- ^ Device release number in- -- binary-coded decimal.+ -- | USB-IF vendor ID.+ , deviceVendorId ∷ VendorId - , deviceManufacturerStrIx ∷ StrIx -- ^ Index of string descriptor- -- describing manufacturer.- , deviceProductStrIx ∷ StrIx -- ^ Index of string descriptor- -- describing product.- , deviceSerialNumberStrIx ∷ StrIx -- ^ Index of string descriptor- -- containing device serial- -- number.+ -- | USB-IF product ID.+ , deviceProductId ∷ ProductId - , deviceNumConfigs ∷ Word8 -- ^ Number of possible- -- configurations.+ -- | Device release number in binary-coded decimal.+ , deviceReleaseNumber ∷ BCD4 - , deviceConfigs ∷ [ConfigDesc] -- ^ List of configurations- -- supported by the device.- } deriving (Show, Eq, Data, Typeable)+ -- | Index of string descriptor describing manufacturer.+ , deviceManufacturerStrIx ∷ StrIx -type VendorId = Word16-type ProductId = Word16+ -- | Index of string descriptor describing product.+ , deviceProductStrIx ∷ StrIx -convertDeviceDesc ∷ Ptr C'libusb_device- → C'libusb_device_descriptor- → IO DeviceDesc-convertDeviceDesc devPtr d = do- let numConfigs = c'libusb_device_descriptor'bNumConfigurations d+ -- | Index of string descriptor containing device serial number.+ , deviceSerialNumberStrIx ∷ StrIx - configs ← mapM (getConfigDesc devPtr) [0..numConfigs-1]+ -- | Number of possible configurations.+ , deviceNumConfigs ∷ Word8 - return DeviceDesc- { deviceUSBSpecReleaseNumber = unmarshalBCD4 $- c'libusb_device_descriptor'bcdUSB d- , deviceClass = c'libusb_device_descriptor'bDeviceClass d- , deviceSubClass = c'libusb_device_descriptor'bDeviceSubClass d- , deviceProtocol = c'libusb_device_descriptor'bDeviceProtocol d- , deviceMaxPacketSize0 = c'libusb_device_descriptor'bMaxPacketSize0 d- , deviceVendorId = c'libusb_device_descriptor'idVendor d- , deviceProductId = c'libusb_device_descriptor'idProduct d- , deviceReleaseNumber = unmarshalBCD4 $- c'libusb_device_descriptor'bcdDevice d- , deviceManufacturerStrIx = c'libusb_device_descriptor'iManufacturer d- , deviceProductStrIx = c'libusb_device_descriptor'iProduct d- , deviceSerialNumberStrIx = c'libusb_device_descriptor'iSerialNumber d- , deviceNumConfigs = numConfigs- , deviceConfigs = configs- }+ -- | List of configurations supported by the device.+ , deviceConfigs ∷ [ConfigDesc]+ } deriving (Show, Eq, Data, Typeable) +type VendorId = Word16+type ProductId = Word16+ -------------------------------------------------------------------------------- -- ** Configuration descriptor --------------------------------------------------------------------------------@@ -732,33 +697,31 @@ This structure can be retrieved by 'deviceConfigs'. -} data ConfigDesc = ConfigDesc- { configValue ∷ ConfigValue -- ^ Identifier value for the- -- configuration.+ { -- | Identifier value for the configuration.+ configValue ∷ ConfigValue - , configStrIx ∷ StrIx -- ^ Index of string descriptor- -- describing the configuration.- , configAttribs ∷ ConfigAttribs- -- ^ Configuration characteristics.- , configMaxPower ∷ Word8 -- ^ Maximum power consumption of the- -- USB device from the bus in the- -- configuration when the device is- -- fully operational. Expressed in- -- 2 mA units (i.e., 50 = 100 mA).+ -- | Index of string descriptor describing the configuration.+ , configStrIx ∷ StrIx - , configNumInterfaces ∷ Word8 -- ^ Number of interfaces supported by- -- the configuration.- , configInterfaces ∷ [Interface] -- ^ List of interfaces supported by- -- the configuration.- -- Note that the length of this list- -- should equal- -- 'configNumInterfaces'.+ -- | Configuration characteristics.+ , configAttribs ∷ ConfigAttribs - , configExtra ∷ B.ByteString- -- ^ Extra descriptors. If libusb- -- encounters unknown configuration- -- descriptors, it will store them- -- here, should you wish to parse- -- them.+ -- | Maximum power consumption of the USB device from the bus in the+ -- configuration when the device is fully operational. Expressed in 2 mA+ -- units (i.e., 50 = 100 mA).+ , configMaxPower ∷ Word8++ -- | Number of interfaces supported by the configuration.+ , configNumInterfaces ∷ Word8++ -- | List of interfaces supported by the configuration. Note that the+ -- length of this list should equal 'configNumInterfaces'.+ , configInterfaces ∷ [Interface]++ -- | Extra descriptors. If @libusb@ encounters unknown configuration+ -- descriptors, it will store them here, should you wish to parse them.+ , configExtra ∷ B.ByteString+ } deriving (Show, Eq, Data, Typeable) -- | An interface is represented as a list of alternate interface settings.@@ -768,6 +731,8 @@ -- *** Configuration attributes -------------------------------------------------------------------------------- +-- | The USB 2.0 specification specifices that the configuration attributes only+-- describe the device status. type ConfigAttribs = DeviceStatus data DeviceStatus = DeviceStatus@@ -779,40 +744,206 @@ -- device is currently self-powered } deriving (Show, Eq, Data, Typeable) -unmarshalConfigAttribs ∷ Word8 → ConfigAttribs-unmarshalConfigAttribs a =- DeviceStatus { remoteWakeup = testBit a 5- , selfPowered = testBit a 6- }+--------------------------------------------------------------------------------+-- ** Interface descriptor+-------------------------------------------------------------------------------- +{-| A structure representing the standard USB interface descriptor.++This descriptor is documented in section 9.6.5 of the USB 2.0 specification.++This structure can be retrieved using 'configInterfaces'.+-}+data InterfaceDesc = InterfaceDesc+ { -- | Number of the interface.+ interfaceNumber ∷ InterfaceNumber++ -- | Value used to select the alternate setting for the interface.+ , interfaceAltSetting ∷ InterfaceAltSetting++ -- | USB-IF class code for the interface.+ , interfaceClass ∷ Word8++ -- | USB-IF subclass code for the interface, qualified by the+ -- 'interfaceClass' value.+ , interfaceSubClass ∷ Word8++ -- | USB-IF protocol code for the interface, qualified by the+ -- 'interfaceClass' and 'interfaceSubClass' values.+ , interfaceProtocol ∷ Word8++ -- | Index of string descriptor describing the interface.+ , interfaceStrIx ∷ StrIx++ -- | List of endpoints supported by the interface.+ , interfaceEndpoints ∷ [EndpointDesc]++ -- | Extra descriptors. If @libusb@ encounters unknown interface+ -- descriptors, it will store them here, should you wish to parse them.+ , interfaceExtra ∷ B.ByteString+ } deriving (Show, Eq, Data, Typeable)++ --------------------------------------------------------------------------------+-- ** Endpoint descriptor+-------------------------------------------------------------------------------- -getConfigDesc ∷ Ptr C'libusb_device → Word8 → IO ConfigDesc-getConfigDesc devPtr ix =- alloca $ \configDescPtrPtr →- bracket ( do handleUSBException $ c'libusb_get_config_descriptor- devPtr- ix- configDescPtrPtr- peek configDescPtrPtr- )- c'libusb_free_config_descriptor- ((convertConfigDesc =<<) ∘ peek)+{-| A structure representing the standard USB endpoint descriptor. +This descriptor is documented in section 9.6.3 of the USB 2.0 specification. All+multiple-byte fields are represented in host-endian format.+-}+data EndpointDesc = EndpointDesc+ { -- | The address of the endpoint described by the descriptor.+ endpointAddress ∷ EndpointAddress++ -- | Attributes which apply to the endpoint when it is configured using the+ -- 'configValue'.+ , endpointAttribs ∷ EndpointAttribs++ -- | Maximum packet size the endpoint is capable of sending/receiving.+ , endpointMaxPacketSize ∷ MaxPacketSize++ -- | Interval for polling endpoint for data transfers. Expressed in frames+ -- or microframes depending on the device operating speed (i.e., either 1+ -- millisecond or 125 μs units).+ , endpointInterval ∷ Word8++ -- | /For audio devices only:/ the rate at which synchronization feedback+ -- is provided.+ , endpointRefresh ∷ Word8++ -- | /For audio devices only:/ the address if the synch endpoint.+ , endpointSynchAddress ∷ Word8++ -- | Extra descriptors. If @libusb@ encounters unknown endpoint descriptors,+ -- it will store them here, should you wish to parse them.+ , endpointExtra ∷ B.ByteString+ } deriving (Show, Eq, Data, Typeable)+ --------------------------------------------------------------------------------+-- *** Endpoint address+-------------------------------------------------------------------------------- +-- | The address of an endpoint.+data EndpointAddress = EndpointAddress+ { endpointNumber ∷ Int -- ^ Must be >= 0 and <= 15+ , transferDirection ∷ TransferDirection+ } deriving (Show, Eq, Data, Typeable)++-- | The direction of data transfer relative to the host.+data TransferDirection = Out -- ^ Out transfer direction (host -> device) used+ -- for writing.+ | In -- ^ In transfer direction (device -> host) used+ -- for reading.+ deriving (Show, Eq, Data, Typeable)++--------------------------------------------------------------------------------+-- *** Endpoint attributes+--------------------------------------------------------------------------------++-- | The USB 2.0 specification specifies that the endpoint attributes only+-- describe the endpoint transfer type.+type EndpointAttribs = TransferType++-- | Describes what types of transfers are allowed on the endpoint.+data TransferType =+ -- | Control transfers are typically used for command and status+ -- operations.+ Control++ -- | Isochronous transfers occur continuously and periodically.+ | Isochronous Synchronization Usage++ -- | Bulk transfers can be used for large bursty data.+ | Bulk++ -- | Interrupt transfers are typically non-periodic, small device+ -- \"initiated\" communication requiring bounded latency.+ | Interrupt+ deriving (Show, Eq, Data, Typeable)++data Synchronization = NoSynchronization+ | Asynchronous+ | Adaptive+ | Synchronous+ deriving (Enum, Show, Eq, Data, Typeable)++data Usage = Data+ | Feedback+ | Implicit+ deriving (Enum, Show, Eq, Data, Typeable)++--------------------------------------------------------------------------------+-- *** Endpoint max packet size+--------------------------------------------------------------------------------++data MaxPacketSize = MaxPacketSize+ { maxPacketSize ∷ Size+ , transactionOpportunities ∷ TransactionOpportunities+ } deriving (Show, Eq, Data, Typeable)++-- | Number of additional transactions.+data TransactionOpportunities = Zero | One | Two+ deriving (Enum, Show, Eq, Data, Typeable)++--------------------------------------------------------------------------------+-- Retrieving and converting descriptors+--------------------------------------------------------------------------------++getDeviceDesc ∷ Ptr C'libusb_device → IO DeviceDesc+getDeviceDesc devPtr = alloca $ \devDescPtr → do+ handleUSBException $ c'libusb_get_device_descriptor devPtr devDescPtr+ peek devDescPtr >>= convertDeviceDesc devPtr++convertDeviceDesc ∷ Ptr C'libusb_device+ → C'libusb_device_descriptor+ → IO DeviceDesc+convertDeviceDesc devPtr d = do+ let numConfigs = c'libusb_device_descriptor'bNumConfigurations d++ configs ← forM [0..numConfigs-1] $ getConfigDesc devPtr++ return DeviceDesc+ { deviceUSBSpecReleaseNumber = unmarshalBCD4 $+ c'libusb_device_descriptor'bcdUSB d+ , deviceClass = c'libusb_device_descriptor'bDeviceClass d+ , deviceSubClass = c'libusb_device_descriptor'bDeviceSubClass d+ , deviceProtocol = c'libusb_device_descriptor'bDeviceProtocol d+ , deviceMaxPacketSize0 = c'libusb_device_descriptor'bMaxPacketSize0 d+ , deviceVendorId = c'libusb_device_descriptor'idVendor d+ , deviceProductId = c'libusb_device_descriptor'idProduct d+ , deviceReleaseNumber = unmarshalBCD4 $+ c'libusb_device_descriptor'bcdDevice d+ , deviceManufacturerStrIx = c'libusb_device_descriptor'iManufacturer d+ , deviceProductStrIx = c'libusb_device_descriptor'iProduct d+ , deviceSerialNumberStrIx = c'libusb_device_descriptor'iSerialNumber d+ , deviceNumConfigs = numConfigs+ , deviceConfigs = configs+ }++getConfigDesc ∷ Ptr C'libusb_device → Word8 → IO ConfigDesc+getConfigDesc devPtr ix = bracket getConfigDescPtr+ c'libusb_free_config_descriptor+ ((convertConfigDesc =<<) ∘ peek)+ where+ getConfigDescPtr = alloca $ \configDescPtrPtr → do+ handleUSBException $ c'libusb_get_config_descriptor+ devPtr+ ix+ configDescPtrPtr+ peek configDescPtrPtr+ convertConfigDesc ∷ C'libusb_config_descriptor → IO ConfigDesc convertConfigDesc c = do let numInterfaces = c'libusb_config_descriptor'bNumInterfaces c - interfaces ← peekArray (fromIntegral numInterfaces)- (c'libusb_config_descriptor'interface c) >>=- mapM convertInterface+ interfaces ← mapPeekArray convertInterface+ (fromIntegral numInterfaces)+ (c'libusb_config_descriptor'interface c) - extra ← B.packCStringLen- ( castPtr $ c'libusb_config_descriptor'extra c- , fromIntegral $ c'libusb_config_descriptor'extra_length c- )+ extra ← getExtra (c'libusb_config_descriptor'extra c)+ (c'libusb_config_descriptor'extra_length c) return ConfigDesc { configValue = c'libusb_config_descriptor'bConfigurationValue c@@ -825,68 +956,32 @@ , configExtra = extra } -convertInterface∷ C'libusb_interface → IO [InterfaceDesc]-convertInterface i =- peekArray (fromIntegral $ c'libusb_interface'num_altsetting i)- (c'libusb_interface'altsetting i) >>=- mapM convertInterfaceDesc------------------------------------------------------------------------------------- ** Interface descriptor-----------------------------------------------------------------------------------{-| A structure representing the standard USB interface descriptor.--This descriptor is documented in section 9.6.5 of the USB 2.0 specification.+unmarshalConfigAttribs ∷ Word8 → ConfigAttribs+unmarshalConfigAttribs a = DeviceStatus { remoteWakeup = testBit a 5+ , selfPowered = testBit a 6+ } -This structure can be retrieved using 'configInterfaces'.--}-data InterfaceDesc = InterfaceDesc- { interfaceNumber ∷ InterfaceNumber -- ^ Number of the- -- interface.- , interfaceAltSetting ∷ InterfaceAltSetting -- ^ Value used to select- -- the alternate setting- -- for the interface.- , interfaceClass ∷ Word8 -- ^ USB-IF class code for- -- the interface.- , interfaceSubClass ∷ Word8 -- ^ USB-IF subclass code for- -- the interface,- -- qualified by the- -- 'interfaceClass' value.- , interfaceProtocol ∷ Word8 -- ^ USB-IF protocol code for- -- the interface,- -- qualified by the- -- 'interfaceClass' and- -- 'interfaceSubClass'- -- values.- , interfaceStrIx ∷ StrIx -- ^ Index of string- -- descriptor describing- -- the interface.- , interfaceEndpoints ∷ [EndpointDesc] -- ^ List of endpoints- -- supported by the- -- interface.- , interfaceExtra ∷ B.ByteString -- ^ Extra descriptors. If- -- libusb encounters- -- unknown interface- -- descriptors, it will- -- store them here, should- -- you wish to parse them.- } deriving (Show, Eq, Data, Typeable)+getExtra ∷ Ptr CUChar → CInt → IO B.ByteString+getExtra extra extraLength = B.packCStringLen ( castPtr extra+ , fromIntegral extraLength+ ) ---------------------------------------------------------------------------------+convertInterface∷ C'libusb_interface → IO [InterfaceDesc]+convertInterface i =+ mapPeekArray convertInterfaceDesc+ (fromIntegral $ c'libusb_interface'num_altsetting i)+ (c'libusb_interface'altsetting i) convertInterfaceDesc ∷ C'libusb_interface_descriptor → IO InterfaceDesc convertInterfaceDesc i = do let n = c'libusb_interface_descriptor'bNumEndpoints i - endpoints ← peekArray (fromIntegral n)- (c'libusb_interface_descriptor'endpoint i) >>=- mapM convertEndpointDesc+ endpoints ← mapPeekArray convertEndpointDesc+ (fromIntegral n)+ (c'libusb_interface_descriptor'endpoint i) - extra ← B.packCStringLen- ( castPtr $ c'libusb_interface_descriptor'extra i- , fromIntegral $ c'libusb_interface_descriptor'extra_length i- )+ extra ← getExtra (c'libusb_interface_descriptor'extra i)+ (c'libusb_interface_descriptor'extra_length i) return InterfaceDesc { interfaceNumber = c'libusb_interface_descriptor'bInterfaceNumber i@@ -899,53 +994,10 @@ , interfaceExtra = extra } ------------------------------------------------------------------------------------ ** Endpoint descriptor-----------------------------------------------------------------------------------{-| A structure representing the standard USB endpoint descriptor.--This descriptor is documented in section 9.6.3 of the USB 2.0 specification. All-multiple-byte fields are represented in host-endian format.--}-data EndpointDesc = EndpointDesc- { endpointAddress ∷ EndpointAddress- -- ^ The address of the endpoint described- -- by the descriptor.- , endpointAttribs ∷ EndpointAttribs- -- ^ Attributes which apply to the- -- endpoint when it is configured using- -- the 'configValue'.- , endpointMaxPacketSize ∷ MaxPacketSize- -- ^ Maximum packet size the endpoint is- -- capable of sending/receiving.- , endpointInterval ∷ Word8 -- ^ Interval for polling endpoint for- -- data transfers. Expressed in frames- -- or microframes depending on the- -- device operating speed (i.e., either- -- 1 millisecond or 125 μs units).- , endpointRefresh ∷ Word8 -- ^ /For audio devices only:/ the rate at- -- which synchronization feedback is- -- provided.- , endpointSynchAddress ∷ Word8 -- ^ /For audio devices only:/ the address- -- if the synch endpoint.- , endpointExtra ∷ B.ByteString- -- ^ Extra descriptors. If libusb- -- encounters unknown endpoint- -- descriptors, it will store- -- them here, should you wish to- -- parse them.- } deriving (Show, Eq, Data, Typeable)------------------------------------------------------------------------------------convertEndpointDesc ∷ C'libusb_endpoint_descriptor- → IO EndpointDesc+convertEndpointDesc ∷ C'libusb_endpoint_descriptor → IO EndpointDesc convertEndpointDesc e = do- extra ← B.packCStringLen- ( castPtr $ c'libusb_endpoint_descriptor'extra e- , fromIntegral $ c'libusb_endpoint_descriptor'extra_length e- )+ extra ← getExtra (c'libusb_endpoint_descriptor'extra e)+ (c'libusb_endpoint_descriptor'extra_length e) return EndpointDesc { endpointAddress = unmarshalEndpointAddress $@@ -960,33 +1012,13 @@ , endpointExtra = extra } ------------------------------------------------------------------------------------ *** Endpoint address------------------------------------------------------------------------------------- | The address of an endpoint.-data EndpointAddress = EndpointAddress- { endpointNumber ∷ Int -- ^ Must be >= 0 and <= 15- , transferDirection ∷ TransferDirection- } deriving (Show, Eq, Data, Typeable)---- | The direction of data transfer relative to the host.-data TransferDirection = Out -- ^ Out transfer direction (host → device) used- -- for writing.- | In -- ^ In transfer direction (device → host) used- -- for reading.- deriving (Show, Eq, Data, Typeable)- unmarshalEndpointAddress ∷ Word8 → EndpointAddress unmarshalEndpointAddress a = EndpointAddress { endpointNumber = fromIntegral $ bits 0 3 a- , transferDirection = if testBit a 7- then In- else Out+ , transferDirection = if testBit a 7 then In else Out } -marshalEndpointAddress ∷ (Bits a, Num a)- ⇒ EndpointAddress → a+marshalEndpointAddress ∷ (Bits a, Num a) ⇒ EndpointAddress → a marshalEndpointAddress (EndpointAddress num transDir) | between num 0 15 = let n = fromIntegral num in case transDir of@@ -995,52 +1027,16 @@ | otherwise = error "marshalEndpointAddress: endpointNumber not >= 0 and <= 15" ------------------------------------------------------------------------------------ *** Endpoint attributes-----------------------------------------------------------------------------------type EndpointAttribs = TransferType--data TransferType = Control- | Isochronous Synchronization Usage- | Bulk- | Interrupt- deriving (Show, Eq, Data, Typeable)--data Synchronization = NoSynchronization- | Asynchronous- | Adaptive- | Synchronous- deriving (Enum, Show, Eq, Data, Typeable)--data Usage = Data- | Feedback- | Implicit- deriving (Enum, Show, Eq, Data, Typeable)- unmarshalEndpointAttribs ∷ Word8 → EndpointAttribs unmarshalEndpointAttribs a = case bits 0 1 a of 0 → Control 1 → Isochronous (genToEnum $ bits 2 3 a)- (genToEnum $ bits 4 5 a)+ (genToEnum $ bits 4 5 a) 2 → Bulk 3 → Interrupt _ → error "unmarshalEndpointAttribs: this can't happen!" ------------------------------------------------------------------------------------ *** Endpoint max packet size-----------------------------------------------------------------------------------data MaxPacketSize = MaxPacketSize- { maxPacketSize ∷ Size- , transactionOpportunities ∷ TransactionOpportunities- } deriving (Show, Eq, Data, Typeable)---- | Number of additional transactions.-data TransactionOpportunities = Zero | One | Two- deriving (Enum, Show, Eq, Data, Typeable)- unmarshalMaxPacketSize ∷ Word16 → MaxPacketSize unmarshalMaxPacketSize m = MaxPacketSize@@ -1064,9 +1060,9 @@ let maxSize = 255 -- Some devices choke on size > 255 in allocaArray maxSize $ \dataPtr → do reportedSize ← putStrDesc devHndl 0 0 maxSize dataPtr- fmap (fmap unmarshalLangId) $- peekArray ((reportedSize - strDescHeaderSize) `div` 2)- (castPtr $ dataPtr `plusPtr` strDescHeaderSize)+ map unmarshalLangId <$>+ peekArray ((reportedSize - strDescHeaderSize) `div` 2)+ (castPtr $ dataPtr `plusPtr` strDescHeaderSize) {-| @putStrDesc devHndl strIx langId maxSize dataPtr@ retrieves the@@ -1090,12 +1086,12 @@ langId dataPtr (fromIntegral maxSize)- -- if there're enough bytes, parse the header+ -- if there are enough bytes, parse the header when (actualSize < strDescHeaderSize) $ throwIO IOException reportedSize ← peek dataPtr descType ← peekElemOff dataPtr 1 - -- Check header correctness:+ -- Check header incorrectness: when ( descType ≢ c'LIBUSB_DT_STRING ∨ reportedSize > fromIntegral actualSize ) $ throwIO IOException@@ -1107,7 +1103,7 @@ <http://www.usb.org/developers/docs/USB_LANGIDs.pdf> -For a mapping between IDs and languages see the /usb-id-database/ package at:+For a mapping between IDs and languages see the @usb-id-database@ package at: <http://hackage.haskell.org/package/usb-id-database> @@ -1139,11 +1135,10 @@ getStrDesc ∷ DeviceHandle → StrIx → LangId → Size → IO String getStrDesc devHndl strIx langId size = fmap (T.unpack ∘ TE.decodeUtf16LE ∘ B.drop strDescHeaderSize) $- BI.createAndTrim size $ putStrDesc- devHndl- strIx- (marshalLangId langId)- size+ BI.createAndTrim size $ putStrDesc devHndl+ strIx+ (marshalLangId langId)+ size ∘ castPtr {-| Retrieve a string descriptor from a device using the first supported@@ -1180,16 +1175,16 @@ A @ReadAction@ is a function which takes a 'Timeout' and a 'Size' which defines how many bytes to read. The function returns an 'IO' action which, when executed, performs the actual read and returns the 'B.ByteString' that was read-paired with an indication if the transfer timed out.+paired with a flag which indicates whether a transfer timed out. -}-type ReadAction = Timeout → Size → IO (B.ByteString, Bool)+type ReadAction = Timeout → Size → IO (B.ByteString, Bool) {-| Handy type synonym for write transfers. A @WriteAction@ is a function which takes a 'Timeout' and the 'B.ByteString' to write. The function returns an 'IO' action which, when exectued, returns the-number of bytes that were actually written paired with an indication if the-transfer timed out.+number of bytes that were actually written paired with an flag which indicates+whether a transfer timed out. -} type WriteAction = Timeout → B.ByteString → IO (Size, Bool) @@ -1201,7 +1196,7 @@ -- | Number of bytes transferred. type Size = Int - -------------------------------------------------------------------------------+------------------------------------------------------------------------------- -- ** Control transfers ------------------------------------------------------------------------------- @@ -1240,19 +1235,19 @@ → Word16 -- ^ Value. → Word16 -- ^ Index. → Timeout -- ^ Timeout (in milliseconds) that this function should- -- wait before giving up due to no response being- -- received. For no timeout, use value 0.+ -- wait before giving up due to no response being+ -- received. For no timeout, use value 0. → IO () control devHndl reqType reqRecipient request value index timeout =- ignore ∘ checkUSBException $ c'libusb_control_transfer- (getDevHndlPtr devHndl)- (marshalRequestType reqType reqRecipient)- request- value- index- nullPtr- 0- (fromIntegral timeout)+ void $ checkUSBException $ c'libusb_control_transfer+ (getDevHndlPtr devHndl)+ (marshalRequestType reqType reqRecipient)+ request+ value+ index+ nullPtr+ 0+ (fromIntegral timeout) {-| Perform a USB /control/ read. @@ -1277,9 +1272,7 @@ BI.createAndTrim' size $ \dataPtr → do err ← c'libusb_control_transfer (getDevHndlPtr devHndl)- (setBit (marshalRequestType reqType reqRecipient)- 7- )+ (setBit (marshalRequestType reqType reqRecipient) 7) request value index@@ -1484,7 +1477,7 @@ * 'PipeException' if the endpoint halted. * 'OverflowException' if the device offered more data,- see /Packets and overflows/ in the libusb documentation:+ see /Packets and overflows/ in the @libusb@ documentation: <http://libusb.sourceforge.net/api-1.0/packetoverflow.html>. * 'NoDeviceException' if the device has been disconnected.@@ -1506,7 +1499,7 @@ * 'PipeException' if the endpoint halted. * 'OverflowException' if the device offered more data,- see /Packets and overflows/ in the libusb documentation:+ see /Packets and overflows/ in the @libusb@ documentation: <http://libusb.sourceforge.net/api-1.0/packetoverflow.html>. * 'NoDeviceException' if the device has been disconnected.@@ -1557,7 +1550,7 @@ * 'PipeException' if the endpoint halted. * 'OverflowException' if the device offered more data,- see /Packets and overflows/ in the libusb documentation:+ see /Packets and overflows/ in the @libusb@ documentation: <http://libusb.sourceforge.net/api-1.0/packetoverflow.html>. * 'NoDeviceException' if the device has been disconnected.@@ -1584,9 +1577,7 @@ → CUInt -- timeout → IO CInt -- error -readTransfer ∷ C'TransferFunc → DeviceHandle- → EndpointAddress- → ReadAction+readTransfer ∷ C'TransferFunc → DeviceHandle → EndpointAddress → ReadAction readTransfer c'transfer devHndl endpointAddr = \timeout size → BI.createAndTrim' size $ \dataPtr → do (transferred, timedOut) ← transfer c'transfer@@ -1597,9 +1588,7 @@ dataPtr return (0, transferred, timedOut) -writeTransfer ∷ C'TransferFunc → DeviceHandle- → EndpointAddress- → WriteAction+writeTransfer ∷ C'TransferFunc → DeviceHandle → EndpointAddress → WriteAction writeTransfer c'transfer devHndl endpointAddr = \timeout input → input `writeWith` transfer c'transfer devHndl@@ -1614,11 +1603,11 @@ timeout size dataPtr = alloca $ \transferredPtr → do err ← c'transfer (getDevHndlPtr devHndl)- (marshalEndpointAddress endpointAddr)- (castPtr dataPtr)- (fromIntegral size)- transferredPtr- (fromIntegral timeout)+ (marshalEndpointAddress endpointAddr)+ (castPtr dataPtr)+ (fromIntegral size)+ transferredPtr+ (fromIntegral timeout) let timedOut = err ≡ c'LIBUSB_ERROR_TIMEOUT if err ≢ c'LIBUSB_SUCCESS ∧ not timedOut then throwIO $ convertUSBException err@@ -1704,7 +1693,7 @@ -- | Decode a @Word16@ as a Binary Coded Decimal using 4 bits per digit. unmarshalBCD4 ∷ Word16 → BCD4-unmarshalBCD4 bcd = let [a, b, c, d] = fmap fromIntegral $ decodeBCD 4 bcd+unmarshalBCD4 bcd = let [a, b, c, d] = map fromIntegral $ decodeBCD 4 bcd in (a, b, c, d) {-| @decodeBCD bitsInDigit n@ decodes the Binary Coded Decimal @n@ to a list of@@ -1736,8 +1725,8 @@ between n b e = n ≥ b ∧ n ≤ e -- | Execute the given action but ignore the result.-ignore ∷ Monad m ⇒ m α → m ()-ignore = (>> return ())+void ∷ Functor m ⇒ m α → m ()+void = (() <$) -- | A generalized 'toEnum' that works on any 'Integral' type. genToEnum ∷ (Integral i, Enum e) ⇒ i → e@@ -1746,6 +1735,11 @@ -- | A generalized 'fromEnum' that returns any 'Integral' type. genFromEnum ∷ (Integral i, Enum e) ⇒ e → i genFromEnum = fromIntegral ∘ fromEnum++-- | @mapPeekArray f n a@ applies the monadic function @f@ to each of the @n@+-- elements of the array @a@ and returns the results in a list.+mapPeekArray ∷ Storable α ⇒ (α → IO β) → Int → Ptr α → IO [β]+mapPeekArray f n a = peekArray n a >>= mapM f -- | @input `writeWith` doWrite@ first converts the @input@ @ByteString@ to an -- array of @Word8@s, then @doWrite@ is executed by pointing it to the size of
usb.cabal view
@@ -1,11 +1,11 @@ name: usb-version: 0.3.0.1+version: 0.3.1 cabal-version: >=1.6 build-type: Simple license: BSD3 license-file: LICENSE-copyright: 2009 Bas van Dijk-author: Bas van Dijk+copyright: 2009–2010 Bas van Dijk <v.dijk.bas@gmail.com>+author: Bas van Dijk <v.dijk.bas@gmail.com> maintainer: Bas van Dijk <v.dijk.bas@gmail.com> stability: experimental category: System@@ -19,29 +19,22 @@ Type: darcs Location: http://code.haskell.org/~basvandijk/code/usb -Flag Enumerator- Description: Export module System.USB.IO.Synchronous.Enumerator- Default: True- Library- GHC-Options: -O2 -Wall- build-depends: base >= 4 && < 4.3- , base-unicode-symbols >= 0.1.1 && < 0.2- , bindings-libusb >= 1.3 && < 1.5- , bytestring == 0.9.*- , text >= 0.5 && < 0.8+ GHC-Options: -Wall+ build-depends: base >= 4 && < 4.3+ , base-unicode-symbols >= 0.1.1 && < 0.3+ , bindings-libusb >= 1.3 && < 1.5+ , bytestring >= 0.9 && < 0.10+ , text >= 0.5 && < 0.8+ , iteratee >= 0.3.5 && < 0.4+ , transformers >= 0.2 && < 0.3+ , MonadCatchIO-transformers >= 0.2 && < 0.3 exposed-modules: System.USB System.USB.Initialization System.USB.Enumeration System.USB.DeviceHandling System.USB.Descriptors System.USB.IO.Synchronous+ System.USB.IO.Synchronous.Enumerator System.USB.Exceptions other-modules: System.USB.Internal-- if flag(Enumerator)- build-depends: iteratee >= 0.2 && < 0.4- , transformers >= 0.1.4 && < 0.2- , MonadCatchIO-transformers == 0.0.2.*-- exposed-modules: System.USB.IO.Synchronous.Enumerator