usb-safe 0.6 → 0.7
raw patch · 2 files changed
+234/−226 lines, 2 filesdep +iterateedep ~regionsdep ~usb
Dependencies added: iteratee
Dependency ranges changed: regions, usb
Files
- System/USB/Safe.hs +230/−223
- usb-safe.cabal +4/−3
System/USB/Safe.hs view
@@ -1,16 +1,15 @@ {-# LANGUAGE UnicodeSyntax , NoImplicitPrelude , DeriveDataTypeable+ , KindSignatures , RankNTypes , MultiParamTypeClasses , FunctionalDependencies- , TypeFamilies , TypeSynonymInstances+ , FlexibleContexts , UndecidableInstances , GADTs , EmptyDataDecls- , ViewPatterns- , NamedFieldPuns , CPP #-} @@ -67,34 +66,30 @@ module System.USB.Safe ( -- * USB devices as scarce resources - {-| This module provides an instance for 'Resource' for 'USB.Device'.- This allows you to open devices in a region which are automatically- closed when the region terminates but it disallows you to return handles- to these closed devices from the region so preventing I/O with closed- devices.-+ {-| Note that this module re-exports the @Control.Monad.Trans.Region@ module from the @regions@ package which allows you to: - * Open devices using 'open'.- * Run regions using 'runRegionT'. * Concurrently run /top-level/ regions inside another region using 'forkTopRegion'. - * Duplicate regional device handles to a parent region using 'dup'.+ * Duplicate a 'RegionalDeviceHandle' to a parent region using 'dup'. -} module Control.Monad.Trans.Region -- ** Regional device handles , RegionalDeviceHandle- , getDevice++ , openDevice+ , withDevice , withDeviceWhich, NotFound(NotFound) + , getDevice+ -- * Getting descriptors- , GetDescriptor- , getDesc+ , GetDescriptor(getDesc) -- * Resetting devices , resetDevice@@ -114,8 +109,9 @@ , getInterfaces -- ** Claiming interfaces- , RegionalIfHandle+ , RegionalInterfaceHandle , claim+ , withInterface , withInterfaceWhich -- * Alternates@@ -148,10 +144,14 @@ -- * Endpoint I/O , ReadAction , WriteAction+ , readEndpoint , writeEndpoint + , enumReadEndpoint+ -- ** Control transfers+ , ControlAction , RequestType(..) , control , readControl@@ -176,22 +176,20 @@ -- from base: import Prelude ( fromInteger )-import Control.Applicative ( (<*>) ) import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, withMVar ) import Control.Monad ( Monad, return, (>>=), fail- , (>>), when+ , (>>), when, liftM ) import Control.Exception ( Exception, throwIO ) import Data.Typeable ( Typeable ) import Data.Function ( ($) )-import Data.Functor ( (<$>) )-import Data.Word ( Word8, Word16 )+import Data.Word ( Word8 ) import Data.Char ( String ) import Data.Bool ( Bool( True, False ) ) import Data.List ( map, head, filter, find ) import Data.Maybe ( Maybe( Nothing, Just ), fromJust )-import Text.Show ( Show ) import System.IO ( IO )+import Text.Show ( Show ) -- from base-unicode-symbols: import Data.Bool.Unicode ( (∧) )@@ -205,14 +203,15 @@ import Control.Monad.IO.Class ( MonadIO, liftIO ) -- from MonadCatchIO-transformers:-import Control.Monad.CatchIO ( MonadCatchIO, bracket_, throw )+import Control.Monad.CatchIO ( MonadCatchIO, bracket_, throw, block ) --- from regions:-import Control.Resource ( Resource(..) )+-- from iteratee:+import Data.Iteratee.Base ( EnumeratorGM )+import Data.Iteratee.Base.StreamChunk ( ReadableChunk ) -import Control.Monad.Trans.Region.Unsafe ( internalHandle )-import qualified Control.Monad.Trans.Region as Region ( open )-import Control.Monad.Trans.Region -- (re-exported entirely)+-- from regions:+import Control.Monad.Trans.Region.OnExit ( CloseHandle, onExit )+import Control.Monad.Trans.Region -- (re-exported entirely) -- from usb: import qualified System.USB.Initialization as USB@@ -245,59 +244,75 @@ import qualified System.USB.IO.Synchronous as USB ( Timeout, Size , RequestType(Class, Vendor)- , Recipient+ , Recipient, Request, Value, Index , control, readControl, writeControl , getInterfaceAltSetting , readBulk, readInterrupt , writeBulk, writeInterrupt ) +import qualified System.USB.IO.Synchronous.Enumerator as USB+ ( enumReadBulk, enumReadInterrupt )+ #ifdef __HADDOCK__-import System.USB.Exceptions ( USBException(..) )+import System.USB.Descriptors ( maxPacketSize, endpointMaxPacketSize )+import System.USB.Exceptions ( USBException(..) ) #endif ----------------------------------------------------------------------------------- * Device regions+-- ** Regional device handles -------------------------------------------------------------------------------- -instance Resource USB.Device where+{-| A regional handle to an opened USB device. - data Handle USB.Device = DeviceHandle- { internalDevHndl ∷ USB.DeviceHandle- , configAlreadySetMVar ∷ MVar Bool- -- ^ A mutable shared variable which keeps track of wheter a- -- configuration has been set. See: 'setConfig'.- }+A regional handle to an opened USB device can be created by applying+'openDevice' or 'withDevice' to the USB device you wish to open. - open dev = DeviceHandle <$> USB.openDevice dev <*> newMVar False- close = USB.closeDevice ∘ internalDevHndl+Note that you can also /duplicate/ a regional device handle by applying 'dup' to+it.+-}+data RegionalDeviceHandle (r ∷ * → *) = RegionalDeviceHandle+ (USB.DeviceHandle)+ (MVar Bool)+ (CloseHandle r) +instance Dup RegionalDeviceHandle where+ dup (RegionalDeviceHandle h mv ch) =+ liftM (RegionalDeviceHandle h mv) $ dup ch ------------------------------------------------------------------------------------ ** Regional device handles---------------------------------------------------------------------------------+{-| Open a device and obtain a regional device handle. The device is+automatically closed when the region terminates. -{-| Handy type synonym for a regional handle to an opened USB device.+This is a non-blocking function; no requests are sent over the bus. -A regional handle to an opened USB device can be created by applying 'open' or-'with' to the USB device you wish to open.+Exceptions: -Note that you can also /duplicate/ a regional device handle by applying 'dup' to-it.--}-type RegionalDeviceHandle r = RegionalHandle USB.Device r+ * 'NoMemException' if there is a memory allocation failure. --- | Internally used function for getting the actual USB device handle from a--- regional device handle.-getInternalDevHndl ∷ RegionalDeviceHandle r → USB.DeviceHandle-getInternalDevHndl = internalDevHndl ∘ internalHandle+ * 'AccessException' if the user has insufficient permissions. --- | Convenience function for retrieving the device from the given regional--- handle.-getDevice ∷ RegionalDeviceHandle r → USB.Device-getDevice = USB.getDevice ∘ getInternalDevHndl+ * 'NoDeviceException' if the device has been disconnected. + * Another 'USBException'.+-}+openDevice ∷ MonadCatchIO pr+ ⇒ USB.Device → RegionT s pr (RegionalDeviceHandle (RegionT s pr))+openDevice dev = block $ do+ h ← liftIO $ USB.openDevice dev+ mv ← liftIO $ newMVar False+ ch ← onExit $ USB.closeDevice h+ return $ RegionalDeviceHandle h mv ch++{-| Convenience function which opens the device, applies the given continuation+function to the resulting regional device handle and runs the resulting region.+-}+withDevice ∷ MonadCatchIO pr+ ⇒ USB.Device+ → (∀ s. RegionalDeviceHandle (RegionT s pr) → RegionT s pr α)+ → pr α+withDevice dev f = runRegionT $ openDevice dev >>= f+ {-| Convenience function which finds the first device attached to the system which satisfies the given predicate on its descriptor, then opens that device and applies the given continuation function to the resulting device handle.@@ -322,7 +337,7 @@ -- ^ Continuation function → pr α withDeviceWhich ctx p f = do devs ← liftIO $ USB.getDevices ctx- useWhich devs with p f+ useWhich devs withDevice p f -- | Internally used function which searches through the given list of USB -- entities (like Devices, Configs, Interfaces or Alternates) for the first@@ -346,7 +361,17 @@ instance Exception NotFound +-- | Internally used function for getting the actual USB device handle from a+-- regional device handle.+getInternalDevHndl ∷ RegionalDeviceHandle r → USB.DeviceHandle+getInternalDevHndl (RegionalDeviceHandle h _ _) = h +-- | Convenience function for retrieving the device from the given regional+-- handle.+getDevice ∷ RegionalDeviceHandle r → USB.Device+getDevice = USB.getDevice ∘ getInternalDevHndl++ -------------------------------------------------------------------------------- -- * Getting descriptors --------------------------------------------------------------------------------@@ -397,9 +422,7 @@ -} resetDevice ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → cr ()-resetDevice (internalHandle → DeviceHandle { internalDevHndl- , configAlreadySetMVar- }) =+resetDevice (RegionalDeviceHandle internalDevHndl configAlreadySetMVar _) = liftIO $ withMVar configAlreadySetMVar $ \configAlreadySet → if configAlreadySet then throwIO SettingAlreadySet@@ -463,7 +486,7 @@ The type variable @sCfg@ is used to ensure that you can't return this handle from these functions. -}-data ConfigHandle sCfg = ConfigHandle (Handle USB.Device)+data ConfigHandle sCfg = ConfigHandle USB.DeviceHandle USB.ConfigDesc {-| Set the active configuration for a device and then apply the given@@ -507,14 +530,12 @@ ⇒ Config pr -- ^ The configuration you wish to set. → (∀ sCfg. ConfigHandle sCfg → cr α) -- ^ Continuation function. → cr α-setConfig (Config (internalHandle → devHndl@(DeviceHandle { internalDevHndl- , configAlreadySetMVar- }))+setConfig (Config (RegionalDeviceHandle internalDevHndl configAlreadySetMVar _) configDesc) f = withUnsettedMVar configAlreadySetMVar $ do liftIO $ USB.setConfig internalDevHndl $ USB.configValue configDesc- f $ ConfigHandle devHndl configDesc+ f $ ConfigHandle internalDevHndl configDesc -- | Internally used function which throws a 'SettingAlreadySet' exception if -- the given @MVar@ was set. If the given @MVar@ wasn't set it will be set@@ -570,16 +591,13 @@ -- active configuration. → (∀ sCfg. ConfigHandle sCfg → cr α) -- ^ Continuation function → cr α-useActiveConfig (internalHandle → devHndl@(DeviceHandle { internalDevHndl- , configAlreadySetMVar- }))- f =+useActiveConfig (RegionalDeviceHandle internalDevHndl configAlreadySetMVar _) f = withUnsettedMVar configAlreadySetMVar $ do activeConfigValue ← liftIO $ USB.getConfig internalDevHndl when (activeConfigValue ≡ 0) $ throw NoActiveConfig let activeConfigDesc = fromJust $ find isActive $ getConfigDescs internalDevHndl isActive = (activeConfigValue ≡) ∘ USB.configValue- f $ ConfigHandle devHndl activeConfigDesc+ f $ ConfigHandle internalDevHndl activeConfigDesc {-| This exception can be thrown in 'useActiveConfig' to indicate that the device is currently not configured.@@ -630,10 +648,9 @@ To retrieve the 'USB.Interface' descriptors of an interface use 'getDesc'. -}-data Interface sCfg = Interface { ifDevHndlI ∷ USB.DeviceHandle- , ifNum ∷ USB.InterfaceNumber- , ifDescs ∷ USB.Interface- }+data Interface sCfg = Interface USB.DeviceHandle+ USB.InterfaceNumber+ USB.Interface {-| Retrieve the supported interfaces from the configuration handle. @@ -647,49 +664,37 @@ configuration claiming it would be an error. -} getInterfaces ∷ ConfigHandle sCfg → [Interface sCfg]-getInterfaces (ConfigHandle (DeviceHandle {internalDevHndl}) configDesc) =- map newInterface $ USB.configInterfaces configDesc+getInterfaces (ConfigHandle internalDevHndl configDesc) =+ map newIf $ USB.configInterfaces configDesc where- newInterface alts = Interface internalDevHndl- (USB.interfaceNumber $ head alts)- alts+ newIf alts = Interface internalDevHndl+ (USB.interfaceNumber $ head alts)+ alts instance GetDescriptor (Interface sCfg) USB.Interface where- getDesc = ifDescs+ getDesc (Interface _ _ ifDescs) = ifDescs -------------------------------------------------------------------------------- -- ** Interface regions -------------------------------------------------------------------------------- -instance Resource (Interface sCfg) where-- data Handle (Interface sCfg) = InterfaceHandle- { interface ∷ Interface sCfg- , _alternateAlreadySetMVar ∷ MVar Bool- -- ^ A mutable shared variable which keeps track of wheter an- -- alternate has been set. See: 'setAlternate'.- }-- open (i@Interface {ifDevHndlI, ifNum}) = do- USB.claimInterface ifDevHndlI ifNum- InterfaceHandle i <$> newMVar False-- close (interface → Interface {ifDevHndlI, ifNum}) =- USB.releaseInterface ifDevHndlI ifNum--{-| Handy type synonym for a regional handle to a claimed interface.+{-| A regional handle to a claimed interface. -A regional handle to a claimed interface can be created by applying 'claim'-(@= 'Region.open'@) or 'with' to the interface you wish to claim.+A regional handle to a claimed interface can be created by applying 'claim' or+'withInterface' to the interface you wish to claim. -}-type RegionalIfHandle sCfg r = RegionalHandle (Interface sCfg) r-+data RegionalInterfaceHandle sCfg (r ∷ * → *) = RegionalInterfaceHandle+ (Interface sCfg)+ (MVar Bool)+ (CloseHandle r) -{-| Claim the given interface in the interface region.+instance Dup (RegionalInterfaceHandle sCfg) where+ dup (RegionalInterfaceHandle interface mv ch) =+ liftM (RegionalInterfaceHandle interface mv) $ dup ch -Note that: @claim = @'Region.open' which just reads better when applied to an-interface.+{-| Claim the given interface in the region. When the region terminates the+interface is released automatically. Note that it is allowed to claim an already-claimed interface. @@ -712,10 +717,22 @@ . MonadCatchIO pr ⇒ Interface sCfg -- ^ Interface you wish to claim → RegionT s pr- (RegionalIfHandle sCfg+ (RegionalInterfaceHandle sCfg (RegionT s pr))-claim = Region.open+claim interface@(Interface internalDevHndl ifNum _) = block $ do+ mv ← liftIO $ newMVar False+ liftIO $ USB.claimInterface internalDevHndl ifNum+ ch ← onExit $ USB.releaseInterface internalDevHndl ifNum+ return $ RegionalInterfaceHandle interface mv ch +withInterface ∷ ∀ pr sCfg α+ . MonadCatchIO pr+ ⇒ Interface sCfg -- ^ The interface you wish to claim.+ → (∀ s. RegionalInterfaceHandle sCfg (RegionT s pr)+ → RegionT s pr α+ ) -- ^ Continuation function.+ → pr α+withInterface interface f = runRegionT $ claim interface >>= f {-| Convenience function which finds the first interface of the given configuration handle which satisfies the given predicate on its descriptors,@@ -738,11 +755,11 @@ ⇒ ConfigHandle sCfg -- ^ Handle to a configuration of which -- you want to claim an interface. → (USB.Interface → Bool) -- ^ Predicate on the interface descriptors.- → (∀ s. RegionalIfHandle sCfg (RegionT s pr)+ → (∀ s. RegionalInterfaceHandle sCfg (RegionT s pr) → RegionT s pr α ) -- ^ Continuation function. → pr α-withInterfaceWhich h = useWhich (getInterfaces h) with+withInterfaceWhich h = useWhich (getInterfaces h) withInterface --------------------------------------------------------------------------------@@ -751,7 +768,7 @@ -- | A supported 'Interface' alternate setting which you can retrieve using -- 'getAlternates'.-data Alternate sCfg (r ∷ * → *) = Alternate (RegionalIfHandle sCfg r)+data Alternate sCfg (r ∷ * → *) = Alternate (RegionalInterfaceHandle sCfg r) USB.InterfaceDesc {-| Retrieve the supported alternate settings from the given interface handle.@@ -760,10 +777,12 @@ the interface handle. This ensures you can never use an alternate setting outside the region in which the interface handle was created. -}-getAlternates ∷ RegionalIfHandle sCfg r → [Alternate sCfg r]-getAlternates regionalIfHandle@(internalHandle- → (interface → Interface {ifDescs})) =- map (Alternate regionalIfHandle) ifDescs+getAlternates ∷ RegionalInterfaceHandle sCfg r → [Alternate sCfg r]+getAlternates regionalIfHandle@(RegionalInterfaceHandle (Interface _ _ alts)+ _+ _+ ) =+ map (Alternate regionalIfHandle) alts instance GetDescriptor (Alternate sIntrf r) USB.InterfaceDesc where getDesc (Alternate _ ifDesc) = ifDesc@@ -784,9 +803,9 @@ 'setAlternateWhich'. The type variable @sAlt@ is used to ensure that you can't return this handle from these functions. -}-data AlternateHandle sCfg sAlt (r ∷ * → *) = AlternateHandle- (Handle (Interface sCfg))- USB.InterfaceDesc+data AlternateHandle sAlt (r ∷ * → *) = AlternateHandle+ USB.DeviceHandle+ USB.InterfaceDesc {-| Activate an alternate setting for an interface and then apply the given continuation function to the resulting alternate handle.@@ -814,22 +833,23 @@ setAlternate ∷ ∀ pr cr sCfg α . (pr `ParentOf` cr, MonadCatchIO cr) ⇒ Alternate sCfg pr -- ^ The alternate you wish to set.- → (∀ sAlt. AlternateHandle sCfg sAlt pr → cr α)- -- ^ Continuation function.+ → (∀ sAlt. AlternateHandle sAlt pr → cr α) -- ^ Continuation function. → cr α-setAlternate (Alternate ( internalHandle- → ifHndl@(InterfaceHandle (Interface {ifDevHndlI})- alternateAlreadySetMVar- )+setAlternate (Alternate (RegionalInterfaceHandle (Interface internalDevHndl+ ifNum+ _+ )+ alternateAlreadySetMVar+ _ ) ifDesc- ) f =+ )+ f = withUnsettedMVar alternateAlreadySetMVar $ do- liftIO $ USB.setInterfaceAltSetting- ifDevHndlI- (USB.interfaceNumber ifDesc)- (USB.interfaceAltSetting ifDesc)- f $ AlternateHandle ifHndl ifDesc+ liftIO $ USB.setInterfaceAltSetting internalDevHndl+ ifNum+ (USB.interfaceAltSetting ifDesc)+ f $ AlternateHandle internalDevHndl ifDesc {-| Apply the given function to the alternate handle of the current active@@ -850,29 +870,26 @@ -} useActiveAlternate ∷ ∀ pr cr sCfg α . (pr `ParentOf` cr, MonadCatchIO cr)- ⇒ RegionalIfHandle sCfg pr -- ^ Regional handle to the+ ⇒ RegionalInterfaceHandle sCfg pr -- ^ Regional handle to the -- interface from which you want -- to use the active alternate.- → (∀ sAlt. AlternateHandle sCfg sAlt pr → cr α)- -- ^ Continuation function.+ → (∀ sAlt. AlternateHandle sAlt pr → cr α) -- ^ Continuation function. → cr α-useActiveAlternate (internalHandle → ifHndl@(InterfaceHandle- (Interface { ifDevHndlI- , ifNum- , ifDescs- }- )- alternateAlreadySetMVar+useActiveAlternate (RegionalInterfaceHandle (Interface internalDevHndl+ ifNum+ alts )+ alternateAlreadySetMVar+ _ ) f = withUnsettedMVar alternateAlreadySetMVar $ do let timeout = 5000 -- ms- activeAltValue ← liftIO $ USB.getInterfaceAltSetting ifDevHndlI+ activeAltValue ← liftIO $ USB.getInterfaceAltSetting internalDevHndl ifNum timeout- let activeAlt = fromJust $ find isActive ifDescs+ let activeAlt = fromJust $ find isActive alts isActive = (activeAltValue ≡) ∘ USB.interfaceAltSetting- f $ AlternateHandle ifHndl activeAlt+ f $ AlternateHandle internalDevHndl activeAlt {-| Convenience function which finds the first alternate of the given interface@@ -895,13 +912,12 @@ -} setAlternateWhich ∷ ∀ pr cr sCfg α . (pr `ParentOf` cr, MonadCatchIO cr)- ⇒ RegionalIfHandle sCfg pr -- ^ Regional handle to the- -- interface for which you want- -- to set an alternate.- → (USB.InterfaceDesc → Bool) -- ^ Predicate on the interface- -- descriptor.- → (∀ sAlt. AlternateHandle sCfg sAlt pr → cr α)- -- ^ Continuation function+ ⇒ RegionalInterfaceHandle sCfg pr -- ^ Regional handle to the+ -- interface for which you want+ -- to set an alternate.+ → (USB.InterfaceDesc → Bool) -- ^ Predicate on the interface+ -- descriptor.+ → (∀ sAlt. AlternateHandle sAlt pr → cr α) -- ^ Continuation function → cr α setAlternateWhich h = useWhich (getAlternates h) setAlternate @@ -946,21 +962,18 @@ -- given transfer direction and transfer type. getEndpoints ∷ ∀ transDir transType- sCfg sAlt r- . AlternateHandle sCfg sAlt r -- ^ Handle to the alternate from- -- which you want to retrieve its- -- endpoints.- → TransferDirection transDir -- ^ Filter all endpoints which have- -- this transfer direction.- → TransferType transType -- ^ Filter all endpoints which have- -- this transfer type.+ sAlt r+ . AlternateHandle sAlt r -- ^ Handle to the alternate from+ -- which you want to retrieve its+ -- endpoints.+ → TransferDirection transDir -- ^ Filter all endpoints which have+ -- this transfer direction.+ → TransferType transType -- ^ Filter all endpoints which have+ -- this transfer type. → [Endpoint transDir transType sAlt r]-getEndpoints (AlternateHandle- (InterfaceHandle {interface = Interface {ifDevHndlI}})- ifDesc- ) transDir transType = map (Endpoint ifDevHndlI)- $ filter eqDirAndType- $ USB.interfaceEndpoints ifDesc+getEndpoints (AlternateHandle internalDevHndl ifDesc) transDir transType =+ map (Endpoint internalDevHndl) $ filter eqDirAndType+ $ USB.interfaceEndpoints ifDesc where eqDirAndType endpointDesc = transDir `eqDir` transDirUSB@@ -1030,12 +1043,12 @@ {-| Handy type synonym for read transfers. -A @ReadAction@ is a function which takes a timeout and a size which defines how-many bytes to read. The function returns an action which, when executed,+A @ReadAction@ is a function which takes a size which defines how many bytes to+read and a timeout. The function returns an action which, when executed, performs the actual read and returns the bytestring that was read paired with an indication if the transfer timed out. -}-type ReadAction r = USB.Timeout → USB.Size → r (ByteString, Bool)+type ReadAction r = USB.Size → USB.Timeout → r (ByteString, Bool) -- | Class of transfer types that support reading. class ReadEndpoint transType where@@ -1065,28 +1078,25 @@ readEndpoint = transferWith USB.readInterrupt transferWith ∷ (pr `ParentOf` cr, MonadIO cr)- ⇒ ( USB.DeviceHandle → USB.EndpointAddress- → USB.Timeout → α → IO (β, Bool)- )- → ( Endpoint transDir transType sAlt pr- → USB.Timeout → α → cr (β, Bool)- )-transferWith f (Endpoint internalDevHndl endpointDesc) =- \timeout sbs → liftIO $ f internalDevHndl- (USB.endpointAddress endpointDesc)- timeout- sbs+ ⇒ (USB.DeviceHandle → USB.EndpointAddress → α → USB.Timeout → IO β)+ → (Endpoint transDir transType sAlt pr → α → USB.Timeout → cr β)+transferWith f = \endpoint sbs timeout → liftIO $ wrap f endpoint sbs timeout +wrap ∷ (USB.DeviceHandle → USB.EndpointAddress → α)+ → (Endpoint transDir transType sAlt pr → α)+wrap f = \(Endpoint internalDevHndl endpointDesc) →+ f internalDevHndl (USB.endpointAddress endpointDesc)+ -------------------------------------------------------------------------------- {-| Handy type synonym for write transfers. -A @WriteAction@ is a function which takes a timeout and the bytestring to-write. The function returns an action which, when exectued, returns the number+A @WriteAction@ is a function which takes the bytestring to write and a+timeout. The function returns an action which, when exectued, returns the number of bytes that were actually written paired with an indication if the transfer timed out. -}-type WriteAction r = USB.Timeout → ByteString → r (USB.Size, Bool)+type WriteAction r = ByteString → USB.Timeout → r (USB.Size, Bool) -- | Class of transfer types that support writing class WriteEndpoint transType where@@ -1113,9 +1123,40 @@ --------------------------------------------------------------------------------++-- | Class of transfer types that support enumerating.+class EnumReadEndpoint transType where+ -- | An enumerator for an 'In' endpoint with either a 'Bulk' or 'Interrupt'+ -- transfer type.+ enumReadEndpoint ∷ (pr `ParentOf` cr, MonadCatchIO cr, ReadableChunk s Word8)+ ⇒ Endpoint In transType sAlt pr+ → USB.Size -- ^ Chunk size. A good value for this would be+ -- the @'maxPacketSize' . 'endpointMaxPacketSize'@.+ → USB.Timeout -- ^ Timeout (in milliseconds) that this function+ -- should wait for each chunk before giving up+ -- due to no response being received. For no+ -- timeout, use value 0.+ → EnumeratorGM s Word8 cr α++instance EnumReadEndpoint Bulk where+ enumReadEndpoint = wrap USB.enumReadBulk++instance EnumReadEndpoint Interrupt where+ enumReadEndpoint = wrap USB.enumReadInterrupt+++-------------------------------------------------------------------------------- -- ** Control transfers -------------------------------------------------------------------------------- +-- | Handy type synonym that names the parameters of a control transfer.+type ControlAction α = RequestType+ → USB.Recipient+ → USB.Request+ → USB.Value+ → USB.Index+ → α+ {-| Control transfers can have three request types: @Standard@, @Class@ and @Vendor@. We disallow @Standard@ requests however because with them you can destroy the safety guarantees that this module provides.@@ -1128,8 +1169,6 @@ {-| Perform a USB /control/ request that does not transfer data. -The /value/ and /index/ values should be given in host-endian byte order.- Exceptions: * 'TimeoutException' if the transfer timed out.@@ -1140,21 +1179,9 @@ * Another 'USBException'. -}-control ∷ ∀ pr cr- . (pr `ParentOf` cr, MonadIO cr)- ⇒ RegionalDeviceHandle pr -- ^ A handle for the device to communicate- -- with.- → RequestType -- ^ The type of request.- → USB.Recipient -- ^ The recipient of the request.- → Word8 -- ^ Request.- → Word16 -- ^ Value.- → Word16 -- ^ Index.- → USB.Timeout -- ^ Timeout (in milliseconds) that this- -- function should wait before giving up due- -- to no response being received. For no- -- timeout, use value 0.- → cr ()-control regionalDevHndl reqType reqRecipient request value index timeout =+control ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalDeviceHandle pr → ControlAction (USB.Timeout → cr ())+control regionalDevHndl = \reqType reqRecipient request value index → \timeout → liftIO $ USB.control (getInternalDevHndl regionalDevHndl) (reqTypeToInternal reqType) reqRecipient@@ -1165,8 +1192,6 @@ {-| Perform a USB /control/ read. -The /value/ and /index/ values should be given in host-endian byte order.- Exceptions: * 'PipeException' if the control request was not supported by the device@@ -1175,17 +1200,9 @@ * Another 'USBException'. -}-readControl ∷ ∀ pr cr- . (pr `ParentOf` cr, MonadIO cr)- ⇒ RegionalDeviceHandle pr -- ^ A handle for the device to- -- communicate with.- → RequestType -- ^ The type of request.- → USB.Recipient -- ^ The recipient of the request.- → Word8 -- ^ Request.- → Word16 -- ^ Value.- → Word16 -- ^ Index.- → ReadAction cr-readControl regionalDevHndl reqType reqRecipient request value index = \timeout size →+readControl ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalDeviceHandle pr → ControlAction (ReadAction cr)+readControl regionalDevHndl = \reqType reqRecipient request value index → \timeout size → liftIO $ USB.readControl (getInternalDevHndl regionalDevHndl) (reqTypeToInternal reqType) reqRecipient@@ -1197,8 +1214,6 @@ {-| Perform a USB /control/ write. -The /value/ and /index/ values should be given in host-endian byte order.- Exceptions: * 'PipeException' if the control request was not supported by the device@@ -1207,17 +1222,9 @@ * Another 'USBException'. -}-writeControl ∷ ∀ pr cr- . (pr `ParentOf` cr, MonadIO cr)- ⇒ RegionalDeviceHandle pr -- ^ A handle for the device to- -- communicate with.- → RequestType -- ^ The type of request.- → USB.Recipient -- ^ The recipient of the request.- → Word8 -- ^ Request.- → Word16 -- ^ Value.- → Word16 -- ^ Index.- → WriteAction cr-writeControl regionalDevHndl reqType reqRecipient request value index = \timeout input →+writeControl ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalDeviceHandle pr → ControlAction (WriteAction cr)+writeControl regionalDevHndl = \reqType reqRecipient request value index → \timeout input → liftIO $ USB.writeControl (getInternalDevHndl regionalDevHndl) (reqTypeToInternal reqType) reqRecipient
usb-safe.cabal view
@@ -1,5 +1,5 @@ name: usb-safe-version: 0.6+version: 0.7 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -71,9 +71,10 @@ GHC-Options: -Wall -fno-warn-orphans build-depends: base >= 4 && < 4.3 , base-unicode-symbols >= 0.1.1 && < 0.3- , usb >= 0.3 && < 0.4+ , usb >= 0.4 && < 0.5+ , iteratee >= 0.3.5 && < 0.4 , bytestring >= 0.9 && < 0.10- , regions >= 0.5 && < 0.6+ , regions >= 0.6 && < 0.7 , transformers >= 0.2 && < 0.3 , MonadCatchIO-transformers >= 0.2 && < 0.3 exposed-modules: System.USB.Safe