usb-safe 0.13 → 0.14
raw patch · 3 files changed
+466/−32 lines, 3 filesdep +bindings-libusbdep −monad-controldep −usb-iterateedep ~regions
Dependencies added: bindings-libusb
Dependencies removed: monad-control, usb-iteratee
Dependency ranges changed: regions
Files
- System/USB/Safe.hs +23/−28
- System/USB/Safe/Iteratee.hs +439/−0
- usb-safe.cabal +4/−4
System/USB/Safe.hs view
@@ -185,7 +185,7 @@ -- from base: import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, withMVar ) import Control.Monad ( Monad, return, (>>=), (>>), liftM )-import Control.Exception ( Exception, bracket_ )+import Control.Exception ( Exception, throwIO, bracket_ ) import Data.Typeable ( Typeable ) import Data.Function ( ($) ) import Data.Word ( Word8 )@@ -215,10 +215,6 @@ -- from transformers: import Control.Monad.IO.Class ( MonadIO, liftIO ) --- from monad-control:-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_ )@@ -281,8 +277,8 @@ import System.USB.Descriptors ( maxPacketSize, endpointMaxPacketSize ) #endif --- from usb-iteratee:-import qualified System.USB.IO.Iteratee as USB+-- from usb-safe (this package):+import System.USB.Safe.Iteratee ( enumReadBulk , enumReadInterrupt #ifdef HAS_EVENT_MANAGER@@ -298,7 +294,6 @@ mask_ = block #endif - -------------------------------------------------------------------------------- -- ** Regional device handles --------------------------------------------------------------------------------@@ -332,7 +327,7 @@ * Another 'USB.USBException'. -}-openDevice ∷ MonadControlIO pr+openDevice ∷ RegionControlIO pr ⇒ USB.Device → RegionT s pr (RegionalDeviceHandle (RegionT s pr)) openDevice dev = unsafeLiftIOOp_ mask_ $ do h ← liftIO $ USB.openDevice dev@@ -343,7 +338,7 @@ {-| Convenience function which opens the device, applies the given continuation function to the resulting regional device handle and runs the resulting region. -}-withDevice ∷ MonadControlIO pr+withDevice ∷ RegionControlIO pr ⇒ USB.Device → (∀ s. RegionalDeviceHandle (RegionT s pr) → RegionT s pr α) → pr α@@ -366,7 +361,7 @@ * Another 'USB.USBException'. -} withDeviceWhich ∷ ∀ pr α- . MonadControlIO pr+ . RegionControlIO pr ⇒ USB.Ctx → (USB.DeviceDesc → Bool) -- ^ Predicate on the device descriptor. → (∀ s. RegionalDeviceHandle (RegionT s pr) → RegionT s pr α)@@ -382,7 +377,7 @@ -- See: http://thread.gmane.org/gmane.comp.lang.haskell.glasgow.user/19134/focus=19153 -- A solution is to just inline the code of useWhich: (I know this is ugly!) case find (p ∘ getDesc) devs of- Nothing → throwIO USB.NotFoundException+ Nothing → liftIO $ throwIO USB.NotFoundException Just dev → withDevice dev f #endif @@ -398,7 +393,7 @@ → k -- ^ Continuation function → m α useWhich ds w p f = case find (p ∘ getDesc) ds of- Nothing → throwIO USB.NotFoundException+ Nothing → liftIO $ throwIO USB.NotFoundException Just d → w d f -- | Internally used function for getting the actual USB device handle from a@@ -560,7 +555,7 @@ * Another 'USB.USBException'. -} setConfig ∷ ∀ pr cr s α- . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr)+ . (pr `AncestorRegion` RegionT s cr, RegionControlIO cr) ⇒ Config pr -- ^ The configuration you wish to set. → (∀ sCfg. ConfigHandle sCfg → RegionT s cr α) -- ^ Continuation function. → RegionT s cr α@@ -626,7 +621,7 @@ * Another 'USB.USBException'. -} useActiveConfig ∷ ∀ pr cr s α- . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr)+ . (pr `AncestorRegion` RegionT s cr, RegionControlIO cr) ⇒ RegionalDeviceHandle pr -- ^ Regional handle to the device -- from which you want to use the -- active configuration.@@ -672,7 +667,7 @@ * Another 'USB.USBException'. -} setConfigWhich ∷ ∀ pr cr s α- . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr)+ . (pr `AncestorRegion` RegionT s cr, RegionControlIO cr) ⇒ RegionalDeviceHandle pr -- ^ Regional handle to the device for -- which you want to set a -- configuration.@@ -758,7 +753,7 @@ * Another 'USB.USBException'. -} claim ∷ ∀ pr sCfg s- . MonadControlIO pr+ . RegionControlIO pr ⇒ Interface sCfg -- ^ Interface you wish to claim → RegionT s pr (RegionalInterfaceHandle sCfg@@ -770,7 +765,7 @@ return $ RegionalInterfaceHandle interface mv ch withInterface ∷ ∀ pr sCfg α- . MonadControlIO pr+ . RegionControlIO pr ⇒ Interface sCfg -- ^ The interface you wish to claim. → (∀ s. RegionalInterfaceHandle sCfg (RegionT s pr) → RegionT s pr α@@ -795,7 +790,7 @@ -} withInterfaceWhich ∷ ∀ pr sCfg α- . MonadControlIO pr+ . RegionControlIO pr ⇒ ConfigHandle sCfg -- ^ Handle to a configuration of which -- you want to claim an interface. → (USB.Interface → Bool) -- ^ Predicate on the interface descriptors.@@ -875,7 +870,7 @@ * Another 'USB.USBException'. -} setAlternate ∷ ∀ pr cr s sCfg α- . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr)+ . (pr `AncestorRegion` RegionT s cr, RegionControlIO cr) ⇒ Alternate sCfg pr -- ^ The alternate you wish to set. → (∀ sAlt. AlternateHandle sAlt pr → RegionT s cr α) -- ^ Continuation function. → RegionT s cr α@@ -906,7 +901,7 @@ * Another 'USB.USBException'. -} useActiveAlternate ∷ ∀ pr cr s sCfg α- . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr)+ . (pr `AncestorRegion` RegionT s cr, RegionControlIO cr) ⇒ RegionalInterfaceHandle sCfg pr -- ^ Regional handle to the -- interface from which you want -- to use the active alternate.@@ -945,7 +940,7 @@ * Another 'USB.USBException'. -} setAlternateWhich ∷ ∀ pr cr sCfg s α- . (pr `AncestorRegion` RegionT s cr, MonadControlIO cr)+ . (pr `AncestorRegion` RegionT s cr, RegionControlIO cr) ⇒ RegionalInterfaceHandle sCfg pr -- ^ Regional handle to the -- interface for which you want -- to set an alternate.@@ -1180,7 +1175,7 @@ class EnumReadEndpoint transType where -- | An enumerator for an 'In' endpoint -- with either a 'Bulk' or 'Interrupt' transfer type.- enumReadEndpoint ∷ ( pr `AncestorRegion` cr, MonadControlIO cr+ enumReadEndpoint ∷ ( pr `AncestorRegion` cr, RegionControlIO cr , ReadableChunk s Word8, NullPoint s ) ⇒ Endpoint In transType sAlt pr@@ -1192,8 +1187,8 @@ -- timeout, use value 0. → Enumerator s cr α -instance EnumReadEndpoint Bulk where enumReadEndpoint = wrap USB.enumReadBulk-instance EnumReadEndpoint Interrupt where enumReadEndpoint = wrap USB.enumReadInterrupt+instance EnumReadEndpoint Bulk where enumReadEndpoint = wrap enumReadBulk+instance EnumReadEndpoint Interrupt where enumReadEndpoint = wrap enumReadInterrupt #ifdef HAS_EVENT_MANAGER --------------------------------------------------------------------------------@@ -1260,13 +1255,13 @@ -- function to work correctly. It throws a runtime error otherwise! enumReadIsochronousEndpoint ∷ ∀ s pr cr sAlt α . ( ReadableChunk s Word8- , pr `AncestorRegion` cr, MonadControlIO cr+ , pr `AncestorRegion` cr, RegionControlIO cr ) ⇒ Endpoint In Isochronous sAlt pr → [USB.Size] → USB.Timeout → Enumerator [s] cr α-enumReadIsochronousEndpoint = wrap USB.enumReadIsochronous+enumReadIsochronousEndpoint = wrap enumReadIsochronous #endif -------------------------------------------------------------------------------- -- ** Control transfers@@ -1543,7 +1538,7 @@ * Another 'USB.USBException'. -}-withDetachedKernelDriver ∷ (pr `AncestorRegion` RegionT s cr, MonadControlIO cr)+withDetachedKernelDriver ∷ (pr `AncestorRegion` RegionT s cr, RegionControlIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber → RegionT s cr α
+ System/USB/Safe/Iteratee.hs view
@@ -0,0 +1,439 @@+{-# LANGUAGE CPP+ , UnicodeSyntax+ , NoImplicitPrelude+ , FlexibleContexts+ , ScopedTypeVariables+ #-}++--------------------------------------------------------------------------------+-- |+-- Module : System.USB.Safe.Iteratee+-- Copyright : (c) 2011 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-- Iteratee enumerators for endpoints.+--+--------------------------------------------------------------------------------++module System.USB.Safe.Iteratee+ ( enumReadBulk+ , enumReadInterrupt+#ifdef HAS_EVENT_MANAGER+ , enumReadIsochronous+#endif+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Prelude ( fromIntegral )+import Data.Function ( ($) )+import Data.Word ( Word8 )+import Data.Maybe ( Maybe(Nothing, Just) )+import Control.Monad ( (>>=), return )+import Foreign.Storable ( peek )+import Foreign.Ptr ( castPtr )+import Foreign.Marshal.Alloc ( alloca, allocaBytes )+import Control.Exception ( toException )++#if __GLASGOW_HASKELL__ < 700+import Prelude ( fromInteger )+import Control.Monad ( fail )+#endif++-- from base-unicode-symbols:+import Data.Eq.Unicode ( (≡), (≢) )+import Data.Bool.Unicode ( (∧) )+import Data.Function.Unicode ( (∘) )++-- from bindings-libusb:+import Bindings.Libusb ( c'libusb_bulk_transfer+ , c'libusb_interrupt_transfer+ , c'LIBUSB_SUCCESS+ , c'LIBUSB_ERROR_TIMEOUT+ )++-- from usb:+import System.USB.DeviceHandling ( DeviceHandle )+import System.USB.Descriptors ( EndpointAddress )+import System.USB.IO ( Timeout, Size )++import System.USB.Internal ( C'TransferFunc+ , withDevHndlPtr+ , marshalEndpointAddress+ , convertUSBException+ )++#ifdef __HADDOCK__+import System.USB.Descriptors ( maxPacketSize, endpointMaxPacketSize+ , TransferDirection(In)+ , TransferType(Bulk, Interrupt)+ )+#endif++-- from iteratee:+import Data.Iteratee.Base ( Stream(EOF, Chunk), runIter, idoneM )+import Data.Iteratee.Iteratee ( Enumerator, throwErr )+import Data.Iteratee.Base.ReadableChunk ( ReadableChunk(readFromPtr) )+import Data.NullPoint ( NullPoint(empty) )++-- from regions:+import Control.Monad.Trans.Region ( RegionControlIO )+import Control.Monad.Trans.Region.Unsafe ( unsafeControlIO ) ++#ifdef HAS_EVENT_MANAGER+--------------------------------------------------------------------------------+-- from base:+import Data.Bool ( otherwise, not )+import Data.Int ( Int )+import Data.Function ( id )+import Data.List ( (++), map )+import Foreign.Ptr ( Ptr, nullPtr, plusPtr )+import Foreign.Storable ( poke )+import System.IO ( IO )+import Text.Show ( show )+import Prelude ( (*), error, String )+import Control.Exception ( SomeException, onException, mask, uninterruptibleMask_ )++import+#if MIN_VERSION_base(4,4,0)+ GHC.Event+#else+ System.Event+#endif+ ( registerTimeout, unregisterTimeout )++-- from iteratee:+import Data.Iteratee.Base ( Iteratee )++-- from bindings-libusb:+import Bindings.Libusb ( c'LIBUSB_TRANSFER_TYPE_BULK+ , c'LIBUSB_TRANSFER_TYPE_INTERRUPT+ , c'LIBUSB_TRANSFER_TYPE_ISOCHRONOUS++ , c'LIBUSB_TRANSFER_COMPLETED+ , c'LIBUSB_TRANSFER_TIMED_OUT+ , c'LIBUSB_TRANSFER_ERROR+ , c'LIBUSB_TRANSFER_NO_DEVICE+ , c'LIBUSB_TRANSFER_OVERFLOW+ , c'LIBUSB_TRANSFER_STALL+ , c'LIBUSB_TRANSFER_CANCELLED++ , C'libusb_iso_packet_descriptor(..)+ , C'libusb_transfer(..)++ , c'libusb_submit_transfer+ , c'libusb_cancel_transfer++ , p'libusb_transfer'status+ , p'libusb_transfer'actual_length+ )++-- from usb:+import System.USB.DeviceHandling ( getDevice )+import System.USB.Exceptions ( USBException(..), ioException )+#ifdef __HADDOCK__+import System.USB.Descriptors ( TransferType(Isochronous), maxIsoPacketSize )+#endif+import System.USB.IO ( noTimeout )+import System.USB.Internal ( threaded+ , C'TransferType+ , allocaTransfer, withCallback+ , newLock, acquire, release+ , SumLength(..), sumLength+ , peekIsoPacketDescs+ , initIsoPacketDesc+ , getCtx, getEventManager+ )+#endif++--------------------------------------------------------------------------------+-- Enumerators+--------------------------------------------------------------------------------++-- | Iteratee enumerator for reading /bulk/ endpoints.+enumReadBulk ∷ (ReadableChunk s Word8, NullPoint s, RegionControlIO m)+ ⇒ DeviceHandle -- ^ A handle for the device to communicate with.+ → EndpointAddress -- ^ The address of a valid 'In' and 'Bulk'+ -- endpoint to communicate with. Make sure the+ -- endpoint belongs to the current alternate+ -- setting of a claimed interface which belongs+ -- to the device.+ → Size -- ^ Chunk size. A good value for this would be+ -- the @'maxPacketSize' . 'endpointMaxPacketSize'@.+ → Timeout -- ^ Timeout (in milliseconds) that this function+ -- should wait for each chunk before giving up+ -- due to no response being received.+ → Enumerator s m α+enumReadBulk+#ifdef HAS_EVENT_MANAGER+ | threaded = enumReadAsync c'LIBUSB_TRANSFER_TYPE_BULK+#endif+ | otherwise = enumReadSync c'libusb_bulk_transfer++-- | Iteratee enumerator for reading /interrupt/ endpoints.+enumReadInterrupt ∷ (ReadableChunk s Word8, NullPoint s, RegionControlIO m)+ ⇒ DeviceHandle -- ^ A handle for the device to communicate+ -- with.+ → EndpointAddress -- ^ The address of a valid 'In' and+ -- 'Interrupt' endpoint to communicate+ -- with. Make sure the endpoint belongs to+ -- the current alternate setting of a+ -- claimed interface which belongs to the+ -- device.+ → Size -- ^ Chunk size. A good value for this would+ -- be the @'maxPacketSize' . 'endpointMaxPacketSize'@.+ → Timeout -- ^ Timeout (in milliseconds) that this+ -- function should wait for each chunk+ -- before giving up due to no response+ -- being received.+ → Enumerator s m α+enumReadInterrupt+#ifdef HAS_EVENT_MANAGER+ | threaded = enumReadAsync c'LIBUSB_TRANSFER_TYPE_INTERRUPT+#endif+ | otherwise = enumReadSync c'libusb_interrupt_transfer++type Run s m α = Stream s → IO (Restore s m α)++type Restore s m α = m (Iteratee s m α)++#ifdef HAS_EVENT_MANAGER+--------------------------------------------------------------------------------+-- Asynchronous+--------------------------------------------------------------------------------++enumReadAsync ∷ ∀ s m α+ . (ReadableChunk s Word8, NullPoint s, RegionControlIO m)+ ⇒ C'TransferType+ → DeviceHandle → EndpointAddress → Size → Timeout+ → Enumerator s m α+enumReadAsync transType = \devHndl endpointAddr chunkSize timeout →+ enum transType+ 0 []+ devHndl endpointAddr+ timeout+ chunkSize+ withResult withResult+ where+ withResult ∷ WithResult s m α+ withResult transPtr bufferPtr cont stop = do+ n ← peek $ p'libusb_transfer'actual_length transPtr+ if n ≡ 0+ then stop $ Chunk empty+ else readFromPtr bufferPtr (fromIntegral n) >>= cont ∘ Chunk++type WithResult s m α = Ptr C'libusb_transfer → Ptr Word8+ → Run s m α -- To continue+ → Run s m α -- To stop+ → IO (Restore s m α)++enum ∷ ∀ m s α+ . RegionControlIO m+ ⇒ C'TransferType+ → Int → [C'libusb_iso_packet_descriptor]+ → DeviceHandle → EndpointAddress+ → Timeout+ → Size+ → WithResult s m α → WithResult s m α+ → Enumerator s m α+enum transType+ nrOfIsoPackets isoPackageDescs+ devHndl endpointAddr+ timeout+ chunkSize+ onCompletion onTimeout = \iter →+ unsafeControlIO $ \runInIO →+ withDevHndlPtr devHndl $ \devHndlPtr →+ allocaBytes chunkSize $ \bufferPtr →+ allocaTransfer nrOfIsoPackets $ \transPtr → do+ lock ← newLock+ let Just (evtMgr, mbHandleEvents) = getEventManager $+ getCtx $+ getDevice devHndl+ waitForTermination =+ case mbHandleEvents of+ Just handleEvents | timeout ≢ noTimeout → do+ tk ← registerTimeout evtMgr (timeout * 1000) handleEvents+ acquire lock+ `onException`+ (uninterruptibleMask_ $ do+ unregisterTimeout evtMgr tk+ _err ← c'libusb_cancel_transfer transPtr+ acquire lock)+ _ → acquire lock+ `onException`+ (uninterruptibleMask_ $ do+ _err ← c'libusb_cancel_transfer transPtr+ acquire lock)+ withCallback (\_ → release lock) $ \cbPtr → do++ poke transPtr $ C'libusb_transfer+ { c'libusb_transfer'dev_handle = devHndlPtr+ , c'libusb_transfer'flags = 0 -- unused+ , c'libusb_transfer'endpoint = marshalEndpointAddress endpointAddr+ , c'libusb_transfer'type = transType+ , c'libusb_transfer'timeout = fromIntegral timeout+ , c'libusb_transfer'status = 0 -- output+ , c'libusb_transfer'length = fromIntegral chunkSize+ , c'libusb_transfer'actual_length = 0 -- output+ , c'libusb_transfer'callback = cbPtr+ , c'libusb_transfer'user_data = nullPtr -- unused+ , c'libusb_transfer'buffer = castPtr bufferPtr+ , c'libusb_transfer'num_iso_packets = fromIntegral nrOfIsoPackets+ , c'libusb_transfer'iso_packet_desc = isoPackageDescs+ }++ let go ∷ Enumerator s m α+ go i = runIter i idoneM on_cont++ on_cont ∷ (Stream s → Iteratee s m α)+ → Maybe SomeException+ → m (Iteratee s m α)+ on_cont _ (Just e) = return $ throwErr e+ on_cont k Nothing =+ unsafeControlIO $ \runInIO' →+ mask $ \restore → do++ let stop, cont ∷ Run s m α+ stop = return ∘ return ∘ k+ cont = runInIO' ∘ go ∘ k++ ex ∷ USBException → IO (Restore s m α)+ ex = stop ∘ EOF ∘ Just ∘ toException++ err ← c'libusb_submit_transfer transPtr++ if err ≢ c'LIBUSB_SUCCESS+ then ex $ convertUSBException err+ else do+ waitForTermination+ restore $ do+ status ← peek $ p'libusb_transfer'status transPtr+ let run withResult = withResult transPtr bufferPtr cont stop+ case status of+ ts | ts ≡ c'LIBUSB_TRANSFER_COMPLETED → run onCompletion+ | ts ≡ c'LIBUSB_TRANSFER_TIMED_OUT → run onTimeout++ | ts ≡ c'LIBUSB_TRANSFER_ERROR → ex ioException+ | ts ≡ c'LIBUSB_TRANSFER_NO_DEVICE → ex NoDeviceException+ | ts ≡ c'LIBUSB_TRANSFER_OVERFLOW → ex OverflowException+ | ts ≡ c'LIBUSB_TRANSFER_STALL → ex PipeException++ | ts ≡ c'LIBUSB_TRANSFER_CANCELLED →+ moduleError "transfer status can't be Cancelled!"++ | otherwise → moduleError $ "Unknown transfer status: "+ ++ show ts ++ "!"+ runInIO $ go iter++moduleError ∷ String → error+moduleError msg = error $ thisModule ++ ": " ++ msg++thisModule ∷ String+thisModule = "System.USB.IO.Iteratee"++needThreadedRTSError ∷ String → error+needThreadedRTSError msg = moduleError $ msg +++ " is only supported when using the threaded runtime. " +++ "Please build your program with -threaded."++--------------------------------------------------------------------------------+-- Isochronous+--------------------------------------------------------------------------------++-- | 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!+enumReadIsochronous ∷ ∀ s m α+ . (ReadableChunk s Word8, RegionControlIO m)+ ⇒ DeviceHandle -- ^ A handle for the device to communicate with.+ → EndpointAddress -- ^ The address of a valid 'In' and 'Isochronous'+ -- endpoint to communicate with. Make sure the+ -- endpoint belongs to the current alternate+ -- setting of a claimed interface which belongs+ -- to the device.+ → [Size] -- ^ Sizes of isochronous packets. A good+ -- value for these would be the+ -- 'maxIsoPacketSize'+ → Timeout -- ^ Timeout (in milliseconds) that this+ -- function should wait for each chunk+ -- before giving up due to no response+ -- being received.+ → Enumerator [s] m α+enumReadIsochronous devHndl endpointAddr sizes timeout+ | not threaded = needThreadedRTSError "enumReadIsochronous"+ | otherwise = enum c'LIBUSB_TRANSFER_TYPE_ISOCHRONOUS+ nrOfIsoPackets (map initIsoPacketDesc sizes)+ devHndl endpointAddr+ timeout+ totalSize+ onCompletion onTimeout+ where+ SumLength totalSize nrOfIsoPackets = sumLength sizes++ onCompletion, onTimeout ∷ WithResult [s] m α+ onCompletion transPtr bufferPtr cont _ =+ peekIsoPacketDescs nrOfIsoPackets transPtr >>= go bufferPtr id+ where+ go _ ss [] = cont $ Chunk $ ss []+ go ptr ss (C'libusb_iso_packet_descriptor l a _ : ds) = do+ s ← readFromPtr ptr (fromIntegral a)+ go (ptr `plusPtr` fromIntegral l) (ss ∘ (s:)) ds++ onTimeout _ _ _ stop = stop ∘ EOF ∘ Just ∘ toException $ TimeoutException+#endif++--------------------------------------------------------------------------------+-- Synchronous+--------------------------------------------------------------------------------++enumReadSync ∷ ∀ s m α+ . (ReadableChunk s Word8, NullPoint s, RegionControlIO m)+ ⇒ C'TransferFunc → ( DeviceHandle+ → EndpointAddress+ → Size+ → Timeout+ → Enumerator s m α+ )+enumReadSync c'transfer = \devHndl+ endpoint+ chunkSize+ timeout → \iter →+ unsafeControlIO $ \runInIO →+ withDevHndlPtr devHndl $ \devHndlPtr →+ alloca $ \transferredPtr →+ allocaBytes chunkSize $ \dataPtr →+ let go ∷ Enumerator s m α+ go i = runIter i idoneM on_cont++ on_cont ∷ (Stream s → Iteratee s m α) → Maybe SomeException → m (Iteratee s m α)+ on_cont _ (Just e) = return $ throwErr e+ on_cont k Nothing =+ unsafeControlIO $ \runInIO' → do++ let stop, cont ∷ Run s m α+ stop = return ∘ return ∘ k+ cont = runInIO' ∘ go ∘ k++ err ← c'transfer devHndlPtr+ (marshalEndpointAddress endpoint)+ (castPtr dataPtr)+ (fromIntegral chunkSize)+ transferredPtr+ (fromIntegral timeout)++ if err ≢ c'LIBUSB_SUCCESS ∧+ err ≢ c'LIBUSB_ERROR_TIMEOUT+ then stop ∘ EOF ∘ Just ∘ toException $ convertUSBException err+ else do+ t ← peek transferredPtr+ if t ≡ 0+ then stop $ Chunk empty+ else readFromPtr dataPtr (fromIntegral t) >>= cont ∘ Chunk+ in runInIO $ go iter
usb-safe.cabal view
@@ -1,5 +1,5 @@ name: usb-safe-version: 0.13+version: 0.14 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -72,14 +72,14 @@ build-depends: base >= 4 && < 4.5 , base-unicode-symbols >= 0.1.1 && < 0.3 , usb >= 1.0 && < 1.1- , usb-iteratee >= 0.4 && < 0.5+ , bindings-libusb >= 1.3 && < 1.5 , iteratee >= 0.4 && < 0.9 , bytestring >= 0.9 && < 0.10 , text >= 0.5 && < 0.12- , regions >= 0.9 && < 0.11+ , regions >= 0.11 && < 0.12 , transformers >= 0.2 && < 0.3- , monad-control >= 0.2 && < 0.3 exposed-modules: System.USB.Safe+ other-modules: System.USB.Safe.Iteratee if impl(ghc>7) && !os(windows) cpp-options: -DHAS_EVENT_MANAGER