module System.Hardware.Serialport.Posix where

import System.IO
import System.IO.Error
import System.Posix.IO
import System.Posix.Types
import System.Posix.Terminal
import System.Hardware.Serialport.Types


-- |Open and configure a serial port
openSerial :: FilePath     -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@
           -> SerialPortSettings
           -> IO SerialPort
openSerial dev settings =
  do fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True }
     setSerialSettings fd' settings
     return $ SerialPort fd' settings
        

-- |Possibly receive a character unless the timeout given in openSerial is exceeded.
recvChar :: SerialPort -> IO (Maybe Char)
recvChar (SerialPort fd' _) =
  do result <- try $ fdRead fd' 1
     case result of
       Right (str, _) -> return $ Just $ head str
       Left _         -> return Nothing


-- |Send a character
sendChar :: SerialPort -> Char -> IO ()
sendChar (SerialPort fd' _ ) c =
  fdWrite fd' [c] >> return ()


-- |Close the serial port
closeSerial :: SerialPort -> IO ()
closeSerial (SerialPort fd' _ ) =
  closeFd fd' 


setSerialSettings :: Fd -> SerialPortSettings -> IO ()
setSerialSettings fd' settings = 
  do termOpts <- getTerminalAttributes fd'
     let termOpts' = configureSettings termOpts settings
     setTerminalAttributes fd' termOpts' Immediately


withParity :: TerminalAttributes -> Parity -> TerminalAttributes
withParity termOpts Even = termOpts `withMode` EnableParity 
                                    `withoutMode` OddParity
withParity termOpts Odd = termOpts `withMode` EnableParity
                                   `withMode` OddParity
withParity termOpts NoParity = termOpts `withoutMode` EnableParity


withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes
withFlowControl termOpts NoFlowControl = termOpts
                                         `withoutMode` StartStopInput
                                         `withoutMode` StartStopOutput
withFlowControl termOpts Software = termOpts
                                    `withMode` StartStopInput
                                    `withMode` StartStopOutput


withStopBits :: TerminalAttributes -> StopBits -> TerminalAttributes
withStopBits termOpts One = termOpts `withoutMode` TwoStopBits
withStopBits termOpts Two = termOpts `withMode` TwoStopBits


configureSettings :: TerminalAttributes -> SerialPortSettings -> TerminalAttributes
configureSettings termOpts settings =
    termOpts `withInputSpeed` (baudRate settings)
                 `withOutputSpeed` (baudRate settings)
                 `withBits` (fromIntegral (bitsPerWord settings))
                 `withStopBits` (stopb settings)
                 `withParity` (parity settings)
                 `withFlowControl` (flowControl settings)
                 `withoutMode` EnableEcho
                 `withoutMode` EchoErase
                 `withoutMode` EchoKill
                 `withoutMode` ProcessInput
                 `withoutMode` ProcessOutput
                 `withoutMode` MapCRtoLF
                 `withoutMode` EchoLF
                 `withoutMode` HangupOnClose
                 `withoutMode` KeyboardInterrupts
                 `withoutMode` ExtendedFunctions
                 `withMode` LocalMode
                 `withMode` ReadEnable
                 `withTime` (timeout settings)
                 `withMinInput` 0