usb 1.3.0.0 → 1.3.0.1
raw patch · 8 files changed
+95/−55 lines, 8 filesdep ~basedep ~ghc-primPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, ghc-prim
API changes (from Hackage documentation)
Files
- Changelog +7/−1
- System/USB.hs +1/−1
- System/USB/Base.hs +80/−30
- System/USB/IO/StandardDeviceRequests.hs +0/−1
- Utils.hs +1/−1
- default.nix +2/−14
- shell.nix +1/−4
- usb.cabal +3/−3
Changelog view
@@ -1,5 +1,10 @@-1.3+1.3.0.1 + * Support GHC-7.10+++1.3.0.0 (Sun Dec 14 23:11:35 UTC 2014)+ * Add hotplug support. * Add the System.USB.IO.Transfers module which separates the@@ -16,6 +21,7 @@ the hasCapability & libusbVersion functions. * Extended the Verbosity type with the PrintDebug constructor.+ 1.2.0.1 (Fri May 23 21:50:20 UTC 2014)
System/USB.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Safe #-} #endif --------------------------------------------------------------------------------
System/USB/Base.hs view
@@ -2,6 +2,7 @@ , NoImplicitPrelude , DeriveDataTypeable , BangPatterns+ , ScopedTypeVariables #-} #if __GLASGOW_HASKELL__ >= 704@@ -44,14 +45,18 @@ import Data.Typeable ( Typeable ) import Data.Maybe ( Maybe(Nothing, Just), maybe, fromMaybe ) import Data.Monoid ( Monoid, mempty, mappend )-import Data.List ( map, lookup, (++), null )+import Data.List import Data.Int ( Int ) import Data.Word ( Word8, Word16 ) import Data.Eq ( Eq, (==), (/=) ) import Data.Ord ( Ord, (<), (>) ) import Data.Bool ( Bool(False, True), not, otherwise, (&&) ) import Data.Bits ( Bits, (.&.), (.|.), setBit, testBit, shiftL, shiftR )-import Data.Version ( Version(Version), versionBranch, versionTags )+import Data.Version ( Version(..)+#if MIN_VERSION_base(4,8,0)+ , makeVersion+#endif+ ) import System.IO ( IO ) import System.IO.Unsafe ( unsafePerformIO ) import Text.Show ( Show, show )@@ -91,9 +96,11 @@ -- from usb (this package): import Utils ( bits, between, genToEnum, genFromEnum, peekVector, mapPeekArray- , allocaPeek, ifM, uncons+ , allocaPeek, ifM ) +import qualified Utils as V ( uncons )+ -------------------------------------------------------------------------------- #ifdef HAS_EVENT_MANAGER@@ -104,14 +111,28 @@ import Foreign.Marshal.Array ( peekArray0, copyArray, advancePtr ) import Foreign.Storable ( Storable, sizeOf, poke, pokeElemOff ) import Foreign.Ptr ( nullFunPtr )+#if MIN_VERSION_base(4,4,0) import Foreign.ForeignPtr.Unsafe ( unsafeForeignPtrToPtr )+#else+import Foreign.ForeignPtr ( unsafeForeignPtrToPtr )+#endif import Control.Monad ( mapM_, forM_, unless ) import Data.IORef ( IORef, newIORef, atomicModifyIORef, readIORef, writeIORef ) import System.Posix.Types ( Fd(Fd) ) import Control.Exception ( uninterruptibleMask_ )-import Control.Concurrent.MVar ( newMVar, withMVar, withMVarMasked )+import Control.Concurrent.MVar+ ( newMVar+ , withMVar+#if MIN_VERSION_base(4,7,0)+ , withMVarMasked+#endif+ ) import System.IO ( hPutStrLn, stderr ) +#if MIN_VERSION_base(4,8,0)+import Unsafe.Coerce ( unsafeCoerce )+#endif+ #if MIN_VERSION_base(4,4,0) import GHC.Event #else@@ -148,7 +169,7 @@ #include "EventConfig.h" #define HAVE_ONE_SHOT \- (__GLASGOW_HASKELL__ >= 708 && \+ (__GLASGOW_HASKELL__ >= 708 && !MIN_VERSION_base(4,8,1) && \ !(defined(darwin_HOST_OS) || defined(ios_HOST_OS)) && \ (defined(HAVE_EPOLL) || defined(HAVE_KQUEUE))) @@ -293,10 +314,17 @@ wait <- determineWait - fmap (Ctx (Just wait)) $ FC.newForeignPtr ctxPtr $ do- finalizeRegisterPollFds- free zeroTimevalPtr- c'libusb_exit ctxPtr+ let finalize :: IO ()+ finalize = do+ finalizeRegisterPollFds+ free zeroTimevalPtr+ c'libusb_exit ctxPtr++ ctxFrgnPtr <- FC.newForeignPtr ctxPtr finalize++ return Ctx{ ctxGetWait = Just wait+ , getCtxFrgnPtr = ctxFrgnPtr+ } where registerPollFds :: IO (IO ()) registerPollFds = do@@ -310,7 +338,7 @@ unregisterAllPollFds fdKeyMapRef where -- Register initial libusb file descriptors with the event manager- -- and return the initial Fd to FdKey association:+ -- and store the Fd to FdKey associations: registerInitialPollFds :: IORef (IntMap FdKey) -> IO () registerInitialPollFds fdKeyMapRef = do -- Get the initial file descriptors:@@ -367,6 +395,18 @@ registerAndInsert :: IO () registerAndInsert = do fdKey <- registerFd evtMgr callback (Fd fd) (Poll.toEvent evt)+ -- In base-4.8 registerFd gains an additonal argument of type+ -- Lifetime. However, because of an oversight, base-4.8 doesn't export+ -- the constructors: OneShot | MultiShot. We therefor use the hack of+ -- unsafely coercing a Bool to a Lifetime.+#if MIN_VERSION_base(4,8,1)+ MultiShot+#elif MIN_VERSION_base(4,8,0)+ -- We would like to use MultiShot (unsafeCoerce True)+ -- registrations. However, base-4.8 has a bug in the MultiShot+ -- implementation which means we have to fall back to OneShot.+ (unsafeCoerce False)+#endif -- Associate the fd with the fdKey: newFdKeyMap <- atomicModifyIORef fdKeyMapRef $ \fdKeyMap ->@@ -377,11 +417,12 @@ callback :: IOCallback callback _fdKey _ev = do #if HAVE_ONE_SHOT- -- In GHC >= 7.8 the system event manager might have- -- one-shot semantics. One-shot semantics means that when an- -- event occurs on a registered fd the fd is unregistered- -- before the callback is called. This usb library only- -- works if registered fds stay registered until they are+ -- In GHC >= 7.8 && <= 7.10.1 the system event manager might+ -- have one-shot semantics. One-shot semantics means that+ -- when an event occurs on a registered fd the fd is+ -- unregistered before the callback is called. This usb+ -- library only works with multi-shot semantics,+ -- i.e. registered fds stay registered until they are -- explicitly unregistered. To work around the one-shot -- semantics we register the fd again when the callback -- fires:@@ -528,11 +569,19 @@ -- | Convert a 'LibusbVersion' to a 'Version' for easy comparison. toVersion :: LibusbVersion -> Version-toVersion (LibusbVersion maj min mic nan rcTag) =- Version { versionBranch = map fromIntegral [maj, min, mic, nan]- , versionTags = if null rcTag then [] else [rcTag]+toVersion (LibusbVersion maj min mic nan _rcTag) =+#if MIN_VERSION_base(4,8,0)+ makeVersion branch+#else+ Version { versionBranch = branch+ , versionTags = if null _rcTag then [] else [_rcTag] }+#endif+ where+ branch :: [Int]+ branch = map fromIntegral [maj, min, mic, nan] + -------------------------------------------------------------------------------- -- | Capabilities supported by an instance of @libusb@ on the current running@@ -708,10 +757,11 @@ -------------------------------------------------------------------------------- --- | Hotplug callback function type.+-- | Hotplug callback function type used in 'registerHotplugCallback'. ----- @libusb@ will call this function later, when a matching event had happened on--- a matching device.+-- @libusb@ will call this function, once registered using+-- 'registerHotplugCallback', when a matching event has happened on a matching+-- device. -- -- This callback may be called by an internal event thread and as such it is -- recommended the callback do minimal processing before returning. In fact, it@@ -784,8 +834,8 @@ -- Register a hotplug callback function with the context. The callback will fire -- when a matching event occurs on a matching device. The callback is armed -- until either it is deregistered with 'deregisterHotplugCallback' or the--- supplied callback returns 'True' to indicate it is finished processing--- events.+-- supplied callback returns 'DeregisterThisCallback' to indicate it is finished+-- processing events. -- -- If the 'enumerate' flag is passed the callback will be called with a -- 'deviceArrived' for all devices already plugged into the machine. Note that@@ -793,7 +843,7 @@ -- calling hotplug callbacks from @libusb_handle_events()@, so it is possible -- for a device to already be present on, or removed from, its internal device -- list, while the hotplug callbacks still need to be dispatched. This means--- that when using the 'enumerate` flag, your callback may be called twice for+-- that when using the 'enumerate' flag, your callback may be called twice for -- the arrival of the same device, once from 'registerHotplugCallback' and once -- from @libusb_handle_events()@; and\/or your callback may be called for the -- removal of a device for which an arrived call was never made.@@ -813,7 +863,7 @@ mbProductId mbDevClass hotplugCallback = do- mbCbFnPtrMv <- newEmptyMVar+ (mbCbFnPtrMv :: MVar (Maybe C'libusb_hotplug_callback_fn)) <- newEmptyMVar let cb :: Ptr C'libusb_context -> Ptr C'libusb_device@@ -833,7 +883,7 @@ return 1 withCtxPtr ctx $ \ctxPtr ->- alloca $ \hotplugCallbackHandlePtr ->+ alloca $ \(hotplugCallbackHandlePtr :: Ptr C'libusb_hotplug_callback_handle) -> mask_ $ do -- We mask to ensure the freeing of cbFnPtr. cbFnPtr <- mk'libusb_hotplug_callback_fn cb putMVar mbCbFnPtrMv $ Just cbFnPtr@@ -1961,7 +2011,7 @@ -> IO Text getStrDescFirstLang devHndl strIx nrOfChars = do langIds <- getLanguages devHndl- case uncons langIds of+ case V.uncons langIds of Nothing -> throwIO $ IOException "Zero languages" Just (langId, _) -> getStrDesc devHndl strIx langId nrOfChars @@ -2986,7 +3036,7 @@ bufferPtr <- castPtr <$> peek (p'libusb_transfer'buffer transPtr) bs <- BI.create len $ \ptr ->- BI.memcpy ptr (bufferPtr `plusPtr` controlSetupSize) len+ BI.memcpy ptr (bufferPtr `plusPtr` controlSetupSize) (fromIntegral len) return (bs, status) @@ -3203,7 +3253,7 @@ len <- fromIntegral <$> peek (p'libusb_transfer'actual_length transPtr) bufferPtr <- castPtr <$> peek (p'libusb_transfer'buffer transPtr) - bs <- BI.create len $ \ptr -> BI.memcpy ptr bufferPtr len+ bs <- BI.create len $ \ptr -> BI.memcpy ptr bufferPtr (fromIntegral len) return (bs, status) @@ -3373,7 +3423,7 @@ withTransPtr transfer $ \transPtr -> do len <- fromIntegral <$> peek (p'libusb_transfer'length transPtr) bufferPtr <- castPtr <$> peek (p'libusb_transfer'buffer transPtr)- BI.create len $ \ptr -> BI.memcpy ptr bufferPtr len+ BI.create len $ \ptr -> BI.memcpy ptr bufferPtr (fromIntegral len) -- | Retrieve the timeout of a bulk or interrupt write transfer. getWriteTransferTimeout :: WriteTransfer -> IO Timeout
System/USB/IO/StandardDeviceRequests.hs view
@@ -58,7 +58,6 @@ #if __GLASGOW_HASKELL__ < 700 import Prelude ( fromInteger )-import Data.Eq ( (==) ) #endif -- from bytestring:
Utils.hs view
@@ -18,7 +18,7 @@ ) #if __GLASGOW_HASKELL__ < 700-import Prelude ( fromInteger )+import Prelude ( fromInteger, fail ) #endif import Control.Monad ( Monad, return, (>>=), (>>) )
default.nix view
@@ -1,14 +1,2 @@-{ cabal, bindingsLibusb, text, vector }:--cabal.mkDerivation (self: {- pname = "usb";- version = "1.3.0.0";- src = ./.;- buildDepends = [ bindingsLibusb text vector ];- meta = {- homepage = "http://basvandijk.github.com/usb";- description = "Communicate with USB devices";- license = self.stdenv.lib.licenses.bsd3;- platforms = self.ghc.meta.platforms;- };-})+let pkgs = import <nixpkgs> {};+in pkgs.haskellPackages.callPackage ./usb.nix {}
shell.nix view
@@ -2,7 +2,7 @@ pkgs = import <nixpkgs> {}; haskellPackages = pkgs.haskellPackages.override { extension = self: super: {- usb = self.callPackage ./. {};+ usb = self.callPackage ./usb.nix {}; bindingsLibusb = self.callPackage ../bindings-libusb {}; }; };@@ -10,9 +10,6 @@ in pkgs.myEnvFun { name = haskellPackages.usb.name; buildInputs = [- #pkgs.curl- #pkgs.git- #pkgs.openssh pkgs.pkgconfig pkgs.libusb1 (haskellPackages.ghcWithPackages (hs: ([
usb.cabal view
@@ -1,5 +1,5 @@ name: usb-version: 1.3.0.0+version: 1.3.0.1 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -60,7 +60,7 @@ Library GHC-Options: -Wall - build-depends: base >= 4 && < 4.8+ build-depends: base >= 4 && < 4.9 , bindings-libusb >= 1.4.5 && < 1.5 , bytestring >= 0.9 && < 0.11 , text >= 0.5 && < 1.3@@ -85,4 +85,4 @@ if impl(ghc >= 7.2.1) cpp-options: -DGENERICS- build-depends: ghc-prim >= 0.2 && < 0.4+ build-depends: ghc-prim >= 0.2 && < 0.5