serialport 0.5.0 → 0.5.1
raw patch · 4 files changed
+45/−112 lines, 4 files
Files
- System/Hardware/Serialport.hs +7/−0
- System/Hardware/Serialport/Posix.hsc +17/−49
- System/Hardware/Serialport/Windows.hs +19/−61
- serialport.cabal +2/−2
System/Hardware/Serialport.hs view
@@ -42,6 +42,7 @@ ,openSerial ,closeSerial ,withSerial+ ,hWithSerial -- ** Sending & receiving ,send ,recv@@ -58,8 +59,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 :: 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
System/Hardware/Serialport/Posix.hsc view
@@ -5,22 +5,18 @@ module System.Hardware.Serialport.Posix where import GHC.IO.Handle-import GHC.IO.Device (RawIO(..), IODevice(..), IODeviceType(Stream))-import GHC.IO.BufferedIO-import GHC.IO.Buffer import GHC.IO.Encoding import System.Posix.IO import System.Posix.Types (Fd, ByteCount) import System.Posix.Terminal -import Foreign (Ptr, castPtr, alloca, peek, with)+import Foreign (Ptr, nullPtr, castPtr, alloca, peek, with) import Foreign.C -import Control.Monad (void)- import Data.Typeable import Data.Bits+ import qualified Data.ByteString.Char8 as B import qualified Control.Exception as Ex @@ -32,44 +28,12 @@ , portSettings :: SerialPortSettings } deriving (Show, Typeable) --instance RawIO SerialPort where- read (SerialPort fd' _) ptr n = 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-- -- |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 @@ -80,6 +44,7 @@ -> IO SerialPort openSerial dev settings = do fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True, nonBlock = True }+ setTIOCEXCL fd' setFdOption fd' NonBlockingRead False let serial_port = SerialPort fd' defaultSerialSettings setSerialSettings serial_port settings@@ -101,8 +66,8 @@ -- |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))+recv port n = do+ result <- withEncoding char8 $ Ex.try $ fdRead (fd port) count :: IO (Either IOError (String, ByteCount)) return $ case result of Right (str, _) -> B.pack str Left _ -> B.empty@@ -115,14 +80,13 @@ :: SerialPort -> B.ByteString -> IO Int -- ^ Number of bytes actually sent-send (SerialPort fd' _ ) msg =- fromIntegral <$> withEncoding char8 (fdWrite fd' (B.unpack msg))+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@@ -150,6 +114,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@@ -172,11 +140,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
System/Hardware/Serialport/Windows.hs view
@@ -3,9 +3,6 @@ module System.Hardware.Serialport.Windows where import GHC.IO.Handle-import GHC.IO.Device -import GHC.IO.BufferedIO-import GHC.IO.Buffer import System.Win32.Types import System.Win32.File@@ -13,7 +10,7 @@ import Foreign.Marshal.Alloc -import Control.Monad+import Control.Monad (unless) import Data.Typeable import Data.Bits@@ -28,48 +25,13 @@ , portSettings :: SerialPortSettings } deriving (Show, Typeable) --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"---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-- -- |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@@ -77,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@@ -89,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@@ -102,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@@ -112,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 @@ -128,32 +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+setSerialSettings port 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.setCommTimeouts (handle port) ct - Comm.setCommState h new_settings+ Comm.setCommState (handle port) new_settings - return (SerialPort h new_settings)+ return $ SerialPort (handle port) new_settings -- |Get configuration from serial port
serialport.cabal view
@@ -1,11 +1,11 @@ Name: serialport-Version: 0.5.0+Version: 0.5.1 Cabal-Version: >= 1.10 Build-Type: Simple license: BSD3 license-file: LICENSE copyright: (c) 2009-2011 Joris Putcuyps,- (c) 2020 David Cox+ (c) 2020-2021 David Cox author: Joris Putcuyps, David Cox maintainer: David Cox <standard.semiconductor@gmail.com> homepage: https://github.com/standardsemiconductor/serialport