diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,50 @@ +0.6.0 (9/21/2025) +================== +* Remove custom baud rates [22](https://github.com/standardsemiconductor/serialport/pull/22) +* Update package dependency constraints +* Add `serialport` command-line executable [16](https://github.com/standardsemiconductor/serialport/pull/16) +0.5.6 (11/23/2024) +================== +* Add custom baud rates [13](https://github.com/standardsemiconductor/serialport/pull/13) +* Update package dependency constraints -4.7 (28/08/2014) +0.5.5 (1/15/2024) +================= +* Fix runtime error on Windows [6](https://github.com/standardsemiconductor/serialport/pull/6) +* Deprecate String `fdRead` [9](https://github.com/standardsemiconductor/serialport/pull/9) +* Update to unix-2.8 [8](https://github.com/standardsemiconductor/serialport/pull/8) + +0.5.4 (12/02/2022) +================== +* Update package dependency constraints + * base >= 4.12 && < 4.17 + +0.5.3 (26/09/2021) +================== +* Update package dependency constraints + * Win32 >= 2.11 && < 2.14 +* Add documentation and code samples + +0.5.2 (30/3/2021) +================= +* Update package dependency constraints + +0.5.1 (16/1/2021) +================= +* Lock Posix serial port for exclusive access +* Simplify internal usage of serial port handles under both Posix and Windows +* Add hWithSerial +* Minor updates to make future refactoring easier + +0.5.0 (16/12/2020) +================== +* Derive Show and Read instances for SerialPortSettings, CommSpeed, StopBits, Parity, and FlowControl datatypes. +* Update minimum Cabal-version to 1.10 +* Minor syntax changes +* Minor code cleanup + +0.4.7 (28/08/2014) ================ * Open in non-blocking mode, immediately reverting to blocking to fix OS-X problem diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,5 @@ Copyright (c) 2009, Joris Putcuyps +Copyright (c) 2020, David Cox All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,25 +1,59 @@ -Objectives -========== -* Cross platform: at least Linux, Windows and Mac OS. +# Serialport -Tests -===== +[![Haskell CI](https://github.com/standardsemiconductor/serialport/actions/workflows/haskell.yml/badge.svg)](https://github.com/standardsemiconductor/serialport/actions/workflows/haskell.yml) +[![Hackage][hackage-badge]][hackage] -Setup ------ +Cross platform (Linux, Windows and Mac OS) [serial port](https://en.wikipedia.org/wiki/Serial_port) interface. + +## Sample Usage + +```haskell +import System.IO +import System.Hardware.Serialport +import qualified Data.ByteString.Char8 as B + +let port = "COM3" -- Windows +let port = "/dev/ttyUSB0" -- Linux +withSerial port defaultSerialSettings $ \s -> do + send s $ B.pack "AT\r" + recv s 10 >>= print +``` + +[Concurrently](https://hackage.haskell.org/package/async) read and write a serial port at 19200 [baud](https://learn.sparkfun.com/tutorials/serial-communication/rules-of-serial) using `hWithSerial`: +```haskell +import Control.Concurrent.Async +import Control.Monad +import System.Hardware.Serialport +import System.IO + +com :: String -> IO () +com portPath = hWithSerial portPath serialPortSettings $ \hndl -> do + hSetBuffering stdin NoBuffering + hSetBuffering stdout NoBuffering + concurrently_ (readUart hndl) (writeUart hndl) + where + readUart hndl = forever $ putChar =<< hGetChar hndl + writeUart hndl = forever $ hPutChar hndl =<< getChar + +serialPortSettings :: SerialPortSettings +serialPortSettings = defaultSerialSettings{ commSpeed = CS19200 } +``` + +## Tests + +### Setup * [Arduino Leonardo](http://arduino.cc/en/Main/arduinoBoardLeonardo) + [Sparkfun FTDI breakout board](https://www.sparkfun.com/products/718). * Connections: TX, RX and GND -Prepare Arduino ---------------- +### Prepare Arduino * Upload arduino code using Arduino IDE or avrdude -Prepare haskell test program ----------------------------- -* Configure cabal to build the tests: cabal configure --enable-tests. -* Build: cabal build +### Prepare haskell test program +* Configure cabal to build the tests: `cabal configure --enable-tests`. +* Build: `cabal build` -Running the tests ------------------ -* Run the tests: cabal test --test-options="/dev/ttyACM0 /dev/ttyUSB0" +### Running the tests +* Run the tests: `cabal test --test-options="/dev/ttyACM0 /dev/ttyUSB0"` +[hackage]: +[hackage-badge]: diff --git a/System/Hardware/Serialport.hs b/System/Hardware/Serialport.hs --- a/System/Hardware/Serialport.hs +++ b/System/Hardware/Serialport.hs @@ -6,22 +6,19 @@ -- > import System.Hardware.Serialport -- > let port = "COM3" -- Windows -- > let port = "/dev/ttyUSB0" -- Linux --- > s <- openSerial port defaultSerialSettings { commSpeed = CS2400 } --- > send s $ B.pack "AT\r" --- > recv s 10 >>= print --- > closeSerial s +-- > withSerial port defaultSerialSettings{ commSpeed = CS2400 } $ \s -> do +-- > send s $ B.pack "AT\r" +-- > recv s 10 >>= print -- --- Or use the experimental interface with standard handles: +-- Alternatively, use handles to perform IO: -- -- > import System.IO -- > import System.Hardware.Serialport -- > let port = "COM3" -- Windows -- > let port = "/dev/ttyUSB0" -- Linux --- > h <- hOpenSerial port defaultSerialSettings --- > hPutStr h "AT\r" --- > hGetLine h >>= print --- > hClose h - +-- > hWithSerial port defaultSerialSettings $ \h -> do +-- > hPutStr h "AT\r" +-- > hGetLine h >>= print module System.Hardware.Serialport ( -- * Types @@ -42,6 +39,7 @@ ,openSerial ,closeSerial ,withSerial + ,hWithSerial -- ** Sending & receiving ,send ,recv @@ -58,8 +56,14 @@ #endif import System.Hardware.Serialport.Types +import System.IO (Handle, hClose) import qualified Control.Exception as Ex + -- |Safer device function, so you don't forget to close the device -withSerial :: String -> SerialPortSettings -> ( SerialPort -> IO a ) -> IO a +withSerial :: FilePath -> SerialPortSettings -> ( SerialPort -> IO a ) -> IO a withSerial dev settings = Ex.bracket (openSerial dev settings) closeSerial + +-- |Like `withSerial` but using `Handle` +hWithSerial :: FilePath -> SerialPortSettings -> (Handle -> IO a) -> IO a +hWithSerial dev settings = Ex.bracket (hOpenSerial dev settings) hClose diff --git a/System/Hardware/Serialport/Cli.hs b/System/Hardware/Serialport/Cli.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Serialport/Cli.hs @@ -0,0 +1,114 @@ +module System.Hardware.Serialport.Cli + ( SerialPortCli(..) + , serialPortCli + , -- * Parsers + serialPortCliParser + , serialPortPathParser + , serialPortSettingsParser + , commSpeedParser + , bitsPerWordParser + , stopBitsParser + , parityParser + , flowControlParser + , timeoutParser + ) where + +import Data.Word +import Options.Applicative +import System.Hardware.Serialport.Types + +data SerialPortCli = SerialPortCli + { serialPortPath :: FilePath + , serialPortSettings :: SerialPortSettings + } + +serialPortCli :: IO SerialPortCli +serialPortCli = + customExecParser serialPortCliPrefs $ + info (serialPortCliParser <**> helper) mempty + +serialPortCliPrefs :: ParserPrefs +serialPortCliPrefs = prefs $ showHelpOnError <> showHelpOnEmpty + +serialPortCliParser :: Parser SerialPortCli +serialPortCliParser = + SerialPortCli + <$> serialPortPathParser + <*> serialPortSettingsParser + +serialPortPathParser :: Parser FilePath +serialPortPathParser = strArgument $ mconcat + [ help "serial port file path" + , metavar "" + , completer $ bashCompleter "file" + ] + +serialPortSettingsParser :: Parser SerialPortSettings +serialPortSettingsParser = + SerialPortSettings + <$> commSpeedParser + <*> bitsPerWordParser + <*> stopBitsParser + <*> parityParser + <*> flowControlParser + <*> timeoutParser + +commSpeedParser :: Parser CommSpeed +commSpeedParser = option auto $ mconcat + [ long "baudrate" + , short 'b' + , value CS115200 + , showDefault + , metavar "" + , help "Baud rate" + ] + +bitsPerWordParser :: Parser Word8 +bitsPerWordParser = option auto $ mconcat + [ long "databits" + , short 'd' + , value $ bitsPerWord defaultSerialSettings + , showDefault + , metavar "7|8" + , help "Data bits" + ] + +stopBitsParser :: Parser StopBits +stopBitsParser = option auto $ mconcat + [ long "stopbits" + , short 's' + , value $ stopb defaultSerialSettings + , showDefault + , metavar "One|Two" + , help "Stop bits" + ] + +parityParser :: Parser Parity +parityParser = option auto $ mconcat + [ long "parity" + , short 'p' + , value $ parity defaultSerialSettings + , showDefault + , metavar "Even|Odd|NoParity" + , help "Parity" + ] + +flowControlParser :: Parser FlowControl +flowControlParser = option auto $ mconcat + [ long "flow" + , short 'f' + , value $ flowControl defaultSerialSettings + , showDefault + , metavar "Software|NoFlowControl" + , help "Flow control" + ] + +timeoutParser :: Parser Int +timeoutParser = option auto $ mconcat + [ long "timeout" + , short 't' + , value $ timeout defaultSerialSettings + , showDefault + , metavar "TIME" + , help "Timeout in tenth-of-seconds" + ] diff --git a/System/Hardware/Serialport/Posix.hsc b/System/Hardware/Serialport/Posix.hsc --- a/System/Hardware/Serialport/Posix.hsc +++ b/System/Hardware/Serialport/Posix.hsc @@ -1,82 +1,50 @@ -{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-} -{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_HADDOCK hide #-} module System.Hardware.Serialport.Posix where -import qualified Data.ByteString.Char8 as B import qualified Control.Exception as Ex -import System.Posix.IO -import System.Posix.Types -import System.Posix.Terminal -import System.Hardware.Serialport.Types -import Foreign (Ptr, castPtr, alloca, peek, with) +import Data.Bits +import qualified Data.ByteString.Char8 as B +import Data.Either +import Data.Typeable +import Foreign (Ptr, nullPtr, castPtr, alloca, peek, with) import Foreign.C import GHC.IO.Handle -import GHC.IO.Device -import GHC.IO.BufferedIO -import Data.Typeable -import GHC.IO.Buffer import GHC.IO.Encoding -import Control.Monad (void) -import Data.Bits - - -data SerialPort = SerialPort { - fd :: Fd, - portSettings :: SerialPortSettings - } - deriving (Typeable) - - -instance RawIO SerialPort where - read (SerialPort fd' _) ptr n = return . fromIntegral =<< fdReadBuf fd' ptr (fromIntegral n) - readNonBlocking _ _ _ = error "readNonBlocking not implemented" - write (SerialPort fd' _) ptr n = void (fdWriteBuf fd' ptr (fromIntegral n)) - writeNonBlocking _ _ _ = error "writenonblocking not implemented" - - -instance IODevice SerialPort where - ready _ _ _ = return True - close = closeSerial - isTerminal _ = return False - isSeekable _ = return False - seek _ _ _ = return () - tell _ = return 0 - getSize _ = return 0 - setSize _ _ = return () - setEcho _ _ = return () - getEcho _ = return False - setRaw _ _ = return () - devType _ = return Stream - - -instance BufferedIO SerialPort where - newBuffer _ = newByteBuffer 100 - fillReadBuffer = readBuf - fillReadBuffer0 = readBufNonBlocking - flushWriteBuffer = writeBuf - flushWriteBuffer0 = writeBufNonBlocking +import System.Hardware.Serialport.Types +import System.Posix.IO +import qualified System.Posix.IO.ByteString as BIO +import System.Posix.Types (Fd) +import System.Posix.Terminal +data SerialPort = SerialPort + { fd :: Fd + , portSettings :: SerialPortSettings + } deriving (Show, Typeable) -- |Open and configure a serial port returning a standard Handle hOpenSerial :: FilePath -> SerialPortSettings -> IO Handle hOpenSerial dev settings = do - ser <- openSerial dev settings - h <- mkDuplexHandle ser dev Nothing noNewlineTranslation + h <- fdToHandle . fd =<< openSerial dev settings hSetBuffering h NoBuffering return h -- |Open and configure a serial port -openSerial :: FilePath -- ^ Serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ - -> SerialPortSettings - -> IO SerialPort +openSerial + :: FilePath -- ^ Serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ + -> SerialPortSettings + -> IO SerialPort openSerial dev settings = do - fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True, nonBlock = True } + fd' <- openFd dev ReadWrite defaultFileFlags { noctty = True, nonBlock = True } + setTIOCEXCL fd' setFdOption fd' NonBlockingRead False let serial_port = SerialPort fd' defaultSerialSettings - return =<< setSerialSettings serial_port settings + setSerialSettings serial_port settings -- |Use specific encoding for an action and restore old encoding afterwards @@ -95,28 +63,24 @@ -- |Receive bytes, given the maximum number recv :: SerialPort -> Int -> IO B.ByteString -recv (SerialPort fd' _) n = do - result <- withEncoding char8 $ Ex.try $ fdRead fd' count :: IO (Either IOError (String, ByteCount)) - case result of - Right (str, _) -> return $ B.pack str - Left _ -> return B.empty +recv port n = do + result <- withEncoding char8 $ Ex.try $ BIO.fdRead (fd port) count :: IO (Either IOError B.ByteString) + return $ fromRight B.empty result where count = fromIntegral n - -- |Send bytes -send :: SerialPort - -> B.ByteString - -> IO Int -- ^ Number of bytes actually sent -send (SerialPort fd' _ ) msg = do - ret <- withEncoding char8 (fdWrite fd' (B.unpack msg)) - return $ fromIntegral ret +send + :: SerialPort + -> B.ByteString + -> IO Int -- ^ Number of bytes actually sent +send port msg = + fromIntegral <$> withEncoding char8 (fdWrite (fd port) (B.unpack msg)) -- |Flush buffers flush :: SerialPort -> IO () -flush (SerialPort fd' _) = - discardData fd' BothQueues +flush port = discardData (fd port) BothQueues -- |Close the serial port @@ -144,6 +108,10 @@ with val $ cIoctl' fd' #{const TIOCMSET} +setTIOCEXCL :: Fd -> IO () +setTIOCEXCL fd' = cIoctl' fd' #{const TIOCEXCL} nullPtr + + -- |Set the Data Terminal Ready level setDTR :: SerialPort -> Bool -> IO () setDTR (SerialPort fd' _) set = do @@ -166,11 +134,11 @@ 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' +setSerialSettings port new_settings = do + termOpts <- getTerminalAttributes $ fd port let termOpts' = configureSettings termOpts new_settings - setTerminalAttributes fd' termOpts' Immediately - return (SerialPort fd' new_settings) + setTerminalAttributes (fd port) termOpts' Immediately + return $ SerialPort (fd port) new_settings -- |Get configuration from serial port @@ -230,18 +198,15 @@ 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 - - +commSpeedToBaudRate = \case + CS110 -> B110 + CS300 -> B300 + CS600 -> B600 + CS1200 -> B1200 + CS2400 -> B2400 + CS4800 -> B4800 + CS9600 -> B9600 + CS19200 -> B19200 + CS38400 -> B38400 + CS57600 -> B57600 + CS115200 -> B115200 diff --git a/System/Hardware/Serialport/Types.hs b/System/Hardware/Serialport/Types.hs --- a/System/Hardware/Serialport/Types.hs +++ b/System/Hardware/Serialport/Types.hs @@ -3,7 +3,6 @@ import Data.Word - -- | Supported baudrates data CommSpeed = CS110 @@ -17,23 +16,27 @@ | CS38400 | CS57600 | CS115200 - deriving (Show, Eq, Bounded) + deriving (Show, Read, Eq, Bounded) +data StopBits = One | Two + deriving (Show, Read, Eq, Bounded) -data StopBits = One | Two deriving (Show, Eq, Bounded) -data Parity = Even | Odd | NoParity deriving (Show, Eq) -data FlowControl = Software | NoFlowControl deriving (Show, Eq) +data Parity = Even | Odd | NoParity + deriving (Show, Read, Eq) -data SerialPortSettings = SerialPortSettings { - commSpeed :: CommSpeed, -- ^ 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 - } +data FlowControl = Software | NoFlowControl + deriving (Show, Read, Eq) +data SerialPortSettings = SerialPortSettings + { commSpeed :: CommSpeed, -- ^ 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 + } deriving (Show, Read, Eq) + -- | Most commonly used configuration -- -- - 9600 baud @@ -51,4 +54,3 @@ defaultSerialSettings :: SerialPortSettings defaultSerialSettings = SerialPortSettings CS9600 8 One NoParity NoFlowControl 1 - diff --git a/System/Hardware/Serialport/Windows.hs b/System/Hardware/Serialport/Windows.hs --- a/System/Hardware/Serialport/Windows.hs +++ b/System/Hardware/Serialport/Windows.hs @@ -2,70 +2,36 @@ {-# OPTIONS_HADDOCK hide #-} module System.Hardware.Serialport.Windows where -import Data.Bits -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Unsafe as BU -import qualified System.Win32.Comm as Comm -import System.Win32.Types -import System.Win32.File -import Foreign.Marshal.Alloc -import System.Hardware.Serialport.Types -import Control.Monad import GHC.IO.Handle -import GHC.IO.Device -import GHC.IO.BufferedIO -import Data.Typeable -import GHC.IO.Buffer - -data SerialPort = SerialPort { - handle :: HANDLE, - portSettings :: SerialPortSettings - } - deriving (Typeable) +import System.Win32.Types +import System.Win32.File +import qualified System.Win32.Comm as Comm +import Foreign.Marshal.Alloc -instance RawIO SerialPort where - read (SerialPort h _) ptr n = return . fromIntegral =<< win32_ReadFile h ptr (fromIntegral n) Nothing - readNonBlocking _ _ _ = error "readNonBlocking not implemented" - write (SerialPort h _) ptr n = void (win32_WriteFile h ptr (fromIntegral n) Nothing) - writeNonBlocking _ _ _ = error "writenonblocking not implemented" +import Control.Monad (unless) +import Data.Typeable +import Data.Bits +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Unsafe as BU -instance IODevice SerialPort where - ready _ _ _ = return True - close = closeSerial - isTerminal _ = return False - isSeekable _ = return False - seek _ _ _ = return () - tell _ = return 0 - getSize _ = return 0 - setSize _ _ = return () - setEcho _ _ = return () - getEcho _ = return False - setRaw _ _ = return () - devType _ = return Stream +import System.Hardware.Serialport.Types -instance BufferedIO SerialPort where - newBuffer _ = newByteBuffer 100 - fillReadBuffer = readBuf - fillReadBuffer0 = readBufNonBlocking - flushWriteBuffer = writeBuf - flushWriteBuffer0 = writeBufNonBlocking - +data SerialPort = SerialPort + { handle :: HANDLE + , portSettings :: SerialPortSettings + } deriving (Show, Typeable) -- |Open and configure a serial port returning a standard Handle. -hOpenSerial :: String - -> SerialPortSettings - -> IO Handle +hOpenSerial :: String -> SerialPortSettings -> IO Handle hOpenSerial dev settings = do - ser <- openSerial dev settings - h <- mkDuplexHandle ser dev Nothing noNewlineTranslation + h <- hANDLEToHandle . handle =<< openSerial dev settings hSetBuffering h NoBuffering return h - -- | Open and configure a serial port openSerial :: String -- ^ Serial port, such as @COM5@ or @CNCA0@ -> SerialPortSettings @@ -73,7 +39,7 @@ 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 + setSerialSettings serial_port settings where access_mode = gENERIC_READ .|. gENERIC_WRITE share_mode = fILE_SHARE_NONE @@ -85,10 +51,9 @@ -- |Receive bytes, given the maximum number recv :: SerialPort -> Int -> IO B.ByteString -recv (SerialPort h _) n = - allocaBytes n $ \p -> do - recv_cnt <- win32_ReadFile h p count overlapped - B.packCStringLen (p, fromIntegral recv_cnt) +recv port n = allocaBytes n $ \p -> do + recv_cnt <- win32_ReadFile (handle port) p count overlapped + B.packCStringLen (p, fromIntegral recv_cnt) where count = fromIntegral n overlapped = Nothing @@ -98,9 +63,8 @@ send :: SerialPort -> B.ByteString -> IO Int -- ^ Number of bytes actually sent -send (SerialPort h _) msg = - BU.unsafeUseAsCString msg $ \p -> - fromIntegral `fmap` win32_WriteFile h p count overlapped +send port msg = BU.unsafeUseAsCString msg $ \p -> + fromIntegral `fmap` win32_WriteFile (handle port) p count overlapped where count = fromIntegral $ B.length msg overlapped = Nothing @@ -108,12 +72,10 @@ -- |Flush buffers flush :: SerialPort -> IO () -flush s@(SerialPort h _) = - flushFileBuffers h - >> consumeIncomingChars +flush port = flushFileBuffers (handle port) >> consumeIncomingChars where consumeIncomingChars = do - ch <- recv s 1 + ch <- recv port 1 unless (ch == B.empty) consumeIncomingChars @@ -124,33 +86,32 @@ -- |Set the Data Terminal Ready level setDTR :: SerialPort -> Bool -> IO () -setDTR (SerialPort h _ ) True = Comm.escapeCommFunction h Comm.setDTR -setDTR (SerialPort h _ ) False = Comm.escapeCommFunction h Comm.clrDTR +setDTR port True = Comm.escapeCommFunction (handle port) Comm.setDTR +setDTR port False = Comm.escapeCommFunction (handle port) Comm.clrDTR -- |Set the Ready to send level setRTS :: SerialPort -> Bool -> IO () -setRTS (SerialPort h _ ) True = Comm.escapeCommFunction h Comm.setRTS -setRTS (SerialPort h _ ) False = Comm.escapeCommFunction h Comm.clrRTS +setRTS port True = Comm.escapeCommFunction (handle port) Comm.setRTS +setRTS port False = Comm.escapeCommFunction (handle port) Comm.clrRTS -- |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 new_settings) * 100, - Comm.writeTotalTimeoutMultiplier = 0, - Comm.writeTotalTimeoutConstant = 0 } - Comm.setCommTimeouts h ct - - Comm.setCommState h new_settings - - return (SerialPort h new_settings) - +setSerialSettings port new_settings = do + Comm.setCommTimeouts (handle port) commTimeouts + Comm.setCommState (handle port) new_settings + return $ SerialPort (handle port) new_settings + where + commTimeouts = Comm.COMMTIMEOUTS + { Comm.readIntervalTimeout = maxBound :: DWORD + , Comm.readTotalTimeoutMultiplier = maxBound :: DWORD + , Comm.readTotalTimeoutConstant = fromIntegral (timeout new_settings) * 100 + , Comm.writeTotalTimeoutMultiplier = 0 + , Comm.writeTotalTimeoutConstant = 0 + } -- |Get configuration from serial port getSerialSettings :: SerialPort -> SerialPortSettings diff --git a/System/Win32/Comm.hsc b/System/Win32/Comm.hsc --- a/System/Win32/Comm.hsc +++ b/System/Win32/Comm.hsc @@ -37,7 +37,7 @@ instance Storable SerialPortSettings where sizeOf _ = #{size DCB} - alignment = sizeOf + alignment _ = 16 poke buf settings = do #{poke DCB, DCBlength} buf (sizeOf settings) #{poke DCB, BaudRate} buf (fromIntegral (commSpeedToBaudRate (commSpeed settings)) :: DWORD) @@ -138,7 +138,7 @@ instance Storable COMMTIMEOUTS where sizeOf _ = #{size COMMTIMEOUTS} - alignment = sizeOf + alignment _ = 16 poke buf ct = do #{poke COMMTIMEOUTS, ReadIntervalTimeout} buf (readIntervalTimeout ct) #{poke COMMTIMEOUTS, ReadTotalTimeoutMultiplier} buf ( readTotalTimeoutMultiplier ct) diff --git a/exe/Main.hs b/exe/Main.hs new file mode 100644 --- /dev/null +++ b/exe/Main.hs @@ -0,0 +1,19 @@ +import Control.Concurrent.Async +import Control.Monad +import System.Hardware.Serialport +import System.Hardware.Serialport.Cli +import System.IO + +main :: IO () +main = do + opts <- serialPortCli + hWithSerial (serialPortPath opts) (serialPortSettings opts) com + +com :: Handle -> IO () +com hndl = do + hSetBuffering stdin NoBuffering + hSetBuffering stdout NoBuffering + concurrently_ readUart writeUart + where + readUart = forever $ putChar =<< hGetChar hndl + writeUart = forever $ hPutChar hndl =<< getChar diff --git a/serialport.cabal b/serialport.cabal --- a/serialport.cabal +++ b/serialport.cabal @@ -1,14 +1,15 @@ Name: serialport -Version: 0.4.7 -Cabal-Version: >= 1.8 +Version: 0.6.0 +Cabal-Version: >= 1.10 Build-Type: Simple license: BSD3 license-file: LICENSE -copyright: (c) 2009-2011 Joris Putcuyps -author: Joris Putcuyps -maintainer: Joris.Putcuyps@gmail.com -homepage: https://github.com/jputcu/serialport -bug-reports: https://github.com/jputcu/serialport/issues +copyright: (c) 2009-2011 Joris Putcuyps, + (c) 2020-2025 David Cox +author: Joris Putcuyps, David Cox +maintainer: David Cox +homepage: https://github.com/standardsemiconductor/serialport +bug-reports: https://github.com/standardsemiconductor/serialport/issues synopsis: Cross platform serial port library. description: Cross platform haskell library for using the serial port. category: Hardware @@ -18,26 +19,41 @@ source-repository head type: git - location: git://github.com/jputcu/serialport.git + location: https://github.com/standardsemiconductor/serialport Library Exposed-Modules: System.Hardware.Serialport + System.Hardware.Serialport.Cli Other-Modules: System.Hardware.Serialport.Types - Build-Depends: base >= 4 && < 5, bytestring - ghc-options: -Wall -fno-warn-orphans - + Build-Depends: base >= 4.12 && < 4.22, + bytestring >= 0.11 && < 0.13, + optparse-applicative >= 0.18 && < 0.20 + ghc-options: -Wall + default-language: Haskell2010 + if !os(windows) - Build-Depends: unix + Build-Depends: unix >= 2.8 && < 2.9 Other-Modules: System.Hardware.Serialport.Posix else - Build-Depends: Win32 + Build-Depends: Win32 >= 2.11 && < 2.15 Other-Modules: System.Hardware.Serialport.Windows System.Win32.Comm +executable serialport + ghc-options: -Wall -O2 -threaded + main-is: Main.hs + hs-source-dirs: exe + default-language: Haskell2010 + build-depends: async >= 2.2 && < 2.3, + base, + optparse-applicative >= 0.18 && < 0.19, + serialport + Test-Suite Tests type: exitcode-stdio-1.0 main-is: Tests.hs hs-source-dirs: tests + default-language: Haskell2010 build-depends: base, HUnit, bytestring,