diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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 + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/Hardware/Serialport.hs b/System/Hardware/Serialport.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Serialport.hs @@ -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 diff --git a/System/Hardware/Serialport/Posix.hs b/System/Hardware/Serialport/Posix.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Serialport/Posix.hs @@ -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 diff --git a/System/Hardware/Serialport/Windows.hs b/System/Hardware/Serialport/Windows.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Serialport/Windows.hs @@ -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 + diff --git a/System/Win32/Comm.hsc b/System/Win32/Comm.hsc new file mode 100644 --- /dev/null +++ b/System/Win32/Comm.hsc @@ -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 + +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 + diff --git a/serialport.cabal b/serialport.cabal new file mode 100644 --- /dev/null +++ b/serialport.cabal @@ -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