module System.USB.IO.Synchronous.Enumerator
( enumReadBulk
, enumReadInterrupt
) where
import Prelude ( fromIntegral )
import Data.Function ( ($) )
import Data.Int ( Int )
import Data.Maybe ( Maybe(Nothing, Just) )
import Control.Monad ( Monad, return, (>>=), fail )
import System.IO ( IO )
import Text.Show ( show )
import Foreign.Marshal.Alloc ( malloc, mallocBytes, free )
import Foreign.Storable ( Storable, peek, sizeOf )
import Foreign.Ptr ( Ptr, castPtr )
import Prelude.Unicode ( (⋅), (⊥) )
import Data.Function.Unicode ( (∘) )
import Data.Eq.Unicode ( (≢) )
import Data.Bool.Unicode ( (∧) )
import Bindings.Libusb ( c'libusb_bulk_transfer, c'libusb_interrupt_transfer
, c'LIBUSB_SUCCESS, c'LIBUSB_ERROR_TIMEOUT
)
import Control.Monad.IO.Class ( liftIO )
import Control.Monad.CatchIO ( MonadCatchIO, bracket )
import Data.Iteratee.Base ( EnumeratorGM
, StreamG(Chunk)
, IterGV(Done, Cont)
, runIter
, enumErr
, throwErr
)
import Data.Iteratee.Base.StreamChunk ( ReadableChunk (readFromPtr) )
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
)
enumReadBulk ∷ (ReadableChunk s el, MonadCatchIO m)
⇒ DeviceHandle
→ EndpointAddress
→ Timeout
→ Size
→ EnumeratorGM s el m α
enumReadBulk = enumRead c'libusb_bulk_transfer
enumReadInterrupt ∷ (ReadableChunk s el, MonadCatchIO m)
⇒ DeviceHandle
→ EndpointAddress
→ Timeout
→ Size
→ EnumeratorGM s el 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
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
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)