{-# LANGUAGE CPP #-}
module System.Hardware.Serialport.Types where

import Data.Word
#if defined(linux_HOST_OS)
import System.Posix.Terminal
import System.Posix.Types
#elif defined(mingw32_HOST_OS)
import System.Win32.Types

-- | Same as System.Posix.Terminal
data BaudRate
  = B0
  | B50
  | B75
  | B110
  | B134
  | B150
  | B200
  | B300
  | B600
  | B1200
  | B1800
  | B2400
  | B4800
  | B9600
  | B19200
  | B38400
  | B57600
  | B115200
#endif

fromBaudToInt :: BaudRate -> Int
fromBaudToInt b =
  case b of
    B0 -> 0
    B50 -> 50
    B75 -> 75
    B110 -> 110
    B134 -> 134
    B150 -> 150
    B200 -> 200
    B300 -> 300
    B600 -> 600
    B1200 -> 1200
    B1800 -> 1800
    B2400 -> 2400
    B4800 -> 4800
    B9600 -> 9600
    B19200 -> 19200
    B38400 -> 38400
    B57600 -> 57600
    B115200 -> 115200


fromIntToBaud :: Int -> BaudRate
fromIntToBaud i =
  case i of
    0 -> B0
    50 -> B50
    75 -> B75
    110 -> B110
    134 -> B134
    150 -> B150
    200 -> B200
    300 -> B300
    600 -> B600
    1200 -> B1200
    1800 -> B1800
    2400 -> B2400
    4800 -> B4800
    9600 -> B9600
    19200 -> B19200
    38400 -> B38400
    57600 -> B57600
    115200 -> B115200
    _ -> error $ "unsupported baudrate " ++ show i
    


data StopBits = One | Two
data Parity = Even | Odd | NoParity
data FlowControl = Software | NoFlowControl

data SerialPortSettings = SerialPortSettings {
                      baudRate :: BaudRate,       -- ^ baudrate
                      bitsPerWord :: Word8,       -- ^ Number of bits in a word
                      stopb :: StopBits,          -- ^ Number of stop bits
                      parity :: Parity,           -- ^ Type of parity
                      flowControl :: FlowControl, -- ^ Type of flowcontrol
                      timeout :: Int              -- ^ Timeout when receiving a char in tenth of seconds
                  }


instance Show SerialPortSettings where
  show settings = baudrate ++ "/" ++ bits ++ "-" ++ par ++ "-" ++ stopbits ++ " (" ++ flow ++ ", " ++ wait ++ ")"
                  where
                    baudrate = show $ fromBaudToInt $ baudRate settings
                    bits = show $ bitsPerWord settings
                    par = case parity settings of
                             Even     -> "E"
                             Odd      -> "O"
                             NoParity -> "N"
                    stopbits = case stopb settings of
                                 One -> "1"
                                 Two -> "2"
                    flow = case flowControl settings of
                                 NoFlowControl -> "no flow control"
                                 Software -> "software flow control"
                    wait = "timeout:" ++ show ((timeout settings) * 100)
                      

data SerialPort = SerialPort { 
#if defined(mingw32_HOST_OS)
                      handle :: HANDLE,
#else
                      fd :: Fd,
#endif
                      newSettings :: SerialPortSettings
                  }


-- | Most commonly used configuration
--  
--  - 9600 baud
--
--  - 8 data bits
--
--  - 1 stop bit
--
--  - no parity
--
--  - no flow control
--
--  - 0.1 millisecond receive timeout
--
defaultSerialSettings :: SerialPortSettings
defaultSerialSettings =
  SerialPortSettings B9600 8 One NoParity NoFlowControl 1