{-# 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)

-- |Open and configure a serial port returning a standard Handle
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


-- |Open and configure a serial port
openSerial
  :: FilePath            -- ^ Serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@
  -> 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


-- |Use specific encoding for an action and restore old encoding afterwards
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" #-}


-- |Receive bytes, given the maximum number
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 bytes
send
  :: SerialPort
  -> B.ByteString
  -> IO Int          -- ^ Number of bytes actually sent
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 buffers
flush :: SerialPort -> IO ()
flush :: SerialPort -> IO ()
flush SerialPort
port = Fd -> QueueSelector -> IO ()
discardData (SerialPort -> Fd
fd SerialPort
port) QueueSelector
BothQueues


-- |Close the serial port
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" #-}


-- |Set the Data Terminal Ready level
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" #-}


-- |Set the Ready to send level
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" #-}


-- |Configure the serial port
setSerialSettings :: SerialPort           -- ^ The currently opened serial port
                  -> SerialPortSettings   -- ^ The new settings
                  -> IO SerialPort        -- ^ New serial port
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


-- |Get configuration from serial port
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