{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, ScopedTypeVariables #-}---------------------------------------------------------------------------------- |-- Module : System.USB.IO.Synchronous.Enumerator-- Copyright : (c) 2009–2010 Bas van Dijk-- License : BSD3 (see the file LICENSE)-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>---- /Untested/ /experimental/ enumerators for endpoints.----------------------------------------------------------------------------------moduleSystem.USB.IO.Synchronous.Enumerator(enumReadBulk,enumReadInterrupt)where---------------------------------------------------------------------------------- Imports---------------------------------------------------------------------------------- from base:importPrelude(fromIntegral)importData.Function(($))importData.Int(Int)importData.Maybe(Maybe(Nothing,Just))importControl.Monad(Monad,return,(>>=),fail)importSystem.IO(IO)importText.Show(show)importForeign.Marshal.Alloc(malloc,mallocBytes,free)importForeign.Storable(Storable,peek,sizeOf)importForeign.Ptr(Ptr,castPtr)-- from base-unicode-symbols:importPrelude.Unicode((⋅),(⊥))importData.Function.Unicode((∘))importData.Eq.Unicode((≢))importData.Bool.Unicode((∧))-- from bindings-libusb:importBindings.Libusb(c'libusb_bulk_transfer,c'libusb_interrupt_transfer,c'LIBUSB_SUCCESS,c'LIBUSB_ERROR_TIMEOUT)-- from transformers:importControl.Monad.IO.Class(liftIO)-- from MonadCatchIO-transformers:importControl.Monad.CatchIO(MonadCatchIO,bracket)-- from iteratee:importData.Iteratee.Base(EnumeratorGM,StreamG(Chunk),IterGV(Done,Cont),runIter,enumErr,throwErr)importData.Iteratee.Base.StreamChunk(ReadableChunk(readFromPtr))-- from myself:importSystem.USB.DeviceHandling(DeviceHandle)importSystem.USB.Descriptors(EndpointAddress)importSystem.USB.IO.Synchronous(Timeout,Size)importSystem.USB.Internal(C'TransferFunc,getDevHndlPtr,marshalEndpointAddress,convertUSBException)---------------------------------------------------------------------------------- Enumerators--------------------------------------------------------------------------------enumReadBulk∷(ReadableChunksel,MonadCatchIOm)⇒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.→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'.→EnumeratorGMselmαenumReadBulk=enumReadc'libusb_bulk_transferenumReadInterrupt∷(ReadableChunksel,MonadCatchIOm)⇒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.→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'.→EnumeratorGMselmαenumReadInterrupt=enumReadc'libusb_interrupt_transfer--------------------------------------------------------------------------------enumRead∷∀selmα.(ReadableChunksel,MonadCatchIOm)⇒C'TransferFunc→DeviceHandle→EndpointAddress→Timeout→Size→EnumeratorGMselmαenumReadc'transferdevHndlendpointtimeoutchunkSize=\iter->genAlloca$\transferredPtr→letbufferSize=chunkSize⋅sizeOf((⊥)∷el)ingenAllocaBytesbufferSize$\dataPtr→letloopi1=doerr←liftIO$c'transfer(getDevHndlPtrdevHndl)(marshalEndpointAddressendpoint)(castPtrdataPtr)(fromIntegralbufferSize)transferredPtr(fromIntegraltimeout)iferr≢c'LIBUSB_SUCCESS∧err≢c'LIBUSB_ERROR_TIMEOUTthenenumErr(show$convertUSBExceptionerr)i1elsedot←liftIO$peektransferredPtrs←liftIO$readFromPtrdataPtr$fromIntegraltr←runIteri1$ChunkscaserofDonex_→return$returnxConti2Nothing→loopi2Cont_(Juste)→return$throwErreinloopiter---------------------------------------------------------------------------------- Utilities--------------------------------------------------------------------------------genAlloca∷(Storableα,MonadCatchIOm)⇒(Ptrα→mβ)→mβgenAlloca=bracketIOmallocfreegenAllocaBytes∷(Storableα,MonadCatchIOm)⇒Int→(Ptrα→mβ)→mβgenAllocaBytesn=bracketIO(mallocBytesn)freebracketIO∷MonadCatchIOm⇒IOα→(α→IOγ)→(α→mβ)→mβbracketIObeforeafter=bracket(liftIObefore)(liftIO∘after)-- The End ---------------------------------------------------------------------