diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,20 @@ +0.4 + +(Released on: Mon Sep 12 19:50:49 UTC 2011) + +* Renamed package from usb-enumerator to usb-iteratee. + This makes it more clear that this package provides iteratee + enumerators instead of the enumerators from the enumerator package. + +* Renamed System.USB.IO.Synchronous.Enumerator to System.USB.IO.Iteratee. + +* The enumerators now use an asynchronous implementation when support + for the GHC event manager is available. This should be more + efficient. + +* Support for an isochronous enumerator. + + 0.3 (Released on: Wed Mar 9 12:22:02 UTC 2011) diff --git a/System/USB/IO/Iteratee.hs b/System/USB/IO/Iteratee.hs --- a/System/USB/IO/Iteratee.hs +++ b/System/USB/IO/Iteratee.hs @@ -5,6 +5,14 @@ , ScopedTypeVariables #-} +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE Trustworthy #-} +#endif + +#ifdef HAS_EVENT_MANAGER +{-# LANGUAGE PatternGuards #-} +#endif + -------------------------------------------------------------------------------- -- | -- Module : System.USB.IO.Iteratee @@ -34,6 +42,7 @@ import Data.Function ( ($) ) import Data.Word ( Word8 ) import Data.Maybe ( Maybe(Nothing, Just) ) +import Control.Exception ( toException ) import Control.Monad ( (>>=), return ) import Foreign.Storable ( peek ) import Foreign.Ptr ( castPtr ) @@ -46,6 +55,7 @@ -- from base-unicode-symbols: import Data.Eq.Unicode ( (≡), (≢) ) +import Data.Function.Unicode ( (∘) ) import Data.Bool.Unicode ( (∧) ) -- from bindings-libusb: @@ -56,7 +66,7 @@ ) -- from monad-control: -import Control.Monad.IO.Control ( MonadControlIO, controlIO ) +import Control.Monad.Trans.Control ( MonadBaseControl, StM, control ) -- from usb: import System.USB.DeviceHandling ( DeviceHandle ) @@ -82,16 +92,10 @@ import Data.Iteratee.Base.ReadableChunk ( ReadableChunk(readFromPtr) ) import Data.NullPoint ( NullPoint(empty) ) --- from base: -import Control.Exception ( toException ) - --- from base-unicode-symbols: -import Data.Function.Unicode ( (∘) ) - #ifdef HAS_EVENT_MANAGER -------------------------------------------------------------------------------- -- from base: -import Data.Bool ( otherwise, not ) +import Data.Bool ( otherwise ) import Data.Int ( Int ) import Data.Function ( id ) import Data.List ( (++), map ) @@ -99,16 +103,8 @@ 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 ) +import Prelude ( error, String ) +import Control.Exception ( SomeException, mask ) -- from iteratee: import Data.Iteratee.Base ( Iteratee ) @@ -130,27 +126,23 @@ , 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 +import System.USB.Internal ( getWait, Wait , C'TransferType , allocaTransfer, withCallback - , newLock, acquire, release + , newLock, release , SumLength(..), sumLength , peekIsoPacketDescs , initIsoPacketDesc - , getCtx, getEventManager ) #endif @@ -159,7 +151,7 @@ -------------------------------------------------------------------------------- -- | Iteratee enumerator for reading /bulk/ endpoints. -enumReadBulk ∷ (ReadableChunk s Word8, NullPoint s, MonadControlIO m) +enumReadBulk ∷ (ReadableChunk s Word8, NullPoint s, MonadBaseControl IO 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 @@ -172,14 +164,15 @@ -- should wait for each chunk before giving up -- due to no response being received. → Enumerator s m α -enumReadBulk +enumReadBulk devHndl #ifdef HAS_EVENT_MANAGER - | threaded = enumReadAsync c'LIBUSB_TRANSFER_TYPE_BULK + | Just wait ← getWait devHndl = + enumReadAsync wait c'LIBUSB_TRANSFER_TYPE_BULK devHndl #endif - | otherwise = enumReadSync c'libusb_bulk_transfer + | otherwise = enumReadSync c'libusb_bulk_transfer devHndl -- | Iteratee enumerator for reading /interrupt/ endpoints. -enumReadInterrupt ∷ (ReadableChunk s Word8, NullPoint s, MonadControlIO m) +enumReadInterrupt ∷ (ReadableChunk s Word8, NullPoint s, MonadBaseControl IO m) ⇒ DeviceHandle -- ^ A handle for the device to communicate -- with. → EndpointAddress -- ^ The address of a valid 'In' and @@ -195,15 +188,14 @@ -- before giving up due to no response -- being received. → Enumerator s m α -enumReadInterrupt +enumReadInterrupt devHndl #ifdef HAS_EVENT_MANAGER - | threaded = enumReadAsync c'LIBUSB_TRANSFER_TYPE_INTERRUPT + | Just wait ← getWait devHndl = + enumReadAsync wait c'LIBUSB_TRANSFER_TYPE_INTERRUPT devHndl #endif - | otherwise = enumReadSync c'libusb_interrupt_transfer - -type Run s m α = Stream s → IO (Restore s m α) + | otherwise = enumReadSync c'libusb_interrupt_transfer devHndl -type Restore s m α = m (Iteratee s m α) +type Run s m α = Stream s → IO (StM m (Iteratee s m α)) #ifdef HAS_EVENT_MANAGER -------------------------------------------------------------------------------- @@ -211,12 +203,14 @@ -------------------------------------------------------------------------------- enumReadAsync ∷ ∀ s m α - . (ReadableChunk s Word8, NullPoint s, MonadControlIO m) - ⇒ C'TransferType + . (ReadableChunk s Word8, NullPoint s, MonadBaseControl IO m) + ⇒ Wait + → C'TransferType → DeviceHandle → EndpointAddress → Size → Timeout → Enumerator s m α -enumReadAsync transType = \devHndl endpointAddr chunkSize timeout → - enum transType +enumReadAsync wait transType = \devHndl endpointAddr chunkSize timeout → + enum wait + transType 0 [] devHndl endpointAddr timeout @@ -233,46 +227,30 @@ type WithResult s m α = Ptr C'libusb_transfer → Ptr Word8 → Run s m α -- To continue → Run s m α -- To stop - → IO (Restore s m α) + → IO (StM m (Iteratee s m α)) enum ∷ ∀ m s α - . MonadControlIO m - ⇒ C'TransferType + . MonadBaseControl IO m + ⇒ Wait + → C'TransferType → Int → [C'libusb_iso_packet_descriptor] → DeviceHandle → EndpointAddress → Timeout → Size → WithResult s m α → WithResult s m α → Enumerator s m α -enum transType +enum wait + transType nrOfIsoPackets isoPackageDescs devHndl endpointAddr timeout chunkSize onCompletion onTimeout = \iter → - controlIO $ \runInIO → + control $ \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 @@ -291,7 +269,10 @@ , c'libusb_transfer'iso_packet_desc = isoPackageDescs } - let go ∷ Enumerator s m α + let waitForTermination ∷ IO () + waitForTermination = wait timeout lock transPtr + + go ∷ Enumerator s m α go i = runIter i idoneM on_cont on_cont ∷ (Stream s → Iteratee s m α) @@ -299,14 +280,14 @@ → m (Iteratee s m α) on_cont _ (Just e) = return $ throwErr e on_cont k Nothing = - controlIO $ \runInIO' → + control $ \runInIO' → mask $ \restore → do let stop, cont ∷ Run s m α - stop = return ∘ return ∘ k + stop = runInIO' ∘ return ∘ k cont = runInIO' ∘ go ∘ k - ex ∷ USBException → IO (Restore s m α) + ex ∷ USBException → IO (StM m (Iteratee s m α)) ex = stop ∘ EOF ∘ Just ∘ toException err ← c'libusb_submit_transfer transPtr @@ -354,7 +335,7 @@ -- /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, MonadControlIO m) + . (ReadableChunk s Word8, MonadBaseControl IO 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 @@ -370,13 +351,15 @@ -- 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 + | Just wait ← getWait devHndl = + enum wait + c'LIBUSB_TRANSFER_TYPE_ISOCHRONOUS + nrOfIsoPackets (map initIsoPacketDesc sizes) + devHndl endpointAddr + timeout + totalSize + onCompletion onTimeout + | otherwise = needThreadedRTSError "enumReadIsochronous" where SumLength totalSize nrOfIsoPackets = sumLength sizes @@ -397,7 +380,7 @@ -------------------------------------------------------------------------------- enumReadSync ∷ ∀ s m α - . (ReadableChunk s Word8, NullPoint s, MonadControlIO m) + . (ReadableChunk s Word8, NullPoint s, MonadBaseControl IO m) ⇒ C'TransferFunc → ( DeviceHandle → EndpointAddress → Size @@ -408,7 +391,7 @@ endpoint chunkSize timeout → \iter → - controlIO $ \runInIO → + control $ \runInIO → withDevHndlPtr devHndl $ \devHndlPtr → alloca $ \transferredPtr → allocaBytes chunkSize $ \dataPtr → @@ -418,10 +401,10 @@ on_cont ∷ (Stream s → Iteratee s m α) → Maybe SomeException → m (Iteratee s m α) on_cont _ (Just e) = return $ throwErr e on_cont k Nothing = - controlIO $ \runInIO' → do + control $ \runInIO' → do let stop, cont ∷ Run s m α - stop = return ∘ return ∘ k + stop = runInIO' ∘ return ∘ k cont = runInIO' ∘ go ∘ k err ← c'transfer devHndlPtr diff --git a/usb-iteratee.cabal b/usb-iteratee.cabal --- a/usb-iteratee.cabal +++ b/usb-iteratee.cabal @@ -1,16 +1,16 @@ name: usb-iteratee -version: 0.4 +version: 0.4.0.1 cabal-version: >=1.6 build-type: Custom license: BSD3 license-file: LICENSE -copyright: 2011 Bas van Dijk +copyright: 2011-2012 Bas van Dijk author: Bas van Dijk maintainer: Bas van Dijk -homepage: https://github.com/basvandijk/usb-iteratee/ +homepage: https://github.com/basvandijk/usb-iteratee bug-reports: https://github.com/basvandijk/usb-iteratee/issues stability: experimental -category: System +category: System, Hardware synopsis: Iteratee enumerators for the usb package description: This packages provides @iteratee@ enumerators for the @usb@ package. @@ -23,13 +23,12 @@ Library GHC-Options: -Wall - build-depends: base >= 4 && < 4.5 + build-depends: base >= 4 && < 4.6 , base-unicode-symbols >= 0.1.1 && < 0.3 , bindings-libusb >= 1.3 && < 1.5 , iteratee >= 0.4 && < 0.9 - , transformers >= 0.2 && < 0.3 - , monad-control >= 0.2 && < 0.3 - , usb >= 1.0 && < 1.1 + , monad-control >= 0.3 && < 0.4 + , usb >= 1.1 && < 1.2 exposed-modules: System.USB.IO.Iteratee if impl(ghc>7) && !os(windows)