serialport 0.3.3 → 0.4.0
raw patch · 6 files changed
+284/−363 lines, 6 filesbuild-type:Custom
Files
- System/Hardware/Serialport.hs +11/−2
- System/Hardware/Serialport/Posix.hsc +91/−60
- System/Hardware/Serialport/Types.hs +0/−141
- System/Hardware/Serialport/Windows.hs +45/−48
- System/Win32/Comm.hsc +126/−105
- serialport.cabal +11/−7
System/Hardware/Serialport.hs view
@@ -1,9 +1,17 @@ {-# LANGUAGE CPP #-} +-- |This module provides the serial port interface.+--+-- > import System.Hardware.Serialport+-- > s <- openSerial "/dev/ttyUSB0" defaultSerialSettings+-- > sendChar s 'A'+-- > Just resp <- recvChar s+-- > closeSerial s+-- module System.Hardware.Serialport ( -- * Types- BaudRate(..)+ CommSpeed(..) ,StopBits(..) ,Parity(..) ,FlowControl(..)@@ -19,12 +27,13 @@ ,closeSerial ,setDTR ,setRTS+ ,setSerialSettings+ ,getSerialSettings ) where #if defined(mingw32_HOST_OS) import System.Hardware.Serialport.Windows #else import System.Hardware.Serialport.Posix-import System.Posix.Terminal #endif import System.Hardware.Serialport.Types
System/Hardware/Serialport/Posix.hsc view
@@ -11,22 +11,22 @@ -- |Open and configure a serial port-openSerial :: FilePath -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@+openSerial :: FilePath -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ -> SerialPortSettings -> IO SerialPort-openSerial dev settings =- do fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True }- setSerialSettings fd' settings- return $ SerialPort fd' settings+openSerial dev settings = do+ fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True }+ let serial_port = (SerialPort fd' defaultSerialSettings)+ return =<< setSerialSettings serial_port settings -- |Possibly receive a character unless the timeout given in openSerial is exceeded. recvChar :: SerialPort -> IO (Maybe Char)-recvChar (SerialPort fd' _) =- do result <- try $ fdRead fd' 1- case result of- Right (str, _) -> return $ Just $ head str- Left _ -> return Nothing+recvChar (SerialPort fd' _) = do+ result <- try $ fdRead fd' 1+ case result of+ Right (str, _) -> return $ Just $ head str+ Left _ -> return Nothing -- |Send a character@@ -53,81 +53,112 @@ getTIOCM :: Fd -> IO Int getTIOCM fd' =- alloca $ \p -> cIoctl' fd' (#const TIOCMGET) p >> peek p+ alloca $ \p -> cIoctl' fd' #{const TIOCMGET} p >> peek p setTIOCM :: Fd -> Int -> IO () setTIOCM fd' val =- with val $ cIoctl' fd' (#const TIOCMSET)+ with val $ cIoctl' fd' #{const TIOCMSET} -- |Set the Data Terminal Ready level setDTR :: SerialPort -> Bool -> IO ()-setDTR (SerialPort fd' _) set =- do current <- getTIOCM fd'- setTIOCM fd' $ if set- then current .|. (#const TIOCM_DTR)- else current .&. (complement (#const TIOCM_DTR))+setDTR (SerialPort fd' _) set = do+ current <- getTIOCM fd'+ setTIOCM fd' $ if set+ then current .|. #{const TIOCM_DTR}+ else current .&. complement #{const TIOCM_DTR} -- |Set the Ready to send level setRTS :: SerialPort -> Bool -> IO ()-setRTS (SerialPort fd' _) set =- do current <- getTIOCM fd'- setTIOCM fd' $ if set- then current .|. (#const TIOCM_RTS)- else current .&. (complement (#const TIOCM_RTS))+setRTS (SerialPort fd' _) set = do+ current <- getTIOCM fd'+ setTIOCM fd' $ if set+ then current .|. #{const TIOCM_RTS}+ else current .&. complement #{const TIOCM_RTS} -setSerialSettings :: Fd -> SerialPortSettings -> IO ()-setSerialSettings fd' settings = - do termOpts <- getTerminalAttributes fd'- let termOpts' = configureSettings termOpts settings- setTerminalAttributes fd' termOpts' Immediately+-- |Configure the serial port+setSerialSettings :: SerialPort -- ^ The currently opened serial port+ -> SerialPortSettings -- ^ The new settings+ -> IO SerialPort -- ^ New serial port+setSerialSettings (SerialPort fd' _) new_settings = do+ termOpts <- getTerminalAttributes fd'+ let termOpts' = configureSettings termOpts new_settings+ setTerminalAttributes fd' termOpts' Immediately+ return (SerialPort fd' new_settings) +-- |Get configuration from serial port+getSerialSettings :: SerialPort -> SerialPortSettings+getSerialSettings (SerialPort _ settings) = settings++ withParity :: TerminalAttributes -> Parity -> TerminalAttributes-withParity termOpts Even = termOpts `withMode` EnableParity - `withoutMode` OddParity-withParity termOpts Odd = termOpts `withMode` EnableParity- `withMode` OddParity-withParity termOpts NoParity = termOpts `withoutMode` EnableParity+withParity termOpts Even =+ termOpts `withMode` EnableParity+ `withoutMode` OddParity+withParity termOpts Odd =+ termOpts `withMode` EnableParity+ `withMode` OddParity+withParity termOpts NoParity =+ termOpts `withoutMode` EnableParity withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes-withFlowControl termOpts NoFlowControl = termOpts- `withoutMode` StartStopInput- `withoutMode` StartStopOutput-withFlowControl termOpts Software = termOpts- `withMode` StartStopInput- `withMode` StartStopOutput+withFlowControl termOpts NoFlowControl =+ termOpts `withoutMode` StartStopInput+ `withoutMode` StartStopOutput+withFlowControl termOpts Software =+ termOpts `withMode` StartStopInput+ `withMode` StartStopOutput withStopBits :: TerminalAttributes -> StopBits -> TerminalAttributes-withStopBits termOpts One = termOpts `withoutMode` TwoStopBits-withStopBits termOpts Two = termOpts `withMode` TwoStopBits+withStopBits termOpts One =+ termOpts `withoutMode` TwoStopBits+withStopBits termOpts Two =+ termOpts `withMode` TwoStopBits configureSettings :: TerminalAttributes -> SerialPortSettings -> TerminalAttributes configureSettings termOpts settings =- termOpts `withInputSpeed` (baudRate settings)- `withOutputSpeed` (baudRate settings)- `withBits` (fromIntegral (bitsPerWord settings))- `withStopBits` (stopb settings)- `withParity` (parity settings)- `withFlowControl` (flowControl settings)- `withoutMode` EnableEcho- `withoutMode` EchoErase- `withoutMode` EchoKill- `withoutMode` ProcessInput- `withoutMode` ProcessOutput- `withoutMode` MapCRtoLF- `withoutMode` EchoLF- `withoutMode` HangupOnClose- `withoutMode` KeyboardInterrupts- `withoutMode` ExtendedFunctions- `withMode` LocalMode- `withMode` ReadEnable- `withTime` (timeout settings)- `withMinInput` 0+ termOpts `withInputSpeed` (commSpeedToBaudRate (commSpeed settings))+ `withOutputSpeed` (commSpeedToBaudRate (commSpeed settings))+ `withBits` fromIntegral (bitsPerWord settings)+ `withStopBits` stopb settings+ `withParity` parity settings+ `withFlowControl` flowControl settings+ `withoutMode` EnableEcho+ `withoutMode` EchoErase+ `withoutMode` EchoKill+ `withoutMode` ProcessInput+ `withoutMode` ProcessOutput+ `withoutMode` MapCRtoLF+ `withoutMode` EchoLF+ `withoutMode` HangupOnClose+ `withoutMode` KeyboardInterrupts+ `withoutMode` ExtendedFunctions+ `withMode` LocalMode+ `withMode` ReadEnable+ `withTime` timeout settings+ `withMinInput` 0+++commSpeedToBaudRate :: CommSpeed -> BaudRate+commSpeedToBaudRate speed =+ case speed of+ CS110 -> B110+ CS300 -> B300+ CS600 -> B600+ CS1200 -> B1200+ CS2400 -> B2400+ CS4800 -> B4800+ CS9600 -> B9600+ CS19200 -> B19200+ CS38400 -> B38400+ CS57600 -> B57600+ CS115200 -> B115200+
− System/Hardware/Serialport/Types.hs
@@ -1,141 +0,0 @@-{-# LANGUAGE CPP #-}-module System.Hardware.Serialport.Types where--import Data.Word-#if defined(mingw32_HOST_OS)-import System.Win32.Types---- | Same as System.Posix.Terminal-data BaudRate- = B0- | B50- | B75- | B110- | B134- | B150- | B200- | B300- | B600- | B1200- | B1800- | B2400- | B4800- | B9600- | B19200- | B38400- | B57600- | B115200--#else-import System.Posix.Terminal-import System.Posix.Types-#endif--fromBaudToInt :: BaudRate -> Int-fromBaudToInt b =- case b of- B0 -> 0- B50 -> 50- B75 -> 75- B110 -> 110- B134 -> 134- B150 -> 150- B200 -> 200- B300 -> 300- B600 -> 600- B1200 -> 1200- B1800 -> 1800- B2400 -> 2400- B4800 -> 4800- B9600 -> 9600- B19200 -> 19200- B38400 -> 38400- B57600 -> 57600- B115200 -> 115200---fromIntToBaud :: Int -> BaudRate-fromIntToBaud i =- case i of- 0 -> B0- 50 -> B50- 75 -> B75- 110 -> B110- 134 -> B134- 150 -> B150- 200 -> B200- 300 -> B300- 600 -> B600- 1200 -> B1200- 1800 -> B1800- 2400 -> B2400- 4800 -> B4800- 9600 -> B9600- 19200 -> B19200- 38400 -> B38400- 57600 -> B57600- 115200 -> B115200- _ -> error $ "unsupported baudrate " ++ show i- ---data StopBits = One | Two-data Parity = Even | Odd | NoParity-data FlowControl = Software | NoFlowControl--data SerialPortSettings = SerialPortSettings {- baudRate :: BaudRate, -- ^ baudrate- bitsPerWord :: Word8, -- ^ Number of bits in a word- stopb :: StopBits, -- ^ Number of stop bits- parity :: Parity, -- ^ Type of parity- flowControl :: FlowControl, -- ^ Type of flowcontrol- timeout :: Int -- ^ Timeout when receiving a char in tenth of seconds- }---instance Show SerialPortSettings where- show settings = baudrate ++ "/" ++ bits ++ "-" ++ par ++ "-" ++ stopbits ++ " (" ++ flow ++ ", " ++ wait ++ ")"- where- baudrate = show $ fromBaudToInt $ baudRate settings- bits = show $ bitsPerWord settings- par = case parity settings of- Even -> "E"- Odd -> "O"- NoParity -> "N"- stopbits = case stopb settings of- One -> "1"- Two -> "2"- flow = case flowControl settings of- NoFlowControl -> "no flow control"- Software -> "software flow control"- wait = "timeout:" ++ show ((timeout settings) * 100)- --data SerialPort = SerialPort { -#if defined(mingw32_HOST_OS)- handle :: HANDLE,-#else- fd :: Fd,-#endif- newSettings :: SerialPortSettings- }----- | Most commonly used configuration--- --- - 9600 baud------ - 8 data bits------ - 1 stop bit------ - no parity------ - no flow control------ - 0.1 millisecond receive timeout----defaultSerialSettings :: SerialPortSettings-defaultSerialSettings =- SerialPortSettings B9600 8 One NoParity NoFlowControl 1-
System/Hardware/Serialport/Windows.hs view
@@ -16,82 +16,79 @@ openSerial :: String -- ^ The filename of the serial port, such as @COM5@ or @\/\/.\/CNCA0@ -> SerialPortSettings -> IO SerialPort-openSerial dev settings =- do h <- createFile dev access_mode share_mode security_attr create_mode file_attr template_file- setSerialSettings h settings- return $ SerialPort h settings- where - access_mode = gENERIC_READ .|. gENERIC_WRITE- share_mode = fILE_SHARE_NONE- security_attr = Nothing- create_mode = oPEN_EXISTING- file_attr = fILE_ATTRIBUTE_NORMAL -- .|. fILE_FLAG_OVERLAPPED- template_file = Nothing+openSerial dev settings = do + h <- createFile dev access_mode share_mode security_attr create_mode file_attr template_file+ let serial_port = SerialPort h defaultSerialSettings+ return =<< setSerialSettings serial_port settings+ where + access_mode = gENERIC_READ .|. gENERIC_WRITE+ share_mode = fILE_SHARE_NONE+ security_attr = Nothing+ create_mode = oPEN_EXISTING+ file_attr = fILE_ATTRIBUTE_NORMAL -- .|. fILE_FLAG_OVERLAPPED+ template_file = Nothing -- |Possibly receive a character unless the timeout given in openSerial is exceeded. recvChar :: SerialPort -> IO (Maybe Char) recvChar (SerialPort h _) =- allocaBytes 1 $ \ p_n -> do - received <- win32_ReadFile h p_n count overlapped- if received == 0- then return Nothing- else do c <- peek p_n :: IO CChar- return $ Just $ castCCharToChar c- where- count = 1- overlapped = Nothing+ allocaBytes 1 $ \ p_n -> do + received <- win32_ReadFile h p_n count overlapped+ if received == 0+ then return Nothing+ else do c <- peek p_n :: IO CChar+ return $ Just $ castCCharToChar c+ where+ count = 1+ overlapped = Nothing -- |Send a character sendChar :: SerialPort -> Char -> IO () sendChar (SerialPort h _) s =- with s (\ p_s -> do win32_WriteFile h p_s count overlapped - return () )- where- count = 1- overlapped = Nothing+ with s (\ p_s -> do _ <- win32_WriteFile h p_s count overlapped + return () )+ where+ count = 1+ overlapped = Nothing -- |Close the serial port closeSerial :: SerialPort -> IO () closeSerial (SerialPort h _) =- closeHandle h+ closeHandle h -- |Set the Data Terminal Ready level setDTR :: SerialPort -> Bool -> IO ()-setDTR (SerialPort h _ ) set =- Comm.escapeCommFunction h $ if set - then Comm.setDTR- else Comm.clrDTR+setDTR (SerialPort h _ ) True = Comm.escapeCommFunction h Comm.setDTR+setDTR (SerialPort h _ ) False = Comm.escapeCommFunction h Comm.clrDTR -- |Set the Ready to send level setRTS :: SerialPort -> Bool -> IO ()-setRTS (SerialPort h _ ) set =- Comm.escapeCommFunction h $ if set - then Comm.setRTS- else Comm.clrRTS+setRTS (SerialPort h _ ) True = Comm.escapeCommFunction h Comm.setRTS+setRTS (SerialPort h _ ) False = Comm.escapeCommFunction h Comm.clrRTS -setSerialSettings :: HANDLE -> SerialPortSettings -> IO ()-setSerialSettings h settings =- do let ct = Comm.COMMTIMEOUTS { +-- |Configure the serial port+setSerialSettings :: SerialPort -- ^ The currently opened serial port+ -> SerialPortSettings -- ^ The new settings+ -> IO SerialPort -- ^ New serial port+setSerialSettings (SerialPort h _) new_settings = do+ let ct = Comm.COMMTIMEOUTS { Comm.readIntervalTimeout = maxBound :: DWORD, Comm.readTotalTimeoutMultiplier = maxBound :: DWORD, - Comm.readTotalTimeoutConstant = fromIntegral (timeout settings) * 100, - Comm.writeTotalTimeoutMultiplier = 0, + Comm.readTotalTimeoutConstant = fromIntegral (timeout new_settings) * 100,+ Comm.writeTotalTimeoutMultiplier = 0, Comm.writeTotalTimeoutConstant = 0 }- Comm.setCommTimeouts h ct+ Comm.setCommTimeouts h ct - let dcb = Comm.DCB {- Comm.baudRate = (baudRate settings),- Comm.parity = (parity settings),- Comm.stopBits = (stopb settings),- Comm.flowControl = (flowControl settings),- Comm.byteSize = (bitsPerWord settings) }- Comm.setCommState h dcb+ Comm.setCommState h new_settings - return ()+ return (SerialPort h new_settings) ++-- |Get configuration from serial port+getSerialSettings :: SerialPort -> SerialPortSettings+getSerialSettings (SerialPort _ settings) = settings
System/Win32/Comm.hsc view
@@ -1,95 +1,96 @@ {-# LANGUAGE ForeignFunctionInterface #-} module System.Win32.Comm where -import System.IO import System.Win32.Types-import Data.Word import Data.Bits import Foreign.Storable import Foreign.Ptr import Foreign.Marshal.Alloc import Foreign.Marshal.Utils-import qualified System.Hardware.Serialport.Types as STypes+import System.Hardware.Serialport.Types #include <windows.h> -type LPDCB = Ptr DCB-data DCB = DCB- { baudRate :: STypes.BaudRate,- parity :: STypes.Parity,- stopBits :: STypes.StopBits,- byteSize :: Word8,- flowControl :: STypes.FlowControl- } ----- | If this member is TRUE, binary mode is enabled. Windows does not support nonbinary mode transfers, so this member must be TRUE.+-- | If this member is TRUE, binary mode is enabled. Windows does not support nonbinary mode transfers,+-- so this member must be TRUE. fBinary :: DWORD-fBinary = 0x0000000000000001+fBinary = 0x00000001 -- | If this member is TRUE, parity checking is performed and errors are reported. fParity :: DWORD-fParity = 0x0000000000000010+fParity = 0x00000002 -instance Storable DCB where- sizeOf = const #size DCB- alignment = sizeOf- poke buf dcb = do- (#poke DCB, DCBlength) buf (sizeOf dcb)- (#poke DCB, BaudRate) buf (fromIntegral (STypes.fromBaudToInt (baudRate dcb)) :: DWORD)- pokeByteOff buf 8 (fBinary .|. fParity :: DWORD)- (#poke DCB, wReserved) buf (0 :: WORD)- (#poke DCB, XonLim) buf (2048 :: WORD)- (#poke DCB, XoffLim) buf (512 :: WORD)- (#poke DCB, ByteSize) buf (byteSize dcb :: BYTE)- (#poke DCB, Parity) buf (case (parity dcb) of- STypes.NoParity -> (#const NOPARITY)- STypes.Odd -> (#const ODDPARITY)- STypes.Even -> (#const EVENPARITY) - :: BYTE)- (#poke DCB, StopBits) buf (case (stopBits dcb) of- STypes.One -> (#const ONESTOPBIT)- STypes.Two -> (#const TWOSTOPBITS)- :: BYTE)- (#poke DCB, wReserved1) buf (0 :: WORD)- peek buf = do- _dCBlength <- (#peek DCB, DCBlength) buf :: IO DWORD- _baudRate <- do _baud <- (#peek DCB, BaudRate) buf :: IO DWORD- return $ STypes.fromIntToBaud (fromIntegral _baud :: Int)- _fsettings <- peekByteOff buf 8 :: IO DWORD- _byteSize <- (#peek DCB, ByteSize) buf :: IO BYTE- _parity <- do _par <- (#peek DCB, Parity) buf :: IO BYTE- case _par of- (#const NOPARITY) -> return STypes.NoParity- (#const ODDPARITY) -> return STypes.Odd- (#const EVENPARITY) -> return STypes.Even- (#const MARKPARITY) -> fail $ "unsupported markparity"- (#const SPACEPARITY) -> fail $ "unsupported spaceparity"- _ -> fail $ "unsupported parity" ++ (show _par)- _stopBits <- do _stopb <- (#peek DCB, StopBits) buf :: IO BYTE- case _stopb of- (#const ONESTOPBIT) -> return STypes.One- (#const ONE5STOPBITS) -> fail $ "unsupported one5stopbits"- (#const TWOSTOPBITS) -> return STypes.Two- _ -> fail "unexpected stop bit count"- _XonLim <- (#peek DCB, XonLim) buf :: IO WORD- _XoffLim <- (#peek DCB, XoffLim) buf :: IO WORD- return DCB { baudRate = _baudRate,- parity = _parity,- stopBits = _stopBits,- flowControl = STypes.NoFlowControl,- byteSize = _byteSize- }+-- Preceding bits: (fBinary)1 + (fParity)1 + (fOutxCtrFlow)1 + (fOutxDsrFlow)1+fDtrEnable :: DWORD+fDtrEnable = (#const DTR_CONTROL_ENABLE) `shift` 4 -getCommState :: HANDLE -> IO DCB+-- Preciding bits:(fBinary)1 + (fParity)1 + (fOutxCtrFlow)1 + (fOutxDsrFlow)1 + (fDtrControl)2 + (fDsrSensitivity)1 ++-- (fTXContinueOnXoff)1 + (fOutX)1 + (fInx)1 + (fErrorChar)1 + (fNull)1+fRtsEnable :: DWORD+fRtsEnable = (#const RTS_CONTROL_ENABLE) `shift` 12+++instance Storable SerialPortSettings where+ sizeOf _ = #{size DCB}+ alignment = sizeOf+ poke buf settings = do+ #{poke DCB, DCBlength} buf (sizeOf settings)+ #{poke DCB, BaudRate} buf (fromIntegral (commSpeedToBaudRate (commSpeed settings)) :: DWORD)+ pokeByteOff buf 8 (fBinary .|. fDtrEnable .|. fRtsEnable )+ #{poke DCB, wReserved} buf (0 :: WORD)+ #{poke DCB, XonLim} buf (2048 :: WORD)+ #{poke DCB, XoffLim} buf (512 :: WORD)+ #{poke DCB, ByteSize} buf (bitsPerWord settings :: BYTE)+ #{poke DCB, Parity} buf (case (parity settings) of+ NoParity -> #const NOPARITY+ Odd -> #const ODDPARITY+ Even -> #const EVENPARITY+ :: BYTE)+ #{poke DCB, StopBits} buf (case (stopb settings) of+ One -> #const ONESTOPBIT+ Two -> #const TWOSTOPBITS+ :: BYTE)+ #{poke DCB, wReserved1} buf (0 :: WORD)+ peek buf = do+ _dCBlength <- #{peek DCB, DCBlength} buf :: IO DWORD+ _commSpeed <- do _baud <- #{peek DCB, BaudRate} buf :: IO DWORD+ return $ baudRateToCommSpeed (fromIntegral _baud)+ _fsettings <- peekByteOff buf 8 :: IO DWORD+ _byteSize <- #{peek DCB, ByteSize} buf :: IO BYTE+ _parity <- do _par <- #{peek DCB, Parity} buf :: IO BYTE+ case _par of+ #{const NOPARITY} -> return NoParity+ #{const ODDPARITY} -> return Odd+ #{const EVENPARITY} -> return Even+ #{const MARKPARITY} -> fail "unsupported markparity"+ #{const SPACEPARITY} -> fail "unsupported spaceparity"+ _ -> fail $ "unsupported parity" ++ show _par+ _stopBits <- do _stopb <- #{peek DCB, StopBits} buf :: IO BYTE+ case _stopb of+ #{const ONESTOPBIT} -> return One+ #{const ONE5STOPBITS} -> fail "unsupported one5stopbits"+ #{const TWOSTOPBITS} -> return Two+ _ -> fail "unexpected stop bit count"+ _XonLim <- #{peek DCB, XonLim} buf :: IO WORD+ _XoffLim <- #{peek DCB, XoffLim} buf :: IO WORD+ return SerialPortSettings {+ commSpeed = _commSpeed,+ bitsPerWord = _byteSize,+ stopb = _stopBits,+ parity = _parity,+ flowControl = NoFlowControl,+ timeout = 0+ }+++getCommState :: HANDLE -> IO SerialPortSettings getCommState h =- alloca (\dcbp -> - do c_GetCommState h dcbp- peek dcbp )+ alloca (\dcbp -> do _ <- c_GetCommState h dcbp+ peek dcbp ) --BOOL WINAPI GetCommState(@@ -97,12 +98,12 @@ -- __inout LPDCB lpDCB --); foreign import stdcall unsafe "winbase.h GetCommState"- c_GetCommState :: HANDLE -> LPDCB -> IO BOOL+ c_GetCommState :: HANDLE -> Ptr SerialPortSettings -> IO BOOL -setCommState :: HANDLE -> DCB -> IO ()-setCommState h dcb =- failIfFalse_ "setCommState" ( with dcb (c_SetCommState h))+setCommState :: HANDLE -> SerialPortSettings -> IO ()+setCommState h settings =+ failIfFalse_ "setCommState" ( with settings (c_SetCommState h)) --BOOL WINAPI SetCommState(@@ -110,14 +111,13 @@ -- __in LPDCB lpDCB --); foreign import stdcall unsafe "winbase.h SetCommState"- c_SetCommState :: HANDLE -> LPDCB -> IO BOOL--+ c_SetCommState :: HANDLE -> Ptr SerialPortSettings -> IO BOOL --- |--- If an application sets ReadIntervalTimeout and ReadTotalTimeoutMultiplier to MAXDWORD and sets ReadTotalTimeoutConstant to a value greater than zero and less than MAXDWORD, one of the following occurs when the ReadFile function is called:+-- If an application sets ReadIntervalTimeout and ReadTotalTimeoutMultiplier to MAXDWORD and+-- sets ReadTotalTimeoutConstant to a value greater than zero and less than MAXDWORD, one of+-- the following occurs when the ReadFile function is called: -- -- * If there are any bytes in the input buffer, ReadFile returns immediately with the bytes in the buffer. --@@ -136,38 +136,37 @@ instance Storable COMMTIMEOUTS where- sizeOf = const #size COMMTIMEOUTS- alignment = sizeOf- poke buf ct = do- (#poke COMMTIMEOUTS, ReadIntervalTimeout) buf (readIntervalTimeout ct)- (#poke COMMTIMEOUTS, ReadTotalTimeoutMultiplier) buf ( readTotalTimeoutMultiplier ct)- (#poke COMMTIMEOUTS, ReadTotalTimeoutConstant) buf ( readTotalTimeoutConstant ct)- (#poke COMMTIMEOUTS, WriteTotalTimeoutMultiplier) buf ( writeTotalTimeoutMultiplier ct)- (#poke COMMTIMEOUTS, WriteTotalTimeoutConstant) buf ( writeTotalTimeoutConstant ct)- peek buf = do- _readIntervalTimeout <- (#peek COMMTIMEOUTS, ReadIntervalTimeout) buf- _readTotalTimeoutMultiplier <- (#peek COMMTIMEOUTS, ReadTotalTimeoutMultiplier ) buf- _readTotalTimeoutConstant <- (#peek COMMTIMEOUTS, ReadTotalTimeoutConstant ) buf- _writeTotalTimeoutMultiplier <- (#peek COMMTIMEOUTS, WriteTotalTimeoutMultiplier ) buf- _writeTotalTimeoutConstant <- (#peek COMMTIMEOUTS, WriteTotalTimeoutConstant ) buf- return COMMTIMEOUTS { readIntervalTimeout = _readIntervalTimeout,- readTotalTimeoutMultiplier = _readTotalTimeoutMultiplier,- readTotalTimeoutConstant = _readTotalTimeoutConstant,- writeTotalTimeoutMultiplier = _writeTotalTimeoutMultiplier,- writeTotalTimeoutConstant = _writeTotalTimeoutConstant }+ sizeOf _ = #{size COMMTIMEOUTS}+ alignment = sizeOf+ poke buf ct = do+ #{poke COMMTIMEOUTS, ReadIntervalTimeout} buf (readIntervalTimeout ct)+ #{poke COMMTIMEOUTS, ReadTotalTimeoutMultiplier} buf ( readTotalTimeoutMultiplier ct)+ #{poke COMMTIMEOUTS, ReadTotalTimeoutConstant} buf ( readTotalTimeoutConstant ct)+ #{poke COMMTIMEOUTS, WriteTotalTimeoutMultiplier} buf ( writeTotalTimeoutMultiplier ct)+ #{poke COMMTIMEOUTS, WriteTotalTimeoutConstant} buf ( writeTotalTimeoutConstant ct)+ peek buf = do+ _readIntervalTimeout <- #{peek COMMTIMEOUTS, ReadIntervalTimeout} buf+ _readTotalTimeoutMultiplier <- #{peek COMMTIMEOUTS, ReadTotalTimeoutMultiplier } buf+ _readTotalTimeoutConstant <- #{peek COMMTIMEOUTS, ReadTotalTimeoutConstant } buf+ _writeTotalTimeoutMultiplier <- #{peek COMMTIMEOUTS, WriteTotalTimeoutMultiplier } buf+ _writeTotalTimeoutConstant <- #{peek COMMTIMEOUTS, WriteTotalTimeoutConstant } buf+ return COMMTIMEOUTS { readIntervalTimeout = _readIntervalTimeout,+ readTotalTimeoutMultiplier = _readTotalTimeoutMultiplier,+ readTotalTimeoutConstant = _readTotalTimeoutConstant,+ writeTotalTimeoutMultiplier = _writeTotalTimeoutMultiplier,+ writeTotalTimeoutConstant = _writeTotalTimeoutConstant } getCommTimeouts :: HANDLE -> IO COMMTIMEOUTS getCommTimeouts h =- alloca (\c -> - do c_GetCommTimeouts h c- peek c )+ alloca (\c -> do _ <- c_GetCommTimeouts h c+ peek c ) -- getcommtimeouts -- winbase.h -> BOOL WINAPI GetCommTimeouts(HANDLE, LPCOMMTIMEOUTS); foreign import stdcall unsafe "winbase.h GetCommTimeouts"- c_GetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL+ c_GetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL @@ -177,13 +176,13 @@ -- setCommTimeouts :: HANDLE -> COMMTIMEOUTS -> IO () setCommTimeouts h ct =- failIfFalse_ "setCommTimeouts" ( with ct (c_SetCommTimeouts h) )+ failIfFalse_ "setCommTimeouts" ( with ct (c_SetCommTimeouts h) ) -- setcommtimeouts -- winbase.h -> BOOL WINAPI SetCommTimeouts(HANDLE, LPCOMMTIMEOUTS); foreign import stdcall unsafe "winbase.h SetCommTimeouts"- c_SetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL+ c_SetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL clrDTR :: DWORD@@ -201,10 +200,32 @@ -- -- foreign import stdcall unsafe "winbase.h EscapeCommFunction"- c_EscapeCommFunction :: HANDLE -> DWORD -> IO BOOL+ c_EscapeCommFunction :: HANDLE -> DWORD -> IO BOOL escapeCommFunction :: HANDLE -> DWORD -> IO () escapeCommFunction h t =- failIfFalse_ "excapeCommFunction" ( c_EscapeCommFunction h t )+ failIfFalse_ "excapeCommFunction" ( c_EscapeCommFunction h t ) ++baudRateToCommSpeed :: Int -> CommSpeed+baudRateToCommSpeed baud =+ case baud of+ (#const CBR_110) -> CS110+ _ -> CS9600+++commSpeedToBaudRate :: CommSpeed -> Int+commSpeedToBaudRate cs =+ case cs of+ CS110 -> (#const CBR_110)+ CS300 -> (#const CBR_300)+ CS600 -> (#const CBR_600)+ CS1200 -> (#const CBR_1200)+ CS2400 -> (#const CBR_2400)+ CS4800 -> (#const CBR_4800)+ CS9600 -> (#const CBR_9600)+ CS19200 -> (#const CBR_19200)+ CS38400 -> (#const CBR_38400)+ CS57600 -> (#const CBR_57600)+ CS115200 -> (#const CBR_115200)
serialport.cabal view
@@ -1,20 +1,24 @@ Name: serialport-Version: 0.3.3-Cabal-Version: >= 1.2-Build-Type: Simple+Version: 0.4.0+Cabal-Version: >= 1.6+Build-Type: Custom license: BSD3 license-file: LICENSE copyright: (c) 2009 Joris Putcuyps author: Joris Putcuyps maintainer: Joris.Putcuyps@gmail.com-homepage: http://users.skynet.be/jputcu/projects/haskell-serialport/index.html-bug-reports: mailto:Joris.Putcuyps@gmail.com-synopsis: Cross platform serial port library. +homepage: https://github.com/jputcu/serialport+bug-reports: https://github.com/jputcu/serialport/issues+synopsis: Cross platform serial port library.+description: Cross platform haskell library for using the serial port. category: Hardware +source-repository head+ type: git+ location: git://github.com/jputcu/serialport.git+ Library Exposed-Modules: System.Hardware.Serialport- System.Hardware.Serialport.Types Build-Depends: base >= 4, base < 5 ghc-options: -Wall