{-# LANGUAGE CPP
, UnicodeSyntax
, NoImplicitPrelude
, DeriveDataTypeable
, BangPatterns
#-}#if __GLASGOW_HASKELL__ >= 704{-# LANGUAGE Unsafe #-}#endif#ifdef HAS_EVENT_MANAGER{-# LANGUAGE PatternGuards #-}#endifmoduleSystem.USB.Basewhere---------------------------------------------------------------------------------- Imports---------------------------------------------------------------------------------- from base:importPrelude(Num,(+),(-),(*),Integral,fromIntegral,div,Enum,fromEnum,error,String)importForeign.C.Types(CUChar,CInt,CUInt)importForeign.C.String(CStringLen)importForeign.Marshal.Alloc(alloca)importForeign.Marshal.Array(peekArray,allocaArray)importForeign.Storable(Storable,peek,peekElemOff)importForeign.Ptr(Ptr,castPtr,plusPtr,nullPtr)importForeign.ForeignPtr(ForeignPtr,newForeignPtr,withForeignPtr)importControl.Applicative(liftA2)importControl.Exception(Exception,throwIO,bracket,bracket_,onException,assert)importControl.Monad(Monad,(>>=),(=<<),return,when,forM)importControl.Arrow((&&&))importData.Function(($),on)importData.Data(Data)importData.Typeable(Typeable)importData.Maybe(Maybe(Nothing,Just),maybe,fromMaybe)importData.List(lookup,map,(++))importData.Int(Int)importData.Word(Word8,Word16)importData.Eq(Eq,(==))importData.Ord(Ord,(<),(>))importData.Bool(Bool(False,True),not,otherwise)importData.Bits(Bits,(.|.),setBit,testBit,shiftL)importSystem.IO(IO)importSystem.IO.Unsafe(unsafePerformIO)importText.Show(Show,show)importText.Read(Read)importText.Printf(printf)#if MIN_VERSION_base(4,2,0)importData.Functor(Functor,fmap,(<$>))#elseimportControl.Monad(Functor,fmap)importControl.Applicative((<$>))#endif#if __GLASGOW_HASKELL__ < 700importPrelude(fromInteger,negate)importControl.Monad((>>),fail)#endif-- from base-unicode-symbols:importData.Function.Unicode((∘))importData.Bool.Unicode((∧))importData.Eq.Unicode((≢),(≡))-- from bytestring:importqualifiedData.ByteStringasB(ByteString,packCStringLen,drop,length)importqualifiedData.ByteString.InternalasBI(createAndTrim,createAndTrim')importqualifiedData.ByteString.UnsafeasBU(unsafeUseAsCStringLen)-- from text:importData.Text(Text)importqualifiedData.Text.EncodingasTE(decodeUtf16LE)-- from bindings-libusb:importBindings.Libusb-- from usb (this package):importUtils(bits,between,genToEnum,genFromEnum,mapPeekArray,ifM,decodeBCD)--------------------------------------------------------------------------------#ifdef HAS_EVENT_MANAGER-- from base:importPrelude(undefined)importForeign.C.Types(CShort,CChar)importForeign.Marshal.Alloc(allocaBytes,free)importForeign.Marshal.Array(peekArray0,copyArray)importForeign.Storable(sizeOf,poke)importForeign.Ptr(nullFunPtr,freeHaskellFunPtr)importControl.Monad(mapM_,foldM_)importData.IORef(newIORef,atomicModifyIORef,readIORef)importData.Function(id)importData.List(foldl')importSystem.Posix.Types(Fd(Fd))importControl.Exception(uninterruptibleMask_)importControl.Concurrent.MVar(MVar,newEmptyMVar,takeMVar,putMVar)importSystem.IO(hPutStrLn,stderr)importqualifiedForeign.ConcurrentasFC(newForeignPtr)#if MIN_VERSION_base(4,4,0)importGHC.Event#elseimportSystem.Event#endif(FdKey,registerFd,unregisterFd,registerTimeout,unregisterTimeout)-- from containers:importData.IntMap(IntMap,fromList,insert,updateLookupWithKey,elems)-- from bytestring:importqualifiedData.ByteString.InternalasBI(create)-- from usb (this package):importTimeval(withTimeval)importqualifiedPoll(toEvent)importSystemEventManager(getSystemEventManager)#endif--------------------------------------------------------------------------------#if MIN_VERSION_base(4,3,0)importControl.Exception(mask,mask_)#elseimportControl.Exception(blocked,block,unblock)importData.Function(id)mask∷((IOα→IOα)→IOβ)→IOβmaskio=dob←blockedifbthenioidelseblock$iounblockmask_∷IOα→IOαmask_=block#endif#define COMMON_INSTANCES Show, Read, Eq, Data, Typeable---------------------------------------------------------------------------------- * Initialization--------------------------------------------------------------------------------{-| Abstract type representing a USB session.
The concept of individual sessions allows your program to use multiple threads
that can independently use this library without interfering with eachother.
Sessions are created and initialized by 'newCtx' and are automatically closed
when they are garbage collected.
The only functions that receive a @Ctx@ are 'setDebug' and 'getDevices'.
-}dataCtx=Ctx{#ifdef HAS_EVENT_MANAGERctxGetWait∷!(MaybeWait),#endifgetCtxFrgnPtr∷!(ForeignPtrC'libusb_context)}derivingTypeable-- | A function to wait for the termination of a submitted transfer.typeWait=Timeout→Lock→PtrC'libusb_transfer→IO()instanceEqCtxwhere(==)=(==)`on`getCtxFrgnPtrwithCtxPtr∷Ctx→(PtrC'libusb_context→IOα)→IOαwithCtxPtr=withForeignPtr∘getCtxFrgnPtrlibusb_init∷IO(PtrC'libusb_context)libusb_init=alloca$\ctxPtrPtr→dohandleUSBException$c'libusb_initctxPtrPtrpeekctxPtrPtrnewCtxNoEventManager∷(ForeignPtrC'libusb_context→Ctx)→IOCtxnewCtxNoEventManagerctx=mask_$doctxPtr←libusb_initctx<$>newForeignPtrp'libusb_exitctxPtr#ifndef HAS_EVENT_MANAGER-- | Create and initialize a new USB context.---- This function may throw 'USBException's.newCtx∷IOCtxnewCtx=newCtxNoEventManagerCtx#else--------------------------------------------------------------------------------{-| Create and initialize a new USB context.
This function may throw 'USBException's.
Note that the internal @libusb@ event handling can return errors. These errors
occur in the thread that is executing the event handling loop. 'newCtx' will
print these errors to 'stderr'. If you need to handle the errors yourself (for
example log them in an application specific way) please use 'newCtx''.
-}newCtx∷IOCtxnewCtx=newCtx'$\e→hPutStrLnstderr$thisModule++": libusb_handle_events_timeout returned error: "++showe-- | Like 'newCtx' but enables you to specify the way errors should be handled-- that occur while handling @libusb@ events.newCtx'∷(USBException→IO())→IOCtxnewCtx'handleError=dombEvtMgr←getSystemEventManagercasembEvtMgrofNothing→newCtxNoEventManager$CtxNothingJustevtMgr→mask_$doctxPtr←libusb_initlethandleEvents=doerr←withTimevalnoTimeout$c'libusb_handle_events_timeoutctxPtrwhen(err≢c'LIBUSB_SUCCESS)$iferr≡c'LIBUSB_ERROR_INTERRUPTEDthenhandleEventselsehandleError$convertUSBExceptionerrregister∷CInt→CShort→IOFdKeyregisterfdevt=registerFdevtMgr(\__→handleEvents)(Fdfd)(Poll.toEventevt)-- Register initial libusb file descriptors with the event manager:pollFdPtrLst←c'libusb_get_pollfdsctxPtrpollFdPtrs←peekArray0nullPtrpollFdPtrLstfdKeys←forMpollFdPtrs$\pollFdPtr→doC'libusb_pollfdfdevt←peekpollFdPtrfdKey←registerfdevtreturn(fromIntegralfd,fdKey)fdKeyMapRef←newIORef(fromListfdKeys∷IntMapFdKey)freepollFdPtrLst-- Be notified when libusb file descriptors are added or removed:aFP←mk'libusb_pollfd_added_cb$\fdevt_→mask_$dofdKey←registerfdevtatomicModifyIOReffdKeyMapRef$\fdKeyMap→(insert(fromIntegralfd)fdKeyfdKeyMap,())rFP←mk'libusb_pollfd_removed_cb$\fd_→mask_$dofdKey←atomicModifyIOReffdKeyMapRef$\fdKeyMap→let(JustfdKey,newFdKeyMap)=updateLookupWithKey(\__→Nothing)(fromIntegralfd)fdKeyMapin(newFdKeyMap,fdKey)unregisterFdevtMgrfdKeyc'libusb_set_pollfd_notifiersctxPtraFPrFPnullPtr-- Check if we have to do our own timeout handling and construct the-- appropriate Wait function:r←c'libusb_pollfds_handle_timeoutsctxPtrletwait∷Wait!wait|r≡0=manualTimeout|otherwise=\_→autoTimeoutmanualTimeouttimeoutlocktransPtr|timeout≡noTimeout=autoTimeoutlocktransPtr|otherwise=dotk←registerTimeoutevtMgr(timeout*1000)handleEventsacquirelock`onException`(uninterruptibleMask_$dounregisterTimeoutevtMgrtk_err←c'libusb_cancel_transfertransPtracquirelock)autoTimeoutlocktransPtr=acquirelock`onException`(uninterruptibleMask_$do_err←c'libusb_cancel_transfertransPtracquirelock)fmap(Ctx(Justwait))$FC.newForeignPtrctxPtr$do-- Remove notifiers after which we can safely free the FunPtrs:c'libusb_set_pollfd_notifiersctxPtrnullFunPtrnullFunPtrnullPtrfreeHaskellFunPtraFPfreeHaskellFunPtrrFP-- Unregister all registered file descriptors from the event manager:readIOReffdKeyMapRef>>=mapM_(unregisterFdevtMgr)∘elems-- Finally deinitialize libusb:c'libusb_exitctxPtr-- | Checks if the system supports asynchronous I\/O.---- * 'Nothing' means asynchronous I\/O is not supported so synchronous I\/O should-- be used instead.---- * @'Just' wait@ means that asynchronous I\/O is supported. The @wait@-- function can be used to wait for submitted transfers.getWait∷DeviceHandle→MaybeWaitgetWait=ctxGetWait∘getCtx∘getDevice#endif--------------------------------------------------------------------------------{-| Set message verbosity.
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 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.
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:
you'll never get any messages.
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()setDebugctxverbosity=withCtxPtrctx$\ctxPtr→c'libusb_set_debugctxPtr$genFromEnumverbosity-- | Message verbositydataVerbosity=PrintNothing-- ^ No messages are ever printed by the library|PrintErrors-- ^ Error messages are printed to stderr|PrintWarnings-- ^ Warning and error messages are printed to stderr|PrintInfo-- ^ Informational messages are printed to stdout,-- warning and error messages are printed to stderrderiving(Enum,Ord,COMMON_INSTANCES)---------------------------------------------------------------------------------- * Enumeration--------------------------------------------------------------------------------{-| 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:
<http://hackage.haskell.org/package/usb-safe>
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 process or driver may be using the device.
To get additional information about a device you can retrieve its descriptor
using 'deviceDesc'.
-}dataDevice=Device{getCtx∷!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∷!(ForeignPtrC'libusb_device),deviceDesc∷!DeviceDesc-- ^ Get the descriptor of the device.}derivingTypeable-- | Equality on devices is defined by comparing their descriptors:-- @(==) = (==) \`on\` `deviceDesc`@instanceEqDevicewhere(==)=(==)`on`deviceDesc-- | Devices are shown in the same way as the popular @lsusb@ program:---- @Bus \<busNumber\> Device \<address\>: ID \<vid\>:\<pid\>@instanceShowDevicewhereshowd=printf"Bus %03d Device %03d: ID %04x:%04x"(busNumberd)(deviceAddressd)(deviceVendorIddesc)(deviceProductIddesc)wheredesc=deviceDescdwithDevicePtr∷Device→(PtrC'libusb_device→IOα)→IOαwithDevicePtr(DevicectxdevFP_)f=withCtxPtrctx$\_→withForeignPtrdevFPf{-| Returns a list of USB devices currently attached to the system.
This is your entry point into finding a USB device.
Exceptions:
* 'NoMemException' on a memory allocation failure.
-}{-
Visual description of the 'devPtrArrayPtr':
D
^ D
D │ ^
^ │ │
│ │ │
devPtrArrayPtr: ┏━┷━┳━┷━┳━━━┳━━━┳━┷━┓
P ───> ┃ P ┃ P ┃ P ┃ P ┃ P ┃
┗━━━┻━━━┻━┯━┻━┯━┻━━━┛
│ │
P = pointer v │
D = device structure D │
v
D
-}getDevices∷Ctx→IO[Device]getDevicesctx=withCtxPtrctx$\ctxPtr→alloca$\devPtrArrayPtr→mask$\restore→donumDevs←checkUSBException$c'libusb_get_device_listctxPtrdevPtrArrayPtrdevPtrArray←peekdevPtrArrayPtrletfreeDevPtrArray=c'libusb_free_device_listdevPtrArray0devs←restore(mapPeekArraymkDevnumDevsdevPtrArray)`onException`freeDevPtrArrayfreeDevPtrArrayreturndevswheremkDev∷PtrC'libusb_device→IODevicemkDevdevPtr=liftA2(Devicectx)(newForeignPtrp'libusb_unref_devicedevPtr)(getDeviceDescdevPtr)-- Both of the following numbers are static variables in the libusb device-- structure. It's therefore safe to use unsafePerformIO:-- | The number of the bus that a device is connected to.busNumber∷Device→Word8busNumberdev=unsafePerformIO$withDevicePtrdevc'libusb_get_bus_number-- | The address of the device on the bus it is connected to.deviceAddress∷Device→Word8deviceAddressdev=unsafePerformIO$withDevicePtrdevc'libusb_get_device_address---------------------------------------------------------------------------------- * Device handling------------------------------------------------------------------------------------------------------------------------------------------------------------------ ** Opening & closing devices--------------------------------------------------------------------------------{-| 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.
-}dataDeviceHandle=DeviceHandle{getDevice∷!Device-- This reference is needed for keeping the 'Device'-- and therefor the 'Ctx' alive.-- ^ Retrieve the 'Device' from the 'DeviceHandle'.,getDevHndlPtr∷!(PtrC'libusb_device_handle)}derivingTypeableinstanceEqDeviceHandlewhere(==)=(==)`on`getDevHndlPtrinstanceShowDeviceHandlewhereshowdevHndl="{USB device handle to: "++show(getDevicedevHndl)++"}"withDevHndlPtr∷DeviceHandle→(PtrC'libusb_device_handle→IOα)→IOαwithDevHndlPtr(DeviceHandledevdevHndlPtr)f=withDevicePtrdev$\_→fdevHndlPtr{-| Open a device and obtain a device handle.
A handle allows you to perform I/O on the device in question.
This is a non-blocking function; no requests are sent over the bus.
It is advisable to use 'withDeviceHandle' because it automatically closes the
device when the computation terminates.
Exceptions:
* 'NoMemException' if there is a memory allocation failure.
* 'AccessException' if the user has insufficient permissions.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}openDevice∷Device→IODeviceHandleopenDevicedev=withDevicePtrdev$\devPtr→alloca$\devHndlPtrPtr→dohandleUSBException$c'libusb_opendevPtrdevHndlPtrPtrDeviceHandledev<$>peekdevHndlPtrPtr{-| Close a device handle.
Should be called on all open handles before your application exits.
This is a non-blocking function; no requests are sent over the bus.
-}closeDevice∷DeviceHandle→IO()closeDevicedevHndl=withDevHndlPtrdevHndlc'libusb_close{-| @withDeviceHandle dev act@ opens the 'Device' @dev@ and passes
the resulting handle to the computation @act@. The handle will be closed on exit
from @withDeviceHandle@ whether by normal termination or by raising an
exception.
-}withDeviceHandle∷Device→(DeviceHandle→IOα)→IOαwithDeviceHandledev=bracket(openDevicedev)closeDevice---------------------------------------------------------------------------------- ** Getting & setting the configuration---------------------------------------------------------------------------------- | Identifier for configurations.---- Can be retrieved by 'getConfig' or by 'configValue'.typeConfigValue=Word8{-| 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.
This function returns 'Nothing' if the device is in unconfigured state.
Exceptions:
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}getConfig∷DeviceHandle→IO(MaybeConfigValue)getConfigdevHndl=alloca$\configPtr→dowithDevHndlPtrdevHndl$\devHndlPtr→handleUSBException$c'libusb_get_configurationdevHndlPtrconfigPtrunmarshal<$>peekconfigPtrwhereunmarshal0=Nothingunmarshaln=Just$fromIntegraln{-| Set the active configuration for a device.
The operating system may or may not have already set an active configuration on
the device. It is up to your application to ensure the correct configuration is
selected before you attempt to claim interfaces and perform other operations.
If you call this function on a device already configured with the selected
configuration, then this function will act as a lightweight device reset: it
will issue a SET_CONFIGURATION request using the current configuration, causing
most USB-related device state to be reset (altsetting reset to zero, endpoint
halts cleared, toggles reset).
You cannot change/reset configuration if your application has claimed interfaces
- you should free them with 'releaseInterface' first. You cannot change/reset
configuration if other applications or drivers have claimed interfaces.
A configuration value of 'Nothing' will put the device in an unconfigured
state. The USB specification states that a configuration value of 0 does this,
however buggy devices exist which actually have a configuration 0.
You should always use this function rather than formulating your own
SET_CONFIGURATION control request. This is because the underlying operating
system needs to know when such changes happen.
This is a blocking function.
Exceptions:
* 'NotFoundException' if the requested configuration does not exist.
* 'BusyException' if interfaces are currently claimed.
* 'NoDeviceException' if the device has been disconnected
* Another 'USBException'.
-}setConfig∷DeviceHandle→MaybeConfigValue→IO()setConfigdevHndlconfig=withDevHndlPtrdevHndl$\devHndlPtr→handleUSBException$c'libusb_set_configurationdevHndlPtr$marshalconfigwheremarshal=maybe(-1)fromIntegral---------------------------------------------------------------------------------- ** Claiming & releasing interfaces--------------------------------------------------------------------------------{-| Identifier for interfaces.
Can be retrieved by 'interfaceNumber'.
-}typeInterfaceNumber=Word8{-| Claim an interface on a given device handle.
You must claim the interface you wish to use before you can perform I/O on any
of its endpoints.
It is legal to attempt to claim an already-claimed interface, in which case this
function just returns without doing anything.
Claiming of interfaces is a purely logical operation; it does not cause any
requests to be sent over the bus. Interface claiming is used to instruct the
underlying operating system that your application wishes to take ownership of
the interface.
This is a non-blocking function.
Exceptions:
* 'NotFoundException' if the requested interface does not exist.
* 'BusyException' if the interface is already claimed.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}claimInterface∷DeviceHandle→InterfaceNumber→IO()claimInterfacedevHndlifNum=withDevHndlPtrdevHndl$\devHndlPtr→handleUSBException$c'libusb_claim_interfacedevHndlPtr(fromIntegralifNum){-| Release an interface previously claimed with 'claimInterface'.
You should release all claimed interfaces before closing a device handle.
This is a blocking function. A SET_INTERFACE control request will be sent to the
device, resetting interface state to the first alternate setting.
Exceptions:
* 'NotFoundException' if the interface was not claimed.
* 'NoDeviceException' if the device has been disconnected
* Another 'USBException'.
-}releaseInterface∷DeviceHandle→InterfaceNumber→IO()releaseInterfacedevHndlifNum=withDevHndlPtrdevHndl$\devHndlPtr→handleUSBException$c'libusb_release_interfacedevHndlPtr(fromIntegralifNum){-| @withClaimedInterface@ claims the interface on the given device handle then
executes the given computation. On exit from @withClaimedInterface@, the
interface is released whether by normal termination or by raising an exception.
-}withClaimedInterface∷DeviceHandle→InterfaceNumber→IOα→IOαwithClaimedInterfacedevHndlifNum=bracket_(claimInterfacedevHndlifNum)(releaseInterfacedevHndlifNum)---------------------------------------------------------------------------------- ** Setting interface alternate settings---------------------------------------------------------------------------------- | Identifier for interface alternate settings.---- Can be retrieved by 'interfaceAltSetting'.typeInterfaceAltSetting=Word8{-| Activate an alternate setting for an interface.
The interface must have been previously claimed with 'claimInterface' or
'withInterfaceHandle'.
You should always use this function rather than formulating your own
SET_INTERFACE control request. This is because the underlying operating system
needs to know when such changes happen.
This is a blocking function.
Exceptions:
* 'NotFoundException' if the interface was not claimed or the requested
alternate setting does not exist.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}setInterfaceAltSetting∷DeviceHandle→InterfaceNumber→InterfaceAltSetting→IO()setInterfaceAltSettingdevHndlifNumalternateSetting=withDevHndlPtrdevHndl$\devHndlPtr→handleUSBException$c'libusb_set_interface_alt_settingdevHndlPtr(fromIntegralifNum)(fromIntegralalternateSetting)---------------------------------------------------------------------------------- ** Clearing & Resetting devices--------------------------------------------------------------------------------{-| Clear the halt/stall condition for an endpoint.
Endpoints with halt status are unable to receive or transmit data until the halt
condition is stalled.
You should cancel all pending transfers before attempting to clear the halt
condition.
This is a blocking function.
Exceptions:
* 'NotFoundException' if the endpoint does not exist.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}clearHalt∷DeviceHandle→EndpointAddress→IO()clearHaltdevHndlendpointAddr=withDevHndlPtrdevHndl$\devHndlPtr→handleUSBException$c'libusb_clear_haltdevHndlPtr(marshalEndpointAddressendpointAddr){-| Perform a USB port reset to reinitialize a device.
The system will attempt to restore the previous configuration and alternate
settings after the reset has completed.
If the reset fails, the descriptors change, or the previous state cannot be
restored, the device will appear to be disconnected and reconnected. This means
that the device handle is no longer valid (you should close it) and rediscover
the device. A 'NotFoundException' is raised to indicate that this is the
case.
This is a blocking function which usually incurs a noticeable delay.
Exceptions:
* 'NotFoundException' if re-enumeration is required, or if the
device has been disconnected.
* Another 'USBException'.
-}resetDevice∷DeviceHandle→IO()resetDevicedevHndl=withDevHndlPtrdevHndl$handleUSBException∘c'libusb_reset_device---------------------------------------------------------------------------------- ** USB kernel drivers--------------------------------------------------------------------------------{-| Determine if a kernel driver is active on an interface.
If a kernel driver is active, you cannot claim the interface, and libusb will be
unable to perform I/O.
Exceptions:
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}kernelDriverActive∷DeviceHandle→InterfaceNumber→IOBoolkernelDriverActivedevHndlifNum=withDevHndlPtrdevHndl$\devHndlPtr→dor←c'libusb_kernel_driver_activedevHndlPtr(fromIntegralifNum)caserof0→returnFalse1→returnTrue_→throwIO$convertUSBExceptionr{-| Detach a kernel driver from an interface.
If successful, you will then be able to claim the interface and perform I/O.
Exceptions:
* 'NotFoundException' if no kernel driver was active.
* 'InvalidParamException' if the interface does not exist.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}detachKernelDriver∷DeviceHandle→InterfaceNumber→IO()detachKernelDriverdevHndlifNum=withDevHndlPtrdevHndl$\devHndlPtr→handleUSBException$c'libusb_detach_kernel_driverdevHndlPtr(fromIntegralifNum){-| Re-attach an interface's kernel driver, which was previously
detached using 'detachKernelDriver'.
Exceptions:
* 'NotFoundException' if no kernel driver was active.
* 'InvalidParamException' if the interface does not exist.
* 'NoDeviceException' if the device has been disconnected.
* 'BusyException' if the driver cannot be attached because the interface
is claimed by a program or driver.
* Another 'USBException'.
-}attachKernelDriver∷DeviceHandle→InterfaceNumber→IO()attachKernelDriverdevHndlifNum=withDevHndlPtrdevHndl$\devHndlPtr→handleUSBException$c'libusb_attach_kernel_driverdevHndlPtr(fromIntegralifNum){-| If a kernel driver is active on the specified interface the driver is
detached and the given action is executed. If the action terminates, whether by
normal termination or by raising an exception, the kernel driver is attached
again. If a kernel driver is not active on the specified interface the action is
just executed.
Exceptions:
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}withDetachedKernelDriver∷DeviceHandle→InterfaceNumber→IOα→IOαwithDetachedKernelDriverdevHndlifNumaction=ifM(kernelDriverActivedevHndlifNum)(bracket_(detachKernelDriverdevHndlifNum)(attachKernelDriverdevHndlifNum)action)action---------------------------------------------------------------------------------- * Descriptors------------------------------------------------------------------------------------------------------------------------------------------------------------------ ** Device descriptor--------------------------------------------------------------------------------{-| A structure representing the standard USB device descriptor.
This descriptor is documented in section 9.6.1 of the USB 2.0 specification.
This structure can be retrieved by 'deviceDesc'.
-}dataDeviceDesc=DeviceDesc{-- | USB specification release number.deviceUSBSpecReleaseNumber∷!ReleaseNumber-- | USB-IF class code for the device.,deviceClass∷!Word8-- | USB-IF subclass code for the device, qualified by the 'deviceClass'-- value.,deviceSubClass∷!Word8-- | USB-IF protocol code for the device, qualified by the 'deviceClass'-- and 'deviceSubClass' values.,deviceProtocol∷!Word8-- | Maximum packet size for endpoint 0.,deviceMaxPacketSize0∷!Word8-- | USB-IF vendor ID.,deviceVendorId∷!VendorId-- | USB-IF product ID.,deviceProductId∷!ProductId-- | Device release number.,deviceReleaseNumber∷!ReleaseNumber-- | Optional index of string descriptor describing manufacturer.,deviceManufacturerStrIx∷!(MaybeStrIx)-- | Optional index of string descriptor describing product.,deviceProductStrIx∷!(MaybeStrIx)-- | Optional index of string descriptor containing device serial number.,deviceSerialNumberStrIx∷!(MaybeStrIx)-- | Number of possible configurations.,deviceNumConfigs∷!Word8-- | List of configurations supported by the device.,deviceConfigs∷![ConfigDesc]}deriving(COMMON_INSTANCES)typeReleaseNumber=(Int,Int,Int,Int)typeVendorId=Word16typeProductId=Word16---------------------------------------------------------------------------------- ** Configuration descriptor--------------------------------------------------------------------------------{-| A structure representing the standard USB configuration descriptor.
This descriptor is documented in section 9.6.3 of the USB 2.0 specification.
This structure can be retrieved by 'deviceConfigs'.
-}dataConfigDesc=ConfigDesc{-- | Identifier value for the configuration.configValue∷!ConfigValue-- | Optional index of string descriptor describing the configuration.,configStrIx∷!(MaybeStrIx)-- | Configuration characteristics.,configAttribs∷!ConfigAttribs-- | 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(COMMON_INSTANCES)-- | An interface is represented as a list of alternate interface settings.typeInterface=[InterfaceDesc]---------------------------------------------------------------------------------- *** Configuration attributes---------------------------------------------------------------------------------- | The USB 2.0 specification specifies that the configuration attributes only-- describe the device status.typeConfigAttribs=DeviceStatusdataDeviceStatus=DeviceStatus{remoteWakeup∷!Bool-- ^ The Remote Wakeup field indicates whether the-- device is currently enabled to request remote-- wakeup. The default mode for devices that-- support remote wakeup is disabled.,selfPowered∷!Bool-- ^ The Self Powered field indicates whether the-- device is currently self-powered}deriving(COMMON_INSTANCES)---------------------------------------------------------------------------------- ** 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'.
-}dataInterfaceDesc=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-- | Optional index of string descriptor describing the interface.,interfaceStrIx∷!(MaybeStrIx)-- | 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(COMMON_INSTANCES)---------------------------------------------------------------------------------- ** 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.
This structure can be retrieved by using 'interfaceEndpoints'.
-}dataEndpointDesc=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 &#956;s units).,endpointInterval∷!Word8-- | /For audio devices only:/ the rate at which synchronization feedback-- is provided.,endpointRefresh∷!Word8-- | /For audio devices only:/ the address of 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(COMMON_INSTANCES)---------------------------------------------------------------------------------- *** Endpoint address---------------------------------------------------------------------------------- | The address of an endpoint.dataEndpointAddress=EndpointAddress{endpointNumber∷!Int-- ^ Must be >= 0 and <= 15,transferDirection∷!TransferDirection}deriving(COMMON_INSTANCES)-- | The direction of data transfer relative to the host.dataTransferDirection=Out-- ^ Out transfer direction (host -> device) used-- for writing.|In-- ^ In transfer direction (device -> host) used-- for reading.deriving(COMMON_INSTANCES)---------------------------------------------------------------------------------- *** Endpoint attributes---------------------------------------------------------------------------------- | The USB 2.0 specification specifies that the endpoint attributes only-- describe the endpoint transfer type.typeEndpointAttribs=TransferType-- | Describes what types of transfers are allowed on the endpoint.dataTransferType=-- | 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.|Interruptderiving(COMMON_INSTANCES)-- | See section 5.12.4.1 of the USB 2.0 specification.dataSynchronization=NoSynchronization|Asynchronous-- ^ Unsynchronized,-- although sinks provide data rate feedback.|Adaptive-- ^ Synchronized using feedback or feedforward-- data rate information|Synchronous-- ^ Synchronized to the USB’s SOF (/Start Of Frame/)deriving(Enum,COMMON_INSTANCES)-- | See section 5.12.4.2 of the USB 2.0 specification.dataUsage=Data|Feedback|Implicitderiving(Enum,COMMON_INSTANCES)---------------------------------------------------------------------------------- *** Endpoint max packet size--------------------------------------------------------------------------------dataMaxPacketSize=MaxPacketSize{maxPacketSize∷!Size,transactionOpportunities∷!TransactionOpportunities}deriving(COMMON_INSTANCES)-- | Number of additional transaction oppurtunities per microframe.---- See table 9-13 of the USB 2.0 specification.dataTransactionOpportunities=Zero-- ^ None (1 transaction per microframe)|One-- ^ 1 additional (2 per microframe)|Two-- ^ 2 additional (3 per microframe)deriving(Enum,Ord,COMMON_INSTANCES){-| Calculate the maximum packet size which a specific endpoint is capable of
sending or receiving in the duration of 1 microframe.
If acting on an 'Isochronous' or 'Interrupt' endpoint, this function will
multiply the 'maxPacketSize' by the additional 'transactionOpportunities'.
If acting on another type of endpoint only the 'maxPacketSize' is returned.
This function is mainly useful for setting up /isochronous/ transfers.
-}maxIsoPacketSize∷EndpointDesc→SizemaxIsoPacketSizeepDesc|isochronousOrInterrupt=mps*(1+fromEnumto)|otherwise=mpswhereMaxPacketSizempsto=endpointMaxPacketSizeepDescisochronousOrInterrupt=caseendpointAttribsepDescofIsochronous__→TrueInterrupt→True_→False---------------------------------------------------------------------------------- ** Retrieving and converting descriptors--------------------------------------------------------------------------------getDeviceDesc∷PtrC'libusb_device→IODeviceDescgetDeviceDescdevPtr=alloca$\devDescPtr→dohandleUSBException$c'libusb_get_device_descriptordevPtrdevDescPtrpeekdevDescPtr>>=convertDeviceDescdevPtrconvertDeviceDesc∷PtrC'libusb_device→C'libusb_device_descriptor→IODeviceDescconvertDeviceDescdevPtrd=doletnumConfigs=c'libusb_device_descriptor'bNumConfigurationsdconfigs←forM[0..numConfigs-1]$getConfigDescdevPtrreturnDeviceDesc{deviceUSBSpecReleaseNumber=unmarshalReleaseNumber$c'libusb_device_descriptor'bcdUSBd,deviceClass=c'libusb_device_descriptor'bDeviceClassd,deviceSubClass=c'libusb_device_descriptor'bDeviceSubClassd,deviceProtocol=c'libusb_device_descriptor'bDeviceProtocold,deviceMaxPacketSize0=c'libusb_device_descriptor'bMaxPacketSize0d,deviceVendorId=c'libusb_device_descriptor'idVendord,deviceProductId=c'libusb_device_descriptor'idProductd,deviceReleaseNumber=unmarshalReleaseNumber$c'libusb_device_descriptor'bcdDeviced,deviceManufacturerStrIx=unmarshalStrIx$c'libusb_device_descriptor'iManufacturerd,deviceProductStrIx=unmarshalStrIx$c'libusb_device_descriptor'iProductd,deviceSerialNumberStrIx=unmarshalStrIx$c'libusb_device_descriptor'iSerialNumberd,deviceNumConfigs=numConfigs,deviceConfigs=configs}-- | Unmarshal a a 16bit word as a release number. The 16bit word should be-- encoded as a Binary Coded Decimal using 4 bits for each of the 4-- decimals. Also see:---- <http://en.wikipedia.org/wiki/Binary-coded_decimal>unmarshalReleaseNumber∷Word16→ReleaseNumberunmarshalReleaseNumberabcd=(a,b,c,d)where[a,b,c,d]=mapfromIntegral$decodeBCD4abcd-- | Unmarshal an 8bit word to a string descriptor index. 0 denotes that a-- string descriptor is not available and unmarshals to 'Nothing'.unmarshalStrIx∷Word8→MaybeStrIxunmarshalStrIx0=NothingunmarshalStrIxstrIx=JuststrIxgetConfigDesc∷PtrC'libusb_device→Word8→IOConfigDescgetConfigDescdevPtrix=bracketgetConfigDescPtrc'libusb_free_config_descriptor((convertConfigDesc=<<)∘peek)wheregetConfigDescPtr=alloca$\configDescPtrPtr→dohandleUSBException$c'libusb_get_config_descriptordevPtrixconfigDescPtrPtrpeekconfigDescPtrPtrconvertConfigDesc∷C'libusb_config_descriptor→IOConfigDescconvertConfigDescc=doletnumInterfaces=c'libusb_config_descriptor'bNumInterfacescinterfaces←mapPeekArrayconvertInterface(fromIntegralnumInterfaces)(c'libusb_config_descriptor'interfacec)extra←getExtra(c'libusb_config_descriptor'extrac)(c'libusb_config_descriptor'extra_lengthc)returnConfigDesc{configValue=c'libusb_config_descriptor'bConfigurationValuec,configStrIx=unmarshalStrIx$c'libusb_config_descriptor'iConfigurationc,configAttribs=unmarshalConfigAttribs$c'libusb_config_descriptor'bmAttributesc,configMaxPower=c'libusb_config_descriptor'MaxPowerc,configNumInterfaces=numInterfaces,configInterfaces=interfaces,configExtra=extra}unmarshalConfigAttribs∷Word8→ConfigAttribsunmarshalConfigAttribsa=DeviceStatus{remoteWakeup=testBita5,selfPowered=testBita6}getExtra∷PtrCUChar→CInt→IOB.ByteStringgetExtraextraextraLength=B.packCStringLen(castPtrextra,fromIntegralextraLength)convertInterface∷C'libusb_interface→IO[InterfaceDesc]convertInterfacei=mapPeekArrayconvertInterfaceDesc(fromIntegral$c'libusb_interface'num_altsettingi)(c'libusb_interface'altsettingi)convertInterfaceDesc∷C'libusb_interface_descriptor→IOInterfaceDescconvertInterfaceDesci=doletnumEndpoints=c'libusb_interface_descriptor'bNumEndpointsiendpoints←mapPeekArrayconvertEndpointDesc(fromIntegralnumEndpoints)(c'libusb_interface_descriptor'endpointi)extra←getExtra(c'libusb_interface_descriptor'extrai)(c'libusb_interface_descriptor'extra_lengthi)returnInterfaceDesc{interfaceNumber=c'libusb_interface_descriptor'bInterfaceNumberi,interfaceAltSetting=c'libusb_interface_descriptor'bAlternateSettingi,interfaceClass=c'libusb_interface_descriptor'bInterfaceClassi,interfaceSubClass=c'libusb_interface_descriptor'bInterfaceSubClassi,interfaceStrIx=unmarshalStrIx$c'libusb_interface_descriptor'iInterfacei,interfaceProtocol=c'libusb_interface_descriptor'bInterfaceProtocoli,interfaceEndpoints=endpoints,interfaceExtra=extra}convertEndpointDesc∷C'libusb_endpoint_descriptor→IOEndpointDescconvertEndpointDesce=doextra←getExtra(c'libusb_endpoint_descriptor'extrae)(c'libusb_endpoint_descriptor'extra_lengthe)returnEndpointDesc{endpointAddress=unmarshalEndpointAddress$c'libusb_endpoint_descriptor'bEndpointAddresse,endpointAttribs=unmarshalEndpointAttribs$c'libusb_endpoint_descriptor'bmAttributese,endpointMaxPacketSize=unmarshalMaxPacketSize$c'libusb_endpoint_descriptor'wMaxPacketSizee,endpointInterval=c'libusb_endpoint_descriptor'bIntervale,endpointRefresh=c'libusb_endpoint_descriptor'bRefreshe,endpointSynchAddress=c'libusb_endpoint_descriptor'bSynchAddresse,endpointExtra=extra}-- | Unmarshal an 8bit word as an endpoint address. This function is primarily-- used when unmarshalling USB descriptors.unmarshalEndpointAddress∷Word8→EndpointAddressunmarshalEndpointAddressa=EndpointAddress{endpointNumber=fromIntegral$bits03a,transferDirection=iftestBita7thenInelseOut}-- | Marshal an endpoint address so that it can be used by the @libusb@ transfer-- functions.marshalEndpointAddress∷(Bitsα,Numα)⇒EndpointAddress→αmarshalEndpointAddress(EndpointAddressnumtransDir)=assert(betweennum015)$letn=fromIntegralnumincasetransDirofOut→nIn→setBitn7unmarshalEndpointAttribs∷Word8→EndpointAttribsunmarshalEndpointAttribsa=casebits01aof0→Control1→Isochronous(genToEnum$bits23a)(genToEnum$bits45a)2→Bulk3→Interrupt_→moduleError"unmarshalEndpointAttribs: this can't happen!"unmarshalMaxPacketSize∷Word16→MaxPacketSizeunmarshalMaxPacketSizem=MaxPacketSize{maxPacketSize=fromIntegral$bits010m,transactionOpportunities=genToEnum$bits1112m}---------------------------------------------------------------------------------- ** String descriptors---------------------------------------------------------------------------------- | The size in number of bytes of the header of string descriptors.strDescHeaderSize∷SizestrDescHeaderSize=2-- | Characters are encoded as UTF16LE so each character takes two bytes.charSize∷SizecharSize=2{-| Retrieve a list of supported languages.
This function may throw 'USBException's.
-}getLanguages∷DeviceHandle→IO[LangId]getLanguagesdevHndl=allocaArraymaxSize$\dataPtr→doreportedSize←writedataPtrletstrSize=(reportedSize-strDescHeaderSize)`div`charSizestrPtr=castPtr$dataPtr`plusPtr`strDescHeaderSizemapunmarshalLangId<$>peekArraystrSizestrPtrwheremaxSize=255-- Some devices choke on size > 255write=putStrDescdevHndl00maxSize{-| @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
location that @dataPtr@ points to. So ensure there is at least space
for @maxSize@ bytes there. Next, the header of the string descriptor
is checked for correctness. If it's incorrect an 'IOException' is
thrown. Finally, the size reported in the header is returned.
-}putStrDesc∷DeviceHandle→StrIx→Word16→Size→PtrCUChar→IOSizeputStrDescdevHndlstrIxlangIdmaxSizedataPtr=doactualSize←withDevHndlPtrdevHndl$\devHndlPtr→checkUSBException$c'libusb_get_string_descriptordevHndlPtrstrIxlangIddataPtr(fromIntegralmaxSize)when(actualSize<strDescHeaderSize)$throwIO$IOException"Incomplete header"reportedSize←peekdataPtrwhen(reportedSize>fromIntegralactualSize)$throwIO$IOException"Not enough space to hold data"descType←peekElemOffdataPtr1when(descType≢c'LIBUSB_DT_STRING)$throwIO$IOException"Invalid header"return$fromIntegralreportedSize{-| The language ID consists of the primary language identifier and the
sublanguage identififier as described in:
<http://www.usb.org/developers/docs/USB_LANGIDs.pdf>
For a mapping between IDs and languages see the @usb-id-database@ package at:
<http://hackage.haskell.org/package/usb-id-database>
To see which 'LangId's are supported by a device see 'getLanguages'.
-}typeLangId=(PrimaryLangId,SubLangId)typePrimaryLangId=Word16typeSubLangId=Word16unmarshalLangId∷Word16→LangIdunmarshalLangId=bits09&&&bits1015marshalLangId∷LangId→Word16marshalLangId(p,s)=p.|.s`shiftL`10-- | Type of indici of string descriptors.---- Can be retrieved by all the *StrIx functions.typeStrIx=Word8{-| Retrieve a string descriptor from a device.
This function may throw 'USBException's.
-}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.→IOTextgetStrDescdevHndlstrIxlangIdnrOfChars=assert(strIx≢0)$fmapdecode$BI.createAndTrimsize$write∘castPtrwherewrite=putStrDescdevHndlstrIx(marshalLangIdlangId)sizesize=strDescHeaderSize+nrOfChars*charSizedecode=TE.decodeUtf16LE∘B.dropstrDescHeaderSize{-| Retrieve a string descriptor from a device using the first supported language.
This function may throw 'USBException's.
-}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.→IOTextgetStrDescFirstLangdevHndlstrIxnrOfChars=dolangIds←getLanguagesdevHndlcaselangIdsof[]→throwIO$IOException"Zero languages"langId:_→getStrDescdevHndlstrIxlangIdnrOfChars---------------------------------------------------------------------------------- * I/O--------------------------------------------------------------------------------{-| Handy type synonym for read transfers.
A @ReadAction@ is a function which takes a 'Size' which defines how many bytes
to read and a 'Timeout'. The function returns an 'IO' action which, when
executed, performs the actual read and returns the 'B.ByteString' that was read
paired with a 'Status' flag which indicates whether the transfer
'Completed' or 'TimedOut'.
-}typeReadAction=Size→Timeout→IO(B.ByteString,Status)-- | Handy type synonym for read transfers that must exactly read the specified-- number of bytes. An 'incompleteReadException' is thrown otherwise.typeReadExactAction=Size→Timeout→IOB.ByteString{-| Handy type synonym for write transfers.
A @WriteAction@ is a function which takes a 'B.ByteString' to write and a
'Timeout'. The function returns an 'IO' action which, when exectued, returns the
number of bytes that were actually written paired with a 'Status' flag which
indicates whether the transfer 'Completed' or 'TimedOut'.
-}typeWriteAction=B.ByteString→Timeout→IO(Size,Status)-- | Handy type synonym for write transfers that must exactly write all the-- given bytes. An 'incompleteWriteException' is thrown otherwise.typeWriteExactAction=B.ByteString→Timeout→IO()-- | Number of bytes transferred.typeSize=Int-- | A timeout in milliseconds. A timeout defines how long a transfer should wait-- before giving up due to no response being received.-- Use 'noTimeout' for no timeout.typeTimeout=Int-- | A timeout of 0 denotes no timeout so: @noTimeout = 0@.noTimeout∷TimeoutnoTimeout=0-- | Status of a terminated transfer.dataStatus=Completed-- ^ All bytes were transferred-- within the maximum allowed 'Timeout' period.|TimedOut-- ^ Not all bytes were transferred-- within the maximum allowed 'Timeout' period.deriving(COMMON_INSTANCES)--------------------------------------------------------------------------------- ** Types of control transfers--------------------------------------------------------------------------------- | Handy type synonym that names the parameters of a control transfer.typeControlActionα=RequestType→Recipient→Request→Value→Index→αdataRequestType=Standard|Class|Vendorderiving(Enum,COMMON_INSTANCES)dataRecipient=ToDevice|ToInterface|ToEndpoint|ToOtherderiving(Enum,COMMON_INSTANCES)typeRequest=Word8-- | (Host-endian)typeValue=Word16-- | (Host-endian)typeIndex=Word16marshalRequestType∷RequestType→Recipient→Word8marshalRequestTypetr=genFromEnumt`shiftL`5.|.genFromEnumr---------------------------------------------------------------------------------- ** Control transfers--------------------------------------------------------------------------------{-| Perform a USB /control/ request that does not transfer data.
Exceptions:
* 'TimeoutException' if the transfer timed out.
* 'PipeException' if the control request was not supported by the device
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}control∷DeviceHandle→ControlAction(Timeout→IO())controldevHndlreqTypereqRecipientrequestvalueindextimeout=do(_,status)←doControlwhen(status≡TimedOut)$throwIOTimeoutExceptionwheredoControl#ifdef HAS_EVENT_MANAGER|Justwait←getWaitdevHndl=allocaBytescontrolSetupSize$\bufferPtr→dopokebufferPtr$C'libusb_control_setuprequestTyperequestvalueindex0transferAsyncwaitc'LIBUSB_TRANSFER_TYPE_CONTROLdevHndlcontrolEndpointtimeout(bufferPtr,controlSetupSize)#endif|otherwise=controlTransferSyncdevHndlrequestTyperequestvalueindextimeout(nullPtr,0)requestType=marshalRequestTypereqTypereqRecipient--------------------------------------------------------------------------------{-| Perform a USB /control/ read.
Exceptions:
* 'PipeException' if the control request was not supported by the device
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}readControl∷DeviceHandle→ControlActionReadActionreadControldevHndlreqTypereqRecipientrequestvalueindexsizetimeout#ifdef HAS_EVENT_MANAGER|Justwait←getWaitdevHndl=dolettotalSize=controlSetupSize+sizeallocaBytestotalSize$\bufferPtr→dopokebufferPtr$C'libusb_control_setuprequestTyperequestvalueindex(fromIntegralsize)(transferred,status)←transferAsyncwaitc'LIBUSB_TRANSFER_TYPE_CONTROLdevHndlcontrolEndpointtimeout(bufferPtr,totalSize)bs←BI.createtransferred$\dataPtr→copyArraydataPtr(bufferPtr`plusPtr`controlSetupSize)transferredreturn(bs,status)#endif|otherwise=createAndTrimNoOffsetsize$\dataPtr→controlTransferSyncdevHndlrequestTyperequestvalueindextimeout(dataPtr,size)whererequestType=marshalRequestTypereqTypereqRecipient`setBit`7-- | A convenience function similar to 'readControl' which checks if the-- specified number of bytes to read were actually read.-- Throws an 'incompleteReadException' if this is not the case.readControlExact∷DeviceHandle→ControlActionReadExactActionreadControlExactdevHndlreqTypereqRecipientrequestvalueindexsizetimeout=do(bs,_)←readControldevHndlreqTypereqRecipientrequestvalueindexsizetimeoutifB.lengthbs≢sizethenthrowIOincompleteReadExceptionelsereturnbs--------------------------------------------------------------------------------{-| Perform a USB /control/ write.
Exceptions:
* 'PipeException' if the control request was not supported by the device
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}writeControl∷DeviceHandle→ControlActionWriteActionwriteControldevHndlreqTypereqRecipientrequestvalueindexinputtimeout#ifdef HAS_EVENT_MANAGER|Justwait←getWaitdevHndl=BU.unsafeUseAsCStringLeninput$\(dataPtr,size)→dolettotalSize=controlSetupSize+sizeallocaBytestotalSize$\bufferPtr→dopokebufferPtr$C'libusb_control_setuprequestTyperequestvalueindex(fromIntegralsize)copyArray(bufferPtr`plusPtr`controlSetupSize)dataPtrsizetransferAsyncwaitc'LIBUSB_TRANSFER_TYPE_CONTROLdevHndlcontrolEndpointtimeout(bufferPtr,totalSize)#endif|otherwise=BU.unsafeUseAsCStringLeninput$controlTransferSyncdevHndlrequestTyperequestvalueindextimeoutwhererequestType=marshalRequestTypereqTypereqRecipient-- | A convenience function similar to 'writeControl' which checks if the given-- bytes were actually fully written.-- Throws an 'incompleteWriteException' if this is not the case.writeControlExact∷DeviceHandle→ControlActionWriteExactActionwriteControlExactdevHndlreqTypereqRecipientrequestvalueindexinputtimeout=do(transferred,_)←writeControldevHndlreqTypereqRecipientrequestvalueindexinputtimeoutwhen(transferred≢B.lengthinput)$throwIOincompleteWriteException--------------------------------------------------------------------------------#ifdef HAS_EVENT_MANAGERcontrolSetupSize∷SizecontrolSetupSize=sizeOf(undefined∷C'libusb_control_setup)controlEndpoint∷CUCharcontrolEndpoint=0#endifcontrolTransferSync∷DeviceHandle→Word8→Request→Value→Index→Timeout→(Ptrbyte,Size)→IO(Size,Status)controlTransferSyncdevHndlreqTyperequestvalueindextimeout(dataPtr,size)=doerr←withDevHndlPtrdevHndl$\devHndlPtr→c'libusb_control_transferdevHndlPtrreqTyperequestvalueindex(castPtrdataPtr)(fromIntegralsize)(fromIntegraltimeout)lettimedOut=err≡c'LIBUSB_ERROR_TIMEOUTiferr<0∧nottimedOutthenthrowIO$convertUSBExceptionerrelsereturn(fromIntegralerr,iftimedOutthenTimedOutelseCompleted)---------------------------------------------------------------------------------- ** Bulk transfers--------------------------------------------------------------------------------{-| Perform a USB /bulk/ read.
Exceptions:
* 'PipeException' if the endpoint halted.
* 'OverflowException' if the device offered more data,
see /Packets and overflows/ in the @libusb@ documentation:
<http://libusb.sourceforge.net/api-1.0/packetoverflow.html>.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}readBulk∷DeviceHandle→EndpointAddress→ReadActionreadBulkdevHndl#ifdef HAS_EVENT_MANAGER|Justwait←getWaitdevHndl=readTransferAsyncwaitc'LIBUSB_TRANSFER_TYPE_BULKdevHndl#endif|otherwise=readTransferSyncc'libusb_bulk_transferdevHndl{-| Perform a USB /bulk/ write.
Exceptions:
* 'PipeException' if the endpoint halted.
* 'OverflowException' if the device offered more data,
see /Packets and overflows/ in the @libusb@ documentation:
<http://libusb.sourceforge.net/api-1.0/packetoverflow.html>.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}writeBulk∷DeviceHandle→EndpointAddress→WriteActionwriteBulkdevHndl#ifdef HAS_EVENT_MANAGER|Justwait←getWaitdevHndl=writeTransferAsyncwaitc'LIBUSB_TRANSFER_TYPE_BULKdevHndl#endif|otherwise=writeTransferSyncc'libusb_bulk_transferdevHndl---------------------------------------------------------------------------------- ** Interrupt transfers--------------------------------------------------------------------------------{-| Perform a USB /interrupt/ read.
Exceptions:
* 'PipeException' if the endpoint halted.
* 'OverflowException' if the device offered more data,
see /Packets and overflows/ in the libusb documentation:
<http://libusb.sourceforge.net/api-1.0/packetoverflow.html>.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}readInterrupt∷DeviceHandle→EndpointAddress→ReadActionreadInterruptdevHndl#ifdef HAS_EVENT_MANAGER|Justwait←getWaitdevHndl=readTransferAsyncwaitc'LIBUSB_TRANSFER_TYPE_INTERRUPTdevHndl#endif|otherwise=readTransferSyncc'libusb_interrupt_transferdevHndl{-| Perform a USB /interrupt/ write.
Exceptions:
* 'PipeException' if the endpoint halted.
* 'OverflowException' if the device offered more data,
see /Packets and overflows/ in the @libusb@ documentation:
<http://libusb.sourceforge.net/api-1.0/packetoverflow.html>.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}writeInterrupt∷DeviceHandle→EndpointAddress→WriteActionwriteInterruptdevHndl#ifdef HAS_EVENT_MANAGER|Justwait←getWaitdevHndl=writeTransferAsyncwaitc'LIBUSB_TRANSFER_TYPE_INTERRUPTdevHndl#endif|otherwise=writeTransferSyncc'libusb_interrupt_transferdevHndl---------------------------------------------------------------------------------- | Handy type synonym for the @libusb@ transfer functions.typeC'TransferFunc=PtrC'libusb_device_handle-- devHndlPtr→CUChar-- endpoint address→PtrCUChar-- dataPtr→CInt-- size→PtrCInt-- transferredPtr→CUInt-- timeout→IOCInt-- errorreadTransferSync∷C'TransferFunc→(DeviceHandle→EndpointAddress→ReadAction)readTransferSyncc'transfer=\devHndlendpointAddr→\sizetimeout→createAndTrimNoOffsetsize$\dataPtr→transferSyncc'transferdevHndlendpointAddrtimeout(castPtrdataPtr,size)writeTransferSync∷C'TransferFunc→(DeviceHandle→EndpointAddress→WriteAction)writeTransferSyncc'transfer=\devHndlendpointAddr→\inputtimeout→BU.unsafeUseAsCStringLeninput$transferSyncc'transferdevHndlendpointAddrtimeouttransferSync∷C'TransferFunc→DeviceHandle→EndpointAddress→Timeout→CStringLen→IO(Size,Status)transferSyncc'transferdevHndlendpointAddrtimeout(dataPtr,size)=alloca$\transferredPtr→doerr←withDevHndlPtrdevHndl$\devHndlPtr→c'transferdevHndlPtr(marshalEndpointAddressendpointAddr)(castPtrdataPtr)(fromIntegralsize)transferredPtr(fromIntegraltimeout)lettimedOut=err≡c'LIBUSB_ERROR_TIMEOUTiferr≢c'LIBUSB_SUCCESS∧nottimedOutthenthrowIO$convertUSBExceptionerrelsedotransferred←peektransferredPtrreturn(fromIntegraltransferred,iftimedOutthenTimedOutelseCompleted)--------------------------------------------------------------------------------#ifdef HAS_EVENT_MANAGERreadTransferAsync∷Wait→C'TransferType→DeviceHandle→EndpointAddress→ReadActionreadTransferAsyncwaittransType=\devHndlendpointAddr→\sizetimeout→createAndTrimNoOffsetsize$\bufferPtr→transferAsyncwaittransTypedevHndl(marshalEndpointAddressendpointAddr)timeout(bufferPtr,size)writeTransferAsync∷Wait→C'TransferType→DeviceHandle→EndpointAddress→WriteActionwriteTransferAsyncwaittransType=\devHndlendpointAddr→\inputtimeout→BU.unsafeUseAsCStringLeninput$transferAsyncwaittransTypedevHndl(marshalEndpointAddressendpointAddr)timeout--------------------------------------------------------------------------------typeC'TransferType=CUChartransferAsync∷Wait→C'TransferType→DeviceHandle→CUChar-- ^ Encoded endpoint address→Timeout→(Ptrbyte,Size)→IO(Size,Status)transferAsyncwaittransTypedevHndlendpointtimeoutbytes=withTerminatedTransferwaittransType0[]devHndlendpointtimeoutbytes(continueCompleted)(continueTimedOut)wherecontinuestatustransPtr=don←peek$p'libusb_transfer'actual_lengthtransPtrreturn(fromIntegraln,status)--------------------------------------------------------------------------------withTerminatedTransfer∷Wait→C'TransferType→Int→[C'libusb_iso_packet_descriptor]→DeviceHandle→CUChar-- ^ Encoded endpoint address→Timeout→(Ptrbyte,Size)→(PtrC'libusb_transfer→IOα)→(PtrC'libusb_transfer→IOα)→IOαwithTerminatedTransferwaittransTypenrOfIsoPacketsisoPackageDescsdevHndlendpointtimeout(bufferPtr,size)onCompletiononTimeout=withDevHndlPtrdevHndl$\devHndlPtr→allocaTransfernrOfIsoPackets$\transPtr→dolock←newLockwithCallback(\_→releaselock)$\cbPtr→dopoketransPtr$C'libusb_transfer{c'libusb_transfer'dev_handle=devHndlPtr,c'libusb_transfer'flags=0-- unused,c'libusb_transfer'endpoint=endpoint,c'libusb_transfer'type=transType,c'libusb_transfer'timeout=fromIntegraltimeout,c'libusb_transfer'status=0-- output,c'libusb_transfer'length=fromIntegralsize,c'libusb_transfer'actual_length=0-- output,c'libusb_transfer'callback=cbPtr,c'libusb_transfer'user_data=nullPtr-- unused,c'libusb_transfer'buffer=castPtrbufferPtr,c'libusb_transfer'num_iso_packets=fromIntegralnrOfIsoPackets,c'libusb_transfer'iso_packet_desc=isoPackageDescs}mask_$dohandleUSBException$c'libusb_submit_transfertransPtrwaittimeoutlocktransPtrstatus←peek$p'libusb_transfer'statustransPtrcasestatusofts|ts≡c'LIBUSB_TRANSFER_COMPLETED→onCompletiontransPtr|ts≡c'LIBUSB_TRANSFER_TIMED_OUT→onTimeouttransPtr|ts≡c'LIBUSB_TRANSFER_ERROR→throwIOioException|ts≡c'LIBUSB_TRANSFER_NO_DEVICE→throwIONoDeviceException|ts≡c'LIBUSB_TRANSFER_OVERFLOW→throwIOOverflowException|ts≡c'LIBUSB_TRANSFER_STALL→throwIOPipeException|ts≡c'LIBUSB_TRANSFER_CANCELLED→moduleError"transfer status can't be Cancelled!"|otherwise→moduleError$"Unknown transfer status: "++showts++"!"---------------------------------------------------------------------------------- | Allocate a transfer with the given number of isochronous packets and apply-- the function to the resulting pointer. The transfer is automatically freed-- when the function terminates (whether normally or by raising an exception).---- A 'NoMemException' may be thrown.allocaTransfer∷Int→(PtrC'libusb_transfer→IOα)→IOαallocaTransfernrOfIsoPackets=bracketmallocTransferc'libusb_free_transferwheremallocTransfer=dotransPtr←c'libusb_alloc_transfer(fromIntegralnrOfIsoPackets)when(transPtr≡nullPtr)(throwIONoMemException)returntransPtr---------------------------------------------------------------------------------- | Create a 'FunPtr' to the given transfer callback function and pass it to-- the continuation function. The 'FunPtr' is automatically freed when the-- continuation terminates (whether normally or by raising an exception).withCallback∷(PtrC'libusb_transfer→IO())→(C'libusb_transfer_cb_fn→IOα)→IOαwithCallbackcb=bracket(mk'libusb_transfer_cb_fncb)freeHaskellFunPtr---------------------------------------------------------------------------------- | A lock is in one of two states: \"locked\" or \"unlocked\".newtypeLock=Lock(MVar())derivingEq-- | Create a lock in the \"unlocked\" state.newLock∷IOLocknewLock=Lock<$>newEmptyMVar{-|
Acquires the 'Lock'. Blocks if another thread has acquired the 'Lock'.
@acquire@ behaves as follows:
* When the state is \"unlocked\" @acquire@ changes the state to \"locked\".
* When the state is \"locked\" @acquire@ /blocks/ until a call to 'release' in
another thread wakes the calling thread. Upon awakening it will change the state
to \"locked\".
-}acquire∷Lock→IO()acquire(Lockmv)=takeMVarmv{-|
@release@ changes the state to \"unlocked\" and returns immediately.
The behaviour is undefined when a lock in the \"unlocked\" state is released!
If there are any threads blocked on 'acquire' the thread that first called
@acquire@ will be woken up.
-}release∷Lock→IO()release(Lockmv)=putMVarmv()---------------------------------------------------------------------------------- ** Isochronous transfers--------------------------------------------------------------------------------{-| Perform a USB /isochronous/ read.
/WARNING:/ You need to enable the threaded runtime (@-threaded@) for this
function to work correctly. It throws a runtime error otherwise!
Exceptions:
* 'PipeException' if the endpoint halted.
* 'OverflowException' if the device offered more data,
see /Packets and overflows/ in the @libusb@ documentation:
<http://libusb.sourceforge.net/api-1.0/packetoverflow.html>.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}readIsochronous∷DeviceHandle→EndpointAddress→[Size]-- ^ Sizes of isochronous packets→Timeout→IO[B.ByteString]readIsochronousdevHndlendpointAddrsizestimeout|Justwait←getWaitdevHndl=doletSumLengthtotalSizenrOfIsoPackets=sumLengthsizesallocaBytestotalSize$\bufferPtr→withTerminatedTransferwaitc'LIBUSB_TRANSFER_TYPE_ISOCHRONOUSnrOfIsoPackets(mapinitIsoPacketDescsizes)devHndl(marshalEndpointAddressendpointAddr)timeout(bufferPtr,totalSize)(\transPtr→convertIsosnrOfIsoPacketstransPtrbufferPtr)(\_→throwIOTimeoutException)|otherwise=needThreadedRTSError"readIsochronous"--------------------------------------------------------------------------------{-| Perform a USB /isochronous/ write.
/WARNING:/ You need to enable the threaded runtime (@-threaded@) for this
function to work correctly. It throws a runtime error otherwise!
Exceptions:
* 'PipeException' if the endpoint halted.
* 'OverflowException' if the device offered more data,
see /Packets and overflows/ in the @libusb@ documentation:
<http://libusb.sourceforge.net/api-1.0/packetoverflow.html>.
* 'NoDeviceException' if the device has been disconnected.
* Another 'USBException'.
-}writeIsochronous∷DeviceHandle→EndpointAddress→[B.ByteString]→Timeout→IO[Size]writeIsochronousdevHndlendpointAddrisoPacketstimeout|Justwait←getWaitdevHndl=doletsizes=mapB.lengthisoPacketsSumLengthtotalSizenrOfIsoPackets=sumLengthsizesallocaBytestotalSize$\bufferPtr→docopyIsos(castPtrbufferPtr)isoPacketswithTerminatedTransferwaitc'LIBUSB_TRANSFER_TYPE_ISOCHRONOUSnrOfIsoPackets(mapinitIsoPacketDescsizes)devHndl(marshalEndpointAddressendpointAddr)timeout(bufferPtr,totalSize)(\transPtr→mapactualLength<$>peekIsoPacketDescsnrOfIsoPacketstransPtr)(\_→throwIOTimeoutException)|otherwise=needThreadedRTSError"writeIsochronous"--------------------------------------------------------------------------------actualLength∷C'libusb_iso_packet_descriptor→SizeactualLength=fromIntegral∘c'libusb_iso_packet_descriptor'actual_length-- | Simultaneously calculate the sum and length of the given list.sumLength∷[Int]→SumLengthsumLength=foldl'(\(SumLengthsl)x→SumLength(s+x)(l+1))(SumLength00)-- | Strict pair of sum and length.dataSumLength=SumLength!Int!Int-- | An isochronous packet descriptor with all fields zero except for the length.initIsoPacketDesc∷Size→C'libusb_iso_packet_descriptorinitIsoPacketDescsize=C'libusb_iso_packet_descriptor{c'libusb_iso_packet_descriptor'length=fromIntegralsize,c'libusb_iso_packet_descriptor'actual_length=0,c'libusb_iso_packet_descriptor'status=0}convertIsos∷Int→PtrC'libusb_transfer→PtrWord8→IO[B.ByteString]convertIsosnrOfIsoPacketstransPtrbufferPtr=peekIsoPacketDescsnrOfIsoPacketstransPtr>>=gobufferPtridwherego_bss[]=return$bss[]goptrbss(C'libusb_iso_packet_descriptorla_:ds)=dolettransferred=fromIntegralabs←BI.createtransferred$\p→copyArraypptrtransferredgo(ptr`plusPtr`fromIntegrall)(bss∘(bs:))ds-- | Retrieve the isochronous packet descriptors from the given transfer.peekIsoPacketDescs∷Int→PtrC'libusb_transfer→IO[C'libusb_iso_packet_descriptor]peekIsoPacketDescsnrOfIsoPackets=peekArraynrOfIsoPackets∘p'libusb_transfer'iso_packet_desccopyIsos∷PtrCChar→[B.ByteString]→IO()copyIsos=foldM_$\bufferPtrbs→BU.unsafeUseAsCStringLenbs$\(ptr,len)→docopyArraybufferPtrptrlenreturn$bufferPtr`plusPtr`len#endif--------------------------------------------------------------------------------createAndTrimNoOffset∷Size→(PtrWord8→IO(Size,α))→IO(B.ByteString,α)createAndTrimNoOffsetsizef=BI.createAndTrim'size$\ptr→do(l,x)←fptrreturn(offset,l,x)whereoffset=0---------------------------------------------------------------------------------- * Exceptions---------------------------------------------------------------------------------- | @handleUSBException action@ executes @action@. If @action@ returned an-- error code other than 'c\'LIBUSB_SUCCESS', the error is converted to a-- 'USBException' and thrown.handleUSBException∷IOCInt→IO()handleUSBExceptionaction=doerr←actionwhen(err≢c'LIBUSB_SUCCESS)(throwIO$convertUSBExceptionerr)-- | @checkUSBException action@ executes @action@. If @action@ returned a-- negative integer the integer is converted to a 'USBException' and thrown. If-- not, the integer is returned.checkUSBException∷(Integralα,Showα)⇒IOα→IOIntcheckUSBExceptionaction=dor←actionifr<0thenthrowIO$convertUSBExceptionrelsereturn$fromIntegralr-- | Convert a @C'libusb_error@ to a 'USBException'. If the @C'libusb_error@ is-- unknown an 'error' is thrown.convertUSBException∷(Numα,Eqα,Showα)⇒α→USBExceptionconvertUSBExceptionerr=fromMaybeunknownLibUsbError$lookuperrlibusb_error_to_USBExceptionwhereunknownLibUsbError=moduleError$"Unknown libusb error code: "++showerr++"!"-- | Association list mapping 'C'libusb_error's to 'USBException's.libusb_error_to_USBException∷Numα⇒[(α,USBException)]libusb_error_to_USBException=[(c'LIBUSB_ERROR_IO,ioException),(c'LIBUSB_ERROR_INVALID_PARAM,InvalidParamException),(c'LIBUSB_ERROR_ACCESS,AccessException),(c'LIBUSB_ERROR_NO_DEVICE,NoDeviceException),(c'LIBUSB_ERROR_NOT_FOUND,NotFoundException),(c'LIBUSB_ERROR_BUSY,BusyException),(c'LIBUSB_ERROR_TIMEOUT,TimeoutException),(c'LIBUSB_ERROR_OVERFLOW,OverflowException),(c'LIBUSB_ERROR_PIPE,PipeException),(c'LIBUSB_ERROR_INTERRUPTED,InterruptedException),(c'LIBUSB_ERROR_NO_MEM,NoMemException),(c'LIBUSB_ERROR_NOT_SUPPORTED,NotSupportedException),(c'LIBUSB_ERROR_OTHER,OtherException)]-- | Type of USB exceptions.dataUSBException=IOExceptionString-- ^ Input/output exception.|InvalidParamException-- ^ Invalid parameter.|AccessException-- ^ Access denied (insufficient permissions). It may-- help to run your program with elevated privileges or-- change the permissions of your device using-- something like @udev@.|NoDeviceException-- ^ No such device (it may have been disconnected).|NotFoundException-- ^ Entity not found.|BusyException-- ^ Resource busy.|TimeoutException-- ^ Operation timed out.|OverflowException-- ^ If the device offered to much data.-- See /Packets and overflows/ in the @libusb@ documentation:-- <http://libusb.sourceforge.net/api-1.0/packetoverflow.html>|PipeException-- ^ Pipe exception.|InterruptedException-- ^ System call interrupted (perhaps due to signal).|NoMemException-- ^ Insufficient memory.|NotSupportedException-- ^ Operation not supported or unimplemented on this-- platform.|OtherException-- ^ Other exception.deriving(COMMON_INSTANCES)instanceExceptionUSBException-- | A general 'IOException'.ioException∷USBExceptionioException=IOException""-- | 'IOException' that is thrown when the number of bytes /read/-- doesn't equal the requested number.incompleteReadException∷USBExceptionincompleteReadException=incompleteException"read"-- | 'IOException' that is thrown when the number of bytes /written/-- doesn't equal the requested number.incompleteWriteException∷USBExceptionincompleteWriteException=incompleteException"written"incompleteException∷String→USBExceptionincompleteExceptionrw=IOException$"The number of bytes "++rw++" doesn't equal the requested number!"--------------------------------------------------------------------------------moduleError∷String→errormoduleErrormsg=error$thisModule++": "++msgthisModule∷StringthisModule="System.USB.Base"needThreadedRTSError∷String→errorneedThreadedRTSErrormsg=moduleError$msg++" is only supported when using the threaded runtime. "++"Please build your program with -threaded."