{-# OPTIONS_HADDOCK hide #-}
module System.Hardware.Serialport.Types where
import Data.Word
data CommSpeed
= CS110
| CS300
| CS600
| CS1200
| CS2400
| CS4800
| CS9600
| CS19200
| CS38400
| CS57600
| CS115200
deriving (Int -> CommSpeed -> ShowS
[CommSpeed] -> ShowS
CommSpeed -> String
(Int -> CommSpeed -> ShowS)
-> (CommSpeed -> String)
-> ([CommSpeed] -> ShowS)
-> Show CommSpeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommSpeed] -> ShowS
$cshowList :: [CommSpeed] -> ShowS
show :: CommSpeed -> String
$cshow :: CommSpeed -> String
showsPrec :: Int -> CommSpeed -> ShowS
$cshowsPrec :: Int -> CommSpeed -> ShowS
Show, ReadPrec [CommSpeed]
ReadPrec CommSpeed
Int -> ReadS CommSpeed
ReadS [CommSpeed]
(Int -> ReadS CommSpeed)
-> ReadS [CommSpeed]
-> ReadPrec CommSpeed
-> ReadPrec [CommSpeed]
-> Read CommSpeed
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommSpeed]
$creadListPrec :: ReadPrec [CommSpeed]
readPrec :: ReadPrec CommSpeed
$creadPrec :: ReadPrec CommSpeed
readList :: ReadS [CommSpeed]
$creadList :: ReadS [CommSpeed]
readsPrec :: Int -> ReadS CommSpeed
$creadsPrec :: Int -> ReadS CommSpeed
Read, CommSpeed -> CommSpeed -> Bool
(CommSpeed -> CommSpeed -> Bool)
-> (CommSpeed -> CommSpeed -> Bool) -> Eq CommSpeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommSpeed -> CommSpeed -> Bool
$c/= :: CommSpeed -> CommSpeed -> Bool
== :: CommSpeed -> CommSpeed -> Bool
$c== :: CommSpeed -> CommSpeed -> Bool
Eq, CommSpeed
CommSpeed -> CommSpeed -> Bounded CommSpeed
forall a. a -> a -> Bounded a
maxBound :: CommSpeed
$cmaxBound :: CommSpeed
minBound :: CommSpeed
$cminBound :: CommSpeed
Bounded)
data StopBits = One | Two
deriving (Int -> StopBits -> ShowS
[StopBits] -> ShowS
StopBits -> String
(Int -> StopBits -> ShowS)
-> (StopBits -> String) -> ([StopBits] -> ShowS) -> Show StopBits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopBits] -> ShowS
$cshowList :: [StopBits] -> ShowS
show :: StopBits -> String
$cshow :: StopBits -> String
showsPrec :: Int -> StopBits -> ShowS
$cshowsPrec :: Int -> StopBits -> ShowS
Show, ReadPrec [StopBits]
ReadPrec StopBits
Int -> ReadS StopBits
ReadS [StopBits]
(Int -> ReadS StopBits)
-> ReadS [StopBits]
-> ReadPrec StopBits
-> ReadPrec [StopBits]
-> Read StopBits
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopBits]
$creadListPrec :: ReadPrec [StopBits]
readPrec :: ReadPrec StopBits
$creadPrec :: ReadPrec StopBits
readList :: ReadS [StopBits]
$creadList :: ReadS [StopBits]
readsPrec :: Int -> ReadS StopBits
$creadsPrec :: Int -> ReadS StopBits
Read, StopBits -> StopBits -> Bool
(StopBits -> StopBits -> Bool)
-> (StopBits -> StopBits -> Bool) -> Eq StopBits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopBits -> StopBits -> Bool
$c/= :: StopBits -> StopBits -> Bool
== :: StopBits -> StopBits -> Bool
$c== :: StopBits -> StopBits -> Bool
Eq, StopBits
StopBits -> StopBits -> Bounded StopBits
forall a. a -> a -> Bounded a
maxBound :: StopBits
$cmaxBound :: StopBits
minBound :: StopBits
$cminBound :: StopBits
Bounded)
data Parity = Even | Odd | NoParity
deriving (Int -> Parity -> ShowS
[Parity] -> ShowS
Parity -> String
(Int -> Parity -> ShowS)
-> (Parity -> String) -> ([Parity] -> ShowS) -> Show Parity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parity] -> ShowS
$cshowList :: [Parity] -> ShowS
show :: Parity -> String
$cshow :: Parity -> String
showsPrec :: Int -> Parity -> ShowS
$cshowsPrec :: Int -> Parity -> ShowS
Show, ReadPrec [Parity]
ReadPrec Parity
Int -> ReadS Parity
ReadS [Parity]
(Int -> ReadS Parity)
-> ReadS [Parity]
-> ReadPrec Parity
-> ReadPrec [Parity]
-> Read Parity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Parity]
$creadListPrec :: ReadPrec [Parity]
readPrec :: ReadPrec Parity
$creadPrec :: ReadPrec Parity
readList :: ReadS [Parity]
$creadList :: ReadS [Parity]
readsPrec :: Int -> ReadS Parity
$creadsPrec :: Int -> ReadS Parity
Read, Parity -> Parity -> Bool
(Parity -> Parity -> Bool)
-> (Parity -> Parity -> Bool) -> Eq Parity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parity -> Parity -> Bool
$c/= :: Parity -> Parity -> Bool
== :: Parity -> Parity -> Bool
$c== :: Parity -> Parity -> Bool
Eq)
data FlowControl = Software | NoFlowControl
deriving (Int -> FlowControl -> ShowS
[FlowControl] -> ShowS
FlowControl -> String
(Int -> FlowControl -> ShowS)
-> (FlowControl -> String)
-> ([FlowControl] -> ShowS)
-> Show FlowControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlowControl] -> ShowS
$cshowList :: [FlowControl] -> ShowS
show :: FlowControl -> String
$cshow :: FlowControl -> String
showsPrec :: Int -> FlowControl -> ShowS
$cshowsPrec :: Int -> FlowControl -> ShowS
Show, ReadPrec [FlowControl]
ReadPrec FlowControl
Int -> ReadS FlowControl
ReadS [FlowControl]
(Int -> ReadS FlowControl)
-> ReadS [FlowControl]
-> ReadPrec FlowControl
-> ReadPrec [FlowControl]
-> Read FlowControl
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FlowControl]
$creadListPrec :: ReadPrec [FlowControl]
readPrec :: ReadPrec FlowControl
$creadPrec :: ReadPrec FlowControl
readList :: ReadS [FlowControl]
$creadList :: ReadS [FlowControl]
readsPrec :: Int -> ReadS FlowControl
$creadsPrec :: Int -> ReadS FlowControl
Read, FlowControl -> FlowControl -> Bool
(FlowControl -> FlowControl -> Bool)
-> (FlowControl -> FlowControl -> Bool) -> Eq FlowControl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlowControl -> FlowControl -> Bool
$c/= :: FlowControl -> FlowControl -> Bool
== :: FlowControl -> FlowControl -> Bool
$c== :: FlowControl -> FlowControl -> Bool
Eq)
data SerialPortSettings = SerialPortSettings
{ SerialPortSettings -> CommSpeed
commSpeed :: CommSpeed,
SerialPortSettings -> Word8
bitsPerWord :: Word8,
SerialPortSettings -> StopBits
stopb :: StopBits,
SerialPortSettings -> Parity
parity :: Parity,
SerialPortSettings -> FlowControl
flowControl :: FlowControl,
SerialPortSettings -> Int
timeout :: Int
} deriving (Int -> SerialPortSettings -> ShowS
[SerialPortSettings] -> ShowS
SerialPortSettings -> String
(Int -> SerialPortSettings -> ShowS)
-> (SerialPortSettings -> String)
-> ([SerialPortSettings] -> ShowS)
-> Show SerialPortSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerialPortSettings] -> ShowS
$cshowList :: [SerialPortSettings] -> ShowS
show :: SerialPortSettings -> String
$cshow :: SerialPortSettings -> String
showsPrec :: Int -> SerialPortSettings -> ShowS
$cshowsPrec :: Int -> SerialPortSettings -> ShowS
Show, ReadPrec [SerialPortSettings]
ReadPrec SerialPortSettings
Int -> ReadS SerialPortSettings
ReadS [SerialPortSettings]
(Int -> ReadS SerialPortSettings)
-> ReadS [SerialPortSettings]
-> ReadPrec SerialPortSettings
-> ReadPrec [SerialPortSettings]
-> Read SerialPortSettings
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SerialPortSettings]
$creadListPrec :: ReadPrec [SerialPortSettings]
readPrec :: ReadPrec SerialPortSettings
$creadPrec :: ReadPrec SerialPortSettings
readList :: ReadS [SerialPortSettings]
$creadList :: ReadS [SerialPortSettings]
readsPrec :: Int -> ReadS SerialPortSettings
$creadsPrec :: Int -> ReadS SerialPortSettings
Read, SerialPortSettings -> SerialPortSettings -> Bool
(SerialPortSettings -> SerialPortSettings -> Bool)
-> (SerialPortSettings -> SerialPortSettings -> Bool)
-> Eq SerialPortSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerialPortSettings -> SerialPortSettings -> Bool
$c/= :: SerialPortSettings -> SerialPortSettings -> Bool
== :: SerialPortSettings -> SerialPortSettings -> Bool
$c== :: SerialPortSettings -> SerialPortSettings -> Bool
Eq)
defaultSerialSettings :: SerialPortSettings
defaultSerialSettings :: SerialPortSettings
defaultSerialSettings =
CommSpeed
-> Word8
-> StopBits
-> Parity
-> FlowControl
-> Int
-> SerialPortSettings
SerialPortSettings CommSpeed
CS9600 Word8
8 StopBits
One Parity
NoParity FlowControl
NoFlowControl Int
1