diff --git a/NEWS b/NEWS new file mode 100644 --- /dev/null +++ b/NEWS @@ -0,0 +1,211 @@ +0.12 + +(Released on: Wed Mar 9 12:22:15 UTC 2011) + +* Exported the ReadEndpoint, WriteEndpoint and EnumReadEndpoint type classes + This way you can refer to them in type signatures. + +* Support usb-0.8: + getStrDesc and getStrDescFirstLang now return a Text instead of a String. + +* Switched from monad-peel to monad-control. + +* Support regions-0.9. + +* Support usb-enumerator-0.3. + +* Support iteratee-0.8.*. + + +0.11.0.2 + +(Released on: Mon Jan 17 22:04:53 UTC 2011) + +* Support usb-0.7 and iteratee-0.7. + + +0.11.0.1 + +(Released on: Sat Nov 13 21:28:28 UTC 2010) + +* Support iteratee-0.6. + +* Documentation fix. + + +0.11 + +(Released on: Sat Nov 6 15:57:49 UTC 2010) + +* Released during BelHac 2010! + +* Depend on regions-0.8. + +* Rename ParentOf to AncestorRegion. + +* Use MonadPeelIO instead of MonadCatchIO. + +* Support iteratee-0.5. + +* Support GHC-7. + + +0.10 + +(Released on: Sat Sep 11 14:20:03 UTC 2010) + +* Support usb-0.6. + +* Never throw a SettingAlreadySet exception from useActiveConfig or useActiveAlternate + These functions don't change the current setting so they're always safe to use. + +* Added strictness flags to all arguments of data constructors. + + +0.9 + +(Released on: Wed Sep 1 20:12:10 UTC 2010) + +* Support iteratee-0.4.* and regions-0.7. + +* Added the overloaded constructor functions mkTransferDirection and mkTransferType + + class MkTransferDirection transDir where + -- | An overloaded constructor function for transfer directions. + mkTransferDirection ∷ TransferDirection transDir + + instance MkTransferDirection Out where mkTransferDirection = Out + instance MkTransferDirection In where mkTransferDirection = In + +* Added getEndpoints' which uses these overloaded functions. + + getEndpoints' ∷ ∀ transDir transType sAlt r + . MkTransferDirection transDir + ⇒ MkTransferType transType + ⇒ AlternateHandle sAlt r + → [Endpoint transDir transType sAlt r] + getEndpoints' altHndl = getEndpoints altHndl mkTransferDirection mkTransferType + + +0.8 + +(Released on: Mon Jul 26 05:49:15 UTC 2010) + +* Support usb-0.5 & + Depend on the new usb-enumerator package + +* Added function: readControlExact + +* Remove custom NotFound exception + and replaced it with the USB.NotFoundException + + +0.7 + +(Released on: Wed Jun 16 09:12:24 UTC 2010) + +* Export type 'ControlAction' + +* Add 'enumReadEndpoint' + +* Support usb-0.4 + +* Use regions >= 0.6 + + +0.6 + +(Released on: Sun May 2 20:26:33 UTC 2010) + +* Added function withDeviceWhich + +* Updated dependencies + base-unicode-symbols >= 0.1.1 && < 0.3 + regions >= 0.5 && < 0.6 + transformers >= 0.2 && < 0.3 + MonadCatchIO-transformers >= 0.2 && < 0.3 + +* Uncapitalized the transfer direction and transfer type types + + +0.5.1.1 + +(Released on: Thu Feb 4 10:21:29 UTC 2010) + +* Depend on regions-0.4.* + +* Depend on more compatible versions of MonadCatchIO-transformers + + +0.5.1 + +(Released on: Sat Jan 23 14:25:41 UTC 2010) + +* Depend on new regions == 0.3.* + +* Bumped version to 0.5.1 because the API of regions got changed and + this package re-exports a module from that package + + +0.5 + +(Released on: Thu Jan 7 14:17:19 UTC 2010) + +* Make use of the new regions-0.2 + + +0.4.1 + +(Released on: Wed Dec 23 13:47:36 UTC 2009) + +* Tested with base-4.2 + +* Depend on base-unicode-symbols instead of unicode-symbols + +* Exported function withInterfaceWhich + + +0.4 + +(Released on: Mon Dec 21 09:57:10 UTC 2009) + +* Generalized regions and moved them to their own package: regions + +* Added derived Functor, Applicative, Alternative, MonadPlus and + MonadFix instances for DeviceRegionT + +* Added function setConfigWhich and setAlternateWhich + +* Filtering endpoints now works with given transfer direction and + transfer type as GADTs + + +0.3 + +(Released on: Wed Dec 9 22:53:04 UTC 2009) + +* Renamed EndpointHandle to FilteredEndpoint + + +0.2 + +(Released on: Wed Dec 9 14:43:25 UTC 2009) + +* Added TopDeviceRegion + +* Added 'type TopDeviceRegion s = DeviceRegionT s IO' + +* Added function 'runTopDeviceRegion' + +* Renamed 'forkDeviceRegionT' to 'forkTopDeviceRegion' + +* Changed the type of it to: + 'forkTopDeviceRegion :: MonadIO m => + TopDeviceRegion s () -> DeviceRegionT s m ThreadId' + + +0.1 + +(Released on: Tue Dec 8 21:07:09 UTC 2009) + +* Initial release diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,55 @@ +The [usb] package provides a standard Haskell abstraction layer over +[bindings-libusb] providing: abstract types instead of `Ptr`s, automatic +marshalling and unmarshalling, automatic garbage collection, exceptions instead +of integer return codes, etc.. + +While all that is very nice there are still some things that you can do +wrong. For example doing I/O with a closed device or reading from or writing to +an endpoint which doesn't belong to the claimed interface. Or reading from an +Out endpoint or writing to an In endpoint. + +`usb-safe` provides the following guarantees: + +* You can't reference handles to devices that are closed. In other words: no I/O + with closed handles is possible. + +* The programmer specifies the *region* in which devices should remain open. On + exit from the region the opened devices will be closed automatically. + +* You can't reference handles to configurations that have not been set. + +* You can't reference handles to interfaces that have not been claimed. + +* Just like with devices, the programmer can specify the region in which + interfaces should remain claimed. On exit from the region the claimed + interfaces will be released automatically. + +* You can't reference handles to alternates that have not been set. + +* You can't reference endpoints that don't belong to a setted alternate. + +* You can't read from an endpoint with an Out transfer direction. + +* You can't write to an endpoint with an In transfer direction. + +* You can't read from or write to endpoints with the unsupported transfer types + Control and Isochronous. Only I/O with endpoints with the Bulk and Interrupt + transfer types is allowed. + +The primary technique used in `usb-safe` is called "Lightweight monadic regions" +which was [invented][1] by Oleg Kiselyov and Chung-chieh Shan. + +This technique is implemented in the [regions] package which is re-exported from +`usb-safe`. + +See the [usb-safe-examples] package for examples how to use this library: + + git clone git://github.com/basvandijk/usb-safe-examples.git + +[1]: http://okmij.org/ftp/Haskell/regions.html#light-weight + +[bindings-libusb]: http://hackage.haskell.org/package/bindings-libusb +[usb]: http://hackage.haskell.org/package/usb +[regions]: http://hackage.haskell.org/package/regions + +[usb-safe-examples]: https://github.com/basvandijk/usb-safe-examples diff --git a/System/USB/Safe.hs b/System/USB/Safe.hs --- a/System/USB/Safe.hs +++ b/System/USB/Safe.hs @@ -7,6 +7,7 @@ , FunctionalDependencies , TypeSynonymInstances , FlexibleContexts + , FlexibleInstances , UndecidableInstances , GADTs , EmptyDataDecls @@ -45,10 +46,6 @@ -- -- * You can't write to an endpoint with an 'In' transfer direction. -- --- * You can't read from or write to endpoints with the unsupported transfer --- types 'Control' and 'Isochronous'. Only I/O with endpoints with the --- supported 'Bulk' and 'Interrupt' transfer types is allowed. --- -- This modules makes use of a technique called /Lightweight monadic regions/ -- invented by Oleg Kiselyov and Chung-chieh Shan -- @@ -59,7 +56,7 @@ -- -- See the @usb-safe-examples@ package for examples how to use this library: -- --- @darcs get@ +-- @git clone @ -- -------------------------------------------------------------------------------- @@ -146,17 +143,27 @@ , ReadAction , WriteAction + -- ** Bulk and interrupt transfers , ReadEndpoint(readEndpoint) , WriteEndpoint(writeEndpoint) , EnumReadEndpoint(enumReadEndpoint) +#ifdef HAS_EVENT_MANAGER + -- ** Isochronous transfers + -- | /WARNING:/ You need to enable the threaded runtime (@-threaded@) when using + -- the isochronous functions. They throw a runtime error otherwise! + , readIsochronousEndpoint + , writeIsochronousEndpoint + + , enumReadIsochronousEndpoint +#endif -- ** Control transfers , ControlAction , RequestType(..) , control - , readControl, readControlExact - , writeControl + , readControl, readControlExact + , writeControl, writeControlExact -- * String descriptors , getLanguages @@ -209,22 +216,18 @@ import Control.Monad.IO.Class ( MonadIO, liftIO ) -- from monad-control: -import Control.Monad.IO.Control ( MonadControlIO, liftIOOp_ ) +import Control.Monad.IO.Control ( MonadControlIO ) import Control.Exception.Control ( throwIO ) -- from regions: import Control.Monad.Trans.Region.OnExit ( FinalizerHandle, onExit ) +import Control.Monad.Trans.Region.Unsafe ( unsafeControlIO, unsafeLiftIOOp_ ) import Control.Monad.Trans.Region -- (re-exported entirely) -- from iteratee: -#if MIN_VERSION_iteratee(0,4,0) import Data.Iteratee.Iteratee ( Enumerator ) import Data.Iteratee.Base.ReadableChunk ( ReadableChunk ) import Data.NullPoint ( NullPoint ) -#else -import Data.Iteratee.Base ( EnumeratorGM ) -import Data.Iteratee.Base.StreamChunk ( ReadableChunk ) -#endif -- from usb: import qualified System.USB.Initialization as USB @@ -256,13 +259,16 @@ , getLanguages, LangId, StrIx, getStrDesc, getStrDescFirstLang ) -import qualified System.USB.IO.Synchronous as USB - ( Timeout, TimedOut, Size +import qualified System.USB.IO as USB + ( Timeout, Status, Size , RequestType(Class, Vendor) , Recipient, Request, Value, Index - , control, readControl, readControlExact, writeControl + , control, readControl, readControlExact, writeControl, writeControlExact , readBulk, readInterrupt , writeBulk, writeInterrupt +#ifdef HAS_EVENT_MANAGER + , readIsochronous, writeIsochronous +#endif ) import qualified System.USB.IO.StandardDeviceRequests as USB @@ -275,15 +281,20 @@ import System.USB.Descriptors ( maxPacketSize, endpointMaxPacketSize ) #endif --- from usb-enumerator: -import qualified System.USB.IO.Synchronous.Enumerator as USB - ( enumReadBulk, enumReadInterrupt ) +-- from usb-iteratee: +import qualified System.USB.IO.Iteratee as USB + ( enumReadBulk + , enumReadInterrupt +#ifdef HAS_EVENT_MANAGER + , enumReadIsochronous +#endif + ) #if MIN_VERSION_base(4,3,0) -import Control.Exception.Control ( mask_ ) +import Control.Exception ( mask_ ) #else -import Control.Exception.Control ( block ) -mask_ ∷ MonadControlIO m ⇒ m α → m α +import Control.Exception ( block ) +mask_ ∷ IO α → IO α mask_ = block #endif @@ -323,7 +334,7 @@ -} openDevice ∷ MonadControlIO pr ⇒ USB.Device → RegionT s pr (RegionalDeviceHandle (RegionT s pr)) -openDevice dev = mask_ $ do +openDevice dev = unsafeLiftIOOp_ mask_ $ do h ← liftIO $ USB.openDevice dev mv ← liftIO $ newMVar False ch ← onExit $ USB.closeDevice h @@ -548,35 +559,33 @@ * Another 'USB.USBException'. -} -setConfig ∷ ∀ pr cr α - . (pr `AncestorRegion` cr, MonadControlIO cr) - ⇒ Config pr -- ^ The configuration you wish to set. - → (∀ sCfg. ConfigHandle sCfg → cr α) -- ^ Continuation function. - → cr α +setConfig ∷ ∀ pr cr s α + . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr) + ⇒ Config pr -- ^ The configuration you wish to set. + → (∀ sCfg. ConfigHandle sCfg → RegionT s cr α) -- ^ Continuation function. + → RegionT s cr α setConfig (Config (RegionalDeviceHandle internalDevHndl mv _) configDesc) f = - withUnsettedMVar mv $ do - liftIO $ USB.setConfig internalDevHndl $ Just $ USB.configValue configDesc - f $ ConfigHandle internalDevHndl configDesc + unsafeControlIO $ \runInIO → withUnsettedMVar mv $ do + USB.setConfig internalDevHndl $ Just $ USB.configValue configDesc + runInIO $ 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 -- before the given computation is performed. When the computation terminates, -- wheter normally or by raising an exception, the @MVar@ will be unset again. -withUnsettedMVar ∷ MonadControlIO m ⇒ MVar Bool → m α → m α -withUnsettedMVar mv = liftIOOp_ $ bracket_ - (do alreadySet ← takeMVar mv - if alreadySet - then do putMVar mv alreadySet - throwIO SettingAlreadySet - else putMVar mv True) - (overwriteMVar mv False) +withUnsettedMVar ∷ MVar Bool → IO α → IO α +withUnsettedMVar mv = bracket_ (do alreadySet ← takeMVar mv + if alreadySet + then do putMVar mv alreadySet + throwIO SettingAlreadySet + else putMVar mv True) + (overwriteMVar mv False) -- | Internally used function which sets the @MVar@ before the computation is -- performed. When the computation terminates, wheter normally or by raising an -- exception, the @MVar@ will be unset again. -withSettedMVar ∷ MonadControlIO m ⇒ MVar Bool → m α → m α -withSettedMVar mv = liftIOOp_ $ bracket_ (overwriteMVar mv True) - (overwriteMVar mv False) +withSettedMVar ∷ MVar Bool → IO α → IO α +withSettedMVar mv = bracket_ (overwriteMVar mv True) (overwriteMVar mv False) -- | Internally used function which overwrites the value in the @MVar@. -- @@ -616,23 +625,23 @@ * Another 'USB.USBException'. -} -useActiveConfig ∷ ∀ pr cr α - . (pr `AncestorRegion` cr, MonadControlIO cr) +useActiveConfig ∷ ∀ pr cr s α + . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr) ⇒ RegionalDeviceHandle pr -- ^ Regional handle to the device -- from which you want to use the -- active configuration. - → (∀ sCfg. ConfigHandle sCfg → cr α) -- ^ Continuation function - → cr α + → (∀ sCfg. ConfigHandle sCfg → RegionT s cr α) -- ^ Continuation function + → RegionT s cr α useActiveConfig (RegionalDeviceHandle internalDevHndl mv _) f = - withSettedMVar mv $ do - mbActiveConfigValue ← liftIO $ USB.getConfig internalDevHndl + unsafeControlIO $ \runInIO → withSettedMVar mv $ do + mbActiveConfigValue ← USB.getConfig internalDevHndl case mbActiveConfigValue of Nothing → throwIO NoActiveConfig Just activeConfigValue → let activeConfigHandle = ConfigHandle internalDevHndl activeConfigDesc activeConfigDesc = fromJust $ find isActive $ getConfigDescs internalDevHndl isActive = (activeConfigValue ≡) ∘ USB.configValue - in f activeConfigHandle + in runInIO $ f activeConfigHandle {-| This exception can be thrown in 'useActiveConfig' to indicate that the device is currently not configured. @@ -662,15 +671,15 @@ * Another 'USB.USBException'. -} -setConfigWhich ∷ ∀ pr cr α - . (pr `AncestorRegion` cr, MonadControlIO cr) +setConfigWhich ∷ ∀ pr cr s α + . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr) ⇒ RegionalDeviceHandle pr -- ^ Regional handle to the device for -- which you want to set a -- configuration. → (USB.ConfigDesc → Bool) -- ^ Predicate on the configuration -- descriptor. - → (∀ sCfg. ConfigHandle sCfg → cr α) -- ^ Continuation function. - → cr α + → (∀ sCfg. ConfigHandle sCfg → RegionT s cr α) -- ^ Continuation function. + → RegionT s cr α setConfigWhich h = useWhich (getConfigs h) setConfig @@ -754,7 +763,7 @@ → RegionT s pr (RegionalInterfaceHandle sCfg (RegionT s pr)) -claim interface@(Interface internalDevHndl ifNum _) = mask_ $ do +claim interface@(Interface internalDevHndl ifNum _) = unsafeLiftIOOp_ mask_ $ do mv ← liftIO $ newMVar False liftIO $ USB.claimInterface internalDevHndl ifNum ch ← onExit $ USB.releaseInterface internalDevHndl ifNum @@ -865,19 +874,19 @@ * Another 'USB.USBException'. -} -setAlternate ∷ ∀ pr cr sCfg α - . (pr `AncestorRegion` cr, MonadControlIO cr) +setAlternate ∷ ∀ pr cr s sCfg α + . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr) ⇒ Alternate sCfg pr -- ^ The alternate you wish to set. - → (∀ sAlt. AlternateHandle sAlt pr → cr α) -- ^ Continuation function. - → cr α + → (∀ sAlt. AlternateHandle sAlt pr → RegionT s cr α) -- ^ Continuation function. + → RegionT s cr α setAlternate (Alternate (RegionalInterfaceHandle (Interface internalDevHndl ifNum _) mv _) ifDesc) f = - withUnsettedMVar mv $ do - liftIO $ USB.setInterfaceAltSetting internalDevHndl + unsafeControlIO $ \runInIO → withUnsettedMVar mv $ do + USB.setInterfaceAltSetting internalDevHndl ifNum (USB.interfaceAltSetting ifDesc) - f $ AlternateHandle internalDevHndl ifDesc + runInIO $ f $ AlternateHandle internalDevHndl ifDesc {-| Apply the given function to the alternate handle of the current active @@ -896,25 +905,25 @@ * Another 'USB.USBException'. -} -useActiveAlternate ∷ ∀ pr cr sCfg α - . (pr `AncestorRegion` cr, MonadControlIO cr) +useActiveAlternate ∷ ∀ pr cr s sCfg α + . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr) ⇒ RegionalInterfaceHandle sCfg pr -- ^ Regional handle to the -- interface from which you want -- to use the active alternate. - → (∀ sAlt. AlternateHandle sAlt pr → cr α) -- ^ Continuation function. - → cr α + → (∀ sAlt. AlternateHandle sAlt pr → RegionT s cr α) -- ^ Continuation function. + → RegionT s cr α useActiveAlternate (RegionalInterfaceHandle (Interface internalDevHndl ifNum alts) mv _ ) f = - withSettedMVar mv $ do + unsafeControlIO $ \runInIO → withSettedMVar mv $ do let timeout = 5000 -- ms - activeAltValue ← liftIO $ USB.getInterfaceAltSetting internalDevHndl - ifNum - timeout + activeAltValue ← USB.getInterfaceAltSetting internalDevHndl + ifNum + timeout let activeAltHandle = AlternateHandle internalDevHndl activeAlt activeAlt = fromJust $ find isActive alts isActive = (activeAltValue ≡) ∘ USB.interfaceAltSetting - f activeAltHandle + runInIO $ f activeAltHandle {-| Convenience function which finds the first alternate of the given interface @@ -935,15 +944,15 @@ * Another 'USB.USBException'. -} -setAlternateWhich ∷ ∀ pr cr sCfg α - . (pr `AncestorRegion` cr, MonadControlIO cr) +setAlternateWhich ∷ ∀ pr cr sCfg s α + . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr) ⇒ 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 α + → (∀ sAlt. AlternateHandle sAlt pr → RegionT s cr α) -- ^ Continuation function + → RegionT s cr α setAlternateWhich h = useWhich (getAlternates h) setAlternate @@ -1097,7 +1106,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, USB.TimedOut) +type ReadAction r = USB.Size → USB.Timeout → r (ByteString, USB.Status) -- | Class of transfer types that support reading. class ReadEndpoint transType where @@ -1142,7 +1151,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, USB.TimedOut) +type WriteAction r = ByteString → USB.Timeout → r (USB.Size, USB.Status) -- | Class of transfer types that support writing class WriteEndpoint transType where @@ -1167,14 +1176,12 @@ -------------------------------------------------------------------------------- --- | Class of transfer types that support enumerating. +-- | Class of transfer types that support enumeration. class EnumReadEndpoint transType where -- | An enumerator for an 'In' endpoint -- with either a 'Bulk' or 'Interrupt' transfer type. - enumReadEndpoint ∷ ( pr `AncestorRegion` cr, MonadControlIO cr, ReadableChunk s Word8 -#if MIN_VERSION_iteratee(0,4,0) - , NullPoint s -#endif + enumReadEndpoint ∷ ( pr `AncestorRegion` cr, MonadControlIO cr + , ReadableChunk s Word8, NullPoint s ) ⇒ Endpoint In transType sAlt pr → USB.Size -- ^ Chunk size. A good value for this would be @@ -1183,15 +1190,84 @@ -- should wait for each chunk before giving up -- due to no response being received. For no -- timeout, use value 0. -#if MIN_VERSION_iteratee(0,4,0) → Enumerator s cr α -#else - → EnumeratorGM s Word8 cr α -#endif + instance EnumReadEndpoint Bulk where enumReadEndpoint = wrap USB.enumReadBulk instance EnumReadEndpoint Interrupt where enumReadEndpoint = wrap USB.enumReadInterrupt +#ifdef HAS_EVENT_MANAGER +-------------------------------------------------------------------------------- +{-| 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: + + * 'USB.PipeException' if the endpoint halted. + + * 'USB.OverflowException' if the device offered more data, + see /Packets and overflows/ in the @libusb@ documentation: + . + + * 'USB.NoDeviceException' if the device has been disconnected. + + * Another 'USB.USBException'. +-} +readIsochronousEndpoint ∷ (pr `AncestorRegion` cr, MonadIO cr) + ⇒ Endpoint In Isochronous sAlt pr + → [USB.Size] -- ^ Sizes of isochronous packets + → USB.Timeout + → cr [ByteString] +readIsochronousEndpoint (Endpoint internalDevHndl endpointDesc) sizes timeout = + liftIO $ USB.readIsochronous internalDevHndl + (USB.endpointAddress endpointDesc) + sizes + timeout + +{-| 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: + + * 'USB.PipeException' if the endpoint halted. + + * 'USB.OverflowException' if the device offered more data, + see /Packets and overflows/ in the @libusb@ documentation: + . + + * 'USB.NoDeviceException' if the device has been disconnected. + + * Another 'USB.USBException'. +-} +writeIsochronousEndpoint ∷ (pr `AncestorRegion` cr, MonadIO cr) + ⇒ Endpoint Out Isochronous sAlt pr + → [ByteString] -- ^ Sizes of isochronous packets + → USB.Timeout + → cr [USB.Size] +writeIsochronousEndpoint (Endpoint internalDevHndl endpointDesc) isoPackets timeout = + liftIO $ USB.writeIsochronous internalDevHndl + (USB.endpointAddress endpointDesc) + isoPackets + timeout + +-- | Iteratee enumerator for reading /isochronous/ endpoints. +-- +-- /WARNING:/ You need to enable the threaded runtime (@-threaded@) for this +-- function to work correctly. It throws a runtime error otherwise! +enumReadIsochronousEndpoint ∷ ∀ s pr cr sAlt α + . ( ReadableChunk s Word8 + , pr `AncestorRegion` cr, MonadControlIO cr + ) + ⇒ Endpoint In Isochronous sAlt pr + → [USB.Size] + → USB.Timeout + → Enumerator [s] cr α +enumReadIsochronousEndpoint = wrap USB.enumReadIsochronous +#endif -------------------------------------------------------------------------------- -- ** Control transfers -------------------------------------------------------------------------------- @@ -1204,6 +1280,9 @@ → USB.Index → α +type ReadExactAction cr = USB.Size → USB.Timeout → cr ByteString +type WriteExactAction cr = ByteString → USB.Timeout → cr () + {-| 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. @@ -1263,17 +1342,16 @@ -- specified number of bytes to read were actually read. -- Throws an 'USB.IOException' if this is not the case. readControlExact ∷ ∀ pr cr. (pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionalDeviceHandle pr → ControlAction - (USB.Size → USB.Timeout → cr ByteString) -readControlExact regionalDevHndl = \reqType reqRecipient request value index → \timeout size → + ⇒ RegionalDeviceHandle pr → ControlAction (ReadExactAction cr) +readControlExact regionalDevHndl = \reqType reqRecipient request value index → \size timeout → liftIO $ USB.readControlExact (getInternalDevHndl regionalDevHndl) (reqTypeToInternal reqType) reqRecipient request value index - timeout size + timeout {-| Perform a USB /control/ write. @@ -1287,16 +1365,30 @@ -} writeControl ∷ ∀ pr cr. (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → ControlAction (WriteAction cr) -writeControl regionalDevHndl = \reqType reqRecipient request value index → \timeout input → +writeControl regionalDevHndl = \reqType reqRecipient request value index → \input timeout → liftIO $ USB.writeControl (getInternalDevHndl regionalDevHndl) (reqTypeToInternal reqType) reqRecipient request value index - timeout input + timeout +-- | 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 ∷ ∀ pr cr. (pr `AncestorRegion` cr, MonadIO cr) + ⇒ RegionalDeviceHandle pr → ControlAction (WriteExactAction cr) +writeControlExact regionalDevHndl = \reqType reqRecipient request value index → \input timeout → + liftIO $ USB.writeControlExact (getInternalDevHndl regionalDevHndl) + (reqTypeToInternal reqType) + reqRecipient + request + value + index + input + timeout -------------------------------------------------------------------------------- -- *** Standard Device Requests @@ -1451,15 +1543,15 @@ * Another 'USB.USBException'. -} -withDetachedKernelDriver ∷ (pr `AncestorRegion` cr, MonadControlIO cr) +withDetachedKernelDriver ∷ (pr `AncestorRegion` RegionT s cr, MonadControlIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber - → cr α - → cr α + → RegionT s cr α + → RegionT s cr α withDetachedKernelDriver regionalDevHndl ifNum = - liftIOOp_ $ USB.withDetachedKernelDriver - (getInternalDevHndl regionalDevHndl) - ifNum + unsafeLiftIOOp_ $ USB.withDetachedKernelDriver + (getInternalDevHndl regionalDevHndl) + ifNum -- The End --------------------------------------------------------------------- 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.12 +version: 0.13 cabal-version: >=1.6 build-type: Custom license: BSD3 @@ -7,6 +7,8 @@ copyright: 2009–2010 Bas van Dijk author: Bas van Dijk maintainer: Bas van Dijk +homepage: https://github.com/basvandijk/usb-safe/ +bug-reports: https://github.com/basvandijk/usb-safe/issues stability: experimental category: System, Monadic Regions synopsis: Type-safe communication with USB devices. @@ -46,10 +48,6 @@ . * You can't write to an endpoint with an In transfer direction. . - * You can't read from or write to endpoints with the unsupported transfer - types Control and Isochronous. Only I/O with endpoints with the Bulk and - Interrupt transfer types is allowed. - . The primary technique used in usb-safe is called \"Lightweight monadic regions\" which was invented by Oleg Kiselyov and Chung-chieh Shan. See: @@ -61,22 +59,27 @@ . See the @usb-safe-examples@ package for examples how to use this library: . - @darcs get@ + @git clone @ +extra-source-files: README.markdown, NEWS + source-repository head - Type: darcs - Location: http://code.haskell.org/~basvandijk/code/usb-safe + Type: git + Location: git://github.com/basvandijk/usb-safe.git Library GHC-Options: -Wall -fno-warn-orphans - build-depends: base >= 4 && < 4.4 + build-depends: base >= 4 && < 4.5 , base-unicode-symbols >= 0.1.1 && < 0.3 - , usb >= 0.8 && < 0.9 - , usb-enumerator >= 0.3 && < 0.4 - , iteratee >= 0.3.5 && < 0.9 + , usb >= 1.0 && < 1.1 + , usb-iteratee >= 0.4 && < 0.5 + , iteratee >= 0.4 && < 0.9 , bytestring >= 0.9 && < 0.10 , text >= 0.5 && < 0.12 - , regions >= 0.9 && < 0.10 + , regions >= 0.9 && < 0.11 , transformers >= 0.2 && < 0.3 , monad-control >= 0.2 && < 0.3 exposed-modules: System.USB.Safe + + if impl(ghc>7) && !os(windows) + cpp-options: -DHAS_EVENT_MANAGER