usb 0.4 → 0.5
raw patch · 11 files changed
+606/−542 lines, 11 filesdep −MonadCatchIO-transformersdep −MonadCatchIO-transformers-foreigndep −iteratee
Dependencies removed: MonadCatchIO-transformers, MonadCatchIO-transformers-foreign, iteratee, transformers
Files
- Data/BCD.hs +49/−0
- System/USB.hs +1/−33
- System/USB/Descriptors.hs +1/−0
- System/USB/IO/StandardDeviceRequests.hs +239/−0
- System/USB/IO/Synchronous.hs +2/−13
- System/USB/IO/Synchronous/Enumerator.hs +0/−157
- System/USB/Initialization.hs +1/−1
- System/USB/Internal.hs +171/−324
- System/USB/Unsafe.hs +21/−0
- Utils.hs +70/−0
- usb.cabal +51/−14
+ Data/BCD.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax #-}++module Data.BCD ( BCD4, unmarshalBCD4, decodeBCD ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Prelude ( fromInteger, fromIntegral, (-) )+import Control.Monad ( (>>) )+import Data.Bits ( Bits, shiftL, shiftR, bitSize )+import Data.Bool ( otherwise )+import Data.Function ( ($) )+import Data.List ( map )+import Data.Ord ( (<) )+import Data.Int ( Int )+import Data.Word ( Word16 )+++--------------------------------------------------------------------------------+-- Binary Coded Decimals+--------------------------------------------------------------------------------++-- | A decoded 16 bits Binary Coded Decimal using 4 bits for each digit.+type BCD4 = (Int, Int, Int, Int)++-- | Decode a @Word16@ as a Binary Coded Decimal using 4 bits per digit.+unmarshalBCD4 ∷ Word16 → BCD4+unmarshalBCD4 abcd = (a, b, c, d)+ where+ [a, b, c, d] = map fromIntegral $ decodeBCD 4 abcd++{-| @decodeBCD bitsInDigit bcd@ decodes the Binary Coded Decimal @bcd@ to a list+of its encoded digits. @bitsInDigit@, which is usually 4, is the number of bits+used to encode a single digit. See:+<http://en.wikipedia.org/wiki/Binary-coded_decimal>+-}+decodeBCD ∷ Bits α ⇒ Int → α → [α]+decodeBCD bitsInDigit abcd = go shftR []+ where+ shftR = bitSize abcd - bitsInDigit++ go shftL ds | shftL < 0 = ds+ | otherwise = go (shftL - bitsInDigit)+ (((abcd `shiftL` shftL) `shiftR` shftR) : ds)+++-- The End ---------------------------------------------------------------------
System/USB.hs view
@@ -5,37 +5,7 @@ -- License : BSD-style (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> ----- This library allows you to communicate with USB devices from userspace. It is--- implemented as a high-level wrapper around @bindings-libusb@ which is a--- low-level binding to the C library: @libusb-1.*@.------ This documentation assumes knowledge of how to operate USB devices from a--- software standpoint (descriptors, configurations, interfaces, endpoints,--- control\/bulk\/interrupt\/isochronous transfers, etc). Full information can--- be found in the USB 2.0 Specification.------ For an example how to use this library see the @ls-usb@ package at:------ <http://hackage.haskell.org/package/ls-usb>------ 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>------ Besides this API documentation the following sources might be interesting:------ * The libusb 1.0 documentation at:--- <http://libusb.sourceforge.net/api-1.0/>------ * The USB 2.0 specification at:--- <http://www.usb.org/developers/docs/>------ * The @bindings-libusb@ documentation at:--- <http://hackage.haskell.org/package/bindings-libusb>------ * \"USB in a NutShell\" at:--- <http://www.beyondlogic.org/usbnutshell/usb1.htm>+-- A convenience module which re-exports all the important modules. -- -------------------------------------------------------------------------------- @@ -45,7 +15,6 @@ , module System.USB.DeviceHandling , module System.USB.Descriptors , module System.USB.IO.Synchronous- , module System.USB.IO.Synchronous.Enumerator , module System.USB.Exceptions ) where @@ -54,5 +23,4 @@ import System.USB.DeviceHandling import System.USB.Descriptors import System.USB.IO.Synchronous-import System.USB.IO.Synchronous.Enumerator import System.USB.Exceptions
System/USB/Descriptors.hs view
@@ -69,3 +69,4 @@ ) where import System.USB.Internal+import Data.BCD ( BCD4 )
+ System/USB/IO/StandardDeviceRequests.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax, DeriveDataTypeable #-}++--------------------------------------------------------------------------------+-- |+-- Module : System.USB.IO.StandardDeviceRequests+-- Copyright : (c) 2009–2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-- This module provides functionality for performing standard device requests.+--+--------------------------------------------------------------------------------++module System.USB.IO.StandardDeviceRequests+ ( setHalt+ , clearRemoteWakeup+ , setRemoteWakeup+ , setStandardTestMode, TestMode(..)+ , getInterfaceAltSetting+ , getDeviceStatus+ , getEndpointStatus+ , setDeviceAddress+ , synchFrame, FrameNumber+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Data.Bits ( testBit, shiftL )+import Data.Bool ( Bool )+import Data.Data ( Data )+import Data.Eq ( Eq )+import Data.Functor ( (<$>) )+import Data.Typeable ( Typeable )+import Data.Word ( Word8, Word16 )+import Prelude ( (+), fromInteger, fromIntegral, Enum )+import System.IO ( IO )+import Text.Read ( Read )+import Text.Show ( Show )++-- from base-unicode-symbols:+import Data.Eq.Unicode ( (≡) )+import Data.Function.Unicode ( (∘) )+import Prelude.Unicode ( (⋅) )++-- from bytestring:+import qualified Data.ByteString as B ( head, unpack )++-- from bindings-libusb:+import Bindings.Libusb ( c'LIBUSB_REQUEST_SET_FEATURE+ , c'LIBUSB_REQUEST_CLEAR_FEATURE+ , c'LIBUSB_REQUEST_GET_INTERFACE+ , c'LIBUSB_REQUEST_GET_STATUS+ , c'LIBUSB_REQUEST_SET_ADDRESS+ , c'LIBUSB_REQUEST_SYNCH_FRAME+ )++-- from usb:+import System.USB.DeviceHandling ( DeviceHandle+ , InterfaceNumber+ , InterfaceAltSetting+ )+import System.USB.Descriptors ( EndpointAddress+ , DeviceStatus(..)+ )+import System.USB.IO.Synchronous ( Timeout+ , RequestType(Standard)+ , Recipient( ToDevice+ , ToInterface+ , ToEndpoint+ )+ , Value+ , control, readControlExact+ )++import System.USB.Unsafe ( marshalEndpointAddress )++import Utils ( genFromEnum )+++--------------------------------------------------------------------------------+-- Standard Device Requests+-------------------------------------------------------------------------------++-- See: USB 2.0 Spec. section 9.4++-- Standard Feature Selectors:+-- See: USB 2.0 Spec. table 9-6+haltFeature, remoteWakeupFeature, testModeFeature ∷ Value+haltFeature = 0+remoteWakeupFeature = 1+testModeFeature = 2++-- | 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)++-- | See: USB 2.0 Spec. section 9.4.1+clearRemoteWakeup ∷ DeviceHandle → (Timeout → IO ())+clearRemoteWakeup devHndl =+ control devHndl+ Standard+ ToDevice+ c'LIBUSB_REQUEST_CLEAR_FEATURE+ remoteWakeupFeature+ 0++-- | See: USB 2.0 Spec. section 9.4.9+setRemoteWakeup ∷ DeviceHandle → (Timeout → IO ())+setRemoteWakeup devHndl =+ control devHndl+ Standard+ ToDevice+ c'LIBUSB_REQUEST_SET_FEATURE+ remoteWakeupFeature+ 0++-- | See: USB 2.0 Spec. section 9.4.9+-- TODO: What about vendor-specific test modes?+setStandardTestMode ∷ DeviceHandle → TestMode → (Timeout → IO ())+setStandardTestMode devHndl testMode =+ control devHndl+ Standard+ ToDevice+ c'LIBUSB_REQUEST_SET_FEATURE+ testModeFeature+ ((genFromEnum testMode + 1) `shiftL` 8)++-- | See: USB 2.0 Spec. table 9-7+data TestMode = Test_J+ | Test_K+ | Test_SE0_NAK+ | Test_Packet+ | Test_Force_Enable+ deriving (Eq, Show, Read, Enum, Data, Typeable)++-- | 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++-- | 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+ where+ unmarshalDeviceStatus ∷ Word8 → DeviceStatus+ unmarshalDeviceStatus 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++-- | See: USB 2.0 Spec. section 9.4.6+setDeviceAddress ∷ DeviceHandle → Word16 → (Timeout → IO ())+setDeviceAddress devHndl deviceAddr = control devHndl+ Standard+ ToDevice+ c'LIBUSB_REQUEST_SET_ADDRESS+ deviceAddr+ 0++-- TODO: setDescriptor See: USB 2.0 Spec. section 9.4.8++-- TODO Sync Frame klopt niet helemaal, je kunt met deze request ook het frame number setten!++{-|+This request is used to set and then report an endpoint's synchronization frame.++When an endpoint supports isochronous transfers, the endpoint may also require+per-frame transfers to vary in size according to a specific pattern. The host+and the endpoint must agree on which frame the repeating pattern begins. The+number of the frame in which the pattern began is returned to the host.++If a high-speed device supports the Synch Frame request, it must internally+synchronize itself to the zeroth microframe and have a time notion of classic+frame. Only the frame number is used to synchronize and reported by the device+endpoint (i.e., no microframe number). The endpoint must synchronize to the+zeroth microframe.++This value is only used for isochronous data transfers using implicit pattern+synchronization. If the specified endpoint does not support this request, then+the device will respond with a Request Error.++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+ where+ unmarshallFrameNumber bs = let [h, l] = B.unpack bs+ in fromIntegral h ⋅ 256 + fromIntegral l++type FrameNumber = Word16+++-- The End ---------------------------------------------------------------------
System/USB/IO/Synchronous.hs view
@@ -14,7 +14,7 @@ ( ReadAction , WriteAction - , Timeout+ , Timeout, TimedOut , Size -- * Control transfers@@ -26,19 +26,8 @@ , Index , control- , readControl+ , readControl, readControlExact , writeControl-- -- ** Standard Device Requests- , setHalt- , clearRemoteWakeup- , setRemoteWakeup- , setStandardTestMode, TestMode(..)- , getInterfaceAltSetting- , getDeviceStatus- , getEndpointStatus- , setDeviceAddress- , synchFrame -- * Bulk transfers , readBulk
− System/USB/IO/Synchronous/Enumerator.hs
@@ -1,157 +0,0 @@-{-# LANGUAGE CPP, UnicodeSyntax, NoImplicitPrelude, FlexibleContexts #-}------------------------------------------------------------------------------------- |--- Module : System.USB.IO.Synchronous.Enumerator--- Copyright : (c) 2009–2010 Bas van Dijk--- License : BSD3 (see the file LICENSE)--- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>------ /Untested/ /experimental/ enumerators for endpoints.--------------------------------------------------------------------------------------module System.USB.IO.Synchronous.Enumerator- ( enumReadBulk- , enumReadInterrupt- ) where-------------------------------------------------------------------------------------- Imports------------------------------------------------------------------------------------- from base:-import Prelude ( fromInteger, fromIntegral )-import Data.Function ( ($) )-import Data.Word ( Word8 )-import Data.Maybe ( Maybe(Nothing, Just) )-import Control.Monad ( return, (>>=), fail )-import Text.Show ( show )-import Foreign.Storable ( peek )-import Foreign.Ptr ( castPtr )---- from base-unicode-symbols:-import Data.Eq.Unicode ( (≡), (≢) )-import Data.Bool.Unicode ( (∧) )---- from 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.IO.Class ( liftIO )---- from MonadCatchIO-transformers:-import Control.Monad.CatchIO ( MonadCatchIO )---- from MonadCatchIO-transformers-foreign:-import Control.Monad.CatchIO.Foreign ( alloca, allocaBytes )---- from iteratee:-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- )--#ifdef __HADDOCK__-import System.USB.Descriptors ( maxPacketSize, endpointMaxPacketSize )-#endif-------------------------------------------------------------------------------------- Enumerators-----------------------------------------------------------------------------------enumReadBulk ∷ (ReadableChunk s Word8, 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.- → Size -- ^ Chunk size. A good value for this would be- -- the @'maxPacketSize' . 'endpointMaxPacketSize'@.- → 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.- → EnumeratorGM s Word8 m α-enumReadBulk = enumRead c'libusb_bulk_transfer--enumReadInterrupt ∷ (ReadableChunk s Word8, 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.- → Size -- ^ Chunk size. A good value for this would- -- be the @'maxPacketSize' . 'endpointMaxPacketSize'@.- → 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.- → EnumeratorGM s Word8 m α-enumReadInterrupt = enumRead c'libusb_interrupt_transfer-------------------------------------------------------------------------------------enumRead ∷ (ReadableChunk s Word8, MonadCatchIO m)- ⇒ C'TransferFunc → ( DeviceHandle- → EndpointAddress- → Size- → Timeout- → EnumeratorGM s Word8 m α- )-enumRead c'transfer = \devHndl- endpoint- chunkSize- timeout → \iter →- alloca $ \transferredPtr →- allocaBytes chunkSize $ \dataPtr →- let loop i1 = do- err ← liftIO $ c'transfer (getDevHndlPtr devHndl)- (marshalEndpointAddress endpoint)- (castPtr dataPtr)- (fromIntegral chunkSize)- 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- if t ≡ 0- then return i1- else do- 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- in loop iter----- The End ---------------------------------------------------------------------
System/USB/Initialization.hs view
@@ -5,7 +5,7 @@ -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> ----- This module provides functionality for initializing this @usb@ library.+-- This module provides functionality for initializing the @usb@ library. -- --------------------------------------------------------------------------------
System/USB/Internal.hs view
@@ -8,13 +8,13 @@ -------------------------------------------------------------------------------- -- from base:-import Prelude ( Num, (+), (-), fromInteger, (^)+import Prelude ( Num, (+), (-), (*), fromInteger , Integral, fromIntegral, div- , Enum, fromEnum, toEnum- , error+ , Enum, error ) import Foreign ( unsafePerformIO ) import Foreign.C.Types ( CUChar, CInt, CUInt )+import Foreign.C.String ( CStringLen ) import Foreign.Marshal.Alloc ( alloca ) import Foreign.Marshal.Array ( peekArray, allocaArray ) import Foreign.Storable ( Storable, peek, peekElemOff )@@ -26,51 +26,48 @@ , bracket, bracket_ , block, unblock , onException+ , assert ) import Control.Monad ( Monad, return, (>>=), (>>), (=<<), fail- , when, forM, mapM+ , when, forM ) import Control.Arrow ( (&&&) )-import Data.Function ( ($), flip )-import Data.Functor ( Functor, fmap, (<$), (<$>) )+import Data.Function ( ($), flip, on )+import Data.Functor ( Functor, fmap, (<$>) ) import Data.Data ( Data ) import Data.Typeable ( Typeable ) import Data.Maybe ( fromMaybe )-import Data.List ( lookup, map )+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 ) import Data.Bits ( Bits- , (.|.), (.&.)+ , (.|.) , setBit, testBit- , shiftR, shiftL- , bitSize+ , shiftL ) import System.IO ( IO )-import Text.Show ( Show )+import Text.Show ( Show, show )+import Text.Read ( Read )+import Text.Printf ( printf ) -- from base-unicode-symbols:-import Prelude.Unicode ( (⋅) ) import Data.Function.Unicode ( (∘) )-import Data.Bool.Unicode ( (∧), (∨) )+import Data.Bool.Unicode ( (∧) ) import Data.Eq.Unicode ( (≢), (≡) )-import Data.Ord.Unicode ( (≥), (≤) ) -- from bytestring: import qualified Data.ByteString as B ( ByteString , packCStringLen , drop- , head- , length- , unpack ) import qualified Data.ByteString.Internal as BI ( createAndTrim , createAndTrim'- , toForeignPtr )+import qualified Data.ByteString.Unsafe as BU ( unsafeUseAsCStringLen ) -- from text: import qualified Data.Text as T ( unpack )@@ -79,7 +76,17 @@ -- from bindings-libusb: import Bindings.Libusb +-- from usb:+import Data.BCD ( BCD4, unmarshalBCD4 )+import Utils ( bits+ , between+ , void+ , genToEnum, genFromEnum+ , mapPeekArray+ , ifM+ ) + -------------------------------------------------------------------------------- -- * Initialization --------------------------------------------------------------------------------@@ -95,6 +102,7 @@ The only functions that receive a @Ctx@ are 'setDebug' and 'getDevices'. -} newtype Ctx = Ctx { unCtx ∷ ForeignPtr C'libusb_context }+ deriving (Eq, Typeable) withCtxPtr ∷ Ctx → (Ptr C'libusb_context → IO α) → IO α withCtxPtr = withForeignPtr ∘ unCtx@@ -129,9 +137,8 @@ nothing: you'll always get messages from all levels. -} setDebug ∷ Ctx → Verbosity → IO ()-setDebug ctx verbosity =- withCtxPtr ctx $ \ctxPtr →- c'libusb_set_debug ctxPtr $ genFromEnum verbosity+setDebug ctx verbosity = withCtxPtr ctx $ \ctxPtr →+ c'libusb_set_debug ctxPtr $ genFromEnum verbosity -- | Message verbosity data Verbosity =@@ -140,7 +147,7 @@ | PrintWarnings -- ^ Warning and error messages are printed to stderr | PrintInfo -- ^ Informational messages are printed to stdout, -- warning and error messages are printed to stderr- deriving Enum+ deriving (Enum, Show, Read, Eq, Ord, Data, Typeable) --------------------------------------------------------------------------------@@ -163,6 +170,9 @@ To get additional information about a device you can retrieve its descriptor using 'deviceDesc'.++Note that equality on devices is defined by comparing their descriptors:+@(==) = (==) \`on\` `deviceDesc`@ -} data Device = Device { _ctx ∷ Ctx -- ^ This reference to the 'Ctx' is needed so that it won't@@ -172,8 +182,19 @@ , getDevFrgnPtr ∷ ForeignPtr C'libusb_device , deviceDesc ∷ DeviceDesc -- ^ Get the descriptor of the device.- }+ } deriving Typeable +instance Eq Device where+ (==) = (==) `on` deviceDesc++instance Show Device where+ show d = printf "Bus %03d Device %03d: ID %04x:%04x" (busNumber d)+ (deviceAddress d)+ (deviceVendorId desc)+ (deviceProductId desc)+ where+ desc = deviceDesc d+ withDevicePtr ∷ Device → (Ptr C'libusb_device → IO α) → IO α withDevicePtr = withForeignPtr ∘ getDevFrgnPtr @@ -206,26 +227,20 @@ -} getDevices ∷ Ctx → IO [Device] getDevices ctx =- withCtxPtr ctx $ \ctxPtr → alloca $ \devPtrArrayPtr → block $ do-- numDevs ← c'libusb_get_device_list ctxPtr devPtrArrayPtr+ numDevs ← withCtxPtr ctx $ flip c'libusb_get_device_list devPtrArrayPtr+ when (numDevs ≡ c'LIBUSB_ERROR_NO_MEM) $ throwIO NoMemException devPtrArray ← peek devPtrArrayPtr- let freeDevPtrArray = c'libusb_free_device_list devPtrArray 0-- devs ← flip onException freeDevPtrArray $ unblock $- case numDevs of- n | n ≡ c'LIBUSB_ERROR_NO_MEM → throwIO NoMemException- | n < 0 → unknownLibUsbError- | otherwise → do- devPtrs ← peekArray (fromIntegral numDevs) devPtrArray- forM devPtrs $ \devPtr →- liftA2 (Device ctx)- (newForeignPtr p'libusb_unref_device devPtr)- (getDeviceDesc devPtr)+ devs ← unblock (mapPeekArray mkDev (fromIntegral numDevs) devPtrArray)+ `onException` freeDevPtrArray freeDevPtrArray return devs+ where+ mkDev ∷ Ptr C'libusb_device → IO Device+ mkDev devPtr = liftA2 (Device ctx)+ (newForeignPtr p'libusb_unref_device devPtr)+ (getDeviceDesc devPtr) -- | The number of the bus that a device is connected to. busNumber ∷ Device → Word8@@ -264,8 +279,15 @@ -- and therefor the 'Ctx' alive. -- ^ Retrieve the 'Device' from the 'DeviceHandle'. , getDevHndlPtr ∷ Ptr C'libusb_device_handle- }+ -- ^ Retrieve the pointer to the @libusb@ device handle.+ } deriving Typeable +instance Eq DeviceHandle where+ (==) = (==) `on` getDevHndlPtr++instance Show DeviceHandle where+ show devHndl = "{USB device handle to: " ++ show (getDevice devHndl) ++ "}"+ {-| Open a device and obtain a device handle. A handle allows you to perform I/O on the device in question.@@ -420,8 +442,8 @@ -} claimInterface ∷ DeviceHandle → InterfaceNumber → IO ()-claimInterface (DeviceHandle _ devHndlPtr) ifNum =- handleUSBException $ c'libusb_claim_interface devHndlPtr+claimInterface devHndl ifNum =+ handleUSBException $ c'libusb_claim_interface (getDevHndlPtr devHndl) (fromIntegral ifNum) {-| Release an interface previously claimed with 'claimInterface'.@@ -440,8 +462,8 @@ * Another 'USBException'. -} releaseInterface ∷ DeviceHandle → InterfaceNumber → IO ()-releaseInterface (DeviceHandle _ devHndlPtr) ifNum =- handleUSBException $ c'libusb_release_interface devHndlPtr+releaseInterface devHndl ifNum =+ handleUSBException $ c'libusb_release_interface (getDevHndlPtr devHndl) (fromIntegral ifNum) {-| @withClaimedInterface@ claims the interface on the given device handle then@@ -681,7 +703,7 @@ -- | List of configurations supported by the device. , deviceConfigs ∷ [ConfigDesc]- } deriving (Show, Eq, Data, Typeable)+ } deriving (Show, Read, Eq, Data, Typeable) type VendorId = Word16 type ProductId = Word16@@ -722,7 +744,7 @@ -- descriptors, it will store them here, should you wish to parse them. , configExtra ∷ B.ByteString - } deriving (Show, Eq, Data, Typeable)+ } deriving (Show, Read, Eq, Data, Typeable) -- | An interface is represented as a list of alternate interface settings. type Interface = [InterfaceDesc]@@ -742,7 +764,7 @@ -- support remote wakeup is disabled. , selfPowered ∷ Bool -- ^ The Self Powered field indicates whether the -- device is currently self-powered- } deriving (Show, Eq, Data, Typeable)+ } deriving (Show, Read, Eq, Data, Typeable) -------------------------------------------------------------------------------- -- ** Interface descriptor@@ -781,7 +803,7 @@ -- | 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)+ } deriving (Show, Read, Eq, Data, Typeable) --------------------------------------------------------------------------------@@ -819,7 +841,7 @@ -- | 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)+ } deriving (Show, Read, Eq, Data, Typeable) -------------------------------------------------------------------------------- -- *** Endpoint address@@ -829,14 +851,14 @@ data EndpointAddress = EndpointAddress { endpointNumber ∷ Int -- ^ Must be >= 0 and <= 15 , transferDirection ∷ TransferDirection- } deriving (Show, Eq, Data, Typeable)+ } deriving (Show, Read, 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)+ deriving (Show, Read, Eq, Data, Typeable) -------------------------------------------------------------------------------- -- *** Endpoint attributes@@ -861,18 +883,18 @@ -- | Interrupt transfers are typically non-periodic, small device -- \"initiated\" communication requiring bounded latency. | Interrupt- deriving (Show, Eq, Data, Typeable)+ deriving (Show, Read, Eq, Data, Typeable) data Synchronization = NoSynchronization | Asynchronous | Adaptive | Synchronous- deriving (Enum, Show, Eq, Data, Typeable)+ deriving (Enum, Show, Read, Eq, Data, Typeable) data Usage = Data | Feedback | Implicit- deriving (Enum, Show, Eq, Data, Typeable)+ deriving (Enum, Show, Read, Eq, Data, Typeable) -------------------------------------------------------------------------------- -- *** Endpoint max packet size@@ -881,11 +903,11 @@ data MaxPacketSize = MaxPacketSize { maxPacketSize ∷ Size , transactionOpportunities ∷ TransactionOpportunities- } deriving (Show, Eq, Data, Typeable)+ } deriving (Show, Read, Eq, Data, Typeable) -- | Number of additional transactions. data TransactionOpportunities = Zero | One | Two- deriving (Enum, Show, Eq, Data, Typeable)+ deriving (Enum, Ord, Show, Read, Eq, Data, Typeable) -------------------------------------------------------------------------------- -- Retrieving and converting descriptors@@ -966,7 +988,7 @@ , fromIntegral extraLength ) -convertInterface∷ C'libusb_interface → IO [InterfaceDesc]+convertInterface ∷ C'libusb_interface → IO [InterfaceDesc] convertInterface i = mapPeekArray convertInterfaceDesc (fromIntegral $ c'libusb_interface'num_altsetting i)@@ -1018,14 +1040,14 @@ , transferDirection = if testBit a 7 then In else Out } +-- | Marshal an @EndpointAddress@ so that it can be used by the @libusb@+-- transfer functions. marshalEndpointAddress ∷ (Bits a, Num a) ⇒ EndpointAddress → a-marshalEndpointAddress (EndpointAddress num transDir)- | between num 0 15 = let n = fromIntegral num- in case transDir of- Out → n- In → setBit n 7- | otherwise =- error "marshalEndpointAddress: endpointNumber not >= 0 and <= 15"+marshalEndpointAddress (EndpointAddress num transDir) =+ assert (between num 0 15) $ let n = fromIntegral num+ in case transDir of+ Out → n+ In → setBit n 7 unmarshalEndpointAttribs ∷ Word8 → EndpointAttribs unmarshalEndpointAttribs a =@@ -1048,6 +1070,7 @@ -- ** String descriptors -------------------------------------------------------------------------------- +-- | The size in number of bytes of the header of string descriptors strDescHeaderSize ∷ Size strDescHeaderSize = 2 @@ -1056,15 +1079,17 @@ This function may throw 'USBException's. -} getLanguages ∷ DeviceHandle → IO [LangId]-getLanguages devHndl =- let maxSize = 255 -- Some devices choke on size > 255- in allocaArray maxSize $ \dataPtr → do- reportedSize ← putStrDesc devHndl 0 0 maxSize dataPtr- map unmarshalLangId <$>- peekArray ((reportedSize - strDescHeaderSize) `div` 2)- (castPtr $ dataPtr `plusPtr` strDescHeaderSize)+getLanguages devHndl = allocaArray maxSize $ \dataPtr → do+ reportedSize ← write dataPtr + let strSize = (reportedSize - strDescHeaderSize) `div` 2+ strPtr = castPtr $ dataPtr `plusPtr` strDescHeaderSize + map unmarshalLangId <$> peekArray strSize strPtr+ where+ maxSize = 255 -- Some devices choke on size > 255+ write = putStrDesc devHndl 0 0 maxSize+ {-| @putStrDesc devHndl strIx langId maxSize dataPtr@ retrieves the string descriptor @strIx@ in the language @langId@ from the @devHndl@ and writes at most @maxSize@ bytes from that string descriptor to the@@ -1086,15 +1111,18 @@ langId dataPtr (fromIntegral maxSize)- -- if there are enough bytes, parse the header- when (actualSize < strDescHeaderSize) $ throwIO IOException+ when (actualSize < strDescHeaderSize) $+ throwIO $ IOException "Incomplete header"+ reportedSize ← peek dataPtr++ when (reportedSize > fromIntegral actualSize) $+ throwIO $ IOException "Not enough space to hold data"+ descType ← peekElemOff dataPtr 1 - -- Check header incorrectness:- when ( descType ≢ c'LIBUSB_DT_STRING- ∨ reportedSize > fromIntegral actualSize- ) $ throwIO IOException+ when (descType ≢ c'LIBUSB_DT_STRING) $+ throwIO $ IOException "Invalid header" return $ fromIntegral reportedSize @@ -1132,14 +1160,19 @@ This function may throw 'USBException's. -}-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- ∘ castPtr+getStrDesc ∷ DeviceHandle+ → StrIx+ → LangId+ → Int -- ^ Maximum number of characters in the requested string. An+ -- 'IOException' will be thrown when the requested string is+ -- larger than this number.+ → IO String+getStrDesc devHndl strIx langId nrOfChars =+ fmap decode $ BI.createAndTrim size $ write ∘ castPtr+ where+ write = putStrDesc devHndl strIx (marshalLangId langId) size+ size = strDescHeaderSize + 2 * nrOfChars -- characters are 2 bytes+ decode = T.unpack ∘ TE.decodeUtf16LE ∘ B.drop strDescHeaderSize {-| Retrieve a string descriptor from a device using the first supported language.@@ -1150,12 +1183,17 @@ This function may throw 'USBException's. -}-getStrDescFirstLang ∷ DeviceHandle → StrIx → Size → IO String-getStrDescFirstLang devHndl strIx size =+getStrDescFirstLang ∷ DeviceHandle+ → StrIx+ → Int -- ^ Maximum number of characters in the requested+ -- string. An 'IOException' will be thrown when the+ -- requested string is larger than this number.+ → IO String+getStrDescFirstLang devHndl strIx nrOfChars = do langIds ← getLanguages devHndl case langIds of- [] → throwIO IOException- langId : _ → getStrDesc devHndl strIx langId size+ [] → throwIO $ IOException "Zero languages"+ langId : _ → getStrDesc devHndl strIx langId nrOfChars --------------------------------------------------------------------------------@@ -1177,7 +1215,7 @@ executed, performs the actual read and returns the 'B.ByteString' that was read paired with a flag which indicates whether a transfer timed out. -}-type ReadAction = Size → Timeout → IO (B.ByteString, Bool)+type ReadAction = Size → Timeout → IO (B.ByteString, TimedOut) {-| Handy type synonym for write transfers. @@ -1186,13 +1224,16 @@ number of bytes that were actually written paired with an flag which indicates whether a transfer timed out. -}-type WriteAction = B.ByteString → Timeout → IO (Size, Bool)+type WriteAction = B.ByteString → Timeout → IO (Size, TimedOut) -- | A timeout in milliseconds. A timeout defines how long a transfer should wait -- before giving up due to no response being received. For no timeout, use value -- 0. type Timeout = Int +-- | 'True' when a transfer timed out and 'False' otherwise.+type TimedOut = Bool+ -- | Number of bytes transferred. type Size = Int @@ -1206,13 +1247,13 @@ data RequestType = Standard | Class | Vendor- deriving (Enum, Show, Eq, Data, Typeable)+ deriving (Enum, Show, Read, Eq, Data, Typeable) data Recipient = ToDevice | ToInterface | ToEndpoint | ToOther- deriving (Enum, Show, Eq, Data, Typeable)+ deriving (Enum, Show, Read, Eq, Data, Typeable) type Request = Word8 @@ -1276,6 +1317,27 @@ then throwIO $ convertUSBException err else return (0, fromIntegral err, timedOut) +-- | A convenience function similar to 'readControl' which checks if the+-- specified number of bytes to read were actually read. Throws an 'IOException'+-- if this is not the case.+readControlExact ∷ DeviceHandle → ControlAction (Size → Timeout → IO B.ByteString)+readControlExact devHndl = \reqType reqRecipient request value index → \size timeout → do+ BI.createAndTrim size $ \dataPtr → do+ err ← c'libusb_control_transfer+ (getDevHndlPtr devHndl)+ (marshalRequestType reqType reqRecipient `setBit` 7)+ request+ value+ index+ (castPtr dataPtr)+ (fromIntegral size)+ (fromIntegral timeout)+ if err < 0 ∧ err ≢ c'LIBUSB_ERROR_TIMEOUT+ then throwIO $ convertUSBException err+ else if err ≢ fromIntegral size+ then throwIO $ IOException "The read number of bytes doesn't equal the requested number"+ else return $ fromIntegral err+ {-| Perform a USB /control/ write. Exceptions:@@ -1288,7 +1350,7 @@ -} writeControl ∷ DeviceHandle → ControlAction WriteAction writeControl devHndl = \reqType reqRecipient request value index → \input timeout →- input `writeWith` \size dataPtr → do+ BU.unsafeUseAsCStringLen input $ \(dataPtr, size) → do err ← c'libusb_control_transfer (getDevHndlPtr devHndl) (marshalRequestType reqType reqRecipient)@@ -1303,147 +1365,7 @@ then throwIO $ convertUSBException err else return (fromIntegral err, timedOut) ------------------------------------------------------------------------------------ *** Standard Device Requests-------------------------------------------------------------------------------- --- See: USB 2.0 Spec. section 9.4---- Standard Feature Selectors:--- See: USB 2.0 Spec. table 9-6-haltFeature, remoteWakeupFeature, testModeFeature ∷ Word16-remoteWakeupFeature = 1-haltFeature = 0-testModeFeature = 2---- | 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)---- | See: USB 2.0 Spec. section 9.4.1-clearRemoteWakeup ∷ DeviceHandle → Timeout → IO ()-clearRemoteWakeup devHndl =- control devHndl- Standard- ToDevice- c'LIBUSB_REQUEST_CLEAR_FEATURE- remoteWakeupFeature- 0---- | See: USB 2.0 Spec. section 9.4.9-setRemoteWakeup ∷ DeviceHandle → Timeout → IO ()-setRemoteWakeup devHndl =- control devHndl- Standard- ToDevice- c'LIBUSB_REQUEST_SET_FEATURE- remoteWakeupFeature- 0---- | See: USB 2.0 Spec. section 9.4.9--- TODO: What about vendor-specific test modes?-setStandardTestMode ∷ DeviceHandle → TestMode → Timeout → IO ()-setStandardTestMode devHndl testMode =- control devHndl- Standard- ToDevice- c'LIBUSB_REQUEST_SET_FEATURE- testModeFeature- (genFromEnum testMode + 1 `shiftL` 8)---- | See: USB 2.0 Spec. table 9-7-data TestMode = Test_J- | Test_K- | Test_SE0_NAK- | Test_Packet- | Test_Force_Enable- deriving (Show, Enum, Data, Typeable)---- | See: USB 2.0 Spec. section 9.4.4-getInterfaceAltSetting ∷ DeviceHandle → InterfaceNumber → Timeout → IO InterfaceAltSetting-getInterfaceAltSetting devHndl ifNum = \timeout → do- (bs, _) ← readControl devHndl- Standard- ToInterface- c'LIBUSB_REQUEST_GET_INTERFACE- 0- (fromIntegral ifNum)- 1- timeout- if B.length bs ≢ 1- then throwIO IOException- else return $ B.head bs---- | See: USB 2.0 Spec. section 9.4.5-getDeviceStatus ∷ DeviceHandle → Timeout → IO DeviceStatus-getDeviceStatus devHndl = \timeout → do- (bs, _) ← readControl devHndl- Standard- ToDevice- c'LIBUSB_REQUEST_GET_STATUS- 0- 0- 2- timeout- if B.length bs ≢ 2- then throwIO IOException- else return $ unmarshalDeviceStatus $ B.head bs- where- unmarshalDeviceStatus ∷ Word8 → DeviceStatus- unmarshalDeviceStatus 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- (bs, _) ← readControl devHndl- Standard- ToEndpoint- c'LIBUSB_REQUEST_GET_STATUS- 0- (marshalEndpointAddress endpointAddr)- 2- timeout- if B.length bs ≢ 2- then throwIO IOException- else return $ B.head bs ≡ 1---- | See: USB 2.0 Spec. section 9.4.6-setDeviceAddress ∷ DeviceHandle → Word16 → Timeout → IO ()-setDeviceAddress devHndl deviceAddr =- control devHndl- Standard- ToDevice- c'LIBUSB_REQUEST_SET_ADDRESS- deviceAddr- 0---- TODO: setDescriptor See: USB 2.0 Spec. section 9.4.8---- | See: USB 2.0 Spec. section 9.4.11-synchFrame ∷ DeviceHandle → EndpointAddress → Timeout → IO Int-synchFrame devHndl endpointAddr = \timeout → do- (bs, _) ← readControl devHndl- Standard- ToEndpoint- c'LIBUSB_REQUEST_SYNCH_FRAME- 0- (marshalEndpointAddress endpointAddr)- 2- timeout- if B.length bs ≢ 2- then throwIO IOException- else return $ let [h, l] = B.unpack bs- in fromIntegral h ⋅ 256 + fromIntegral l- -------------------------------------------------------------------------------- -- ** Bulk transfers --------------------------------------------------------------------------------@@ -1547,6 +1469,7 @@ -------------------------------------------------------------------------------- +-- | Handy type synonym for the @libusb@ transfer functions. type C'TransferFunc = Ptr C'libusb_device_handle -- devHndlPtr → CUChar -- endpoint address → Ptr CUChar -- dataPtr@@ -1562,23 +1485,25 @@ devHndl endpointAddr timeout- size- dataPtr+ (castPtr dataPtr, size) return (0, transferred, timedOut) writeTransfer ∷ C'TransferFunc → (DeviceHandle → EndpointAddress → WriteAction) writeTransfer c'transfer = \devHndl endpointAddr → \input timeout →- input `writeWith` transfer c'transfer- devHndl- endpointAddr- timeout+ BU.unsafeUseAsCStringLen input $ transfer c'transfer+ devHndl+ endpointAddr+ timeout transfer ∷ C'TransferFunc → DeviceHandle → EndpointAddress- → Timeout → Size → Ptr Word8 → IO (Size, Bool)+ → Timeout+ → CStringLen+ → IO (Size, TimedOut) transfer c'transfer devHndl endpointAddr- timeout size dataPtr =+ timeout+ (dataPtr, size) = alloca $ \transferredPtr → do err ← c'transfer (getDevHndlPtr devHndl) (marshalEndpointAddress endpointAddr)@@ -1614,7 +1539,7 @@ then throwIO $ convertUSBException r else return $ fromIntegral r --- | Convert a 'C\'libusb_error' to a 'USBException'. If the C'libusb_error is+-- | Convert a C'libusb_error to a 'USBException'. If the C'libusb_error is -- unknown an 'error' is thrown. convertUSBException ∷ CInt → USBException convertUSBException err = fromMaybe unknownLibUsbError $@@ -1626,7 +1551,7 @@ -- | Association list mapping 'C'libusb_error's to 'USBException's. libusb_error_to_USBException ∷ [(CInt, USBException)] libusb_error_to_USBException =- [ (c'LIBUSB_ERROR_IO, IOException)+ [ (c'LIBUSB_ERROR_IO, IOException "") , (c'LIBUSB_ERROR_INVALID_PARAM, InvalidParamException) , (c'LIBUSB_ERROR_ACCESS, AccessException) , (c'LIBUSB_ERROR_NO_DEVICE, NoDeviceException)@@ -1643,7 +1568,7 @@ -- | Type of USB exceptions. data USBException =- IOException -- ^ Input/output exception.+ IOException String -- ^ Input/output exception. | InvalidParamException -- ^ Invalid parameter. | AccessException -- ^ Access denied (insufficient permissions). | NoDeviceException -- ^ No such device (it may have been disconnected).@@ -1657,87 +1582,9 @@ | NotSupportedException -- ^ Operation not supported or unimplemented on this -- platform. | OtherException -- ^ Other exception.- deriving (Eq, Show, Data, Typeable)+ deriving (Eq, Show, Read, Data, Typeable) instance Exception USBException-------------------------------------------------------------------------------------- * Binary Coded Decimals------------------------------------------------------------------------------------- | A decoded 16 bits Binary Coded Decimal using 4 bits for each digit.-type BCD4 = (Int, Int, Int, Int)---- | Decode a @Word16@ as a Binary Coded Decimal using 4 bits per digit.-unmarshalBCD4 ∷ Word16 → BCD4-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-its encoded digits. @bitsInDigit@, which is usually 4, is the number of bits-used to encode a single digit. See:-<http://en.wikipedia.org/wiki/Binary-coded_decimal>--}-decodeBCD ∷ Bits α ⇒ Int → α → [α]-decodeBCD bitsInDigit n = go shftR []- where- shftR = bitSize n - bitsInDigit-- go shftL ds | shftL < 0 = ds- | otherwise = go (shftL - bitsInDigit)- (((n `shiftL` shftL) `shiftR` shftR) : ds)-------------------------------------------------------------------------------------- * Utils------------------------------------------------------------------------------------- | @bits s e b@ extract bit @s@ to @e@ (including) from @b@.-bits ∷ Bits α ⇒ Int → Int → α → α-bits s e b = (2 ^ (e - s + 1) - 1) .&. (b `shiftR` s)---- | @between n b e@ tests if @n@ is between the given bounds @b@ and @e@--- (including).-between ∷ Ord α ⇒ α → α → α → Bool-between n b e = n ≥ b ∧ n ≤ e---- | Execute the given action but ignore the result.-void ∷ Functor m ⇒ m α → m ()-void = (() <$)---- | A generalized 'toEnum' that works on any 'Integral' type.-genToEnum ∷ (Integral i, Enum e) ⇒ i → e-genToEnum = toEnum ∘ fromIntegral---- | 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--- this array and the array itself. Finally, the result of @doWrite@ is--- returned.------ /Make sure not to return the pointer to the array from @doWrite@!/------ /Note that the converion from the @ByteString@ to the @Word8@ array is O(1)./-writeWith ∷ B.ByteString → (Size → Ptr Word8 → IO α) → IO α-input `writeWith` doWrite =- let (dataFrgnPtr, _, size) = BI.toForeignPtr input- in withForeignPtr dataFrgnPtr $ doWrite size---- | Monadic if...then...else...-ifM ∷ Monad m ⇒ m Bool → m α → m α → m α-ifM cM tM eM = do c ← cM- if c- then tM- else eM -- The End ---------------------------------------------------------------------
+ System/USB/Unsafe.hs view
@@ -0,0 +1,21 @@+--------------------------------------------------------------------------------+-- |+-- Module : System.USB.Unsafe+-- Copyright : (c) 2009–2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-- This module is not intended for end users. It provides internal and unsafe+-- functions used for extending this package.+-- It is primarily used by the @usb-enumerator@ package.+--+--------------------------------------------------------------------------------++module System.USB.Unsafe+ ( C'TransferFunc+ , getDevHndlPtr+ , marshalEndpointAddress+ , convertUSBException+ ) where++import System.USB.Internal
+ Utils.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax #-}++module Utils where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Prelude ( (+), (-), (^)+ , Enum, toEnum, fromEnum+ , fromInteger+ , Integral, fromIntegral+ )+import Control.Monad ( Monad, (>>=), fail, mapM )+import Foreign.Ptr ( Ptr )+import Foreign.Storable ( Storable, )+import Foreign.Marshal.Array ( peekArray )+import Data.Bool ( Bool )+import Data.Ord ( Ord )+import Data.Bits ( Bits, shiftR, (.&.) )+import Data.Int ( Int )+import Data.Functor ( Functor, (<$))+import System.IO ( IO )++-- from base-unicode-symbols:+import Data.Function.Unicode ( (∘) )+import Data.Ord.Unicode ( (≥), (≤) )+import Data.Bool.Unicode ( (∧) )+++--------------------------------------------------------------------------------+-- Utils+--------------------------------------------------------------------------------++-- | @bits s e b@ extract bit @s@ to @e@ (including) from @b@.+bits ∷ Bits α ⇒ Int → Int → α → α+bits s e b = (2 ^ (e - s + 1) - 1) .&. (b `shiftR` s)++-- | @between n b e@ tests if @n@ is between the given bounds @b@ and @e@+-- (including).+between ∷ Ord α ⇒ α → α → α → Bool+between n b e = n ≥ b ∧ n ≤ e++-- | Execute the given action but ignore the result.+void ∷ Functor m ⇒ m α → m ()+void = (() <$)++-- | A generalized 'toEnum' that works on any 'Integral' type.+genToEnum ∷ (Integral i, Enum e) ⇒ i → e+genToEnum = toEnum ∘ fromIntegral++-- | 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++-- | Monadic if...then...else...+ifM ∷ Monad m ⇒ m Bool → m α → m α → m α+ifM cM tM eM = do c ← cM+ if c+ then tM+ else eM+++-- The End ---------------------------------------------------------------------
usb.cabal view
@@ -1,5 +1,5 @@ name: usb-version: 0.4+version: 0.5 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -10,10 +10,48 @@ stability: experimental category: System synopsis: Communicate with USB devices-description: This library enables you to communicate with USB devices from+description: This library allows you to communicate with USB devices from userspace. It is implemented as a high-level wrapper around- bindings-libusb which is a low-level binding to the C library:- libusb-1.*.+ @bindings-libusb@ which is a low-level binding to the C library:+ @libusb-1.*@.+ .+ This documentation assumes knowledge of how to operate USB+ devices from a software standpoint (descriptors, configurations,+ interfaces, endpoints, control\/bulk\/interrupt\/isochronous+ transfers, etc). Full information can be found in the USB 2.0+ Specification.+ .+ For an example how to use this library see the @ls-usb@ package+ at:+ .+ <http://hackage.haskell.org/package/ls-usb>+ .+ 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>+ .+ Finally have a look at the @usb-enumerator@ package which+ provides iteratee enumerators for enumerating bulk and interrupt+ endpoints:+ .+ <http://hackage.haskell.org/package/usb-enumerator>+ .+ Besides this API documentation the following sources might be+ interesting:+ .+ * The libusb 1.0 documentation at:+ <http://libusb.sourceforge.net/api-1.0/>+ .+ * The USB 2.0 specification at:+ <http://www.usb.org/developers/docs/>+ .+ * The @bindings-libusb@ documentation at:+ <http://hackage.haskell.org/package/bindings-libusb>+ .+ * \"USB in a NutShell\" at:+ <http://www.beyondlogic.org/usbnutshell/usb1.htm> source-repository head Type: darcs@@ -21,21 +59,20 @@ Library 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- , MonadCatchIO-transformers-foreign >= 0.1 && < 0.2+ 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 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.IO.StandardDeviceRequests System.USB.Exceptions+ System.USB.Unsafe other-modules: System.USB.Internal+ Data.BCD+ Utils