module System.Hardware.Serialport.Posix where

import System.IO
import System.Posix.Terminal
import System.Posix.IO
import Data.Word


data StopBits = One | Two
data Parity = Even | Odd | NoParity
data FlowControl = Software | NoFlowControl
data SerialPort = SerialPort { handle :: Handle,
                               timeout :: Int }


-- |Open and configure a serial port and return a Handle
hOpenSerial :: String      -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@
           -> BaudRate     
           -> Word8        -- ^ The number of bits per word, typically 8
           -> StopBits     -- ^ Almost always @One@ unless you're talking to a printer
           -> Parity       -- ^ Error checking       
           -> FlowControl
           -> IO Handle
hOpenSerial dev baud bPerB stopBits parity flow = 
  do setSerial dev baud bPerB stopBits parity flow
     h <- openBinaryFile dev ReadWriteMode
     hSetBuffering h NoBuffering 
     return h


-- |Open and configure a serial port
openSerial :: String       -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@
           -> BaudRate     
           -> Word8        -- ^ The number of bits per word, typically 8
           -> StopBits     -- ^ Almost always @One@ unless you're talking to a printer
           -> Parity       
           -> FlowControl
           -> Int          -- ^ Receive timeout in milliseconds
           -> IO SerialPort
openSerial dev baud bPerB stopBits parity flow time_ms = 
  do h <- hOpenSerial dev baud bPerB stopBits parity flow
     return $ SerialPort h time_ms
        

-- |Possibly receive a character unless the timeout given in openSerial is exceeded.
recvChar :: SerialPort -> IO (Maybe Char)
recvChar (SerialPort h time_ms) =
 do  have_input <- hWaitForInput h time_ms
     if have_input
        then do c <- hGetChar h
                return $ Just c
        else return Nothing


-- |Send a character
sendChar :: SerialPort -> Char -> IO ()
sendChar (SerialPort h _) =
    hPutChar h


-- |Close the serial port
closeSerial :: SerialPort -> IO ()
closeSerial (SerialPort h _) =
    hClose h



setSerial :: String       
           -> BaudRate     
           -> Word8          
           -> StopBits     
           -> Parity       
           -> FlowControl
           -> IO ()
setSerial dev baud bPerB stopBits parity flow = do
    fd <- openFd dev ReadWrite Nothing 
          OpenFileFlags { append = True,
                        exclusive = True,
                        noctty = True,
                        nonBlock = True,
                        trunc = False }
    termOpts <- getTerminalAttributes fd
    let termOpts' = configureSettings termOpts baud bPerB stopBits parity flow
    setTerminalAttributes fd termOpts' Immediately
    closeFd fd


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 -> BaudRate -> Word8 -> StopBits -> Parity -> FlowControl -> TerminalAttributes
configureSettings termOpts baud bPerB stopBits parity flow =
    termOpts `withInputSpeed` baud
                 `withOutputSpeed` baud
                 `withBits` (fromIntegral bPerB :: Int)
                 `withStopBits` stopBits
                 `withParity` parity
                 `withFlowControl` flow
                 `withoutMode` EnableEcho
                 `withoutMode` EchoErase
                 `withoutMode` EchoKill
                 `withoutMode` ProcessInput
                 `withoutMode` ProcessOutput
                 `withoutMode` MapCRtoLF
                 `withoutMode` EchoLF
                 `withoutMode` HangupOnClose
                 `withoutMode` KeyboardInterrupts
                 `withoutMode` ExtendedFunctions
                 `withMode` LocalMode
                 `withMode` ReadEnable