usb-1.3.0.6: Communicate with USB devices

Copyright(c) 2009–2017 Bas van Dijk
LicenseBSD3 (see the file LICENSE)
MaintainerBas van Dijk <v.dijk.bas@gmail.com>
Safe HaskellTrustworthy
LanguageHaskell98

System.USB.Enumeration

Contents

Description

This module provides functionality for enumerating the USB devices currently attached to the system.

Synopsis

Documentation

data Device Source #

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.

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 getDeviceDesc.

Instances

Eq Device Source # 

Methods

(==) :: Device -> Device -> Bool #

(/=) :: Device -> Device -> Bool #

Show Device Source #

Devices are shown as: Bus <busNumber> Device <deviceAddress>

Device enumeration

getDevices :: Ctx -> IO (Vector Device) Source #

Returns a vector of USB devices currently attached to the system.

This is your entry point into finding a USB device.

Exceptions:

Device hotplug event notification

Instead of enumerating all devices attached to the system using getDevices you can also be notified on device attachment and removal using the hotplug event notification API.

Hotplug events

data HotplugEvent Source #

The set of hotplug events to trigger the callback in registerHotplugCallback.

Instances

deviceArrived :: HotplugEvent Source #

A device has been plugged in and is ready to use.

deviceLeft :: HotplugEvent Source #

A device has left and is no longer available.

It is the user's responsibility to call closeDevice on any handle associated with a disconnected device. It is safe to call getDeviceDesc on a device that has left.

matchDeviceArrived :: HotplugEvent -> Bool Source #

Determine if the set of events contains a deviceArrived event.

matchDeviceLeft :: HotplugEvent -> Bool Source #

Determine if the set of events contains a deviceLeft event.

Hotplug flags

data HotplugFlag Source #

Set of configuration flags for registerHotplugCallback.

Instances

Semigroup HotplugFlag Source # 
Monoid HotplugFlag Source #

Use mempty to specify the empty set of flags. Use mappend e1 e2 to join the flags in e1 and e2.

enumerate :: HotplugFlag Source #

Fire events for all matching currently attached devices.

Asynchronous event notification

type HotplugCallback = Device -> HotplugEvent -> IO CallbackRegistrationStatus Source #

Hotplug callback function type used in registerHotplugCallback.

libusb will call this function, once registered using registerHotplugCallback, when a matching event has happened on a matching device.

This callback may be called by an internal event thread and as such it is recommended the callback do minimal processing before returning. In fact, it has been observed that doing any I/O with the device from inside the callback results in dead-lock! See the example below on the correct use of this callback.

It is safe to call either registerHotplugCallback or deregisterHotplugCallback from within a callback function.

Should return a CallbackRegistrationStatus which indicates whether this callback is finished processing events. Returning DeregisterThisCallback will cause this callback to be deregistered.

If you need to wait on the arrival of a device after which you need to do something with it, it's recommended to write the device to a concurrent channel like a MVar / TChan / TMVar / TChan / etc. then read the channel outside the callback. This way the processing of the device takes place in a different thread. See the following for one correct use-case:

waitForMyDevice :: Ctx
                -> Maybe VendorId
                -> Maybe ProductId
                -> Maybe Word8
                -> IO Device
waitForMyDevice ctx mbVendorId mbProductId mbDevClass = do
  mv <- newEmptyMVar
  -- We mask asynchronous exceptions to ensure that the callback
  -- gets properly deregistered when an asynchronous exception is
  -- thrown during the interruptible takeMVar operation.
  mask_ $ do
    h <- registerHotplugCallback ctx
                                 deviceArrived
                                 enumerate
                                 mbVendorId
                                 mbProductId
                                 mbDevClass
                                 (\dev event ->
                                    tryPutMVar mv (dev, event) $>
                                      DeregisterThisCallback)
    (dev, _event) <- takeMVar mv
                       `onException`
                         deregisterHotplugCallback h
    return dev

data CallbackRegistrationStatus Source #

Returned from a HotplugCallback to indicate whether the callback is finished processing events.

Constructors

KeepCallbackRegistered

The callback remains registered.

DeregisterThisCallback

The callback will be deregistered.

Instances

Eq CallbackRegistrationStatus Source # 
Data CallbackRegistrationStatus Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CallbackRegistrationStatus -> c CallbackRegistrationStatus #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CallbackRegistrationStatus #

toConstr :: CallbackRegistrationStatus -> Constr #

dataTypeOf :: CallbackRegistrationStatus -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c CallbackRegistrationStatus) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CallbackRegistrationStatus) #

gmapT :: (forall b. Data b => b -> b) -> CallbackRegistrationStatus -> CallbackRegistrationStatus #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CallbackRegistrationStatus -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CallbackRegistrationStatus -> r #

gmapQ :: (forall d. Data d => d -> u) -> CallbackRegistrationStatus -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> CallbackRegistrationStatus -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> CallbackRegistrationStatus -> m CallbackRegistrationStatus #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> CallbackRegistrationStatus -> m CallbackRegistrationStatus #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> CallbackRegistrationStatus -> m CallbackRegistrationStatus #

