serialport 0.3.1 → 0.3.2
raw patch · 6 files changed
+153/−94 lines, 6 files
Files
- System/Hardware/Serialport.hs +1/−0
- System/Hardware/Serialport/Posix.hs +0/−93
- System/Hardware/Serialport/Posix.hsc +126/−0
- System/Hardware/Serialport/Windows.hs +8/−0
- System/Win32/Comm.hsc +17/−0
- serialport.cabal +1/−1
System/Hardware/Serialport.hs view
@@ -17,6 +17,7 @@ ,sendChar ,recvChar ,closeSerial+ ,setDTR ) where #if defined(mingw32_HOST_OS)
− System/Hardware/Serialport/Posix.hs
@@ -1,93 +0,0 @@-module System.Hardware.Serialport.Posix where--import System.IO-import System.IO.Error-import System.Posix.IO-import System.Posix.Types-import System.Posix.Terminal-import System.Hardware.Serialport.Types----- |Open and configure a serial port-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- ---- |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----- |Send a character-sendChar :: SerialPort -> Char -> IO ()-sendChar (SerialPort fd' _ ) c =- fdWrite fd' [c] >> return ()----- |Close the serial port-closeSerial :: SerialPort -> IO ()-closeSerial (SerialPort fd' _ ) =- closeFd fd' ---setSerialSettings :: Fd -> SerialPortSettings -> IO ()-setSerialSettings fd' settings = - do termOpts <- getTerminalAttributes fd'- let termOpts' = configureSettings termOpts settings- setTerminalAttributes fd' termOpts' Immediately---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---withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes-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---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-
+ System/Hardware/Serialport/Posix.hsc view
@@ -0,0 +1,126 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module System.Hardware.Serialport.Posix where++import System.IO+import System.IO.Error+import System.Posix.IO+import System.Posix.Types+import System.Posix.Terminal+import System.Hardware.Serialport.Types+import Foreign+import Foreign.C+import Data.Bits+++-- |Open and configure a serial port+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+ ++-- |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+++-- |Send a character+sendChar :: SerialPort -> Char -> IO ()+sendChar (SerialPort fd' _ ) c =+ fdWrite fd' [c] >> return ()+++-- |Close the serial port+closeSerial :: SerialPort -> IO ()+closeSerial (SerialPort fd' _ ) =+ closeFd fd' +++#include <sys/ioctl.h>++foreign import ccall "ioctl" c_ioctl :: CInt -> CInt -> Ptr () -> IO CInt++c_ioctl' :: Fd -> Int -> Ptr d -> IO ()+c_ioctl' f req =+ throwErrnoIfMinus1_ "ioctl" .+ c_ioctl (fromIntegral f) (fromIntegral req) . castPtr+++getTIOCM :: Fd -> IO Int+getTIOCM fd' =+ alloca $ \p -> c_ioctl' fd' (#const TIOCMGET) p >> peek p+++setTIOCM :: Fd -> Int -> IO ()+setTIOCM fd' val =+ with val $ c_ioctl' 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))+++setSerialSettings :: Fd -> SerialPortSettings -> IO ()+setSerialSettings fd' settings = + do termOpts <- getTerminalAttributes fd'+ let termOpts' = configureSettings termOpts settings+ setTerminalAttributes fd' termOpts' Immediately+++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+++withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes+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+++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+
System/Hardware/Serialport/Windows.hs view
@@ -59,6 +59,14 @@ 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++ setSerialSettings :: HANDLE -> SerialPortSettings -> IO () setSerialSettings h settings = do let ct = Comm.COMMTIMEOUTS {
System/Win32/Comm.hsc view
@@ -184,3 +184,20 @@ foreign import stdcall unsafe "winbase.h SetCommTimeouts" c_SetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL ++clrDTR :: DWORD+clrDTR = #const CLRDTR++setDTR :: DWORD+setDTR = #const SETDTR++-- +--+foreign import stdcall unsafe "winbase.h EscapeCommFunction"+ c_EscapeCommFunction :: HANDLE -> DWORD -> IO BOOL+++escapeCommFunction :: HANDLE -> DWORD -> IO ()+escapeCommFunction h t =+ failIfFalse_ "excapeCommFunction" ( c_EscapeCommFunction h t )+
serialport.cabal view
@@ -1,5 +1,5 @@ Name: serialport-Version: 0.3.1+Version: 0.3.2 Cabal-Version: >= 1.2 Build-Type: Simple license: BSD3