{-# LINE 1 "System/Hardware/Serialport/Posix.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_HADDOCK hide #-}
module System.Hardware.Serialport.Posix where
import qualified Control.Exception as Ex
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.Encoding
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
{ SerialPort -> Fd
fd :: Fd
, SerialPort -> SerialPortSettings
portSettings :: SerialPortSettings
} deriving (Int -> SerialPort -> ShowS
[SerialPort] -> ShowS
SerialPort -> String
(Int -> SerialPort -> ShowS)
-> (SerialPort -> String)
-> ([SerialPort] -> ShowS)
-> Show SerialPort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SerialPort -> ShowS
showsPrec :: Int -> SerialPort -> ShowS
$cshow :: SerialPort -> String
show :: SerialPort -> String
$cshowList :: [SerialPort] -> ShowS
showList :: [SerialPort] -> ShowS
Show, Typeable)
hOpenSerial :: FilePath
-> SerialPortSettings
-> IO Handle
hOpenSerial :: String -> SerialPortSettings -> IO Handle
hOpenSerial String
dev SerialPortSettings
settings = do
Handle
h <- Fd -> IO Handle
fdToHandle (Fd -> IO Handle) -> (SerialPort -> Fd) -> SerialPort -> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialPort -> Fd
fd (SerialPort -> IO Handle) -> IO SerialPort -> IO Handle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> SerialPortSettings -> IO SerialPort
openSerial String
dev SerialPortSettings
settings
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
NoBuffering
Handle -> IO Handle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h
openSerial
:: FilePath
-> SerialPortSettings
-> IO SerialPort
openSerial :: String -> SerialPortSettings -> IO SerialPort
openSerial String
dev SerialPortSettings
settings = do
Fd
fd' <- String -> OpenMode -> OpenFileFlags -> IO Fd
openFd String
dev OpenMode
ReadWrite OpenFileFlags
defaultFileFlags { noctty = True, nonBlock = True }
Fd -> IO ()
setTIOCEXCL Fd
fd'
Fd -> FdOption -> Bool -> IO ()
setFdOption Fd
fd' FdOption
NonBlockingRead Bool
False
let serial_port :: SerialPort
serial_port = Fd -> SerialPortSettings -> SerialPort
SerialPort Fd
fd' SerialPortSettings
defaultSerialSettings
SerialPort -> SerialPortSettings -> IO SerialPort
setSerialSettings SerialPort
serial_port SerialPortSettings
settings
withEncoding :: TextEncoding -> IO a -> IO a
{-# LINE 53 "System/Hardware/Serialport/Posix.hsc" #-}
withEncoding encoding fun = do
cur_enc <- getForeignEncoding
setForeignEncoding encoding
result <- fun
setForeignEncoding cur_enc
return result
{-# LINE 62 "System/Hardware/Serialport/Posix.hsc" #-}
recv :: SerialPort -> Int -> IO B.ByteString
recv :: SerialPort -> Int -> IO ByteString
recv SerialPort
port Int
n = do
Either IOError ByteString
result <- TextEncoding
-> IO (Either IOError ByteString) -> IO (Either IOError ByteString)
forall a. TextEncoding -> IO a -> IO a
withEncoding TextEncoding
char8 (IO (Either IOError ByteString) -> IO (Either IOError ByteString))
-> IO (Either IOError ByteString) -> IO (Either IOError ByteString)
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO (Either IOError ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
Ex.try (IO ByteString -> IO (Either IOError ByteString))
-> IO ByteString -> IO (Either IOError ByteString)
forall a b. (a -> b) -> a -> b
$ Fd -> ByteCount -> IO ByteString
BIO.fdRead (SerialPort -> Fd
fd SerialPort
port) ByteCount
count :: IO (Either IOError B.ByteString)
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either IOError ByteString -> ByteString
forall b a. b -> Either a b -> b
fromRight ByteString
B.empty Either IOError ByteString
result
where
count :: ByteCount
count = Int -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
send
:: SerialPort
-> B.ByteString
-> IO Int
send :: SerialPort -> ByteString -> IO Int
send SerialPort
port ByteString
msg =
ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteCount -> Int) -> IO ByteCount -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextEncoding -> IO ByteCount -> IO ByteCount
forall a. TextEncoding -> IO a -> IO a
withEncoding TextEncoding
char8 (Fd -> String -> IO ByteCount
fdWrite (SerialPort -> Fd
fd SerialPort
port) (ByteString -> String
B.unpack ByteString
msg))
flush :: SerialPort -> IO ()
flush :: SerialPort -> IO ()
flush SerialPort
port = Fd -> QueueSelector -> IO ()
discardData (SerialPort -> Fd
fd SerialPort
port) QueueSelector
BothQueues
closeSerial :: SerialPort -> IO ()
closeSerial :: SerialPort -> IO ()
closeSerial = Fd -> IO ()
closeFd (Fd -> IO ()) -> (SerialPort -> Fd) -> SerialPort -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialPort -> Fd
fd
foreign import ccall "ioctl" c_ioctl :: CInt -> CInt -> Ptr () -> IO CInt
cIoctl' :: Fd -> Int -> Ptr d -> IO ()
cIoctl' :: forall d. Fd -> Int -> Ptr d -> IO ()
cIoctl' Fd
f Int
req =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"ioctl" (IO CInt -> IO ()) -> (Ptr d -> IO CInt) -> Ptr d -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CInt -> CInt -> Ptr () -> IO CInt
c_ioctl (Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
f) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
req) (Ptr () -> IO CInt) -> (Ptr d -> Ptr ()) -> Ptr d -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr d -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr
getTIOCM :: Fd -> IO Int
getTIOCM :: Fd -> IO Int
getTIOCM Fd
fd' =
(Ptr Int -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int -> IO Int) -> IO Int) -> (Ptr Int -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int
p -> Fd -> Int -> Ptr Int -> IO ()
forall d. Fd -> Int -> Ptr d -> IO ()
cIoctl' Fd
fd' Int
21525 Ptr Int
p IO () -> IO Int -> IO Int
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Ptr Int
p
{-# LINE 104 "System/Hardware/Serialport/Posix.hsc" #-}
setTIOCM :: Fd -> Int -> IO ()
setTIOCM :: Fd -> Int -> IO ()
setTIOCM Fd
fd' Int
val =
Int -> (Ptr Int -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Int
val ((Ptr Int -> IO ()) -> IO ()) -> (Ptr Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> Int -> Ptr Int -> IO ()
forall d. Fd -> Int -> Ptr d -> IO ()
cIoctl' Fd
fd' Int
21528
{-# LINE 109 "System/Hardware/Serialport/Posix.hsc" #-}
setTIOCEXCL :: Fd -> IO ()
setTIOCEXCL :: Fd -> IO ()
setTIOCEXCL Fd
fd' = Fd -> Int -> Ptr Any -> IO ()
forall d. Fd -> Int -> Ptr d -> IO ()
cIoctl' Fd
fd' Int
21516 Ptr Any
forall a. Ptr a
nullPtr
{-# LINE 113 "System/Hardware/Serialport/Posix.hsc" #-}
setDTR :: SerialPort -> Bool -> IO ()
setDTR :: SerialPort -> Bool -> IO ()
setDTR (SerialPort Fd
fd' SerialPortSettings
_) Bool
set = do
Int
current <- Fd -> IO Int
getTIOCM Fd
fd'
Fd -> Int -> IO ()
setTIOCM Fd
fd' (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ if Bool
set
then Int
current Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
2
{-# LINE 121 "System/Hardware/Serialport/Posix.hsc" #-}
else Int
current Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Bits a => a -> a
complement Int
2
{-# LINE 122 "System/Hardware/Serialport/Posix.hsc" #-}
setRTS :: SerialPort -> Bool -> IO ()
setRTS :: SerialPort -> Bool -> IO ()
setRTS (SerialPort Fd
fd' SerialPortSettings
_) Bool
set = do
Int
current <- Fd -> IO Int
getTIOCM Fd
fd'
Fd -> Int -> IO ()
setTIOCM Fd
fd' (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ if Bool
set
then Int
current Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
4
{-# LINE 130 "System/Hardware/Serialport/Posix.hsc" #-}
else Int
current Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Bits a => a -> a
complement Int
4
{-# LINE 131 "System/Hardware/Serialport/Posix.hsc" #-}
setSerialSettings :: SerialPort
-> SerialPortSettings
-> IO SerialPort
setSerialSettings :: SerialPort -> SerialPortSettings -> IO SerialPort
setSerialSettings SerialPort
port SerialPortSettings
new_settings = do
TerminalAttributes
termOpts <- Fd -> IO TerminalAttributes
getTerminalAttributes (Fd -> IO TerminalAttributes) -> Fd -> IO TerminalAttributes
forall a b. (a -> b) -> a -> b
$ SerialPort -> Fd
fd SerialPort
port
let termOpts' :: TerminalAttributes
termOpts' = TerminalAttributes -> SerialPortSettings -> TerminalAttributes
configureSettings TerminalAttributes
termOpts SerialPortSettings
new_settings
Fd -> TerminalAttributes -> TerminalState -> IO ()
setTerminalAttributes (SerialPort -> Fd
fd SerialPort
port) TerminalAttributes
termOpts' TerminalState
Immediately
SerialPort -> IO SerialPort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SerialPort -> IO SerialPort) -> SerialPort -> IO SerialPort
forall a b. (a -> b) -> a -> b
$ Fd -> SerialPortSettings -> SerialPort
SerialPort (SerialPort -> Fd
fd SerialPort
port) SerialPortSettings
new_settings
getSerialSettings :: SerialPort -> SerialPortSettings
getSerialSettings :: SerialPort -> SerialPortSettings
getSerialSettings = SerialPort -> SerialPortSettings
portSettings
withParity :: TerminalAttributes -> Parity -> TerminalAttributes
withParity :: TerminalAttributes -> Parity -> TerminalAttributes
withParity TerminalAttributes
termOpts Parity
Even =
TerminalAttributes
termOpts TerminalAttributes -> TerminalMode -> TerminalAttributes
`withMode` TerminalMode
EnableParity
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
OddParity
withParity TerminalAttributes
termOpts Parity
Odd =
TerminalAttributes
termOpts TerminalAttributes -> TerminalMode -> TerminalAttributes
`withMode` TerminalMode
EnableParity
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withMode` TerminalMode
OddParity
withParity TerminalAttributes
termOpts Parity
NoParity =
TerminalAttributes
termOpts TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
EnableParity
withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes
withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes
withFlowControl TerminalAttributes
termOpts FlowControl
NoFlowControl =
TerminalAttributes
termOpts TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
StartStopInput
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
StartStopOutput
withFlowControl TerminalAttributes
termOpts FlowControl
Software =
TerminalAttributes
termOpts TerminalAttributes -> TerminalMode -> TerminalAttributes
`withMode` TerminalMode
StartStopInput
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withMode` TerminalMode
StartStopOutput
withStopBits :: TerminalAttributes -> StopBits -> TerminalAttributes
withStopBits :: TerminalAttributes -> StopBits -> TerminalAttributes
withStopBits TerminalAttributes
termOpts StopBits
One =
TerminalAttributes
termOpts TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
TwoStopBits
withStopBits TerminalAttributes
termOpts StopBits
Two =
TerminalAttributes
termOpts TerminalAttributes -> TerminalMode -> TerminalAttributes
`withMode` TerminalMode
TwoStopBits
configureSettings :: TerminalAttributes -> SerialPortSettings -> TerminalAttributes
configureSettings :: TerminalAttributes -> SerialPortSettings -> TerminalAttributes
configureSettings TerminalAttributes
termOpts SerialPortSettings
settings =
TerminalAttributes
termOpts TerminalAttributes -> BaudRate -> TerminalAttributes
`withInputSpeed` CommSpeed -> BaudRate
commSpeedToBaudRate (SerialPortSettings -> CommSpeed
commSpeed SerialPortSettings
settings)
TerminalAttributes -> BaudRate -> TerminalAttributes
`withOutputSpeed` CommSpeed -> BaudRate
commSpeedToBaudRate (SerialPortSettings -> CommSpeed
commSpeed SerialPortSettings
settings)
TerminalAttributes -> Int -> TerminalAttributes
`withBits` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SerialPortSettings -> Word8
bitsPerWord SerialPortSettings
settings)
TerminalAttributes -> StopBits -> TerminalAttributes
`withStopBits` SerialPortSettings -> StopBits
stopb SerialPortSettings
settings
TerminalAttributes -> Parity -> TerminalAttributes
`withParity` SerialPortSettings -> Parity
parity SerialPortSettings
settings
TerminalAttributes -> FlowControl -> TerminalAttributes
`withFlowControl` SerialPortSettings -> FlowControl
flowControl SerialPortSettings
settings
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
EnableEcho
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
EchoErase
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
EchoKill
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
ProcessInput
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
ProcessOutput
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
MapCRtoLF
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
EchoLF
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
HangupOnClose
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
KeyboardInterrupts
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withoutMode` TerminalMode
ExtendedFunctions
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withMode` TerminalMode
LocalMode
TerminalAttributes -> TerminalMode -> TerminalAttributes
`withMode` TerminalMode
ReadEnable
TerminalAttributes -> Int -> TerminalAttributes
`withTime` SerialPortSettings -> Int
timeout SerialPortSettings
settings
TerminalAttributes -> Int -> TerminalAttributes
`withMinInput` Int
0
commSpeedToBaudRate :: CommSpeed -> BaudRate
commSpeedToBaudRate :: CommSpeed -> BaudRate
commSpeedToBaudRate = \case
CommSpeed
CS110 -> BaudRate
B110
CommSpeed
CS300 -> BaudRate
B300
CommSpeed
CS600 -> BaudRate
B600
CommSpeed
CS1200 -> BaudRate
B1200
CommSpeed
CS2400 -> BaudRate
B2400
CommSpeed
CS4800 -> BaudRate
B4800
CommSpeed
CS9600 -> BaudRate
B9600
CommSpeed
CS19200 -> BaudRate
B19200
CommSpeed
CS38400 -> BaudRate
B38400
CommSpeed
CS57600 -> BaudRate
B57600
CommSpeed
CS115200 -> BaudRate
B115200