serialport (empty) → 0.1.0
raw patch · 8 files changed
+659/−0 lines, 8 filesdep +Win32dep +basedep +unixsetup-changed
Dependencies added: Win32, base, unix
Files
- LICENSE +29/−0
- README +37/−0
- Setup.hs +2/−0
- System/Hardware/Serialport.hs +40/−0
- System/Hardware/Serialport/Posix.hs +129/−0
- System/Hardware/Serialport/Windows.hs +101/−0
- System/Win32/Comm.hsc +286/−0
- serialport.cabal +35/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2009, Joris Putcuyps+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++- Redistributions of source code must retain the above copyright+notice, this list of conditions, and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright+notice, this list of conditions, and the following disclaimer in the+documentation and/or other materials provided with the distribution.++- The names of the copyright holders may not be used to endorse or+promote products derived from this software without specific prior+written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,37 @@+% Haskell serialport++Name+----+ serialport - Cross platform serial port library.+++Description+-----------++This library provides a way to interface the serial port from haskell in a cross platform way.++Tested on the following platforms:+ + - Linux (Arch)+ - Windows XP 32-bit+++Install+-------++Install using the standard Hackagedb way:++ cabal update+ cabal install serialport+++Problems & suggestions+----------------------++Can be reported via e-mail: joris.putcuyps@gmail.com+++References+----------+ - Frederick Ross with his serial package: http://hackage.haskell.org/package/serial+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Hardware/Serialport.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE CPP #-}+{- | +@+s <- openSerial \"\/dev\/ttyUSB0\" B9600 8 One NoParity NoFlowControl++forM_ \"AT\\r\" $ sendChar s++-- from Control.Monad.Loops+response <- unfoldM (recvChar s)++print response++closeSerial s+@+-}+module System.Hardware.Serialport (+ -- * Types+ StopBits(..)+ ,Parity(..)+ ,FlowControl(..)+ ,BaudRate(..)+ ,SerialPort+#if defined(linux_HOST_OS)+ -- * Simple, non-portable. + ,hOpenSerial+#endif+ -- * Portable methods. + ,openSerial+ ,sendChar+ ,recvChar+ ,closeSerial+ ) where++#if defined(mingw32_HOST_OS)+import System.Hardware.Serialport.Windows+import System.Win32.Comm+#elif defined(linux_HOST_OS)+import System.Hardware.Serialport.Posix+import System.Posix.Terminal+#endif
+ System/Hardware/Serialport/Posix.hs view
@@ -0,0 +1,129 @@+module System.Hardware.Serialport.Posix where+++import System.IO+import System.Posix.Terminal+import System.Posix.IO+++data StopBits = One | Two+data Parity = Even | Odd | NoParity+data FlowControl = Software | NoFlowControl+data SerialPort = SerialPort Handle+++{- | + Open and configure a serial port and return a Handle++++-}+hOpenSerial :: String -- ^ The filename of the serial port, such as @/dev/ttyS0@ or @/dev/ttyUSB0@+ -> BaudRate + -> Int -- ^ The number of bits per word, typically 8+ -> StopBits -- ^ Almost always @One@ unless you're talking to a printer+ -> Parity -- ^ Error checking + -> FlowControl+ -> IO Handle+hOpenSerial dev baud bPerB stopBits parity flow = + do+ setSerial dev baud bPerB stopBits parity flow+ h <- openBinaryFile dev ReadWriteMode+ hSetBuffering h NoBuffering + return h+++openSerial :: String -- ^ The filename of the serial port, such as @/dev/ttyS0@+ -> BaudRate + -> Int -- ^ The number of bits per word, typically 8+ -> StopBits -- ^ Almost always @One@ unless you're talking to a printer+ -> Parity + -> FlowControl+ -> IO SerialPort+openSerial dev baud bPerB stopBits parity flow = + do h <- hOpenSerial dev baud bPerB stopBits parity flow+ return $ SerialPort h+ +++setSerial :: String + -> BaudRate + -> Int + -> StopBits + -> Parity + -> FlowControl+ -> IO ()+setSerial dev baud bPerB stopBits parity flow = do+ fd <- openFd dev ReadWrite Nothing + OpenFileFlags { append = True,+ exclusive = True,+ noctty = True,+ nonBlock = True,+ trunc = False }+ termOpts <- getTerminalAttributes fd+ let termOpts' = configureSettings termOpts baud + bPerB stopBits parity flow+ setTerminalAttributes fd termOpts' Immediately+ closeFd fd+++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 -> BaudRate -> Int -> StopBits -> Parity -> FlowControl -> TerminalAttributes+configureSettings termOpts baud bPerB stopBits parity flow =+ termOpts `withInputSpeed` baud+ `withOutputSpeed` baud+ `withBits` bPerB+ `withStopBits` stopBits+ `withParity` parity+ `withFlowControl` flow+ `withoutMode` EnableEcho+ `withoutMode` EchoErase+ `withoutMode` EchoKill+ `withoutMode` ProcessInput+ `withoutMode` ProcessOutput+ `withoutMode` MapCRtoLF+ `withoutMode` EchoLF+ `withoutMode` HangupOnClose+ `withoutMode` KeyboardInterrupts+ `withoutMode` ExtendedFunctions+ `withMode` LocalMode+ `withMode` ReadEnable++ ++recvChar :: SerialPort -> IO (Maybe Char)+recvChar (SerialPort h) =+ do have_input <- hWaitForInput h 100+ if have_input+ then do c <- hGetChar h+ return $ Just c+ else return Nothing+++sendChar :: SerialPort -> Char -> IO ()+sendChar (SerialPort h) c =+ hPutChar h c+++closeSerial :: SerialPort -> IO ()+closeSerial (SerialPort h) =+ hClose h
+ System/Hardware/Serialport/Windows.hs view
@@ -0,0 +1,101 @@+module System.Hardware.Serialport.Windows where ++import System.IO+import System.Win32.File+import System.Win32.Types+import Data.Bits+import Control.Concurrent+import System.Win32.Comm+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Storable+import Foreign.Ptr+import Foreign.C.Types+import Foreign.C.String+++data SerialPort = SerialPort HANDLE++openSerial :: String -- ^ The filename of the serial port, such as @COM5@ or @//./CNCA0@+ -> BaudRate+ -> Int+ -> StopBits+ -> Parity+ -> FlowControl+ -> IO SerialPort+openSerial dev baud bPerB stopBits parity flow = + do h <- createFile dev access_mode share_mode security_attr create_mode file_attr template_file+ setSerial h baud bPerB stopBits parity flow+ return $ SerialPort h+ 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+++setSerial :: HANDLE+ -> BaudRate + -> Int + -> StopBits + -> Parity + -> FlowControl+ -> IO ()+setSerial h baud bPerB stopb parit flow = + do -- set timeouts+ let ct = COMMTIMEOUTS { + readIntervalTimeout = 0, + readTotalTimeoutMultiplier = 100, + readTotalTimeoutConstant = 0, + writeTotalTimeoutMultiplier = 0, + writeTotalTimeoutConstant = 0 }+ setCommTimeouts h ct+ --print $ show ct++ -- configure DCB structure+ dcb <- getCommState h+ --print $ show dcb++ let dcb' = DCB {+ baudRate = baud,+ parity = parit,+ stopBits = stopb,+ flowControl = flow,+ byteSize = bPerB }+ --print $ show dcb'+ setCommState h dcb'++ dcb_check <- getCommState h+ --print $ show dcb_check++ return ()+++sendChar :: SerialPort -> Char -> IO ()+sendChar (SerialPort h) s =+ do with s (\ p_s -> do win32_WriteFile h p_s count overlapped + return () )+ where+ count = 1+ overlapped = Nothing+++recvChar :: SerialPort -> IO (Maybe Char)+recvChar (SerialPort h) =+ do 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+++closeSerial :: SerialPort -> IO ()+closeSerial (SerialPort h) =+ closeHandle h+
+ System/Win32/Comm.hsc view
@@ -0,0 +1,286 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module System.Win32.Comm where++import System.IO+import System.Win32.File+import System.Win32.Types+import Data.Bits+import Data.Word+import Foreign.Storable+import Foreign.Ptr+import Foreign.C.Types+import Foreign.C.String+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils++#include <windows.h>++data BaudRate+ = B0+ | B50+ | B75+ | B110+ | B134+ | B150+ | B200+ | B300+ | B600+ | B1200+ | B1800+ | B2400+ | B4800+ | B9600+ | B19200+ | B38400+ | B57600+ | B115200+ deriving Show++data StopBits = One | Two deriving Show+data Parity = Even | Odd | NoParity deriving Show+data FlowControl = Software | NoFlowControl deriving Show++--typedef struct _DCB {+-- DWORD DCBlength;+-- DWORD BaudRate;+-- DWORD fBinary :1; If this member is TRUE, binary mode is enabled. Windows does not support nonbinary mode transfers, so this member must be TRUE+-- DWORD fParity :1; If this member is TRUE, parity checking is performed and errors are reported+-- DWORD fOutxCtsFlow :1;+-- DWORD fOutxDsrFlow :1;+-- DWORD fDtrControl :2;+-- DWORD fDsrSensitivity :1;+-- DWORD fTXContinueOnXoff :1;+-- DWORD fOutX :1;+-- DWORD fInX :1;+-- DWORD fErrorChar :1;+-- DWORD fNull :1;+-- DWORD fRtsControl :2;+-- DWORD fAbortOnError :1;+-- DWORD fDummy2 :17; Reserved; do not use.+-- WORD wReserved; Reserved; must be zero.+-- WORD XonLim;+-- WORD XoffLim;+-- BYTE ByteSize;+-- BYTE Parity;+-- BYTE StopBits;+-- char XonChar; The value of the XON character for both transmission and reception.+-- char XoffChar; The value of the XOFF character for both transmission and reception.+-- char ErrorChar; The value of the character used to replace bytes received with a parity error.+-- char EofChar; The value of the character used to signal the end of data.+-- char EvtChar; The value of the character used to signal an event.+-- WORD wReserved1; Reserved; do not use.+--}DCB, *LPDCB;++type LPDCB = Ptr DCB+data DCB = DCB+ { baudRate :: BaudRate,+ parity :: Parity,+ stopBits :: StopBits,+ flowControl :: FlowControl,+ byteSize :: Int+ } deriving Show+++instance Storable DCB where+ sizeOf = const #size DCB+ alignment = sizeOf+ poke buf dcb = do+ (#poke DCB, DCBlength) buf (sizeOf dcb)+ (#poke DCB, BaudRate) buf ((case (baudRate dcb) 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) :: DWORD)+ pokeByteOff buf 8 (0x0000000000000001 :: 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+ NoParity -> 0+ Odd -> 1+ Even -> 2 :: BYTE)+ (#poke DCB, StopBits) buf (case (stopBits dcb) of+ One -> 0+ Two -> 2+ :: BYTE)+ (#poke DCB, wReserved1) buf (0 :: WORD)+ peek buf = do+ _dCBlength <- (#peek DCB, DCBlength) buf :: IO DWORD+ --print $ "dcblenth=" ++ (show _dCBlength)+ _baudRate <- do _baud <- (#peek DCB, BaudRate) buf :: IO DWORD+ case _baud of+ 0 -> return B0+ 50 -> return B50+ 75 -> return B75+ 110 -> return B110+ 134 -> return B134+ 150 -> return B150+ 200 -> return B200+ 300 -> return B300+ 600 -> return B600+ 1200 -> return B1200+ 1800 -> return B1800+ 2400 -> return B2400+ 4800 -> return B4800+ 9600 -> return B9600+ 19200 -> return B19200+ 38400 -> return B38400+ 57600 -> return B57600+ 115200 -> return B115200+ _ -> fail "incorrect baudrate"+ _fsettings <- peekByteOff buf 8 :: IO DWORD -- TODO: use this bitmask+ --print $ "fsettings:" ++ (show _fsettings )+ --print $ "bit 0:" ++ (show (testBit _fsettings 0))+ --print $ "bit 1:" ++ (show (testBit _fsettings 1))+ --print $ "bit 2:" ++ (show (testBit _fsettings 2))+ --print $ "bit 3:" ++ (show (testBit _fsettings 3))+ --print $ "bit 4:" ++ (show (testBit _fsettings 4))+ --print $ "bit 5:" ++ (show (testBit _fsettings 5))+ --print $ "bit 6:" ++ (show (testBit _fsettings 6))+ --print $ "bit 7:" ++ (show (testBit _fsettings 7))+ --print $ "bit 8:" ++ (show (testBit _fsettings 8))+ --print $ "bit 9:" ++ (show (testBit _fsettings 9))+ --print $ "bit 10:" ++ (show (testBit _fsettings 10))+ --print $ "bit 11:" ++ (show (testBit _fsettings 11))+ --print $ "bit 12:" ++ (show (testBit _fsettings 12))+ --print $ "bit 31:" ++ (show (testBit _fsettings 31))+ _byteSize <- (#peek DCB, ByteSize) buf :: IO BYTE+ _parity <- do _par <- (#peek DCB, Parity) buf :: IO BYTE+ -- noparity = 0+ -- oddparity = 1+ -- evenparity = 2+ -- markparity = 3+ -- spaceparity = 4+ case _par of+ 0 -> return NoParity+ 1 -> return Odd+ 2 -> return Even+ --3 ->+ --4 ->+ _ -> fail $ "incorrect parity" ++ (show _par)+ _stopBits <- do _stopb <- (#peek DCB, StopBits) buf :: IO BYTE+ case _stopb of+ 0 -> return One+ -- 1 -> one5stopbits+ 2 -> return Two+ _ -> fail "unexpected stop bit count"+ _XonLim <- (#peek DCB, XonLim) buf :: IO WORD+ --print $ show _XonLim+ _XoffLim <- (#peek DCB, XoffLim) buf :: IO WORD+ --print $ show _XoffLim+ return $ DCB { baudRate = _baudRate,+ parity = _parity,+ stopBits = _stopBits,+ flowControl = NoFlowControl,+ byteSize = _byteSize+ }+++getCommState :: HANDLE -> IO DCB+getCommState h =+ do dcb <- alloca (\dcbp -> + do c_GetCommState h dcbp+ dcb <- peek dcbp+ return dcb )+ return dcb++ +--BOOL WINAPI GetCommState(+-- __in HANDLE hFile,+-- __inout LPDCB lpDCB+--);+foreign import stdcall unsafe "winbase.h GetCommState"+ c_GetCommState :: HANDLE -> LPDCB -> IO BOOL+++setCommState :: HANDLE -> DCB -> IO ()+setCommState h dcb =+ do with dcb (\ pdcb -> c_SetCommState h pdcb )+ return ()+++--BOOL WINAPI SetCommState(+-- __in HANDLE hFile,+-- __in LPDCB lpDCB+--);+foreign import stdcall unsafe "winbase.h SetCommState"+ c_SetCommState :: HANDLE -> LPDCB -> IO BOOL+++++++type LPCOMMTIMEOUTS = Ptr COMMTIMEOUTS+data COMMTIMEOUTS = COMMTIMEOUTS + { readIntervalTimeout :: DWORD, -- in milliseconds + readTotalTimeoutMultiplier :: DWORD, -- in milliseconds+ readTotalTimeoutConstant :: DWORD, -- in milliseconds+ writeTotalTimeoutMultiplier :: DWORD, -- in milliseconds+ writeTotalTimeoutConstant :: DWORD } -- in milliseconds+ deriving Show+++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 }+ ++getCommTimeouts :: HANDLE -> IO COMMTIMEOUTS+getCommTimeouts h =+ do comm_timeouts <- alloca (\c -> + do c_GetCommTimeouts h c+ ct <- peek c+ return ct )+ return comm_timeouts+++-- getcommtimeouts+-- winbase.h -> BOOL WINAPI GetCommTimeouts(HANDLE, LPCOMMTIMEOUTS);+foreign import stdcall unsafe "winbase.h GetCommTimeouts"+ c_GetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL+++setCommTimeouts :: HANDLE -> COMMTIMEOUTS -> IO ()+setCommTimeouts h ct =+ do with ct (\ pct -> c_SetCommTimeouts h pct )+ return ()+++-- setcommtimeouts+-- winbase.h -> BOOL WINAPI SetCommTimeouts(HANDLE, LPCOMMTIMEOUTS);+foreign import stdcall unsafe "winbase.h SetCommTimeouts"+ c_SetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL+
+ serialport.cabal view
@@ -0,0 +1,35 @@+Name: serialport+Version: 0.1.0+Cabal-Version: >= 1.2+Build-Type: Simple+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. ++description: This library provides a way to interface the serial port from haskell in a cross platform way.+ .+ Tested on the following platforms:+ . + * Linux (Arch)+ .+ * Windows XP 32-bit++category: Hardware++Library+ Exposed-Modules: System.Hardware.Serialport+ Build-Depends: base >= 4, base < 5 + Extensions: CPP++ if !os(windows)+ Build-Depends: unix+ Exposed-Modules: System.Hardware.Serialport.Posix+ else+ Build-Depends: Win32+ Exposed-Modules: System.Hardware.Serialport.Windows+ System.Win32.Comm