{-# LINE 1 "System/Linux/Input/Event/Constants.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "System/Linux/Input/Event/Constants.hsc" #-}

module System.Linux.Input.Event.Constants where

import Foreign.C.Types
import Data.Word
import Data.Int


{-# LINE 10 "System/Linux/Input/Event/Constants.hsc" #-}

newtype SyncType = SyncType Word16 deriving (Show, Eq)
sync_report       :: SyncType
sync_report       = SyncType 0
sync_config       :: SyncType
sync_config       = SyncType 1
sync_mt_report    :: SyncType
sync_mt_report    = SyncType 2
sync_dropped      :: SyncType
sync_dropped      = SyncType 3

{-# LINE 18 "System/Linux/Input/Event/Constants.hsc" #-}

-- TODO Finish
newtype Key = Key Word16 deriving (Show, Eq)
key_reserved     :: Key
key_reserved     = Key 0
key_esc          :: Key
key_esc          = Key 1

{-# LINE 25 "System/Linux/Input/Event/Constants.hsc" #-}

newtype RelAxis = RelAxis Word16 deriving (Show, Eq)
rel_x             :: RelAxis
rel_x             = RelAxis 0
rel_y             :: RelAxis
rel_y             = RelAxis 1
rel_z             :: RelAxis
rel_z             = RelAxis 2
rel_rx            :: RelAxis
rel_rx            = RelAxis 3
rel_ry            :: RelAxis
rel_ry            = RelAxis 4
rel_rz            :: RelAxis
rel_rz            = RelAxis 5
rel_hWheel        :: RelAxis
rel_hWheel        = RelAxis 6
rel_dial          :: RelAxis
rel_dial          = RelAxis 7
rel_wheel         :: RelAxis
rel_wheel         = RelAxis 8
rel_misc          :: RelAxis
rel_misc          = RelAxis 9

{-# LINE 39 "System/Linux/Input/Event/Constants.hsc" #-}

newtype AbsAxis = AbsAxis Word16 deriving (Show, Eq)
abs_x             :: AbsAxis
abs_x             = AbsAxis 0
abs_y             :: AbsAxis
abs_y             = AbsAxis 1
abs_z             :: AbsAxis
abs_z             = AbsAxis 2
abs_rx            :: AbsAxis
abs_rx            = AbsAxis 3
abs_ry            :: AbsAxis
abs_ry            = AbsAxis 4
abs_rz            :: AbsAxis
abs_rz            = AbsAxis 5

{-# LINE 49 "System/Linux/Input/Event/Constants.hsc" #-}