usb 0.5.0.1 → 0.6
raw patch · 5 files changed
+178/−205 lines, 5 files
Files
- Data/BCD.hs +0/−49
- System/USB/Descriptors.hs +3/−5
- System/USB/Internal.hs +155/−144
- Utils.hs +19/−5
- usb.cabal +1/−2
− Data/BCD.hs
@@ -1,49 +0,0 @@-{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax, BangPatterns #-}--module Data.BCD ( BCD4, unmarshalBCD4, decodeBCD ) where------------------------------------------------------------------------------------- Imports------------------------------------------------------------------------------------- from base:-import Prelude ( fromInteger, fromIntegral, (-) )-import Control.Monad ( (>>) )-import Data.Bits ( Bits, shiftL, shiftR, bitSize )-import Data.Bool ( otherwise )-import Data.Function ( ($) )-import Data.List ( map )-import Data.Ord ( (<) )-import Data.Int ( Int )-import Data.Word ( Word16 )-------------------------------------------------------------------------------------- Binary Coded Decimals------------------------------------------------------------------------------------- | A decoded 16 bits Binary Coded Decimal using 4 bits for each digit.-type BCD4 = (Int, Int, Int, Int)---- | Decode a @Word16@ as a Binary Coded Decimal using 4 bits per digit.-unmarshalBCD4 ∷ Word16 → BCD4-unmarshalBCD4 abcd = (a, b, c, d)- where- [a, b, c, d] = map fromIntegral $ decodeBCD 4 abcd--{-| @decodeBCD bitsInDigit bcd@ decodes the Binary Coded Decimal @bcd@ to a list-of its encoded digits. @bitsInDigit@, which is usually 4, is the number of bits-used to encode a single digit. See:-<http://en.wikipedia.org/wiki/Binary-coded_decimal>--}-decodeBCD ∷ Bits α ⇒ Int → α → [α]-decodeBCD bitsInDigit abcd = go shftR []- where- shftR = bitSize abcd - bitsInDigit-- go shftL ds | shftL < 0 = ds- | otherwise = let !d = (abcd `shiftL` shftL) `shiftR` shftR- in go (shftL - bitsInDigit) (d : ds)----- The End ---------------------------------------------------------------------
System/USB/Descriptors.hs view
@@ -14,9 +14,8 @@ -- -- Where appropriate, descriptors contain references to string descriptors -- ('StrIx') that provide textual information describing a descriptor in--- human-readable form. The inclusion of string descriptors is optional. If a--- device does not support string descriptors, string reference fields must be--- reset to zero to indicate no string descriptor is available.+-- human-readable form. Note that the inclusion of string descriptors is+-- optional. -- -------------------------------------------------------------------------------- @@ -24,7 +23,7 @@ ( -- * Device descriptor DeviceDesc(..) - , BCD4+ , ReleaseNumber -- | For a database of USB vendors and products see the @usb-id-database@ -- package at: <http://hackage.haskell.org/package/usb-id-database>@@ -69,4 +68,3 @@ ) where import System.USB.Internal-import Data.BCD ( BCD4 )
System/USB/Internal.hs view
@@ -30,14 +30,14 @@ import Data.Functor ( Functor, fmap, (<$>) ) import Data.Data ( Data ) import Data.Typeable ( Typeable )-import Data.Maybe ( fromMaybe )+import Data.Maybe ( Maybe(Nothing, Just), fromMaybe ) import Data.List ( lookup, map, (++) ) import Data.Int ( Int ) import Data.Word ( Word8, Word16 ) import Data.Char ( String ) import Data.Eq ( Eq, (==) ) import Data.Ord ( Ord, (<), (>) )-import Data.Bool ( Bool(False, True), not )+import Data.Bool ( Bool(False, True), not, otherwise ) import Data.Bits ( Bits, (.|.), setBit, testBit, shiftL ) import System.IO ( IO ) import Text.Show ( Show, show )@@ -50,20 +50,26 @@ import Data.Eq.Unicode ( (≢), (≡) ) -- from bytestring:-import qualified Data.ByteString as B ( ByteString, packCStringLen, drop )+import qualified Data.ByteString as B ( ByteString, packCStringLen ) import qualified Data.ByteString.Internal as BI ( createAndTrim, createAndTrim' ) import qualified Data.ByteString.Unsafe as BU ( unsafeUseAsCStringLen ) -- from text:-import qualified Data.Text as T ( unpack )-import qualified Data.Text.Encoding as TE ( decodeUtf16LE )+import qualified Data.Text.Foreign as T ( fromPtr )+import qualified Data.Text as T ( unpack ) -- from bindings-libusb: import Bindings.Libusb -- from usb:-import Data.BCD ( BCD4, unmarshalBCD4 )-import Utils ( bits, between, void, genToEnum, genFromEnum, mapPeekArray, ifM )+import Utils ( bits+ , between+ , void+ , genToEnum, genFromEnum+ , mapPeekArray+ , ifM+ , decodeBCD+ ) --------------------------------------------------------------------------------@@ -154,13 +160,13 @@ @(==) = (==) \`on\` `deviceDesc`@ -} data Device = Device- { _ctx ∷ Ctx -- ^ This reference to the 'Ctx' is needed so that it won't- -- get garbage collected. The finalizer "p'libusb_exit" is- -- run only when all references to 'Devices' are gone.+ { _ctx ∷ !Ctx -- ^ This reference to the 'Ctx' is needed so that it won't+ -- get garbage collected. The finalizer "p'libusb_exit" is+ -- run only when all references to 'Devices' are gone. - , getDevFrgnPtr ∷ ForeignPtr C'libusb_device+ , getDevFrgnPtr ∷ !(ForeignPtr C'libusb_device) - , deviceDesc ∷ DeviceDesc -- ^ Get the descriptor of the device.+ , deviceDesc ∷ !DeviceDesc -- ^ Get the descriptor of the device. } deriving Typeable instance Eq Device where@@ -254,11 +260,11 @@ a device handle you should close it by applying 'closeDevice' to it. -} data DeviceHandle = DeviceHandle- { getDevice ∷ Device -- This reference is needed for keeping the 'Device'- -- and therefor the 'Ctx' alive.- -- ^ Retrieve the 'Device' from the 'DeviceHandle'.- , getDevHndlPtr ∷ Ptr C'libusb_device_handle- -- ^ Retrieve the pointer to the @libusb@ device handle.+ { getDevice ∷ !Device -- This reference is needed for keeping the 'Device'+ -- and therefor the 'Ctx' alive.+ -- ^ Retrieve the 'Device' from the 'DeviceHandle'.+ , getDevHndlPtr ∷ !(Ptr C'libusb_device_handle)+ -- ^ Retrieve the pointer to the @libusb@ device handle. } deriving Typeable instance Eq DeviceHandle where@@ -642,48 +648,50 @@ This structure can be retrieved by 'deviceDesc'. -} data DeviceDesc = DeviceDesc- { -- | USB specification release number in binary-coded decimal.- deviceUSBSpecReleaseNumber ∷ BCD4+ { -- | USB specification release number.+ deviceUSBSpecReleaseNumber ∷ !ReleaseNumber -- | USB-IF class code for the device.- , deviceClass ∷ Word8+ , deviceClass ∷ !Word8 -- | USB-IF subclass code for the device, qualified by the 'deviceClass' -- value.- , deviceSubClass ∷ Word8+ , deviceSubClass ∷ !Word8 -- | USB-IF protocol code for the device, qualified by the 'deviceClass' -- and 'deviceSubClass' values.- , deviceProtocol ∷ Word8+ , deviceProtocol ∷ !Word8 -- | Maximum packet size for endpoint 0.- , deviceMaxPacketSize0 ∷ Word8+ , deviceMaxPacketSize0 ∷ !Word8 -- | USB-IF vendor ID.- , deviceVendorId ∷ VendorId+ , deviceVendorId ∷ !VendorId -- | USB-IF product ID.- , deviceProductId ∷ ProductId+ , deviceProductId ∷ !ProductId - -- | Device release number in binary-coded decimal.- , deviceReleaseNumber ∷ BCD4+ -- | Device release number.+ , deviceReleaseNumber ∷ !ReleaseNumber - -- | Index of string descriptor describing manufacturer.- , deviceManufacturerStrIx ∷ StrIx+ -- | Optional index of string descriptor describing manufacturer.+ , deviceManufacturerStrIx ∷ !(Maybe StrIx) - -- | Index of string descriptor describing product.- , deviceProductStrIx ∷ StrIx+ -- | Optional index of string descriptor describing product.+ , deviceProductStrIx ∷ !(Maybe StrIx) - -- | Index of string descriptor containing device serial number.- , deviceSerialNumberStrIx ∷ StrIx+ -- | Optional index of string descriptor containing device serial number.+ , deviceSerialNumberStrIx ∷ !(Maybe StrIx) -- | Number of possible configurations.- , deviceNumConfigs ∷ Word8+ , deviceNumConfigs ∷ !Word8 -- | List of configurations supported by the device.- , deviceConfigs ∷ [ConfigDesc]+ , deviceConfigs ∷ ![ConfigDesc] } deriving (Show, Read, Eq, Data, Typeable) +type ReleaseNumber = (Int, Int, Int, Int)+ type VendorId = Word16 type ProductId = Word16 @@ -699,29 +707,29 @@ -} data ConfigDesc = ConfigDesc { -- | Identifier value for the configuration.- configValue ∷ ConfigValue+ configValue ∷ !ConfigValue - -- | Index of string descriptor describing the configuration.- , configStrIx ∷ StrIx+ -- | Optional index of string descriptor describing the configuration.+ , configStrIx ∷ !(Maybe StrIx) -- | Configuration characteristics.- , configAttribs ∷ ConfigAttribs+ , configAttribs ∷ !ConfigAttribs -- | Maximum power consumption of the USB device from the bus in the -- configuration when the device is fully operational. Expressed in 2 mA -- units (i.e., 50 = 100 mA).- , configMaxPower ∷ Word8+ , configMaxPower ∷ !Word8 -- | Number of interfaces supported by the configuration.- , configNumInterfaces ∷ Word8+ , configNumInterfaces ∷ !Word8 -- | List of interfaces supported by the configuration. Note that the -- length of this list should equal 'configNumInterfaces'.- , configInterfaces ∷ [Interface]+ , configInterfaces ∷ ![Interface] -- | Extra descriptors. If @libusb@ encounters unknown configuration -- descriptors, it will store them here, should you wish to parse them.- , configExtra ∷ B.ByteString+ , configExtra ∷ !B.ByteString } deriving (Show, Read, Eq, Data, Typeable) @@ -737,12 +745,12 @@ type ConfigAttribs = DeviceStatus data DeviceStatus = DeviceStatus- { remoteWakeup ∷ Bool -- ^ The Remote Wakeup field indicates whether the- -- device is currently enabled to request remote- -- wakeup. The default mode for devices that- -- support remote wakeup is disabled.- , selfPowered ∷ Bool -- ^ The Self Powered field indicates whether the- -- device is currently self-powered+ { remoteWakeup ∷ !Bool -- ^ The Remote Wakeup field indicates whether the+ -- device is currently enabled to request remote+ -- wakeup. The default mode for devices that+ -- support remote wakeup is disabled.+ , selfPowered ∷ !Bool -- ^ The Self Powered field indicates whether the+ -- device is currently self-powered } deriving (Show, Read, Eq, Data, Typeable) --------------------------------------------------------------------------------@@ -757,31 +765,31 @@ -} data InterfaceDesc = InterfaceDesc { -- | Number of the interface.- interfaceNumber ∷ InterfaceNumber+ interfaceNumber ∷ !InterfaceNumber -- | Value used to select the alternate setting for the interface.- , interfaceAltSetting ∷ InterfaceAltSetting+ , interfaceAltSetting ∷ !InterfaceAltSetting -- | USB-IF class code for the interface.- , interfaceClass ∷ Word8+ , interfaceClass ∷ !Word8 -- | USB-IF subclass code for the interface, qualified by the -- 'interfaceClass' value.- , interfaceSubClass ∷ Word8+ , interfaceSubClass ∷ !Word8 -- | USB-IF protocol code for the interface, qualified by the -- 'interfaceClass' and 'interfaceSubClass' values.- , interfaceProtocol ∷ Word8+ , interfaceProtocol ∷ !Word8 - -- | Index of string descriptor describing the interface.- , interfaceStrIx ∷ StrIx+ -- | Optional index of string descriptor describing the interface.+ , interfaceStrIx ∷ !(Maybe StrIx) -- | List of endpoints supported by the interface.- , interfaceEndpoints ∷ [EndpointDesc]+ , interfaceEndpoints ∷ ![EndpointDesc] -- | Extra descriptors. If @libusb@ encounters unknown interface -- descriptors, it will store them here, should you wish to parse them.- , interfaceExtra ∷ B.ByteString+ , interfaceExtra ∷ !B.ByteString } deriving (Show, Read, Eq, Data, Typeable) @@ -796,30 +804,30 @@ -} data EndpointDesc = EndpointDesc { -- | The address of the endpoint described by the descriptor.- endpointAddress ∷ EndpointAddress+ endpointAddress ∷ !EndpointAddress -- | Attributes which apply to the endpoint when it is configured using the -- 'configValue'.- , endpointAttribs ∷ EndpointAttribs+ , endpointAttribs ∷ !EndpointAttribs -- | Maximum packet size the endpoint is capable of sending/receiving.- , endpointMaxPacketSize ∷ MaxPacketSize+ , endpointMaxPacketSize ∷ !MaxPacketSize -- | Interval for polling endpoint for data transfers. Expressed in frames -- or microframes depending on the device operating speed (i.e., either 1 -- millisecond or 125 μs units).- , endpointInterval ∷ Word8+ , endpointInterval ∷ !Word8 -- | /For audio devices only:/ the rate at which synchronization feedback -- is provided.- , endpointRefresh ∷ Word8+ , endpointRefresh ∷ !Word8 -- | /For audio devices only:/ the address if the synch endpoint.- , endpointSynchAddress ∷ Word8+ , endpointSynchAddress ∷ !Word8 -- | Extra descriptors. If @libusb@ encounters unknown endpoint descriptors, -- it will store them here, should you wish to parse them.- , endpointExtra ∷ B.ByteString+ , endpointExtra ∷ !B.ByteString } deriving (Show, Read, Eq, Data, Typeable) --------------------------------------------------------------------------------@@ -828,8 +836,8 @@ -- | The address of an endpoint. data EndpointAddress = EndpointAddress- { endpointNumber ∷ Int -- ^ Must be >= 0 and <= 15- , transferDirection ∷ TransferDirection+ { endpointNumber ∷ !Int -- ^ Must be >= 0 and <= 15+ , transferDirection ∷ !TransferDirection } deriving (Show, Read, Eq, Data, Typeable) -- | The direction of data transfer relative to the host.@@ -854,7 +862,7 @@ Control -- | Isochronous transfers occur continuously and periodically.- | Isochronous Synchronization Usage+ | Isochronous !Synchronization !Usage -- | Bulk transfers can be used for large bursty data. | Bulk@@ -880,8 +888,8 @@ -------------------------------------------------------------------------------- data MaxPacketSize = MaxPacketSize- { maxPacketSize ∷ Size- , transactionOpportunities ∷ TransactionOpportunities+ { maxPacketSize ∷ !Size+ , transactionOpportunities ∷ !TransactionOpportunities } deriving (Show, Read, Eq, Data, Typeable) -- | Number of additional transactions.@@ -906,7 +914,7 @@ configs ← forM [0..numConfigs-1] $ getConfigDesc devPtr return DeviceDesc- { deviceUSBSpecReleaseNumber = unmarshalBCD4 $+ { deviceUSBSpecReleaseNumber = unmarshalReleaseNumber $ c'libusb_device_descriptor'bcdUSB d , deviceClass = c'libusb_device_descriptor'bDeviceClass d , deviceSubClass = c'libusb_device_descriptor'bDeviceSubClass d@@ -914,15 +922,27 @@ , deviceMaxPacketSize0 = c'libusb_device_descriptor'bMaxPacketSize0 d , deviceVendorId = c'libusb_device_descriptor'idVendor d , deviceProductId = c'libusb_device_descriptor'idProduct d- , deviceReleaseNumber = unmarshalBCD4 $+ , deviceReleaseNumber = unmarshalReleaseNumber $ c'libusb_device_descriptor'bcdDevice d- , deviceManufacturerStrIx = c'libusb_device_descriptor'iManufacturer d- , deviceProductStrIx = c'libusb_device_descriptor'iProduct d- , deviceSerialNumberStrIx = c'libusb_device_descriptor'iSerialNumber d+ , deviceManufacturerStrIx = unmarshalStrIx $+ c'libusb_device_descriptor'iManufacturer d+ , deviceProductStrIx = unmarshalStrIx $+ c'libusb_device_descriptor'iProduct d+ , deviceSerialNumberStrIx = unmarshalStrIx $+ c'libusb_device_descriptor'iSerialNumber d , deviceNumConfigs = numConfigs , deviceConfigs = configs } +unmarshalReleaseNumber ∷ Word16 → ReleaseNumber+unmarshalReleaseNumber abcd = (a, b, c, d)+ where+ [a, b, c, d] = map fromIntegral $ decodeBCD 4 abcd++unmarshalStrIx ∷ Word8 → Maybe StrIx+unmarshalStrIx strIx | strIx ≡ 0 = Nothing+ | otherwise = Just strIx+ getConfigDesc ∷ Ptr C'libusb_device → Word8 → IO ConfigDesc getConfigDesc devPtr ix = bracket getConfigDescPtr c'libusb_free_config_descriptor@@ -948,7 +968,8 @@ return ConfigDesc { configValue = c'libusb_config_descriptor'bConfigurationValue c- , configStrIx = c'libusb_config_descriptor'iConfiguration c+ , configStrIx = unmarshalStrIx $+ c'libusb_config_descriptor'iConfiguration c , configAttribs = unmarshalConfigAttribs $ c'libusb_config_descriptor'bmAttributes c , configMaxPower = c'libusb_config_descriptor'MaxPower c@@ -989,7 +1010,8 @@ , interfaceAltSetting = c'libusb_interface_descriptor'bAlternateSetting i , interfaceClass = c'libusb_interface_descriptor'bInterfaceClass i , interfaceSubClass = c'libusb_interface_descriptor'bInterfaceSubClass i- , interfaceStrIx = c'libusb_interface_descriptor'iInterface i+ , interfaceStrIx = unmarshalStrIx $+ c'libusb_interface_descriptor'iInterface i , interfaceProtocol = c'libusb_interface_descriptor'bInterfaceProtocol i , interfaceEndpoints = endpoints , interfaceExtra = extra@@ -1049,62 +1071,72 @@ -- ** String descriptors -------------------------------------------------------------------------------- --- | The size in number of bytes of the header of string descriptors-strDescHeaderSize ∷ Size-strDescHeaderSize = 2- {-| Retrieve a list of supported languages. This function may throw 'USBException's. -} getLanguages ∷ DeviceHandle → IO [LangId]-getLanguages devHndl = allocaArray maxSize $ \dataPtr → do- reportedSize ← write dataPtr+getLanguages devHndl = getStrDescUnmarshal devHndl 0 0 maxNrOfLangIds unmarshal+ where+ unmarshal strPtr strSize = map unmarshalLangId <$> peekArray strSize strPtr+ maxNrOfLangIds = 148 -- Based on the number of language identifiers in:+ -- http://www.usb.org/developers/docs/USB_LANGIDs.pdf - let strSize = (reportedSize - strDescHeaderSize) `div` 2- strPtr = castPtr $ dataPtr `plusPtr` strDescHeaderSize+{-| Retrieve a string descriptor from a device. - map unmarshalLangId <$> peekArray strSize strPtr- where- maxSize = 255 -- Some devices choke on size > 255- write = putStrDesc devHndl 0 0 maxSize+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. -{-| @putStrDesc devHndl strIx langId maxSize dataPtr@ retrieves the-string descriptor @strIx@ in the language @langId@ from the @devHndl@-and writes at most @maxSize@ bytes from that string descriptor to the-location that @dataPtr@ points to. So ensure there is at least space-for @maxSize@ bytes there. Next, the header of the string descriptor-is checked for correctness. If it's incorrect an 'IOException' is-thrown. Finally, the size reported in the header is returned.+This function may throw 'USBException's. -}-putStrDesc ∷ DeviceHandle- → StrIx- → Word16- → Size- → Ptr CUChar- → IO Size-putStrDesc devHndl strIx langId maxSize dataPtr = do- actualSize ← checkUSBException $ c'libusb_get_string_descriptor- (getDevHndlPtr devHndl)- strIx- langId- dataPtr- (fromIntegral maxSize)- when (actualSize < strDescHeaderSize) $- throwIO $ IOException "Incomplete header"+getStrDesc ∷ DeviceHandle+ → StrIx -- ^ Should not be 0!+ → LangId -- ^ Make sure this language is supported by the device+ -- (See: 'getLanguages').+ → Int -- ^ Maximum number of characters in the requested string.+ -- An 'IOException' will be thrown when the requested+ -- string is larger than this number.+ → IO String+getStrDesc devHndl strIx langId nrOfChars = assert (strIx ≢ 0) $+ getStrDescUnmarshal devHndl strIx (marshalLangId langId) nrOfChars unmarshal+ where+ unmarshal strPtr strSize = T.unpack <$> T.fromPtr strPtr strSize - reportedSize ← peek dataPtr+getStrDescUnmarshal ∷ DeviceHandle+ → StrIx+ → Word16+ → Int+ → (Ptr Word16 → Int → IO α)+ → IO α+getStrDescUnmarshal devHndl strIx langId nrOfWords unmarshal = do+ let maxSize = headerSize + nrOfWords * 2+ headerSize = 2+ allocaArray maxSize $ \dataPtr → do+ actualSize ← checkUSBException $ c'libusb_get_string_descriptor+ (getDevHndlPtr devHndl)+ strIx+ langId+ dataPtr+ (fromIntegral maxSize)+ when (actualSize < headerSize) $+ throwIO $ IOException "Incomplete header" - when (reportedSize > fromIntegral actualSize) $- throwIO $ IOException "Not enough space to hold data"+ reportedSize ← peek dataPtr - descType ← peekElemOff dataPtr 1+ when (reportedSize > fromIntegral actualSize) $+ throwIO $ IOException "Not enough space to hold data" - when (descType ≢ c'LIBUSB_DT_STRING) $- throwIO $ IOException "Invalid header"+ descType ← peekElemOff dataPtr 1 - return $ fromIntegral reportedSize+ when (descType ≢ c'LIBUSB_DT_STRING) $+ throwIO $ IOException "Invalid header" + let strPtr = castPtr $ dataPtr `plusPtr` headerSize+ strSize = (fromIntegral reportedSize - headerSize) `div` 2++ unmarshal strPtr strSize+ {-| The language ID consists of the primary language identifier and the sublanguage identififier as described in: @@ -1131,28 +1163,6 @@ -- Can be retrieved by all the *StrIx functions. type StrIx = Word8 -{-| 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 'USBException's.--}-getStrDesc ∷ DeviceHandle- → StrIx- → LangId- → Int -- ^ Maximum number of characters in the requested string. An- -- 'IOException' will be thrown when the requested string is- -- larger than this number.- → IO String-getStrDesc devHndl strIx langId nrOfChars =- fmap decode $ BI.createAndTrim size $ write ∘ castPtr- where- write = putStrDesc devHndl strIx (marshalLangId langId) size- size = strDescHeaderSize + 2 * nrOfChars -- characters are 2 bytes- decode = T.unpack ∘ TE.decodeUtf16LE ∘ B.drop strDescHeaderSize- {-| Retrieve a string descriptor from a device using the first supported language. @@ -1163,10 +1173,11 @@ This function may throw 'USBException's. -} getStrDescFirstLang ∷ DeviceHandle- → StrIx- → Int -- ^ Maximum number of characters in the requested- -- string. An 'IOException' will be thrown when the- -- requested string is larger than this number.+ → StrIx -- ^ Should not be 0!+ -- If so, an 'InvalidParamException' will be thrown.+ → Int -- ^ Maximum number of characters in the requested+ -- string. An 'IOException' will be thrown when the+ -- requested string is larger than this number. → IO String getStrDescFirstLang devHndl strIx nrOfChars = do langIds ← getLanguages devHndl
Utils.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax #-}+{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax, BangPatterns #-} module Utils where @@ -12,13 +12,13 @@ , fromInteger , Integral, fromIntegral )-import Control.Monad ( Monad, (>>=), fail, mapM )+import Control.Monad ( Monad, (>>=), (>>), fail, mapM ) import Foreign.Ptr ( Ptr ) import Foreign.Storable ( Storable, ) import Foreign.Marshal.Array ( peekArray )-import Data.Bool ( Bool )-import Data.Ord ( Ord )-import Data.Bits ( Bits, shiftR, (.&.) )+import Data.Bool ( Bool, otherwise )+import Data.Ord ( Ord, (<) )+import Data.Bits ( Bits, shiftL, shiftR, bitSize, (.&.) ) import Data.Int ( Int ) import Data.Functor ( Functor, (<$)) import System.IO ( IO )@@ -65,6 +65,20 @@ if c then tM else eM++{-| @decodeBCD bitsInDigit bcd@ decodes the Binary Coded Decimal @bcd@ to a list+of its encoded digits. @bitsInDigit@, which is usually 4, is the number of bits+used to encode a single digit. See:+<http://en.wikipedia.org/wiki/Binary-coded_decimal>+-}+decodeBCD ∷ Bits α ⇒ Int → α → [α]+decodeBCD bitsInDigit abcd = go shftR []+ where+ shftR = bitSize abcd - bitsInDigit++ go shftL ds | shftL < 0 = ds+ | otherwise = let !d = (abcd `shiftL` shftL) `shiftR` shftR+ in go (shftL - bitsInDigit) (d : ds) -- The End ---------------------------------------------------------------------
usb.cabal view
@@ -1,5 +1,5 @@ name: usb-version: 0.5.0.1+version: 0.6 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -74,5 +74,4 @@ System.USB.Exceptions System.USB.Unsafe other-modules: System.USB.Internal- Data.BCD Utils