Read CallbackRegistrationStatus Source # 
Show CallbackRegistrationStatus Source # 
Generic CallbackRegistrationStatus Source # 
type Rep CallbackRegistrationStatus Source # 
type Rep CallbackRegistrationStatus = D1 * (MetaData "CallbackRegistrationStatus" "System.USB.Base" "usb-1.3.0.6-BxALn33Tmsa87zdhZNpf2H" False) ((:+:) * (C1 * (MetaCons "KeepCallbackRegistered" PrefixI False) (U1 *)) (C1 * (MetaCons "DeregisterThisCallback" PrefixI False) (U1 *)))

data HotplugCallbackHandle Source #

Callback handle.

Callbacks handles are generated by registerHotplugCallback and can be used to deregister callbacks. Callback handles are unique per Ctx and it is safe to call deregisterHotplugCallback on an already deregisted callback.

registerHotplugCallback Source #

Arguments

:: Ctx

Context to register this callback with.

-> HotplugEvent

Set of events that will trigger this callback.

-> HotplugFlag

Set of configuration flags.

-> Maybe VendorId

Just the vendor id to match or Nothing to match anything.

-> Maybe ProductId

Just the product id to match or Nothing to match anything.

-> Maybe Word8

Just the device class to match or Nothing to match anything.

-> HotplugCallback

The function to be invoked on a matching event/device.

-> IO HotplugCallbackHandle 

WARNING: see the note on HotplugCallback for the danger of using this function!

Register a hotplug callback function with the context. The callback will fire when a matching event occurs on a matching device. The callback is armed until either it is deregistered with deregisterHotplugCallback or the supplied callback returns DeregisterThisCallback to indicate it is finished processing events.

If the enumerate flag is passed the callback will be called with a deviceArrived for all devices already plugged into the machine. Note that libusb modifies its internal device list from a separate thread, while calling hotplug callbacks from libusb_handle_events(), so it is possible for a device to already be present on, or removed from, its internal device list, while the hotplug callbacks still need to be dispatched. This means that when using the enumerate flag, your callback may be called twice for the arrival of the same device, once from registerHotplugCallback and once from libusb_handle_events(); and/or your callback may be called for the removal of a device for which an arrived call was never made.

deregisterHotplugCallback :: HotplugCallbackHandle -> IO () Source #

Deregisters a hotplug callback.

Deregister a callback from a Ctx. This function is safe to call from within a hotplug callback.

Device location

busNumber :: Device -> Word8 Source #

The number of the bus that a device is connected to.

portNumber :: Device -> Word8 Source #

Get the number of the port that a is device connected to. Unless the OS does something funky, or you are hot-plugging USB extension cards, the port number returned by this call is usually guaranteed to be uniquely tied to a physical port, meaning that different devices plugged on the same physical port should return the same port number.

But outside of this, there is no guarantee that the port number returned by this call will remain the same, or even match the order in which ports have been numbered by the HUB/HCD manufacturer.

portNumbers Source #

Arguments

:: Device 
-> Int

The maximum number of ports allowed in the resulting vector. If there are more ports than this number Nothing will be returned. As per the USB 3.0 specs, the current maximum limit for the depth is 7.

-> Maybe (Vector Word8) 

Get the list of all port numbers from root for the specified device.

deviceAddress :: Device -> Word8 Source #

The address of the device on the bus it is connected to.

Device speed

deviceSpeed :: Device -> Maybe Speed Source #

Get the negotiated connection speed for a device.

Nothing means that the OS doesn't know or doesn't support returning the negotiated speed.

data Speed Source #

Speed codes. Indicates the speed at which the device is operating.

Constructors

LowSpeed

The device is operating at low speed (1.5MBit/s).

FullSpeed

The device is operating at full speed (12MBit/s).

HighSpeed

The device is operating at high speed (480MBit/s).

SuperSpeed

The device is operating at super speed (5000MBit/s).

Instances

Enum Speed Source # 
Eq Speed Source # 

Methods

(==) :: Speed -> Speed -> Bool #

(/=) :: Speed -> Speed -> Bool #

Data Speed Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Speed -> c Speed #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Speed #

toConstr :: Speed -> Constr #

dataTypeOf :: Speed -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Speed) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Speed) #

gmapT :: (forall b. Data b => b -> b) -> Speed -> Speed #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Speed -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Speed -> r #

gmapQ :: (forall d. Data d => d -> u) -> Speed -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Speed -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Speed -> m Speed #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Speed -> m Speed #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Speed -> m Speed #

Read Speed Source # 
Show Speed Source # 

Methods

showsPrec :: Int -> Speed -> ShowS #

show :: Speed -> String #

showList :: [Speed] -> ShowS #

Generic Speed Source # 

Associated Types

type Rep Speed :: * -> * #

Methods

from :: Speed -> Rep Speed x #

to :: Rep Speed x -> Speed #

type Rep Speed Source # 
type Rep Speed = D1 * (MetaData "Speed" "System.USB.Base" "usb-1.3.0.6-BxALn33Tmsa87zdhZNpf2H" False) ((:+:) * ((:+:) * (C1 * (MetaCons "LowSpeed" PrefixI False) (U1 *)) (C1 * (MetaCons "FullSpeed" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "HighSpeed" PrefixI False) (U1 *)) (C1 * (MetaCons "SuperSpeed" PrefixI False) (U1 *))))