usb-safe 0.11.0.2 → 0.12
raw patch · 2 files changed
+65/−75 lines, 2 filesdep +monad-controldep +textdep −monad-peeldep ~iterateedep ~regionsdep ~usb
Dependencies added: monad-control, text
Dependencies removed: monad-peel
Dependency ranges changed: iteratee, regions, usb, usb-enumerator
Files
- System/USB/Safe.hs +58/−69
- usb-safe.cabal +7/−6
System/USB/Safe.hs view
@@ -146,10 +146,10 @@ , ReadAction , WriteAction - , readEndpoint- , writeEndpoint+ , ReadEndpoint(readEndpoint)+ , WriteEndpoint(writeEndpoint) - , enumReadEndpoint+ , EnumReadEndpoint(enumReadEndpoint) -- ** Control transfers , ControlAction@@ -178,12 +178,11 @@ -- from base: import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, withMVar ) import Control.Monad ( Monad, return, (>>=), (>>), liftM )-import Control.Exception ( Exception, throwIO )+import Control.Exception ( Exception, bracket_ ) import Data.Typeable ( Typeable ) import Data.Function ( ($) ) import Data.Word ( Word8 ) import Data.Int ( Int )-import Data.Char ( String ) import Data.Bool ( Bool(True, False) ) import Data.List ( map, head, filter, find ) import Data.Maybe ( Maybe(Nothing, Just), fromJust )@@ -203,13 +202,15 @@ -- from bytestring: import Data.ByteString ( ByteString ) +-- from text:+import Data.Text ( Text )+ -- from transformers: import Control.Monad.IO.Class ( MonadIO, liftIO ) --- from monad-peel:-import Control.Monad.IO.Peel ( MonadPeelIO )-import Control.Exception.Peel ( bracket_, block )-import qualified Control.Exception.Peel as P ( throwIO )+-- from monad-control:+import Control.Monad.IO.Control ( MonadControlIO, liftIOOp_ )+import Control.Exception.Control ( throwIO ) -- from regions: import Control.Monad.Trans.Region.OnExit ( FinalizerHandle, onExit )@@ -238,7 +239,9 @@ , InterfaceNumber, claimInterface, releaseInterface , setInterfaceAltSetting , clearHalt, resetDevice- , kernelDriverActive, detachKernelDriver, attachKernelDriver+ , kernelDriverActive+ , detachKernelDriver, attachKernelDriver+ , withDetachedKernelDriver ) import qualified System.USB.Descriptors as USB@@ -276,7 +279,15 @@ import qualified System.USB.IO.Synchronous.Enumerator as USB ( enumReadBulk, enumReadInterrupt ) +#if MIN_VERSION_base(4,3,0)+import Control.Exception.Control ( mask_ )+#else+import Control.Exception.Control ( block )+mask_ ∷ MonadControlIO m ⇒ m α → m α+mask_ = block+#endif + -------------------------------------------------------------------------------- -- ** Regional device handles --------------------------------------------------------------------------------@@ -310,9 +321,9 @@ * Another 'USB.USBException'. -}-openDevice ∷ MonadPeelIO pr+openDevice ∷ MonadControlIO pr ⇒ USB.Device → RegionT s pr (RegionalDeviceHandle (RegionT s pr))-openDevice dev = block $ do+openDevice dev = mask_ $ do h ← liftIO $ USB.openDevice dev mv ← liftIO $ newMVar False ch ← onExit $ USB.closeDevice h@@ -321,7 +332,7 @@ {-| Convenience function which opens the device, applies the given continuation function to the resulting regional device handle and runs the resulting region. -}-withDevice ∷ MonadPeelIO pr+withDevice ∷ MonadControlIO pr ⇒ USB.Device → (∀ s. RegionalDeviceHandle (RegionT s pr) → RegionT s pr α) → pr α@@ -344,7 +355,7 @@ * Another 'USB.USBException'. -} withDeviceWhich ∷ ∀ pr α- . MonadPeelIO pr+ . MonadControlIO pr ⇒ USB.Ctx → (USB.DeviceDesc → Bool) -- ^ Predicate on the device descriptor. → (∀ s. RegionalDeviceHandle (RegionT s pr) → RegionT s pr α)@@ -360,7 +371,7 @@ -- See: http://thread.gmane.org/gmane.comp.lang.haskell.glasgow.user/19134/focus=19153 -- A solution is to just inline the code of useWhich: (I know this is ugly!) case find (p ∘ getDesc) devs of- Nothing → P.throwIO USB.NotFoundException+ Nothing → throwIO USB.NotFoundException Just dev → withDevice dev f #endif @@ -376,7 +387,7 @@ → k -- ^ Continuation function → m α useWhich ds w p f = case find (p ∘ getDesc) ds of- Nothing → P.throwIO USB.NotFoundException+ Nothing → throwIO USB.NotFoundException Just d → w d f -- | Internally used function for getting the actual USB device handle from a@@ -538,7 +549,7 @@ * Another 'USB.USBException'. -} setConfig ∷ ∀ pr cr α- . (pr `AncestorRegion` cr, MonadPeelIO cr)+ . (pr `AncestorRegion` cr, MonadControlIO cr) ⇒ Config pr -- ^ The configuration you wish to set. → (∀ sCfg. ConfigHandle sCfg → cr α) -- ^ Continuation function. → cr α@@ -551,20 +562,21 @@ -- 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 ∷ MonadPeelIO m ⇒ MVar Bool → m α → m α-withUnsettedMVar mv = bracket_ (liftIO $ do alreadySet ← takeMVar mv- if alreadySet- then do putMVar mv alreadySet- throwIO SettingAlreadySet- else putMVar mv True)- (liftIO $ overwriteMVar mv False)+withUnsettedMVar ∷ MonadControlIO m ⇒ MVar Bool → m α → m α+withUnsettedMVar mv = liftIOOp_ $ bracket_+ (do alreadySet ← takeMVar mv+ if alreadySet+ then do putMVar mv alreadySet+ throwIO SettingAlreadySet+ else putMVar mv True)+ (overwriteMVar mv False) -- | Internally used function which sets the @MVar@ before the computation is -- performed. When the computation terminates, wheter normally or by raising an -- exception, the @MVar@ will be unset again.-withSettedMVar ∷ MonadPeelIO m ⇒ MVar Bool → m α → m α-withSettedMVar mv = bracket_ (liftIO $ overwriteMVar mv True)- (liftIO $ overwriteMVar mv False)+withSettedMVar ∷ MonadControlIO m ⇒ MVar Bool → m α → m α+withSettedMVar mv = liftIOOp_ $ bracket_ (overwriteMVar mv True)+ (overwriteMVar mv False) -- | Internally used function which overwrites the value in the @MVar@. --@@ -605,7 +617,7 @@ * Another 'USB.USBException'. -} useActiveConfig ∷ ∀ pr cr α- . (pr `AncestorRegion` cr, MonadPeelIO cr)+ . (pr `AncestorRegion` cr, MonadControlIO cr) ⇒ RegionalDeviceHandle pr -- ^ Regional handle to the device -- from which you want to use the -- active configuration.@@ -615,7 +627,7 @@ withSettedMVar mv $ do mbActiveConfigValue ← liftIO $ USB.getConfig internalDevHndl case mbActiveConfigValue of- Nothing → P.throwIO NoActiveConfig+ Nothing → throwIO NoActiveConfig Just activeConfigValue → let activeConfigHandle = ConfigHandle internalDevHndl activeConfigDesc activeConfigDesc = fromJust $ find isActive $ getConfigDescs internalDevHndl@@ -651,7 +663,7 @@ * Another 'USB.USBException'. -} setConfigWhich ∷ ∀ pr cr α- . (pr `AncestorRegion` cr, MonadPeelIO cr)+ . (pr `AncestorRegion` cr, MonadControlIO cr) ⇒ RegionalDeviceHandle pr -- ^ Regional handle to the device for -- which you want to set a -- configuration.@@ -737,19 +749,19 @@ * Another 'USB.USBException'. -} claim ∷ ∀ pr sCfg s- . MonadPeelIO pr+ . MonadControlIO pr ⇒ Interface sCfg -- ^ Interface you wish to claim → RegionT s pr (RegionalInterfaceHandle sCfg (RegionT s pr))-claim interface@(Interface internalDevHndl ifNum _) = block $ do+claim interface@(Interface internalDevHndl ifNum _) = mask_ $ do mv ← liftIO $ newMVar False liftIO $ USB.claimInterface internalDevHndl ifNum ch ← onExit $ USB.releaseInterface internalDevHndl ifNum return $ RegionalInterfaceHandle interface mv ch withInterface ∷ ∀ pr sCfg α- . MonadPeelIO pr+ . MonadControlIO pr ⇒ Interface sCfg -- ^ The interface you wish to claim. → (∀ s. RegionalInterfaceHandle sCfg (RegionT s pr) → RegionT s pr α@@ -774,7 +786,7 @@ -} withInterfaceWhich ∷ ∀ pr sCfg α- . MonadPeelIO pr+ . MonadControlIO pr ⇒ ConfigHandle sCfg -- ^ Handle to a configuration of which -- you want to claim an interface. → (USB.Interface → Bool) -- ^ Predicate on the interface descriptors.@@ -854,7 +866,7 @@ * Another 'USB.USBException'. -} setAlternate ∷ ∀ pr cr sCfg α- . (pr `AncestorRegion` cr, MonadPeelIO cr)+ . (pr `AncestorRegion` cr, MonadControlIO cr) ⇒ Alternate sCfg pr -- ^ The alternate you wish to set. → (∀ sAlt. AlternateHandle sAlt pr → cr α) -- ^ Continuation function. → cr α@@ -885,7 +897,7 @@ * Another 'USB.USBException'. -} useActiveAlternate ∷ ∀ pr cr sCfg α- . (pr `AncestorRegion` cr, MonadPeelIO cr)+ . (pr `AncestorRegion` cr, MonadControlIO cr) ⇒ RegionalInterfaceHandle sCfg pr -- ^ Regional handle to the -- interface from which you want -- to use the active alternate.@@ -924,7 +936,7 @@ * Another 'USB.USBException'. -} setAlternateWhich ∷ ∀ pr cr sCfg α- . (pr `AncestorRegion` cr, MonadPeelIO cr)+ . (pr `AncestorRegion` cr, MonadControlIO cr) ⇒ RegionalInterfaceHandle sCfg pr -- ^ Regional handle to the -- interface for which you want -- to set an alternate.@@ -1159,7 +1171,7 @@ class EnumReadEndpoint transType where -- | An enumerator for an 'In' endpoint -- with either a 'Bulk' or 'Interrupt' transfer type.- enumReadEndpoint ∷ ( pr `AncestorRegion` cr, MonadPeelIO cr, ReadableChunk s Word8+ enumReadEndpoint ∷ ( pr `AncestorRegion` cr, MonadControlIO cr, ReadableChunk s Word8 #if MIN_VERSION_iteratee(0,4,0) , NullPoint s #endif@@ -1332,10 +1344,6 @@ {-| Retrieve a string descriptor from a device. -This is a convenience function which formulates the appropriate control message-to retrieve the descriptor. The string returned is Unicode, as detailed in the-USB specifications.- This function may throw 'USB.USBException's. /TODO: The following can be made more type-safe!/@@ -1352,16 +1360,11 @@ → Int -- ^ Maximum number of characters in the requested string. An -- 'USB.IOException' will be thrown when the requested -- string is larger than this number.- → cr String+ → cr Text getStrDesc devHndl strIx langId size = liftIO $ USB.getStrDesc (getInternalDevHndl devHndl) strIx langId size -{-| Retrieve a string descriptor from a device-using the first supported language.--This is a convenience function which formulates the appropriate control message-to retrieve the descriptor. The string returned is Unicode, as detailed in the-USB specifications.+{-| Retrieve a string descriptor from a device using the first supported language. This function may throw 'USB.USBException's. -}@@ -1371,7 +1374,7 @@ → Int -- ^ Maximum number of characters in the requested -- string. An 'USB.IOException' will be thrown when -- the requested string is larger than this number.- → cr String+ → cr Text getStrDescFirstLang devHndl descStrIx size = liftIO $ USB.getStrDescFirstLang (getInternalDevHndl devHndl) descStrIx size @@ -1448,29 +1451,15 @@ * Another 'USB.USBException'. -}-withDetachedKernelDriver ∷ (pr `AncestorRegion` cr, MonadPeelIO cr)+withDetachedKernelDriver ∷ (pr `AncestorRegion` cr, MonadControlIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber → cr α → cr α-withDetachedKernelDriver regionalDevHndl ifNum action =- ifM (kernelDriverActive regionalDevHndl ifNum)- (bracket_ (detachKernelDriver regionalDevHndl ifNum)- (attachKernelDriver regionalDevHndl ifNum)- action)- action-------------------------------------------------------------------------------------- * Utils------------------------------------------------------------------------------------- | Monadic @if ... then ... else ...@-ifM ∷ Monad m ⇒ m Bool → m α → m α → m α-ifM cM tM eM = do c ← cM- if c- then tM- else eM+withDetachedKernelDriver regionalDevHndl ifNum =+ liftIOOp_ $ USB.withDetachedKernelDriver+ (getInternalDevHndl regionalDevHndl)+ ifNum -- The End ---------------------------------------------------------------------
usb-safe.cabal view
@@ -1,5 +1,5 @@ name: usb-safe-version: 0.11.0.2+version: 0.12 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -71,11 +71,12 @@ GHC-Options: -Wall -fno-warn-orphans build-depends: base >= 4 && < 4.4 , base-unicode-symbols >= 0.1.1 && < 0.3- , usb >= 0.5 && < 0.8- , usb-enumerator >= 0.2 && < 0.3- , iteratee >= 0.3.5 && < 0.8+ , usb >= 0.8 && < 0.9+ , usb-enumerator >= 0.3 && < 0.4+ , iteratee >= 0.3.5 && < 0.9 , bytestring >= 0.9 && < 0.10- , regions >= 0.8 && < 0.9+ , text >= 0.5 && < 0.12+ , regions >= 0.9 && < 0.10 , transformers >= 0.2 && < 0.3- , monad-peel >= 0.1 && < 0.2+ , monad-control >= 0.2 && < 0.3 exposed-modules: System.USB.Safe