hidapi (empty) → 0.1

raw patch · 4 files changed

+291/−0 lines, 4 filesdep +basedep +bytestringsetup-changed

Dependencies added: base, bytestring

Files

LICENSE +19/−0
Setup.hs +4/−0
System/HIDAPI.hsc +244/−0
hidapi.cabal +24/−0

+ LICENSE view

@@ -0,0 +1,19 @@+Copyright (c) 2013 Patrick Chilton++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain

+ System/HIDAPI.hsc view

@@ -0,0 +1,244 @@+{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-}++#include "hidapi/hidapi.h"++module System.HIDAPI+  ( System.HIDAPI.init, exit, withHIDAPI+  , enumerate, enumerateAll+  , open, openPath, openDeviceInfo+  , close+  , System.HIDAPI.read+  , getSerialNumberString+  , System.HIDAPI.error+  , HIDAPIException(HIDAPIException)+  , Device()+  , DeviceInfo (..)+  , DevicePath+  , VendorID+  , ProductID+  , ReleaseNumber+  , SerialNumber+  , InterfaceNumber+  ) where++import Control.Applicative+import Control.Exception+import Control.Monad+import Data.ByteString+import Data.Maybe+import Data.Typeable+import Data.Data+import Foreign+import Foreign.C.Types+import Foreign.C.String++type Hid_Device_Ptr = Ptr () -- used where hid_device* is used on C side+newtype Device = Device Hid_Device_Ptr++data DeviceInfoInternal = DeviceInfoInternal+  { _path :: CString+  , _vendorId :: CUShort+  , _productId :: CUShort+  , _serialNumber :: CWString+  , _releaseNumber :: CUShort+  , _manufacturerString :: CWString+  , _productString :: CWString+  , _usagePage :: CUShort+  , _usage :: CUShort+  , _interfaceNumber :: CInt+  , _next :: Ptr DeviceInfoInternal+  } deriving (Show)++#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++instance Storable DeviceInfoInternal where+  alignment _ = #{alignment struct hid_device_info}+  sizeOf _ = #{size struct hid_device_info}+  peek p = DeviceInfoInternal <$>+    #{peek struct hid_device_info, path} p <*>+    #{peek struct hid_device_info, vendor_id} p <*>+    #{peek struct hid_device_info, product_id} p <*>+    #{peek struct hid_device_info, serial_number} p <*>+    #{peek struct hid_device_info, release_number} p <*>+    #{peek struct hid_device_info, manufacturer_string} p <*>+    #{peek struct hid_device_info, product_string} p <*>+    #{peek struct hid_device_info, usage_page} p <*>+    #{peek struct hid_device_info, usage} p <*>+    #{peek struct hid_device_info, interface_number} p <*>+    #{peek struct hid_device_info, next} p++-- Aliases for writing better type signatures and haddocks.+type DevicePath = String+type VendorID = Word16+type ProductID = Word16+type ReleaseNumber = Word16+type SerialNumber = String+type InterfaceNumber = Int++data DeviceInfo = DeviceInfo+  { path :: DevicePath+  , vendorId :: VendorID+  , productId :: ProductID+  , serialNumber :: Maybe SerialNumber+  , releaseNumber :: ReleaseNumber+  , manufacturerString :: Maybe String+  , productString :: Maybe String+  , usagePage :: Word16+  , usage :: Word16+  , interfaceNumber :: InterfaceNumber+  } deriving (Show)++peekOptString :: Ptr CWchar -> IO (Maybe String)+peekOptString p+  | p == nullPtr = return Nothing+  | otherwise = Just <$> peekCWString p++fromInternalDeviceInfo :: DeviceInfoInternal -> IO DeviceInfo+fromInternalDeviceInfo di = DeviceInfo <$>+  peekCString (_path di) <*>+  pure (fromIntegral $ _vendorId di) <*>+  pure (fromIntegral $ _productId di) <*>+  peekOptString (_serialNumber di) <*>+  pure (fromIntegral $ _releaseNumber di) <*>+  peekOptString (_manufacturerString di) <*>+  peekOptString (_productString di) <*>+  pure (fromIntegral $ _usagePage di) <*>+  pure (fromIntegral $ _usage di) <*>+  pure (fromIntegral $ _interfaceNumber di)++foreign import ccall unsafe "hidapi/hidapi.h hid_error"+  hid_error :: Hid_Device_Ptr -> IO CWString++data HIDAPIException = HIDAPIException String String+  deriving (Data, Typeable)++instance Show HIDAPIException where+  showsPrec _ (HIDAPIException a c) = showString a . showString ": " . showString c++instance Exception HIDAPIException++-- TODO As of https://github.com/signal11/hidapi/issues/123 it is unclear+--      whether the passed in pointer may be NULL, and if hid_error ever+--      returns something useful.+error :: Device -> IO (Maybe String)+error (Device devicePtr) = do+  e <- hid_error devicePtr+  if e == nullPtr+    then return Nothing+    else do+      es <- peekCWString e+      free e+      return (Just es)++check :: Bool -> String -> String -> IO ()+check c msg reason = unless c $ throwIO $ HIDAPIException msg reason++-- Device is only used to obtain a more detailed error if the condition is+-- false and device is not a NULL pointer.+checkWithHidError :: Bool -> Device -> String -> String -> IO ()+checkWithHidError c dev@(Device devPtr) msg defaultReason = unless c $ do+  reason <- if devPtr /= nullPtr+              then fromMaybe defaultReason <$> System.HIDAPI.error dev+              else return defaultReason+  throwIO $ HIDAPIException msg reason++foreign import ccall unsafe "hidapi/hidapi.h hid_init"+  hid_init :: IO CInt++init :: IO ()+init = do+  r <- hid_init+  check (r == 0) "HIDAPI initialization failed" "hid_init /= 0"++foreign import ccall unsafe "hidapi/hidapi.h hid_exit"+  hid_exit :: IO CInt++exit :: IO ()+exit = do+	r <- hid_exit+	check (r == 0) "HIDAPI shutdown failed" "hid_exit /= 0"++withHIDAPI :: IO a -> IO a+withHIDAPI = bracket_ System.HIDAPI.init exit++foreign import ccall unsafe "hidapi/hidapi.h hid_enumerate"+  hid_enumerate :: CUShort -> CUShort -> IO (Ptr DeviceInfoInternal)++foreign import ccall unsafe "hidapi/hidapi.h hid_free_enumeration"+  hid_free_enumeration :: Ptr DeviceInfoInternal -> IO ()++parseEnumeration :: Ptr DeviceInfoInternal -> IO [ DeviceInfo ]+parseEnumeration dip+  | dip == nullPtr = return []+  | otherwise = do+    idi <- peek dip+    di <- fromInternalDeviceInfo idi+    dis <- parseEnumeration (_next idi)+    return (di : dis)++enumerate :: Maybe VendorID -> Maybe ProductID -> IO [ DeviceInfo ]+enumerate m'vendorId m'productId = do+  dip <- hid_enumerate (maybe 0 fromIntegral m'vendorId) (maybe 0 fromIntegral m'productId)+  -- Docs say hid_enumerate also returns "NULL in the case of failure", but+  -- this is indistinguishable from "no devices". :/+  if dip == nullPtr+    then return []+    else do+      dis <- parseEnumeration dip+      hid_free_enumeration dip+      return dis++enumerateAll :: IO [ DeviceInfo ]+enumerateAll = enumerate Nothing Nothing++foreign import ccall unsafe "hidapi/hidapi.h hid_open"+  hid_open :: CUShort -> CUShort -> CWString -> IO Hid_Device_Ptr++open :: VendorID -> ProductID -> Maybe SerialNumber -> IO Device+open vendor_id product_id serial = do+  let vid = fromIntegral vendor_id+  let pid = fromIntegral product_id+  dev@(Device dp) <- Device <$> case serial of+    Nothing -> hid_open vid pid nullPtr+    Just sn -> withCWString sn (hid_open vid pid)+  checkWithHidError (dp /= nullPtr) dev "Device open (by vendor/product id) failed" "hid_open returned NULL"+  return dev++foreign import ccall unsafe "hidapi/hidapi.h hid_open_path"+  hid_open_path :: CString -> IO Hid_Device_Ptr++openPath :: DevicePath -> IO Device+openPath p = do+  dev@(Device dp) <- Device <$> withCString p hid_open_path+  checkWithHidError (dp /= nullPtr) dev "Device open (by path) failed" "hid_open returned NULL"+  return dev++openDeviceInfo :: DeviceInfo -> IO Device+openDeviceInfo+  = openPath . path++foreign import ccall unsafe "hidapi/hidapi.h hid_close"+  close :: Device -> IO ()++foreign import ccall unsafe "hidapi/hidapi.h hid_read"+  hid_read :: Device -> Ptr CChar -> CSize -> IO CInt++read :: Device -> Int -> IO ByteString+read dev n = allocaBytes n $ \b -> do+  n' <- hid_read dev b (fromIntegral n)+  checkWithHidError (n' /= -1) dev "Read failed" "hid_read returned -1"+  packCStringLen ( b, fromIntegral n' )++foreign import ccall unsafe "hidapi/hidapi.h hid_get_serial_number_string"+  hid_get_serial_number_string :: Device -> CWString -> CSize -> IO CInt++_SERIAL_NUMBER_MAX_LENGTH :: Int+_SERIAL_NUMBER_MAX_LENGTH = 32768++getSerialNumberString :: Device -> IO SerialNumber+getSerialNumberString dev = do+  let bs = _SERIAL_NUMBER_MAX_LENGTH * sizeOf (undefined :: CWchar)+  bracket (mallocBytes bs) free $ \b -> do+    n' <- hid_get_serial_number_string dev b (fromIntegral _SERIAL_NUMBER_MAX_LENGTH)+    checkWithHidError (n' /= -1) dev "Getting serial number failed" "hid_get_serial_number_string returned -1"+    peekCWString b

+ hidapi.cabal view

@@ -0,0 +1,24 @@+name:              hidapi+version:           0.1+build-type:        Simple+cabal-version:     >= 1.6+category:          Hardware+author:            Patrick Chilton <chpatrick@gmail.com>, Niklas Hambüchen <mail@nh2.me>+maintainer:        Patrick Chilton <chpatrick@gmail.com>+homepage:          https://github.com/vahokif/haskell-hidapi+bug-reports:       https://github.com/vahokif/haskell-hidapi/issues+synopsis:          Haskell bindings to HIDAPI+description:       Haskell bindings to the HIDAPI library (<http://www.signal11.us/oss/hidapi/>).+license:           MIT+license-file:      LICENSE++source-repository head+  type:      git+  location:  git://github.com/vahokif/haskell-hidapi.git++library+  exposed-modules: System.HIDAPI+  build-depends:+      base < 5+    , bytestring >= 0.10+  extra-libraries: hidapi-hidraw