diff --git a/System/USB/Safe.hs b/System/USB/Safe.hs --- a/System/USB/Safe.hs +++ b/System/USB/Safe.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UnicodeSyntax #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -99,6 +100,8 @@ , RegionalIfHandle , claim + , withInterfaceWhich + -- * Alternates , Alternate , getAlternates @@ -157,16 +160,21 @@ -------------------------------------------------------------------------------- -- from base: -import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, withMVar) - -import Control.Monad ( when, liftM2 ) - +import Prelude ( fromInteger ) +import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, withMVar ) +import Control.Monad ( Monad, return, (>>=), fail + , (>>), when, liftM2 + ) import Control.Exception ( Exception, throwIO ) import Data.Typeable ( Typeable ) - +import Data.Function ( ($) ) import Data.Word ( Word8, Word16 ) -import Data.List ( filter, find ) -import Data.Maybe ( fromJust ) +import Data.Char ( String ) +import Data.Bool ( Bool( True, False ) ) +import Data.List ( map, head, filter, find ) +import Data.Maybe ( Maybe( Nothing, Just ), fromJust ) +import Text.Show ( Show ) +import System.IO ( IO ) -- from bytestring: import Data.ByteString ( ByteString ) @@ -176,8 +184,11 @@ -- from MonadCatchIO-transformers: import Control.Monad.CatchIO ( MonadCatchIO, bracket_, throw ) + -- from unicode-symbols: -import Prelude.Unicode ( (∘), (≡), (∧) ) +import Data.Bool.Unicode ( (∧) ) +import Data.Eq.Unicode ( (≡) ) +import Data.Function.Unicode ( (∘) ) -- from usb: import qualified System.USB.Enumeration as USB ( Device, deviceDesc ) @@ -280,6 +291,8 @@ closeResource = USB.closeDevice ∘ internalDevHndl +-- | Internally used function for getting the actual USB device handle from a +-- regional device handle. getInternalDevHndl ∷ RegionalDeviceHandle r → USB.DeviceHandle getInternalDevHndl = internalDevHndl ∘ internalHandle @@ -403,6 +416,8 @@ ∘ getInternalDevHndl $ regionalDevHndl +-- | Internally used function for getting all the configuration descriptors of +-- the given device. getConfigDescs ∷ USB.DeviceHandle → [USB.ConfigDesc] getConfigDescs = USB.deviceConfigs ∘ USB.deviceDesc ∘ USB.getDevice @@ -411,7 +426,12 @@ instance Dup Config USB.Device where dup (Config regionalDevHndlC configDesc) = do + -- Duplicating a configuration just means duplicating the associated + -- regional device handle: regionalDevHndlP ← dup regionalDevHndlC + + -- And returning a new configuration with the same parameters of the given + -- one but with a type that is parameterized by the parent region: return $ Config regionalDevHndlP configDesc @@ -474,8 +494,10 @@ liftIO $ USB.setConfig internalDevHndl $ USB.configValue configDesc f $ ConfigHandle devHndl configDesc --- | If the given @MVar@ was set a 'SettingAlreadySet' exception will be --- thrown. If not it will be set before the given computation will be performed. +-- | Internally used function which throws a 'SettingAlreadySet' exception if +-- the given @MVar@ was set. If the given @MVar@ wasn't set it will be set +-- before the given computation is performed. When the computation terminates, +-- wheter normally or by raising an exception, the @MVar@ will be unset again. withUnsettedMVar ∷ MonadCatchIO m ⇒ MVar Bool → m α → m α withUnsettedMVar settingAlreadySetMVar = bracket_ (liftIO $ do settingAlreadySet ← takeMVar settingAlreadySetMVar @@ -629,7 +651,7 @@ data Handle (Interface sCfg) = InterfaceHandle { interface ∷ Interface sCfg - , alternateAlreadySetMVar ∷ MVar Bool + , _alternateAlreadySetMVar ∷ MVar Bool -- ^ A mutable shared variable which keeps track of wheter an -- alternate has been set. See: 'setAlternate'. } @@ -689,23 +711,25 @@ (RegionT (Interface sCfg) s pr)) claim = open -{-| Convenience function which finds the first interfaces of the given -configuration handle which satisfies the given predicate on its descriptor, then -claims that interfaces and applies the given function on the resulting regional -handle. +{-| Convenience function which finds the first interface of the given +configuration handle which satisfies the given predicate on its descriptors, +then claims that interfaces and applies the given continuation function on the +resulting regional handle. -} withInterfaceWhich ∷ MonadCatchIO pr - ⇒ ConfigHandle sCfg - → (USB.Interface → Bool) - → (∀ s. RegionalIfHandle sCfg (RegionT (Interface sCfg) s pr) - → IfRegionT sCfg s pr α - ) + ⇒ ConfigHandle sCfg -- ^ Handle to a configuration of which + -- you want to claim an interface. + → (USB.Interface → Bool) -- ^ Predicate on the interface descriptors. + → (∀ s. RegionalIfHandle sCfg (RegionT (Interface sCfg) s pr) + → IfRegionT sCfg s pr α + ) -- ^ Continuation function. → pr α withInterfaceWhich confHndl p f = case find (p ∘ getDesc) $ getInterfaces confHndl of Nothing → throw NotFound Just intrf → with intrf f + -------------------------------------------------------------------------------- -- * Alternates -------------------------------------------------------------------------------- @@ -999,10 +1023,25 @@ -- | Class of transfer types that support reading. class ReadEndpoint transType where - -- | Read bytes from an 'IN' endpoint with either a 'BULK' or 'INTERRUPT' - -- transfer type. + {-| Read bytes from an 'IN' endpoint with either a 'BULK' or 'INTERRUPT' + transfer type. + + Exceptions: + + * 'PipeException' if the endpoint halted. + + * 'OverflowException' if the device offered more data, + see /Packets and overflows/ in the libusb documentation: + . + + * 'NoDeviceException' if the device has been disconnected. + + * Another 'USBException'. + -} readEndpoint ∷ (pr `ParentOf` cr, MonadIO cr) - ⇒ Endpoint IN transType sAlt pr → ReadAction cr + ⇒ Endpoint IN transType sAlt pr -- ^ The endpoint you wish to + -- read from. + → ReadAction cr instance ReadEndpoint BULK where readEndpoint = transferWith USB.readBulk @@ -1036,10 +1075,21 @@ -- | Class of transfer types that support writing class WriteEndpoint transType where - -- | Write bytes to an 'OUT' endpoint with either a 'BULK' or 'INTERRUPT' - -- transfer type. + {-| Write bytes to an 'OUT' endpoint with either a 'BULK' or 'INTERRUPT' + transfer type. + + Exceptions: + + * 'PipeException' if the endpoint halted. + + * 'NoDeviceException' if the device has been disconnected. + + * Another 'USBException'. + -} writeEndpoint ∷ (pr `ParentOf` cr, MonadIO cr) - ⇒ Endpoint OUT transType sAlt pr → WriteAction cr + ⇒ Endpoint OUT transType sAlt pr -- ^ The endpoint you wish to + -- write to. + → WriteAction cr instance WriteEndpoint BULK where writeEndpoint = transferWith USB.writeBulk diff --git a/usb-safe.cabal b/usb-safe.cabal --- a/usb-safe.cabal +++ b/usb-safe.cabal @@ -1,5 +1,5 @@ name: usb-safe -version: 0.4 +version: 0.4.1 cabal-version: >=1.6 build-type: Simple license: BSD3 @@ -103,11 +103,11 @@ Location: http://code.haskell.org/~basvandijk/code/usb-safe Library - GHC-Options: -O2 -Wall - build-depends: base >= 4 && < 4.2 + GHC-Options: -O2 -Wall -fno-warn-orphans + build-depends: base >= 4 && < 4.3 + , base-unicode-symbols >= 0.1.1 && < 0.2 , usb == 0.3.* , bytestring == 0.9.* - , unicode-symbols == 0.1.* , regions == 0.1.* , transformers >= 0.1.4 && < 0.2 , MonadCatchIO-transformers == 0.0.2.*