module System.USB.HID.Requests (
HIDDescriptorClass
,HIDControlRequest
,HIDProtocol
,DescriptorIndex
,HIDInterfaceNumber
,Duration
,ReportID
,Report
,ReportType
,getHIDReportDesc
,getPhysicalDescriptor
,getReport
,setReport
,getIdle
,setIdle
,getProtocol
,setProtocol
) where
import GHC.Generics
import Data.Word
import System.USB
import Data.Attoparsec.ByteString
import System.USB.HID.Descriptor
import System.USB.HID.Parsers
import Data.ByteString as B (ByteString,empty,head)
import Data.Maybe (fromJust)
import Data.Tuple (swap)
data HIDDescriptorClass = HIDR
| HIDReportR
| PhysicalDescriptorR
deriving (Eq,Show,Generic)
data HIDControlRequest = GetReport
| GetIdle
| GetProtocol
| SetReport
| SetIdle
| SetProtocol
deriving (Eq,Show,Generic)
data HIDProtocol = Boot | Report
deriving (Eq, Show,Enum,Generic)
instance Enum HIDControlRequest where
toEnum x = fromJust (lookup x (zip [1,2,3,9,10,11] [GetReport, GetIdle, GetProtocol, SetReport, SetIdle, SetProtocol]))
fromEnum x = fromJust (lookup x (zip [GetReport, GetIdle, GetProtocol, SetReport, SetIdle, SetProtocol] [1,2,3,9,10,11]))
type DescriptorIndex = Word8
type HIDInterfaceNumber = Word16
type Duration = Word8
type ReportID = Word8
type Report = ByteString
data ReportType = RInput | ROutput | RFeature
deriving (Eq,Show,Generic)
instance Enum ReportType where
toEnum x = fromJust (lookup x as)
where as = [(1,RInput),(2,ROutput),(3,RFeature)]
fromEnum x = fromJust (lookup x (map swap as))
where as = [(1,RInput),(2,ROutput),(3,RFeature)]
instance Enum HIDDescriptorClass where
toEnum 0x21 = HIDR
toEnum 0x22 = HIDReportR
toEnum 0x23 = PhysicalDescriptorR
fromEnum HIDR = 0x21
fromEnum HIDReportR = 0x22
fromEnum PhysicalDescriptorR = 0x23
getHIDDesc :: DeviceHandle -> Parser a -> HIDControlRequest -> HIDDescriptorClass -> DescriptorIndex -> HIDInterfaceNumber -> Size -> Timeout -> IO a
getHIDDesc h parser cr dc di intN s t = do
(bs,s) <- readControl h (ControlSetup Class ToInterface (convertEnum $ cr) ((convertEnum $ dc )*256 + (convertEnum $ di)) intN) s t
case parseOnly parser bs of
Left x -> fail "Could not Parse descriptor"
Right x -> return x
getHIDReportDesc :: DeviceHandle -> HIDInterfaceNumber -> Size -> Timeout -> IO HIDReportDesc
getHIDReportDesc h intN = getHIDDesc h parseHIDReportDesc GetReport HIDReportR 0 intN
getPhysicalDescriptor :: DeviceHandle -> HIDInterfaceNumber -> DescriptorIndex -> Size -> Timeout -> IO HIDPhysDescSet
getPhysicalDescriptor h intN di = getHIDDesc h parsePhysDescSet GetReport PhysicalDescriptorR di intN
getReport :: DeviceHandle -> ReportType -> ReportID -> HIDInterfaceNumber -> Size -> Timeout -> IO (ByteString,Status)
getReport h rt ri intN s t = hidGet h (convertEnum $ SetReport) ((convertEnum $ rt )*256 + (convertEnum $ ri)) intN s t
setReport :: DeviceHandle -> ReportType -> ReportID -> HIDInterfaceNumber -> Report -> Timeout -> IO (Size,Status)
setReport h rt ri intN r t = hidSet h (convertEnum $ SetReport) ((convertEnum $ rt )*256 + (convertEnum $ ri)) intN r t
getIdle :: DeviceHandle -> HIDInterfaceNumber -> ReportID -> Timeout -> IO (HIDProtocol,Status)
getIdle h intN rid t = do
(p,s) <- hidGet h (convertEnum $ GetIdle) (convertEnum $ rid) intN 1 t
let i = fromEnum (B.head p)
return (toEnum i ,s)
setIdle :: DeviceHandle -> HIDInterfaceNumber -> Duration -> ReportID -> Timeout -> IO (Size,Status)
setIdle h intN d rid = hidSet h (convertEnum $ SetIdle) ((convertEnum $ d )*256 + (convertEnum $ rid)) intN empty
getProtocol :: DeviceHandle -> HIDInterfaceNumber -> Timeout -> IO (HIDProtocol,Status)
getProtocol h intN t = do
(p,s) <- hidGet h (convertEnum $ GetProtocol) 0 intN 1 t
let i = fromEnum (B.head p)
return (toEnum i ,s)
setProtocol :: DeviceHandle -> HIDProtocol -> HIDInterfaceNumber -> Timeout -> IO (Size,Status)
setProtocol h p intN = hidSet h (convertEnum $ SetProtocol) (convertEnum $ p) intN empty
hidSet :: DeviceHandle -> Word8 -> Word16 -> Word16 -> ByteString ->Timeout -> IO (Size,Status)
hidSet h r v = writeControl h . ControlSetup Class ToInterface r v
hidGet :: DeviceHandle -> Word8 -> Word16 -> Word16 -> Size -> Timeout -> IO (ByteString,Status)
hidGet h r v = readControl h . ControlSetup Class ToInterface r v