usb-enumerator (empty) → 0.1
raw patch · 4 files changed
+264/−0 lines, 4 filesdep +MonadCatchIO-transformersdep +MonadCatchIO-transformers-foreigndep +basebuild-type:Customsetup-changed
Dependencies added: MonadCatchIO-transformers, MonadCatchIO-transformers-foreign, base, base-unicode-symbols, bindings-libusb, iteratee, transformers, usb
Files
- LICENSE +31/−0
- Setup.hs +47/−0
- System/USB/IO/Synchronous/Enumerator.hs +157/−0
- usb-enumerator.cabal +29/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2010 Bas van Dijk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The name of Bas van Dijk and the names of contributors may NOT+ be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,47 @@+#! /usr/bin/env runhaskell++{-# 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/Enumerator.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE CPP, UnicodeSyntax, NoImplicitPrelude, FlexibleContexts #-}++--------------------------------------------------------------------------------+-- |+-- 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>+--+-- Iteratee enumerators for endpoints.+--+--------------------------------------------------------------------------------++module System.USB.IO.Synchronous.Enumerator+ ( enumReadBulk+ , enumReadInterrupt+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Prelude ( fromInteger, fromIntegral )+import Data.Function ( ($) )+import Data.Word ( Word8 )+import Data.Maybe ( Maybe(Nothing, Just) )+import Control.Monad ( return, (>>=), fail )+import Text.Show ( show )+import Foreign.Storable ( peek )+import Foreign.Ptr ( castPtr )++-- from base-unicode-symbols:+import Data.Eq.Unicode ( (≡), (≢) )+import Data.Bool.Unicode ( (∧) )++-- from bindings-libusb:+import Bindings.Libusb ( c'libusb_bulk_transfer, c'libusb_interrupt_transfer+ , c'LIBUSB_SUCCESS, c'LIBUSB_ERROR_TIMEOUT+ )++-- from transformers:+import Control.Monad.IO.Class ( liftIO )++-- from MonadCatchIO-transformers:+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)+ , IterGV(Done, Cont)+ , runIter+ , enumErr+ , throwErr+ )+import Data.Iteratee.Base.StreamChunk ( ReadableChunk(readFromPtr) )++-- from usb:+import System.USB.DeviceHandling ( DeviceHandle )+import System.USB.Descriptors ( EndpointAddress )+import System.USB.IO.Synchronous ( Timeout, Size )++import System.USB.Unsafe ( C'TransferFunc+ , getDevHndlPtr+ , marshalEndpointAddress+ , convertUSBException+ )++#ifdef __HADDOCK__+import System.USB.Descriptors ( maxPacketSize, endpointMaxPacketSize )+#endif+++--------------------------------------------------------------------------------+-- Enumerators+--------------------------------------------------------------------------------++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.+ → EnumeratorGM s Word8 m α+enumReadBulk = enumRead c'libusb_bulk_transfer++enumReadInterrupt ∷ (ReadableChunk s Word8, MonadCatchIO m)+ ⇒ 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.+ → 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.+ → EnumeratorGM s Word8 m α+enumReadInterrupt = enumRead c'libusb_interrupt_transfer+++--------------------------------------------------------------------------------++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+ 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+++-- The End ---------------------------------------------------------------------
+ usb-enumerator.cabal view
@@ -0,0 +1,29 @@+name: usb-enumerator+version: 0.1+cabal-version: >=1.6+build-type: Custom+license: BSD3+license-file: LICENSE+copyright: 2010 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>+stability: experimental+category: System+synopsis: Iteratee enumerators for the usb package+description: This packages provides iteratee enumerators for the @usb@ package.++source-repository head+ Type: darcs+ Location: http://code.haskell.org/~basvandijk/code/usb-enumerator++Library+ GHC-Options: -Wall+ build-depends: base >= 4 && < 4.3+ , base-unicode-symbols >= 0.1.1 && < 0.3+ , bindings-libusb >= 1.3 && < 1.5+ , iteratee >= 0.3.5 && < 0.4+ , transformers >= 0.2 && < 0.3+ , MonadCatchIO-transformers >= 0.2 && < 0.3+ , MonadCatchIO-transformers-foreign >= 0.1 && < 0.2+ , usb >= 0.5 && < 0.6+ exposed-modules: System.USB.IO.Synchronous.Enumerator