usb-safe 0.10 → 0.11
raw patch · 2 files changed
+70/−52 lines, 2 filesdep +monad-peeldep −MonadCatchIO-transformersdep ~basedep ~iterateedep ~regions
Dependencies added: monad-peel
Dependencies removed: MonadCatchIO-transformers
Dependency ranges changed: base, iteratee, regions, usb-enumerator
Files
- System/USB/Safe.hs +64/−46
- usb-safe.cabal +6/−6
System/USB/Safe.hs view
@@ -182,9 +182,8 @@ -------------------------------------------------------------------------------- -- from base:-import Prelude ( fromInteger ) import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, withMVar )-import Control.Monad ( Monad, return, (>>=), fail, (>>), when, liftM )+import Control.Monad ( Monad, return, (>>=), (>>), when, liftM ) import Control.Exception ( Exception, throwIO ) import Data.Typeable ( Typeable ) import Data.Function ( ($) )@@ -197,6 +196,11 @@ import System.IO ( IO ) import Text.Show ( Show ) +#if __GLASGOW_HASKELL__ < 701+import Prelude ( fromInteger )+import Control.Monad ( fail )+#endif+ -- from base-unicode-symbols: import Data.Bool.Unicode ( (∧) ) import Data.Eq.Unicode ( (≡) )@@ -208,11 +212,13 @@ -- from transformers: import Control.Monad.IO.Class ( MonadIO, liftIO ) --- from MonadCatchIO-transformers:-import Control.Monad.CatchIO ( MonadCatchIO, bracket_, throw, block )+-- from monad-peel:+import Control.Monad.IO.Peel ( MonadPeelIO )+import Control.Exception.Peel ( bracket_, block )+import qualified Control.Exception.Peel as P ( throwIO ) -- from regions:-import Control.Monad.Trans.Region.OnExit ( CloseHandle, onExit )+import Control.Monad.Trans.Region.OnExit ( FinalizerHandle, onExit ) import Control.Monad.Trans.Region -- (re-exported entirely) -- from iteratee:@@ -290,7 +296,7 @@ -} data RegionalDeviceHandle (r ∷ * → *) = RegionalDeviceHandle !(USB.DeviceHandle) !(MVar Bool)- !(CloseHandle r)+ !(FinalizerHandle r) instance Dup RegionalDeviceHandle where dup (RegionalDeviceHandle h mv ch) = liftM (RegionalDeviceHandle h mv) $ dup ch@@ -310,7 +316,7 @@ * Another 'USB.USBException'. -}-openDevice ∷ MonadCatchIO pr+openDevice ∷ MonadPeelIO pr ⇒ USB.Device → RegionT s pr (RegionalDeviceHandle (RegionT s pr)) openDevice dev = block $ do h ← liftIO $ USB.openDevice dev@@ -321,7 +327,7 @@ {-| Convenience function which opens the device, applies the given continuation function to the resulting regional device handle and runs the resulting region. -}-withDevice ∷ MonadCatchIO pr+withDevice ∷ MonadPeelIO pr ⇒ USB.Device → (∀ s. RegionalDeviceHandle (RegionT s pr) → RegionT s pr α) → pr α@@ -344,14 +350,25 @@ * Another 'USB.USBException'. -} withDeviceWhich ∷ ∀ pr α- . MonadCatchIO pr+ . MonadPeelIO pr ⇒ USB.Ctx → (USB.DeviceDesc → Bool) -- ^ Predicate on the device descriptor. → (∀ s. RegionalDeviceHandle (RegionT s pr) → RegionT s pr α) -- ^ Continuation function → pr α-withDeviceWhich ctx p f = do devs ← liftIO $ USB.getDevices ctx- useWhich devs withDevice p f+withDeviceWhich ctx p f = do+ devs ← liftIO $ USB.getDevices ctx+#if __GLASGOW_HASKELL__ < 700+ useWhich devs withDevice p f+#else+ -- GHC-7 simplified the treatment of impredicativity+ -- which unfortunately causes the above to break.+ -- 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+ Just dev → withDevice dev f+#endif -- | Internally used function which searches through the given list of USB -- entities (like Devices, Configs, Interfaces or Alternates) for the first@@ -365,7 +382,7 @@ → k -- ^ Continuation function → m α useWhich ds w p f = case find (p ∘ getDesc) ds of- Nothing → throw USB.NotFoundException+ Nothing → P.throwIO USB.NotFoundException Just d → w d f -- | Internally used function for getting the actual USB device handle from a@@ -398,7 +415,7 @@ The system will attempt to restore the previous configuration and alternate settings after the reset has completed. -Note the constraint: @pr \`ParentOf\` cr@. This allows this function to be+Note the constraint: @pr \`AncestorRegion\` cr@. This allows this function to be executed in any child region @cr@ of the parent region @pr@ in which the given regional handle was created. @@ -426,7 +443,7 @@ * Another 'USB.USBException'. -}-resetDevice ∷ (pr `ParentOf` cr, MonadIO cr)+resetDevice ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → cr () resetDevice (RegionalDeviceHandle internalDevHndl mv _) = liftIO $ withMVar mv $ \configAlreadySet → if configAlreadySet@@ -527,7 +544,7 @@ * Another 'USB.USBException'. -} setConfig ∷ ∀ pr cr α- . (pr `ParentOf` cr, MonadCatchIO cr)+ . (pr `AncestorRegion` cr, MonadPeelIO cr) ⇒ Config pr -- ^ The configuration you wish to set. → (∀ sCfg. ConfigHandle sCfg → cr α) -- ^ Continuation function. → cr α@@ -540,7 +557,7 @@ -- 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 ∷ MonadPeelIO m ⇒ MVar Bool → m α → m α withUnsettedMVar mv = bracket_ (liftIO $ do alreadySet ← takeMVar mv if alreadySet then do putMVar mv alreadySet@@ -551,7 +568,7 @@ -- | 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 ∷ MonadCatchIO m ⇒ MVar Bool → m α → m α+withSettedMVar ∷ MonadPeelIO m ⇒ MVar Bool → m α → m α withSettedMVar mv = bracket_ (liftIO $ overwriteMVar mv True) (liftIO $ overwriteMVar mv False) @@ -594,7 +611,7 @@ * Another 'USB.USBException'. -} useActiveConfig ∷ ∀ pr cr α- . (pr `ParentOf` cr, MonadCatchIO cr)+ . (pr `AncestorRegion` cr, MonadPeelIO cr) ⇒ RegionalDeviceHandle pr -- ^ Regional handle to the device -- from which you want to use the -- active configuration.@@ -603,7 +620,7 @@ useActiveConfig (RegionalDeviceHandle internalDevHndl mv _) f = withSettedMVar mv $ do activeConfigValue ← liftIO $ USB.getConfig internalDevHndl- when (activeConfigValue ≡ 0) $ throw NoActiveConfig+ when (activeConfigValue ≡ 0) $ P.throwIO NoActiveConfig let activeConfigHandle = ConfigHandle internalDevHndl activeConfigDesc activeConfigDesc = fromJust $ find isActive $ getConfigDescs internalDevHndl isActive = (activeConfigValue ≡) ∘ USB.configValue@@ -638,7 +655,7 @@ * Another 'USB.USBException'. -} setConfigWhich ∷ ∀ pr cr α- . (pr `ParentOf` cr, MonadCatchIO cr)+ . (pr `AncestorRegion` cr, MonadPeelIO cr) ⇒ RegionalDeviceHandle pr -- ^ Regional handle to the device for -- which you want to set a -- configuration.@@ -697,7 +714,7 @@ data RegionalInterfaceHandle sCfg (r ∷ * → *) = RegionalInterfaceHandle !(Interface sCfg) !(MVar Bool)- !(CloseHandle r)+ !(FinalizerHandle r) instance Dup (RegionalInterfaceHandle sCfg) where dup (RegionalInterfaceHandle interface mv ch) =@@ -724,7 +741,7 @@ * Another 'USB.USBException'. -} claim ∷ ∀ pr sCfg s- . MonadCatchIO pr+ . MonadPeelIO pr ⇒ Interface sCfg -- ^ Interface you wish to claim → RegionT s pr (RegionalInterfaceHandle sCfg@@ -736,7 +753,7 @@ return $ RegionalInterfaceHandle interface mv ch withInterface ∷ ∀ pr sCfg α- . MonadCatchIO pr+ . MonadPeelIO pr ⇒ Interface sCfg -- ^ The interface you wish to claim. → (∀ s. RegionalInterfaceHandle sCfg (RegionT s pr) → RegionT s pr α@@ -761,7 +778,7 @@ -} withInterfaceWhich ∷ ∀ pr sCfg α- . MonadCatchIO pr+ . MonadPeelIO pr ⇒ ConfigHandle sCfg -- ^ Handle to a configuration of which -- you want to claim an interface. → (USB.Interface → Bool) -- ^ Predicate on the interface descriptors.@@ -841,7 +858,7 @@ * Another 'USB.USBException'. -} setAlternate ∷ ∀ pr cr sCfg α- . (pr `ParentOf` cr, MonadCatchIO cr)+ . (pr `AncestorRegion` cr, MonadPeelIO cr) ⇒ Alternate sCfg pr -- ^ The alternate you wish to set. → (∀ sAlt. AlternateHandle sAlt pr → cr α) -- ^ Continuation function. → cr α@@ -872,7 +889,7 @@ * Another 'USB.USBException'. -} useActiveAlternate ∷ ∀ pr cr sCfg α- . (pr `ParentOf` cr, MonadCatchIO cr)+ . (pr `AncestorRegion` cr, MonadPeelIO cr) ⇒ RegionalInterfaceHandle sCfg pr -- ^ Regional handle to the -- interface from which you want -- to use the active alternate.@@ -886,9 +903,10 @@ activeAltValue ← liftIO $ USB.getInterfaceAltSetting internalDevHndl ifNum timeout- let activeAlt = fromJust $ find isActive alts- isActive = (activeAltValue ≡) ∘ USB.interfaceAltSetting- f $ AlternateHandle internalDevHndl activeAlt+ let activeAltHandle = AlternateHandle internalDevHndl activeAlt+ activeAlt = fromJust $ find isActive alts+ isActive = (activeAltValue ≡) ∘ USB.interfaceAltSetting+ f activeAltHandle {-| Convenience function which finds the first alternate of the given interface@@ -910,7 +928,7 @@ * Another 'USB.USBException'. -} setAlternateWhich ∷ ∀ pr cr sCfg α- . (pr `ParentOf` cr, MonadCatchIO cr)+ . (pr `AncestorRegion` cr, MonadPeelIO cr) ⇒ RegionalInterfaceHandle sCfg pr -- ^ Regional handle to the -- interface for which you want -- to set an alternate.@@ -1056,7 +1074,7 @@ * Another 'USB.USBException'. -}-clearHalt ∷ (pr `ParentOf` cr, MonadIO cr)+clearHalt ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ Endpoint transDir transType sAlt pr → cr () clearHalt (Endpoint internalDevHndl endpointDesc) = liftIO $ USB.clearHalt internalDevHndl $ USB.endpointAddress endpointDesc@@ -1090,14 +1108,14 @@ * Another 'USB.USBException'. -}- readEndpoint ∷ (pr `ParentOf` cr, MonadIO cr)+ readEndpoint ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ Endpoint In transType sAlt pr → ReadAction cr instance ReadEndpoint Bulk where readEndpoint = transferWith USB.readBulk instance ReadEndpoint Interrupt where readEndpoint = transferWith USB.readInterrupt -transferWith ∷ (pr `ParentOf` cr, MonadIO cr)+transferWith ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ (USB.DeviceHandle → USB.EndpointAddress → α → USB.Timeout → IO β) → (Endpoint transDir transType sAlt pr → α → USB.Timeout → cr β) transferWith f = \endpoint sbs timeout → liftIO $ wrap f endpoint sbs timeout@@ -1131,7 +1149,7 @@ * Another 'USB.USBException'. -}- writeEndpoint ∷ (pr `ParentOf` cr, MonadIO cr)+ writeEndpoint ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ Endpoint Out transType sAlt pr → WriteAction cr @@ -1145,7 +1163,7 @@ class EnumReadEndpoint transType where -- | An enumerator for an 'In' endpoint -- with either a 'Bulk' or 'Interrupt' transfer type.- enumReadEndpoint ∷ ( pr `ParentOf` cr, MonadCatchIO cr, ReadableChunk s Word8+ enumReadEndpoint ∷ ( pr `AncestorRegion` cr, MonadPeelIO cr, ReadableChunk s Word8 #if MIN_VERSION_iteratee(0,4,0) , NullPoint s #endif@@ -1200,7 +1218,7 @@ * Another 'USB.USBException'. -}-control ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr)+control ∷ ∀ pr cr. (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → ControlAction (USB.Timeout → cr ()) control regionalDevHndl = \reqType reqRecipient request value index → \timeout → liftIO $ USB.control (getInternalDevHndl regionalDevHndl)@@ -1221,7 +1239,7 @@ * Another 'USB.USBException'. -}-readControl ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr)+readControl ∷ ∀ pr cr. (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → ControlAction (ReadAction cr) readControl regionalDevHndl = \reqType reqRecipient request value index → \timeout size → liftIO $ USB.readControl (getInternalDevHndl regionalDevHndl)@@ -1236,7 +1254,7 @@ -- | A convenience function similar to 'readControl' which checks if the -- specified number of bytes to read were actually read. -- Throws an 'USB.IOException' if this is not the case.-readControlExact ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr)+readControlExact ∷ ∀ pr cr. (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → ControlAction (USB.Size → USB.Timeout → cr ByteString) readControlExact regionalDevHndl = \reqType reqRecipient request value index → \timeout size →@@ -1259,7 +1277,7 @@ * Another 'USB.USBException'. -}-writeControl ∷ ∀ pr cr. (pr `ParentOf` cr, MonadIO cr)+writeControl ∷ ∀ pr cr. (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → ControlAction (WriteAction cr) writeControl regionalDevHndl = \reqType reqRecipient request value index → \timeout input → liftIO $ USB.writeControl (getInternalDevHndl regionalDevHndl)@@ -1311,7 +1329,7 @@ This function may throw 'USB.USBException's. -}-getLanguages ∷ (pr `ParentOf` cr, MonadIO cr)+getLanguages ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → cr [USB.LangId] getLanguages devHndl = liftIO $ USB.getLanguages (getInternalDevHndl devHndl)@@ -1331,7 +1349,7 @@ words I would like to get a type error when they are some arbitrary number or come from another device. -}-getStrDesc ∷ (pr `ParentOf` cr, MonadIO cr)+getStrDesc ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → USB.StrIx → USB.LangId@@ -1351,7 +1369,7 @@ This function may throw 'USB.USBException's. -}-getStrDescFirstLang ∷ (pr `ParentOf` cr, MonadIO cr)+getStrDescFirstLang ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → USB.StrIx → Int -- ^ Maximum number of characters in the requested@@ -1377,7 +1395,7 @@ * Another 'USB.USBException'. -}-kernelDriverActive ∷ (pr `ParentOf` cr, MonadIO cr)+kernelDriverActive ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber → cr Bool kernelDriverActive regionalDevHndl = liftIO ∘ USB.kernelDriverActive (getInternalDevHndl regionalDevHndl)@@ -1396,7 +1414,7 @@ * Another 'USB.USBException'. -}-detachKernelDriver ∷ (pr `ParentOf` cr, MonadIO cr)+detachKernelDriver ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber → cr () detachKernelDriver regionalDevHndl = liftIO ∘ USB.detachKernelDriver (getInternalDevHndl regionalDevHndl)@@ -1417,7 +1435,7 @@ * Another 'USB.USBException'. -}-attachKernelDriver ∷ (pr `ParentOf` cr, MonadIO cr)+attachKernelDriver ∷ (pr `AncestorRegion` cr, MonadIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber → cr () attachKernelDriver regionalDevHndl = liftIO ∘ USB.attachKernelDriver (getInternalDevHndl regionalDevHndl)@@ -1434,7 +1452,7 @@ * Another 'USB.USBException'. -}-withDetachedKernelDriver ∷ (pr `ParentOf` cr, MonadCatchIO cr)+withDetachedKernelDriver ∷ (pr `AncestorRegion` cr, MonadPeelIO cr) ⇒ RegionalDeviceHandle pr → USB.InterfaceNumber → cr α
usb-safe.cabal view
@@ -1,5 +1,5 @@ name: usb-safe-version: 0.10+version: 0.11 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -69,13 +69,13 @@ Library GHC-Options: -Wall -fno-warn-orphans- build-depends: base >= 4 && < 4.3+ build-depends: base >= 4 && < 4.4 , base-unicode-symbols >= 0.1.1 && < 0.3 , usb >= 0.5 && < 0.7- , usb-enumerator >= 0.1 && < 0.2- , iteratee >= 0.3.5 && < 0.5+ , usb-enumerator >= 0.2 && < 0.3+ , iteratee >= 0.3.5 && < 0.6 , bytestring >= 0.9 && < 0.10- , regions >= 0.6 && < 0.8+ , regions >= 0.8 && < 0.9 , transformers >= 0.2 && < 0.3- , MonadCatchIO-transformers >= 0.2 && < 0.3+ , monad-peel >= 0.1 && < 0.2 exposed-modules: System.USB.Safe