usb 1.0 → 1.1
raw patch · 13 files changed
+237/−129 lines, 13 filesdep ~base
Dependency ranges changed: base
Files
- NEWS +37/−0
- System/USB.hs +5/−0
- System/USB/Base.hs +151/−116
- System/USB/Descriptors.hs +5/−0
- System/USB/DeviceHandling.hs +5/−0
- System/USB/Enumeration.hs +5/−0
- System/USB/Exceptions.hs +5/−0
- System/USB/IO.hs +4/−0
- System/USB/IO/StandardDeviceRequests.hs +4/−0
- System/USB/Initialization.hs +4/−0
- System/USB/Internal.hs +5/−3
- Utils.hs +2/−5
- usb.cabal +5/−5
NEWS view
@@ -1,3 +1,40 @@+1.0++(Released on: Mon Sep 12 19:50:37 UTC 2011)++* Support for isochronous reads and writes.++* All I/O functions now use the libusb asynchronous interface when+ support for the GHC event manager is available.+ This should be more efficient and allows cancelling of an in flight+ transfer by throwing an exception to the thread performing the transfer.++* Added writeControlExact :: DeviceHandle -> ControlAction WriteExactAction.++* All I/O functions which previously returned the boolean TimedOut+ now return a: data Status = Completed | TimedOut.++* Added the timeout constant: noTimeout :: Timeout.++* Added function: maxIsoPacketSize :: EndpointDesc -> Size+ Which calculates the maximum packet size which a specific endpoint+ is capable of sending or receiving in the duration of 1 microframe.+ This function is mainly useful for setting up isochronous transfers.++* Added some specific IOExceptions:+ ioException :: USBException+ incompleteReadException :: USBException+ incompleteWriteException :: USBException++* Renamed System.USB.IO.Synchronous to just System.USB.IO.++* Renamed System.USB.Unsafe to System.USB.Internal and exported more+ functions from it which are primarily needed in the usb-iteratee+ package.++* Fixed some bugs.++ 0.8 (Released on: Wed Mar 9 12:21:51 UTC 2011)
System/USB.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ -------------------------------------------------------------------------------- -- | -- Module : System.USB
System/USB/Base.hs view
@@ -1,7 +1,16 @@-{-# LANGUAGE CPP, UnicodeSyntax, NoImplicitPrelude, DeriveDataTypeable #-}+{-# LANGUAGE CPP+ , UnicodeSyntax+ , NoImplicitPrelude+ , DeriveDataTypeable+ , BangPatterns+ #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Unsafe #-}+#endif+ #ifdef HAS_EVENT_MANAGER-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE PatternGuards #-} #endif module System.USB.Base where@@ -100,8 +109,7 @@ #else import System.Event #endif- ( EventManager- , FdKey+ ( FdKey , registerFd, unregisterFd , registerTimeout, unregisterTimeout )@@ -156,13 +164,14 @@ data Ctx = Ctx { #ifdef HAS_EVENT_MANAGER- getEventManager ∷ !(Maybe (EventManager, Maybe (IO ()))),- -- ^ Retrieve the optional event manager from the context- -- and the optional 'IO' action for handling events.+ ctxGetWait ∷ !(Maybe Wait), #endif- getCtxFrgnPtr ∷ !(ForeignPtr C'libusb_context)+ getCtxFrgnPtr ∷ !(ForeignPtr C'libusb_context) } deriving Typeable +-- | A function to wait for the termination of a submitted transfer.+type Wait = Timeout → Lock → Ptr C'libusb_transfer → IO ()+ instance Eq Ctx where (==) = (==) `on` getCtxFrgnPtr withCtxPtr ∷ Ctx → (Ptr C'libusb_context → IO α) → IO α@@ -210,8 +219,7 @@ Just evtMgr → mask_ $ do ctxPtr ← libusb_init - let handleEvents ∷ IO ()- handleEvents = do+ let handleEvents = do err ← withTimeval noTimeout $ c'libusb_handle_events_timeout ctxPtr when (err ≢ c'LIBUSB_SUCCESS) $@@ -250,12 +258,33 @@ c'libusb_set_pollfd_notifiers ctxPtr aFP rFP nullPtr - -- Check if we have to do our own timeout handling:+ -- Check if we have to do our own timeout handling and construct the+ -- appropriate Wait function: r ← c'libusb_pollfds_handle_timeouts ctxPtr- let mbHandleEvents | r ≡ 0 = Just handleEvents- | otherwise = Nothing - fmap (Ctx (Just (evtMgr, mbHandleEvents))) $ FC.newForeignPtr ctxPtr $ do+ let wait ∷ Wait+ !wait | r ≡ 0 = manualTimeout+ | otherwise = \_ → autoTimeout++ manualTimeout timeout lock transPtr+ | timeout ≡ noTimeout = autoTimeout lock transPtr+ | otherwise = do+ tk ← registerTimeout evtMgr (timeout * 1000) handleEvents+ acquire lock+ `onException`+ (uninterruptibleMask_ $ do+ unregisterTimeout evtMgr tk+ _err ← c'libusb_cancel_transfer transPtr+ acquire lock)++ autoTimeout lock transPtr =+ acquire lock+ `onException`+ (uninterruptibleMask_ $ do+ _err ← c'libusb_cancel_transfer transPtr+ acquire lock)++ fmap (Ctx (Just wait)) $ FC.newForeignPtr ctxPtr $ do -- Remove notifiers after which we can safely free the FunPtrs: c'libusb_set_pollfd_notifiers ctxPtr nullFunPtr nullFunPtr nullPtr freeHaskellFunPtr aFP@@ -267,10 +296,15 @@ -- Finally deinitialize libusb: c'libusb_exit ctxPtr --- | 'True' if the RTS supports bound threads and 'False' otherwise.+-- | Checks if the system supports asynchronous I\/O. ----- The asynchronous implementations only work correctly when this is 'True'.-foreign import ccall unsafe "rtsSupportsBoundThreads" threaded ∷ Bool+-- * 'Nothing' means asynchronous I\/O is not supported so synchronous I\/O should+-- be used instead.+--+-- * @'Just' wait@ means that asynchronous I\/O is supported. The @wait@+-- function can be used to wait for submitted transfers.+getWait ∷ DeviceHandle → Maybe Wait+getWait = ctxGetWait ∘ getCtx ∘ getDevice #endif -------------------------------------------------------------------------------- @@ -1515,15 +1549,17 @@ where doControl #ifdef HAS_EVENT_MANAGER- | threaded = allocaBytes controlSetupSize $ \bufferPtr → do- poke bufferPtr $ C'libusb_control_setup requestType- request value index- 0- transferAsync c'LIBUSB_TRANSFER_TYPE_CONTROL- devHndl- controlEndpoint- timeout- (bufferPtr, controlSetupSize)+ | Just wait ← getWait devHndl =+ allocaBytes controlSetupSize $ \bufferPtr → do+ poke bufferPtr $ C'libusb_control_setup requestType+ request value index+ 0+ transferAsync wait+ c'LIBUSB_TRANSFER_TYPE_CONTROL+ devHndl+ controlEndpoint+ timeout+ (bufferPtr, controlSetupSize) #endif | otherwise = controlTransferSync devHndl requestType@@ -1547,13 +1583,14 @@ readControl ∷ DeviceHandle → ControlAction ReadAction readControl devHndl reqType reqRecipient request value index size timeout #ifdef HAS_EVENT_MANAGER- | threaded = do+ | Just wait ← getWait devHndl = do let totalSize = controlSetupSize + size allocaBytes totalSize $ \bufferPtr → do poke bufferPtr $ C'libusb_control_setup requestType request value index (fromIntegral size)- (transferred, status) ← transferAsync c'LIBUSB_TRANSFER_TYPE_CONTROL+ (transferred, status) ← transferAsync wait+ c'LIBUSB_TRANSFER_TYPE_CONTROL devHndl controlEndpoint timeout (bufferPtr, totalSize)@@ -1600,17 +1637,19 @@ writeControl ∷ DeviceHandle → ControlAction WriteAction writeControl devHndl reqType reqRecipient request value index input timeout #ifdef HAS_EVENT_MANAGER- | threaded = BU.unsafeUseAsCStringLen input $ \(dataPtr, size) → do- let totalSize = controlSetupSize + size- allocaBytes totalSize $ \bufferPtr → do- poke bufferPtr $ C'libusb_control_setup requestType- request value index- (fromIntegral size)- copyArray (bufferPtr `plusPtr` controlSetupSize) dataPtr size- transferAsync c'LIBUSB_TRANSFER_TYPE_CONTROL- devHndl controlEndpoint- timeout- (bufferPtr, totalSize)+ | Just wait ← getWait devHndl =+ BU.unsafeUseAsCStringLen input $ \(dataPtr, size) → do+ let totalSize = controlSetupSize + size+ allocaBytes totalSize $ \bufferPtr → do+ poke bufferPtr $ C'libusb_control_setup requestType+ request value index+ (fromIntegral size)+ copyArray (bufferPtr `plusPtr` controlSetupSize) dataPtr size+ transferAsync wait+ c'LIBUSB_TRANSFER_TYPE_CONTROL+ devHndl controlEndpoint+ timeout+ (bufferPtr, totalSize) #endif | otherwise = BU.unsafeUseAsCStringLen input $ controlTransferSync devHndl@@ -1682,11 +1721,12 @@ * Another 'USBException'. -} readBulk ∷ DeviceHandle → EndpointAddress → ReadAction-readBulk+readBulk devHndl #ifdef HAS_EVENT_MANAGER- | threaded = readTransferAsync c'LIBUSB_TRANSFER_TYPE_BULK+ | Just wait ← getWait devHndl =+ readTransferAsync wait c'LIBUSB_TRANSFER_TYPE_BULK devHndl #endif- | otherwise = readTransferSync c'libusb_bulk_transfer+ | otherwise = readTransferSync c'libusb_bulk_transfer devHndl {-| Perform a USB /bulk/ write. @@ -1703,11 +1743,12 @@ * Another 'USBException'. -} writeBulk ∷ DeviceHandle → EndpointAddress → WriteAction-writeBulk+writeBulk devHndl #ifdef HAS_EVENT_MANAGER- | threaded = writeTransferAsync c'LIBUSB_TRANSFER_TYPE_BULK+ | Just wait ← getWait devHndl =+ writeTransferAsync wait c'LIBUSB_TRANSFER_TYPE_BULK devHndl #endif- | otherwise = writeTransferSync c'libusb_bulk_transfer+ | otherwise = writeTransferSync c'libusb_bulk_transfer devHndl -------------------------------------------------------------------------------- -- ** Interrupt transfers@@ -1728,11 +1769,12 @@ * Another 'USBException'. -} readInterrupt ∷ DeviceHandle → EndpointAddress → ReadAction-readInterrupt+readInterrupt devHndl #ifdef HAS_EVENT_MANAGER- | threaded = readTransferAsync c'LIBUSB_TRANSFER_TYPE_INTERRUPT+ | Just wait ← getWait devHndl =+ readTransferAsync wait c'LIBUSB_TRANSFER_TYPE_INTERRUPT devHndl #endif- | otherwise = readTransferSync c'libusb_interrupt_transfer+ | otherwise = readTransferSync c'libusb_interrupt_transfer devHndl {-| Perform a USB /interrupt/ write.@@ -1750,11 +1792,12 @@ * Another 'USBException'. -} writeInterrupt ∷ DeviceHandle → EndpointAddress → WriteAction-writeInterrupt+writeInterrupt devHndl #ifdef HAS_EVENT_MANAGER- | threaded = writeTransferAsync c'LIBUSB_TRANSFER_TYPE_INTERRUPT+ | Just wait ← getWait devHndl =+ writeTransferAsync wait c'LIBUSB_TRANSFER_TYPE_INTERRUPT devHndl #endif- | otherwise = writeTransferSync c'libusb_interrupt_transfer+ | otherwise = writeTransferSync c'libusb_interrupt_transfer devHndl -------------------------------------------------------------------------------- @@ -1810,18 +1853,24 @@ -------------------------------------------------------------------------------- #ifdef HAS_EVENT_MANAGER-readTransferAsync ∷ C'TransferType → DeviceHandle → EndpointAddress → ReadAction-readTransferAsync transType = \devHndl endpointAddr → \size timeout →+readTransferAsync ∷ Wait+ → C'TransferType+ → DeviceHandle → EndpointAddress → ReadAction+readTransferAsync wait transType = \devHndl endpointAddr → \size timeout → createAndTrimNoOffset size $ \bufferPtr →- transferAsync transType+ transferAsync wait+ transType devHndl (marshalEndpointAddress endpointAddr) timeout (bufferPtr, size) -writeTransferAsync ∷ C'TransferType → DeviceHandle → EndpointAddress → WriteAction-writeTransferAsync transType = \devHndl endpointAddr → \input timeout →+writeTransferAsync ∷ Wait+ → C'TransferType+ → DeviceHandle → EndpointAddress → WriteAction+writeTransferAsync wait transType = \devHndl endpointAddr → \input timeout → BU.unsafeUseAsCStringLen input $- transferAsync transType+ transferAsync wait+ transType devHndl (marshalEndpointAddress endpointAddr) timeout @@ -1829,13 +1878,15 @@ type C'TransferType = CUChar -transferAsync ∷ C'TransferType+transferAsync ∷ Wait+ → C'TransferType → DeviceHandle → CUChar -- ^ Encoded endpoint address → Timeout → (Ptr byte, Size) → IO (Size, Status)-transferAsync transType devHndl endpoint timeout bytes =- withTerminatedTransfer transType+transferAsync wait transType devHndl endpoint timeout bytes =+ withTerminatedTransfer wait+ transType 0 [] devHndl endpoint timeout@@ -1849,7 +1900,8 @@ -------------------------------------------------------------------------------- -withTerminatedTransfer ∷ C'TransferType+withTerminatedTransfer ∷ Wait+ → C'TransferType → Int → [C'libusb_iso_packet_descriptor] → DeviceHandle → CUChar -- ^ Encoded endpoint address → Timeout@@ -1857,7 +1909,8 @@ → (Ptr C'libusb_transfer → IO α) → (Ptr C'libusb_transfer → IO α) → IO α-withTerminatedTransfer transType+withTerminatedTransfer wait+ transType nrOfIsoPackets isoPackageDescs devHndl endpoint timeout@@ -1866,28 +1919,8 @@ onTimeout = withDevHndlPtr devHndl $ \devHndlPtr → 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@@ -1906,7 +1939,7 @@ mask_ $ do handleUSBException $ c'libusb_submit_transfer transPtr- waitForTermination+ wait timeout lock transPtr status ← peek $ p'libusb_transfer'status transPtr case status of@@ -2009,20 +2042,21 @@ → Timeout → IO [B.ByteString] readIsochronous devHndl endpointAddr sizes timeout- | not threaded = needThreadedRTSError "readIsochronous"- | otherwise = do- let SumLength totalSize nrOfIsoPackets = sumLength sizes- allocaBytes totalSize $ \bufferPtr →- withTerminatedTransfer c'LIBUSB_TRANSFER_TYPE_ISOCHRONOUS- nrOfIsoPackets (map initIsoPacketDesc sizes)- devHndl- (marshalEndpointAddress endpointAddr)- timeout- (bufferPtr, totalSize)- (\transPtr → convertIsos nrOfIsoPackets- transPtr- bufferPtr)- (\_ → throwIO TimeoutException)+ | Just wait ← getWait devHndl = do+ let SumLength totalSize nrOfIsoPackets = sumLength sizes+ allocaBytes totalSize $ \bufferPtr →+ withTerminatedTransfer wait+ c'LIBUSB_TRANSFER_TYPE_ISOCHRONOUS+ nrOfIsoPackets (map initIsoPacketDesc sizes)+ devHndl+ (marshalEndpointAddress endpointAddr)+ timeout+ (bufferPtr, totalSize)+ (\transPtr → convertIsos nrOfIsoPackets+ transPtr+ bufferPtr)+ (\_ → throwIO TimeoutException)+ | otherwise = needThreadedRTSError "readIsochronous" -------------------------------------------------------------------------------- @@ -2049,23 +2083,24 @@ → Timeout → IO [Size] writeIsochronous devHndl endpointAddr isoPackets timeout- | not threaded = needThreadedRTSError "writeIsochronous"- | otherwise = do- let sizes = map B.length isoPackets- SumLength totalSize nrOfIsoPackets = sumLength sizes- allocaBytes totalSize $ \bufferPtr → do- copyIsos (castPtr bufferPtr) isoPackets- withTerminatedTransfer c'LIBUSB_TRANSFER_TYPE_ISOCHRONOUS- nrOfIsoPackets (map initIsoPacketDesc sizes)- devHndl- (marshalEndpointAddress endpointAddr)- timeout- (bufferPtr, totalSize)- (\transPtr →- map actualLength <$> peekIsoPacketDescs- nrOfIsoPackets- transPtr)- (\_ → throwIO TimeoutException)+ | Just wait ← getWait devHndl = do+ let sizes = map B.length isoPackets+ SumLength totalSize nrOfIsoPackets = sumLength sizes+ allocaBytes totalSize $ \bufferPtr → do+ copyIsos (castPtr bufferPtr) isoPackets+ withTerminatedTransfer wait+ c'LIBUSB_TRANSFER_TYPE_ISOCHRONOUS+ nrOfIsoPackets (map initIsoPacketDesc sizes)+ devHndl+ (marshalEndpointAddress endpointAddr)+ timeout+ (bufferPtr, totalSize)+ (\transPtr →+ map actualLength <$> peekIsoPacketDescs+ nrOfIsoPackets+ transPtr)+ (\_ → throwIO TimeoutException)+ | otherwise = needThreadedRTSError "writeIsochronous" -------------------------------------------------------------------------------- @@ -2136,7 +2171,7 @@ -- | @checkUSBException action@ executes @action@. If @action@ returned a -- negative integer the integer is converted to a 'USBException' and thrown. If -- not, the integer is returned.-checkUSBException ∷ Integral α ⇒ IO α → IO Int+checkUSBException ∷ (Integral α, Show α) ⇒ IO α → IO Int checkUSBException action = do r ← action if r < 0 then throwIO $ convertUSBException r@@ -2144,7 +2179,7 @@ -- | Convert a @C'libusb_error@ to a 'USBException'. If the @C'libusb_error@ is -- unknown an 'error' is thrown.-convertUSBException ∷ Num α ⇒ α → USBException+convertUSBException ∷ (Num α, Eq α, Show α) ⇒ α → USBException convertUSBException err = fromMaybe unknownLibUsbError $ lookup err libusb_error_to_USBException where
System/USB/Descriptors.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Descriptors
System/USB/DeviceHandling.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Devices
System/USB/Enumeration.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Devices
System/USB/Exceptions.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Exceptions
System/USB/IO.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE CPP, UnicodeSyntax, NoImplicitPrelude #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ -------------------------------------------------------------------------------- -- | -- Module : System.USB.IO
System/USB/IO/StandardDeviceRequests.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE CPP, NoImplicitPrelude, UnicodeSyntax, DeriveDataTypeable #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ -------------------------------------------------------------------------------- -- | -- Module : System.USB.IO.StandardDeviceRequests
System/USB/Initialization.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Init
System/USB/Internal.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Unsafe #-}+#endif+ -------------------------------------------------------------------------------- -- | -- Module : System.USB.Unsafe@@ -35,7 +39,7 @@ -- * Useful types and functions for asynchronous implementations , C'TransferType - , threaded+ , getWait, Wait , allocaTransfer , withCallback@@ -43,8 +47,6 @@ , SumLength(..), sumLength , peekIsoPacketDescs , initIsoPacketDesc-- , getCtx, getEventManager -- ** Locks , Lock, newLock, acquire, release
Utils.hs view
@@ -11,10 +11,7 @@ -------------------------------------------------------------------------------- -- from base:-import Prelude ( (+), (-), (^)- , Enum, toEnum, fromEnum- , Integral, fromIntegral- )+import Prelude ( (+), (-), Enum, toEnum, fromEnum, Integral, fromIntegral ) #if __GLASGOW_HASKELL__ < 700 import Prelude ( fromInteger )@@ -43,7 +40,7 @@ -- | @bits s e b@ extract bit @s@ to @e@ (including) from @b@. bits ∷ Bits α ⇒ Int → Int → α → α-bits s e b = (2 ^ (e - s + 1) - 1) .&. (b `shiftR` s)+bits s e b = ((1 `shiftL` (e - s + 1)) - 1) .&. (b `shiftR` s) -- | @between n b e@ tests if @n@ is between the given bounds @b@ and @e@ -- (including).
usb.cabal view
@@ -1,15 +1,15 @@ name: usb-version: 1.0+version: 1.1 cabal-version: >=1.6 build-type: Custom license: BSD3 license-file: LICENSE-copyright: 2009–2011 Bas van Dijk <v.dijk.bas@gmail.com>+copyright: 2009–2012 Bas van Dijk <v.dijk.bas@gmail.com> author: Bas van Dijk <v.dijk.bas@gmail.com> maintainer: Bas van Dijk <v.dijk.bas@gmail.com>-homepage: https://github.com/basvandijk/usb/+homepage: https://github.com/basvandijk/usb bug-reports: https://github.com/basvandijk/usb/issues-category: System+category: System, Hardware synopsis: Communicate with USB devices description: This library enables you to communicate with USB devices from userspace. It is implemented as a high-level wrapper around@@ -78,7 +78,7 @@ 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.4.4 && < 1.5 , bytestring >= 0.9 && < 0.10