diff --git a/System/Hardware/Serialport.hs b/System/Hardware/Serialport.hs --- a/System/Hardware/Serialport.hs +++ b/System/Hardware/Serialport.hs @@ -11,7 +11,18 @@ -- > recv s 10 >>= print -- > closeSerial s -- +-- Or use the experimental interface with standard handles: +-- +-- > 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 + module System.Hardware.Serialport ( -- * Types CommSpeed(..) @@ -27,6 +38,7 @@ ,getSerialSettings -- * Serial methods -- ** Device + ,hOpenSerial ,openSerial ,closeSerial ,withSerial 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,4 +1,4 @@ -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-} {-# OPTIONS_HADDOCK hide #-} module System.Hardware.Serialport.Posix where @@ -10,14 +10,68 @@ import System.Hardware.Serialport.Types import Foreign 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 +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 = fdWriteBuf fd' ptr (fromIntegral n) >> return () + 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 + 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 dev settings = do - fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True, nonBlock = True } + fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True } let serial_port = SerialPort fd' defaultSerialSettings return =<< setSerialSettings serial_port settings @@ -25,7 +79,10 @@ -- |Receive bytes, given the maximum number recv :: SerialPort -> Int -> IO B.ByteString recv (SerialPort fd' _) n = do + cur_enc <- getForeignEncoding + setForeignEncoding char8 result <- Ex.try $ fdRead fd' count :: IO (Either IOError (String, ByteCount)) + setForeignEncoding cur_enc return $ case result of Right (str, _) -> B.pack str Left _ -> B.empty @@ -37,8 +94,12 @@ send :: SerialPort -> B.ByteString -> IO Int -- ^ Number of bytes actually sent -send (SerialPort fd' _ ) msg = - fromIntegral `fmap` fdWrite fd' (B.unpack msg) +send (SerialPort fd' _ ) msg = do + cur_enc <- getForeignEncoding + setForeignEncoding char8 + ret <- fdWrite fd' (B.unpack msg) + setForeignEncoding cur_enc + return $ fromIntegral ret -- |Flush buffers 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 @@ -1,13 +1,7 @@ -{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} module System.Hardware.Serialport.Types where import Data.Word -#if defined(mingw32_HOST_OS) -import System.Win32.Types (HANDLE) -#else -import System.Posix.Types (Fd) -#endif -- | Supported baudrates @@ -37,16 +31,6 @@ parity :: Parity, -- ^ Type of parity flowControl :: FlowControl, -- ^ Type of flowcontrol timeout :: Int -- ^ Timeout when receiving a char in tenth of seconds - } - - -data SerialPort = SerialPort { -#if defined(mingw32_HOST_OS) - handle :: HANDLE, -#else - fd :: Fd, -#endif - portSettings :: SerialPortSettings } 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_HADDOCK hide #-} module System.Hardware.Serialport.Windows where @@ -10,6 +11,59 @@ 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) + + +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 = win32_WriteFile h ptr (fromIntegral n) Nothing >> return () + 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 dev settings = do + ser <- openSerial dev settings + h <- mkDuplexHandle ser dev Nothing noNewlineTranslation + hSetBuffering h NoBuffering + return h -- | Open and configure a serial port diff --git a/serialport.cabal b/serialport.cabal --- a/serialport.cabal +++ b/serialport.cabal @@ -1,5 +1,5 @@ Name: serialport -Version: 0.4.4 +Version: 0.4.5 Cabal-Version: >= 1.6 Build-Type: Custom license: BSD3 @@ -21,7 +21,7 @@ Exposed-Modules: System.Hardware.Serialport Other-Modules: System.Hardware.Serialport.Types Build-Depends: base >= 4 && < 5, bytestring - ghc-options: -Wall + ghc-options: -Wall -fno-warn-orphans if !os(windows) Build-Depends: unix