diff --git a/System/USB/Safe.hs b/System/USB/Safe.hs --- a/System/USB/Safe.hs +++ b/System/USB/Safe.hs @@ -84,7 +84,7 @@ , openDevice , withDevice - , withDeviceWhich, NotFound(NotFound) + , withDeviceWhich , getDevice @@ -154,7 +154,7 @@ , ControlAction , RequestType(..) , control - , readControl + , readControl, readControlExact , writeControl -- * String descriptors @@ -184,6 +184,7 @@ import Data.Typeable ( Typeable ) import Data.Function ( ($) ) import Data.Word ( Word8 ) +import Data.Int ( Int ) import Data.Char ( String ) import Data.Bool ( Bool( True, False ) ) import Data.List ( map, head, filter, find ) @@ -242,24 +243,29 @@ ) import qualified System.USB.IO.Synchronous as USB - ( Timeout, Size + ( Timeout, TimedOut, Size , RequestType(Class, Vendor) , Recipient, Request, Value, Index - , control, readControl, writeControl - , getInterfaceAltSetting + , control, readControl, readControlExact, writeControl , readBulk, readInterrupt , writeBulk, writeInterrupt ) -import qualified System.USB.IO.Synchronous.Enumerator as USB - ( enumReadBulk, enumReadInterrupt ) +import qualified System.USB.IO.StandardDeviceRequests as USB + ( getInterfaceAltSetting ) +import qualified System.USB.Exceptions as USB + ( USBException(..) ) + #ifdef __HADDOCK__ import System.USB.Descriptors ( maxPacketSize, endpointMaxPacketSize ) -import System.USB.Exceptions ( USBException(..) ) #endif +-- from usb-enumerator: +import qualified System.USB.IO.Synchronous.Enumerator as USB + ( enumReadBulk, enumReadInterrupt ) + -------------------------------------------------------------------------------- -- ** Regional device handles -------------------------------------------------------------------------------- @@ -288,13 +294,13 @@ Exceptions: - * 'NoMemException' if there is a memory allocation failure. + * 'USB.NoMemException' if there is a memory allocation failure. - * 'AccessException' if the user has insufficient permissions. + * 'USB.AccessException' if the user has insufficient permissions. - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} openDevice ∷ MonadCatchIO pr ⇒ USB.Device → RegionT s pr (RegionalDeviceHandle (RegionT s pr)) @@ -319,15 +325,15 @@ Exceptions: - * 'NotFound' if no device is found which satisfies the given predicate. + * 'USB.NotFoundException' if no device is found which satisfies the given predicate. - * 'NoMemException' if there is a memory allocation failure. + * 'USB.NoMemException' if there is a memory allocation failure. - * 'AccessException' if the user has insufficient permissions. + * 'USB.AccessException' if the user has insufficient permissions. - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} withDeviceWhich ∷ ∀ pr α . MonadCatchIO pr @@ -351,16 +357,9 @@ → k -- ^ Continuation function → m α useWhich ds w p f = case find (p ∘ getDesc) ds of - Nothing → throw NotFound + Nothing → throw USB.NotFoundException Just d → w d f --- | This exception can be thrown in 'withDeviceWhich', 'setConfigWhich', --- 'withInterfaceWhich' or 'setAlternateWhich' to indicate that no value was --- found which satisfied the given predicate. -data NotFound = NotFound deriving (Show, Typeable) - -instance Exception NotFound - -- | Internally used function for getting the actual USB device handle from a -- regional device handle. getInternalDevHndl ∷ RegionalDeviceHandle r → USB.DeviceHandle @@ -404,7 +403,7 @@ 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. +the device. A 'USB.NotFoundException' is raised to indicate that this is the case. /TODO: Think about how to handle the implications of the the previous paragraph!/ @@ -415,10 +414,10 @@ * 'SettingAlreadySet' if a configuration has been set using 'setConfig', 'useActiveConfig' and 'setConfigWhich'. - * 'NotFoundException' if re-enumeration is required, or if the + * 'USB.NotFoundException' if re-enumeration is required, or if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} resetDevice ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → cr () @@ -519,11 +518,11 @@ * 'SettingAlreadySet' if a configuration has already been set using 'setConfig', 'useActiveConfig' or 'setConfigWhich'. - * 'BusyException' if interfaces are currently claimed. + * 'USB.BusyException' if interfaces are currently claimed. - * 'NoDeviceException' if the device has been disconnected + * 'USB.NoDeviceException' if the device has been disconnected - * Another 'USBException'. + * Another 'USB.USBException'. -} setConfig ∷ ∀ pr cr α . (pr `ParentOf` cr, MonadCatchIO cr) @@ -580,9 +579,9 @@ * 'NoActiveConfig' if the device is not configured. - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Aanother 'USBException'. + * Aanother 'USB.USBException'. -} useActiveConfig ∷ ∀ pr cr α . (pr `ParentOf` cr, MonadCatchIO cr) @@ -618,14 +617,14 @@ * 'SettingAlreadySet' if a configuration has already been set using 'setConfig', 'useActiveConfig' or 'setConfigWhich'. - * 'NotFound' if no configuration is found that satisfies the given + * 'USB.NotFoundException' if no configuration is found that satisfies the given predicate. - * 'BusyException' if interfaces are currently claimed. + * 'USB.BusyException' if interfaces are currently claimed. - * 'NoDeviceException' if the device has been disconnected + * 'USB.NoDeviceException' if the device has been disconnected - * Another 'USBException'. + * Another 'USB.USBException'. -} setConfigWhich ∷ ∀ pr cr α . (pr `ParentOf` cr, MonadCatchIO cr) @@ -707,11 +706,11 @@ Exceptions: - * 'BusyException' if another program or driver has claimed the interface. + * 'USB.BusyException' if another program or driver has claimed the interface. - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} claim ∷ ∀ pr sCfg s . MonadCatchIO pr @@ -741,13 +740,13 @@ Exceptions: - * 'NotFound' if no interface was found that satisfies the fiven predicate. + * 'USB.NotFoundException' if no interface was found that satisfies the fiven predicate. - * 'BusyException' if another program or driver has claimed the interface. + * 'USB.BusyException' if another program or driver has claimed the interface. - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} withInterfaceWhich ∷ ∀ pr sCfg α @@ -823,12 +822,12 @@ Exceptions: - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. * 'SettingAlreadySet' if an alternate has already been set using 'setAlternate', 'useActiveAlternate' or 'setAlternateWhich'. - * Another 'USBException'. + * Another 'USB.USBException'. -} setAlternate ∷ ∀ pr cr sCfg α . (pr `ParentOf` cr, MonadCatchIO cr) @@ -860,12 +859,12 @@ Exceptions: - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. * 'SettingAlreadySet' if an alternate has already been set using 'setAlternate', 'useActiveAlternate' or 'setAlternateWhich'. - * Aanother 'USBException'. + * Another 'USB.USBException'. -} useActiveAlternate ∷ ∀ pr cr sCfg α @@ -900,15 +899,15 @@ Exceptions: - * 'NotFound' if no alternate is found that satisfies the given + * 'USB.NotFoundException' if no alternate is found that satisfies the given predicate. - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. * 'SettingAlreadySet' if an alternate has already been set using 'setAlternate', 'useActiveAlternate' or 'setAlternateWhich'. - * Another 'USBException'. + * Another 'USB.USBException'. -} setAlternateWhich ∷ ∀ pr cr sCfg α . (pr `ParentOf` cr, MonadCatchIO cr) @@ -998,9 +997,9 @@ Exceptions: - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} clearHalt ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ Endpoint transDir transType sAlt pr → cr () @@ -1048,7 +1047,7 @@ performs the actual read and returns the bytestring that was read paired with an indication if the transfer timed out. -} -type ReadAction r = USB.Size → USB.Timeout → r (ByteString, Bool) +type ReadAction r = USB.Size → USB.Timeout → r (ByteString, USB.TimedOut) -- | Class of transfer types that support reading. class ReadEndpoint transType where @@ -1057,15 +1056,15 @@ Exceptions: - * 'PipeException' if the endpoint halted. + * 'USB.PipeException' if the endpoint halted. - * 'OverflowException' if the device offered more data, + * 'USB.OverflowException' if the device offered more data, see /Packets and overflows/ in the libusb documentation: . - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} readEndpoint ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ Endpoint In transType sAlt pr @@ -1085,7 +1084,7 @@ wrap ∷ (USB.DeviceHandle → USB.EndpointAddress → α) → (Endpoint transDir transType sAlt pr → α) wrap f = \(Endpoint internalDevHndl endpointDesc) → - f internalDevHndl (USB.endpointAddress endpointDesc) + f internalDevHndl $ USB.endpointAddress endpointDesc -------------------------------------------------------------------------------- @@ -1096,7 +1095,7 @@ of bytes that were actually written paired with an indication if the transfer timed out. -} -type WriteAction r = ByteString → USB.Timeout → r (USB.Size, Bool) +type WriteAction r = ByteString → USB.Timeout → r (USB.Size, USB.TimedOut) -- | Class of transfer types that support writing class WriteEndpoint transType where @@ -1105,11 +1104,11 @@ Exceptions: - * 'PipeException' if the endpoint halted. + * 'USB.PipeException' if the endpoint halted. - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} writeEndpoint ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ Endpoint Out transType sAlt pr @@ -1171,13 +1170,13 @@ Exceptions: - * 'TimeoutException' if the transfer timed out. + * 'USB.TimeoutException' if the transfer timed out. - * 'PipeException' if the control request was not supported by the device + * 'USB.PipeException' if the control request was not supported by the device - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} control ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → ControlAction (USB.Timeout → cr ()) @@ -1194,11 +1193,11 @@ Exceptions: - * 'PipeException' if the control request was not supported by the device + * 'USB.PipeException' if the control request was not supported by the device - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} readControl ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → ControlAction (ReadAction cr) @@ -1212,15 +1211,31 @@ timeout size +-- | A convenience function similar to 'readControl' which checks if the +-- specified number of bytes to read were actually read. Throws an 'USB.IOException' +-- if this is not the case. +readControlExact ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr) + ⇒ RegionalDeviceHandle pr → ControlAction + (USB.Size → USB.Timeout → cr ByteString) +readControlExact regionalDevHndl = \reqType reqRecipient request value index → \timeout size → + liftIO $ USB.readControlExact (getInternalDevHndl regionalDevHndl) + (reqTypeToInternal reqType) + reqRecipient + request + value + index + timeout + size + {-| Perform a USB /control/ write. Exceptions: - * 'PipeException' if the control request was not supported by the device + * 'USB.PipeException' if the control request was not supported by the device - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} writeControl ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → ControlAction (WriteAction cr) @@ -1272,7 +1287,7 @@ {-| Retrieve a list of supported languages. -This function may throw 'USBException's. +This function may throw 'USB.USBException's. -} getLanguages ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → cr [USB.LangId] @@ -1285,7 +1300,7 @@ to retrieve the descriptor. The string returned is Unicode, as detailed in the USB specifications. -This function may throw 'USBException's. +This function may throw 'USB.USBException's. /TODO: The following can be made more type-safe!/ @@ -1298,7 +1313,9 @@ ⇒ RegionalDeviceHandle pr → USB.StrIx → USB.LangId - → USB.Size + → Int -- ^ Maximum number of characters in the requested string. An + -- 'USB.IOException' will be thrown when the requested + -- string is larger than this number. → cr String getStrDesc devHndl strIx langId size = liftIO $ USB.getStrDesc (getInternalDevHndl devHndl) @@ -1313,12 +1330,14 @@ to retrieve the descriptor. The string returned is Unicode, as detailed in the USB specifications. -This function may throw 'USBException's. +This function may throw 'USB.USBException's. -} getStrDescFirstLang ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → USB.StrIx - → USB.Size + → Int -- ^ Maximum number of characters in the requested + -- string. An 'USB.IOException' will be thrown when + -- the requested string is larger than this number. → cr String getStrDescFirstLang devHndl descStrIx size = liftIO $ USB.getStrDescFirstLang (getInternalDevHndl devHndl) @@ -1337,9 +1356,9 @@ Exceptions: - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} kernelDriverActive ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber → cr Bool @@ -1352,13 +1371,13 @@ Exceptions: - * 'NotFoundException' if no kernel driver was active. + * 'USB.NotFoundException' if no kernel driver was active. - * 'InvalidParamException' if the interface does not exist. + * 'USB.InvalidParamException' if the interface does not exist. - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} detachKernelDriver ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber → cr () @@ -1370,16 +1389,16 @@ Exceptions: - * 'NotFoundException' if no kernel driver was active. + * 'USB.NotFoundException' if no kernel driver was active. - * 'InvalidParamException' if the interface does not exist. + * 'USB.InvalidParamException' if the interface does not exist. - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * 'BusyException' if the driver cannot be attached because the interface + * 'USB.BusyException' if the driver cannot be attached because the interface is claimed by a program or driver. - * Another 'USBException'. + * Another 'USB.USBException'. -} attachKernelDriver ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber → cr () @@ -1394,9 +1413,9 @@ Exceptions: - * 'NoDeviceException' if the device has been disconnected. + * 'USB.NoDeviceException' if the device has been disconnected. - * Another 'USBException'. + * Another 'USB.USBException'. -} withDetachedKernelDriver ∷ (pr `ParentOf` cr, MonadCatchIO cr) ⇒ RegionalDeviceHandle pr diff --git a/usb-safe.cabal b/usb-safe.cabal --- a/usb-safe.cabal +++ b/usb-safe.cabal @@ -1,5 +1,5 @@ name: usb-safe -version: 0.7 +version: 0.8 cabal-version: >=1.6 build-type: Custom license: BSD3 @@ -71,7 +71,8 @@ GHC-Options: -Wall -fno-warn-orphans build-depends: base >= 4 && < 4.3 , base-unicode-symbols >= 0.1.1 && < 0.3 - , usb >= 0.4 && < 0.5 + , usb >= 0.5 && < 0.6 + , usb-enumerator >= 0.1 && < 0.2 , iteratee >= 0.3.5 && < 0.4 , bytestring >= 0.9 && < 0.10 , regions >= 0.6 && < 0.7