usb 0.3.1 → 0.4
raw patch · 5 files changed
+149/−129 lines, 5 filesdep +MonadCatchIO-transformers-foreignbuild-type:Customsetup-changed
Dependencies added: MonadCatchIO-transformers-foreign
Files
- Setup.hs +46/−2
- System/USB/IO/Synchronous.hs +4/−0
- System/USB/IO/Synchronous/Enumerator.hs +53/−60
- System/USB/Internal.hs +35/−57
- usb.cabal +11/−10
Setup.hs view
@@ -1,3 +1,47 @@-import Distribution.Simple+#! /usr/bin/env runhaskell -main = defaultMain+{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax #-}++module Main (main) where+++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++-- from base+import Control.Monad ( (>>), return )+import System.IO ( IO )++-- from cabal+import Distribution.Simple ( defaultMainWithHooks+ , simpleUserHooks+ , UserHooks(haddockHook)+ , Args+ )++import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )+import Distribution.Simple.Program ( userSpecifyArgs )+import Distribution.Simple.Setup ( HaddockFlags )+import Distribution.PackageDescription ( PackageDescription(..) )+++-------------------------------------------------------------------------------+-- Cabal setup program with support for 'cabal test' and+-- which sets the CPP define '__HADDOCK __' when haddock is run.+-------------------------------------------------------------------------------++main ∷ IO ()+main = defaultMainWithHooks hooks+ where+ hooks = simpleUserHooks { haddockHook = haddockHook' }++-- Define __HADDOCK__ for CPP when running haddock.+haddockHook' ∷ PackageDescription → LocalBuildInfo → UserHooks → HaddockFlags → IO ()+haddockHook' pkg lbi =+ haddockHook simpleUserHooks pkg (lbi { withPrograms = p })+ where+ p = userSpecifyArgs "haddock" ["--optghc=-D__HADDOCK__"] (withPrograms lbi)+++-- The End ---------------------------------------------------------------------
System/USB/IO/Synchronous.hs view
@@ -18,8 +18,12 @@ , Size -- * Control transfers+ , ControlAction , RequestType(..) , Recipient(..)+ , Request+ , Value+ , Index , control , readControl
System/USB/IO/Synchronous/Enumerator.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, ScopedTypeVariables #-}+{-# LANGUAGE CPP, UnicodeSyntax, NoImplicitPrelude, FlexibleContexts #-} -------------------------------------------------------------------------------- -- |@@ -22,21 +22,17 @@ -------------------------------------------------------------------------------- -- from base:-import Prelude ( fromIntegral )+import Prelude ( fromInteger, fromIntegral ) import Data.Function ( ($) )-import Data.Int ( Int )+import Data.Word ( Word8 ) import Data.Maybe ( Maybe(Nothing, Just) )-import Control.Monad ( Monad, return, (>>=), fail )-import System.IO ( IO )+import Control.Monad ( return, (>>=), fail ) import Text.Show ( show )-import Foreign.Marshal.Alloc ( malloc, mallocBytes, free )-import Foreign.Storable ( Storable, peek, sizeOf )-import Foreign.Ptr ( Ptr, castPtr )+import Foreign.Storable ( peek )+import Foreign.Ptr ( castPtr ) -- from base-unicode-symbols:-import Prelude.Unicode ( (⋅), (⊥) )-import Data.Function.Unicode ( (∘) )-import Data.Eq.Unicode ( (≢) )+import Data.Eq.Unicode ( (≡), (≢) ) import Data.Bool.Unicode ( (∧) ) -- from bindings-libusb:@@ -48,8 +44,11 @@ import Control.Monad.IO.Class ( liftIO ) -- from MonadCatchIO-transformers:-import Control.Monad.CatchIO ( MonadCatchIO, bracket )+import Control.Monad.CatchIO ( MonadCatchIO ) +-- from MonadCatchIO-transformers-foreign:+import Control.Monad.CatchIO.Foreign ( alloca, allocaBytes )+ -- from iteratee: import Data.Iteratee.Base ( EnumeratorGM , StreamG(Chunk)@@ -58,40 +57,45 @@ , enumErr , throwErr )-import Data.Iteratee.Base.StreamChunk ( ReadableChunk (readFromPtr) )+import Data.Iteratee.Base.StreamChunk ( ReadableChunk(readFromPtr) ) -- from myself: import System.USB.DeviceHandling ( DeviceHandle ) import System.USB.Descriptors ( EndpointAddress ) import System.USB.IO.Synchronous ( Timeout, Size )+ import System.USB.Internal ( C'TransferFunc , getDevHndlPtr , marshalEndpointAddress , convertUSBException ) +#ifdef __HADDOCK__+import System.USB.Descriptors ( maxPacketSize, endpointMaxPacketSize )+#endif + -------------------------------------------------------------------------------- -- Enumerators -------------------------------------------------------------------------------- -enumReadBulk ∷ (ReadableChunk s el, MonadCatchIO m)+enumReadBulk ∷ (ReadableChunk s Word8, MonadCatchIO 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. For no -- timeout, use value 0.- → Size -- ^ Chunk size. A good value for this would be- -- the 'endpointMaxPacketSize'.- → EnumeratorGM s el m α+ → EnumeratorGM s Word8 m α enumReadBulk = enumRead c'libusb_bulk_transfer -enumReadInterrupt ∷ (ReadableChunk s el, MonadCatchIO m)+enumReadInterrupt ∷ (ReadableChunk s Word8, MonadCatchIO m) ⇒ DeviceHandle -- ^ A handle for the device to communicate -- with. → EndpointAddress -- ^ The address of a valid 'In' and@@ -100,65 +104,54 @@ -- 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. For no timeout, use -- value 0.- → Size -- ^ Chunk size. A good value for this would- -- be the 'endpointMaxPacketSize'.- → EnumeratorGM s el m α+ → EnumeratorGM s Word8 m α enumReadInterrupt = enumRead c'libusb_interrupt_transfer -------------------------------------------------------------------------------- -enumRead ∷ ∀ s el m α. (ReadableChunk s el, MonadCatchIO m)- ⇒ C'TransferFunc → DeviceHandle- → EndpointAddress- → Timeout- → Size- → EnumeratorGM s el m α-enumRead c'transfer devHndl- endpoint- timeout- chunkSize = \iter ->- genAlloca $ \transferredPtr →- let bufferSize = chunkSize ⋅ sizeOf ((⊥) ∷ el)- in genAllocaBytes bufferSize $ \dataPtr →- let loop i1 = do- err ← liftIO $ c'transfer (getDevHndlPtr devHndl)- (marshalEndpointAddress endpoint)- (castPtr dataPtr)- (fromIntegral bufferSize)- transferredPtr- (fromIntegral timeout)- if err ≢ c'LIBUSB_SUCCESS ∧- err ≢ c'LIBUSB_ERROR_TIMEOUT- then enumErr (show $ convertUSBException err) i1+enumRead ∷ (ReadableChunk s Word8, MonadCatchIO m)+ ⇒ C'TransferFunc → ( DeviceHandle+ → EndpointAddress+ → Size+ → Timeout+ → EnumeratorGM s Word8 m α+ )+enumRead c'transfer = \devHndl+ endpoint+ chunkSize+ timeout → \iter →+ alloca $ \transferredPtr →+ allocaBytes chunkSize $ \dataPtr →+ let loop i1 = do+ err ← liftIO $ c'transfer (getDevHndlPtr devHndl)+ (marshalEndpointAddress endpoint)+ (castPtr dataPtr)+ (fromIntegral chunkSize)+ transferredPtr+ (fromIntegral timeout)+ if err ≢ c'LIBUSB_SUCCESS ∧+ err ≢ c'LIBUSB_ERROR_TIMEOUT+ then enumErr (show $ convertUSBException err) i1+ else do+ t ← liftIO $ peek transferredPtr+ if t ≡ 0+ then return i1 else do- t ← liftIO $ peek transferredPtr s ← liftIO $ readFromPtr dataPtr $ fromIntegral t r ← runIter i1 $ Chunk s case r of Done x _ → return $ return x Cont i2 Nothing → loop i2 Cont _ (Just e) → return $ throwErr e- in loop iter-------------------------------------------------------------------------------------- Utilities-----------------------------------------------------------------------------------genAlloca ∷ (Storable α, MonadCatchIO m) ⇒ (Ptr α → m β) → m β-genAlloca = bracketIO malloc free--genAllocaBytes ∷ (Storable α, MonadCatchIO m) ⇒ Int → (Ptr α → m β) → m β-genAllocaBytes n = bracketIO (mallocBytes n) free--bracketIO ∷ MonadCatchIO m ⇒ IO α → (α → IO γ) → (α → m β) → m β-bracketIO before after = bracket (liftIO before) (liftIO ∘ after)+ in loop iter -- The End ---------------------------------------------------------------------
System/USB/Internal.hs view
@@ -1172,23 +1172,23 @@ {-| 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 'IO' action which, when+A @ReadAction@ is a function which takes a 'Size' which defines how many bytes+to read and a 'Timeout'. The function returns an 'IO' action which, when executed, performs the actual read and returns the 'B.ByteString' that was read paired with a flag which indicates whether a transfer timed out. -}-type ReadAction = Timeout → Size → IO (B.ByteString, Bool)+type ReadAction = Size → Timeout → IO (B.ByteString, Bool) {-| Handy type synonym for write transfers. -A @WriteAction@ is a function which takes a 'Timeout' and the 'B.ByteString' to-write. The function returns an 'IO' action which, when exectued, returns the+A @WriteAction@ is a function which takes a 'B.ByteString' to write and a+'Timeout'. The function returns an 'IO' action which, when exectued, returns the number of bytes that were actually written paired with an flag which indicates whether a transfer timed out. -}-type WriteAction = Timeout → B.ByteString → IO (Size, Bool)+type WriteAction = B.ByteString → Timeout → IO (Size, Bool) --- | A timeout in millseconds. A timeout defines how long a transfer should wait+-- | A timeout in milliseconds. A timeout defines how long a transfer should wait -- before giving up due to no response being received. For no timeout, use value -- 0. type Timeout = Int@@ -1200,6 +1200,9 @@ -- ** Control transfers ------------------------------------------------------------------------------- +-- | Handy type synonym that names the parameters of a control transfer.+type ControlAction α = RequestType → Recipient → Request → Value → Index → α+ data RequestType = Standard | Class | Vendor@@ -1211,13 +1214,19 @@ | ToOther deriving (Enum, Show, Eq, Data, Typeable) +type Request = Word8++-- | (Host-endian)+type Value = Word16++-- | (Host-endian)+type Index = Word16+ marshalRequestType ∷ RequestType → Recipient → Word8 marshalRequestType t r = genFromEnum t `shiftL` 5 .|. genFromEnum r {-| 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.@@ -1228,17 +1237,8 @@ * Another 'USBException'. -}-control ∷ DeviceHandle -- ^ A handle for the device to communicate with.- → RequestType -- ^ The type of request.- → Recipient -- ^ The recipient of the request.- → Word8 -- ^ Request.- → Word16 -- ^ Value.- → Word16 -- ^ Index.- → Timeout -- ^ Timeout (in milliseconds) that this function should- -- wait before giving up due to no response being- -- received. For no timeout, use value 0.- → IO ()-control devHndl reqType reqRecipient request value index timeout =+control ∷ DeviceHandle → ControlAction (Timeout → IO ())+control devHndl = \reqType reqRecipient request value index → \timeout → void $ checkUSBException $ c'libusb_control_transfer (getDevHndlPtr devHndl) (marshalRequestType reqType reqRecipient)@@ -1251,8 +1251,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@@ -1261,18 +1259,12 @@ * Another 'USBException'. -}-readControl ∷ DeviceHandle -- ^ A handle for the device to communicate with.- → RequestType -- ^ The type of request.- → Recipient -- ^ The recipient of the request.- → Word8 -- ^ Request.- → Word16 -- ^ Value.- → Word16 -- ^ Index.- → ReadAction-readControl devHndl reqType reqRecipient request value index = \timeout size →+readControl ∷ DeviceHandle → ControlAction ReadAction+readControl devHndl = \reqType reqRecipient request value index → \size timeout → BI.createAndTrim' size $ \dataPtr → do err ← c'libusb_control_transfer (getDevHndlPtr devHndl)- (setBit (marshalRequestType reqType reqRecipient) 7)+ (marshalRequestType reqType reqRecipient `setBit` 7) request value index@@ -1286,8 +1278,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@@ -1296,14 +1286,8 @@ * Another 'USBException'. -}-writeControl ∷ DeviceHandle -- ^ A handle for the device to communicate with.- → RequestType -- ^ The type of request.- → Recipient -- ^ The recipient of the request.- → Word8 -- ^ Request.- → Word16 -- ^ Value.- → Word16 -- ^ Index.- → WriteAction-writeControl devHndl reqType reqRecipient request value index = \timeout input →+writeControl ∷ DeviceHandle → ControlAction WriteAction+writeControl devHndl = \reqType reqRecipient request value index → \input timeout → input `writeWith` \size dataPtr → do err ← c'libusb_control_transfer (getDevHndlPtr devHndl)@@ -1382,11 +1366,8 @@ deriving (Show, Enum, Data, Typeable) -- | See: USB 2.0 Spec. section 9.4.4-getInterfaceAltSetting ∷ DeviceHandle- → InterfaceNumber- → Timeout- → IO InterfaceAltSetting-getInterfaceAltSetting devHndl ifNum timeout = do+getInterfaceAltSetting ∷ DeviceHandle → InterfaceNumber → Timeout → IO InterfaceAltSetting+getInterfaceAltSetting devHndl ifNum = \timeout → do (bs, _) ← readControl devHndl Standard ToInterface@@ -1401,7 +1382,7 @@ -- | See: USB 2.0 Spec. section 9.4.5 getDeviceStatus ∷ DeviceHandle → Timeout → IO DeviceStatus-getDeviceStatus devHndl timeout = do+getDeviceStatus devHndl = \timeout → do (bs, _) ← readControl devHndl Standard ToDevice@@ -1421,11 +1402,8 @@ } -- | See: USB 2.0 Spec. section 9.4.5-getEndpointStatus ∷ DeviceHandle- → EndpointAddress- → Timeout- → IO Bool-getEndpointStatus devHndl endpointAddr timeout = do+getEndpointStatus ∷ DeviceHandle → EndpointAddress → Timeout → IO Bool+getEndpointStatus devHndl endpointAddr = \timeout → do (bs, _) ← readControl devHndl Standard ToEndpoint@@ -1452,7 +1430,7 @@ -- | See: USB 2.0 Spec. section 9.4.11 synchFrame ∷ DeviceHandle → EndpointAddress → Timeout → IO Int-synchFrame devHndl endpointAddr timeout = do+synchFrame devHndl endpointAddr = \timeout → do (bs, _) ← readControl devHndl Standard ToEndpoint@@ -1577,8 +1555,8 @@ → CUInt -- timeout → IO CInt -- error -readTransfer ∷ C'TransferFunc → DeviceHandle → EndpointAddress → ReadAction-readTransfer c'transfer devHndl endpointAddr = \timeout size →+readTransfer ∷ C'TransferFunc → (DeviceHandle → EndpointAddress → ReadAction)+readTransfer c'transfer = \devHndl endpointAddr → \size timeout → BI.createAndTrim' size $ \dataPtr → do (transferred, timedOut) ← transfer c'transfer devHndl@@ -1588,8 +1566,8 @@ dataPtr return (0, transferred, timedOut) -writeTransfer ∷ C'TransferFunc → DeviceHandle → EndpointAddress → WriteAction-writeTransfer c'transfer devHndl endpointAddr = \timeout input →+writeTransfer ∷ C'TransferFunc → (DeviceHandle → EndpointAddress → WriteAction)+writeTransfer c'transfer = \devHndl endpointAddr → \input timeout → input `writeWith` transfer c'transfer devHndl endpointAddr
usb.cabal view
@@ -1,7 +1,7 @@ name: usb-version: 0.3.1+version: 0.4 cabal-version: >=1.6-build-type: Simple+build-type: Custom license: BSD3 license-file: LICENSE copyright: 2009–2010 Bas van Dijk <v.dijk.bas@gmail.com>@@ -21,14 +21,15 @@ Library GHC-Options: -Wall- build-depends: base >= 4 && < 4.3- , base-unicode-symbols >= 0.1.1 && < 0.3- , bindings-libusb >= 1.3 && < 1.5- , bytestring >= 0.9 && < 0.10- , text >= 0.5 && < 0.8- , iteratee >= 0.3.5 && < 0.4- , transformers >= 0.2 && < 0.3- , MonadCatchIO-transformers >= 0.2 && < 0.3+ build-depends: base >= 4 && < 4.3+ , base-unicode-symbols >= 0.1.1 && < 0.3+ , bindings-libusb >= 1.3 && < 1.5+ , bytestring >= 0.9 && < 0.10+ , text >= 0.5 && < 0.8+ , iteratee >= 0.3.5 && < 0.4+ , transformers >= 0.2 && < 0.3+ , MonadCatchIO-transformers >= 0.2 && < 0.3+ , MonadCatchIO-transformers-foreign >= 0.1 && < 0.2 exposed-modules: System.USB System.USB.Initialization System.USB.Enumeration