{-# LANGUAGE CApiFFI #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | -- Module : System.Posix.Terminal.Common -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (requires POSIX) -- -- POSIX Terminal support -- ----------------------------------------------------------------------------- -- see https://android.googlesource.com/platform/bionic/+/9ae59c0/libc/bionic/pathconf.c#37 #if !defined(_POSIX_VDISABLE) && defined(__ANDROID__) #define _POSIX_VDISABLE -1 #endif module System.Posix.Terminal.Common ( -- * Terminal support -- ** Terminal attributes TerminalAttributes, getTerminalAttributes, TerminalState(..), setTerminalAttributes, CTermios, TerminalMode(..), withoutMode, withMode, terminalMode, bitsPerByte, withBits, ControlCharacter(..), controlChar, withCC, withoutCC, inputTime, withTime, minInput, withMinInput, BaudRate ( .. , B0 , B50 , B75 , B110 , B134 , B150 , B200 , B300 , B600 , B1200 , B1800 , B2400 , B4800 , B9600 , B19200 , B38400 #ifdef B7200 , B7200 #endif #ifdef B14400 , B14400 #endif #ifdef B28800 , B28800 #endif #ifdef B57600 , B57600 #endif #ifdef B76800 , B76800 #endif #ifdef B115200 , B115200 #endif #ifdef B230400 , B230400 #endif #ifdef B460800 , B460800 #endif #ifdef B500000 , B500000 #endif #ifdef B576000 , B576000 #endif #ifdef B921600 , B921600 #endif #ifdef B1000000 , B1000000 #endif #ifdef B1152000 , B1152000 #endif #ifdef B1500000 , B1500000 #endif #ifdef B2000000 , B2000000 #endif #ifdef B2500000 , B2500000 #endif #ifdef B3000000 , B3000000 #endif #ifdef B3500000 , B3500000 #endif #ifdef B4000000 , B4000000 #endif ), inputSpeed, withInputSpeed, outputSpeed, withOutputSpeed, -- ** Terminal operations sendBreak, drainOutput, QueueSelector(..), discardData, FlowAction(..), controlFlow, -- ** Process groups getTerminalProcessGroupID, setTerminalProcessGroupID, -- ** Testing a file descriptor queryTerminal, ) where #include "HsUnix.h" import Data.Bits import Data.Char import Foreign.C.Error ( throwErrnoIfMinus1, throwErrnoIfMinus1_ ) import Foreign.C.Types import Foreign.ForeignPtr ( ForeignPtr, withForeignPtr, mallocForeignPtrBytes ) import Foreign.Marshal.Utils ( copyBytes ) import Foreign.Ptr ( Ptr, plusPtr ) import Foreign.Storable ( Storable(..) ) import System.IO.Unsafe ( unsafePerformIO ) import System.Posix.Types import System.Posix.Internals ( CTermios ) #if (!defined(HAVE_TCDRAIN)) || (!defined(HAVE_TERMIOS_H)) import Control.Exception ( throw ) import System.IO.Error ( ioeSetLocation ) import GHC.IO.Exception ( unsupportedOperation ) #endif #if defined(HAVE_TERMIOS_H) -- ----------------------------------------------------------------------------- -- Terminal attributes newtype TerminalAttributes = TerminalAttributes (ForeignPtr CTermios) makeTerminalAttributes :: ForeignPtr CTermios -> TerminalAttributes makeTerminalAttributes = TerminalAttributes withTerminalAttributes :: TerminalAttributes -> (Ptr CTermios -> IO a) -> IO a withTerminalAttributes (TerminalAttributes termios) = withForeignPtr termios #else data TerminalAttributes #endif // HAVE_TERMIOS_H data TerminalMode -- input flags = InterruptOnBreak -- ^ @BRKINT@ - Signal interrupt on break | MapCRtoLF -- ^ @ICRNL@ - Map CR to NL on input | IgnoreBreak -- ^ @IGNBRK@ - Ignore break condition | IgnoreCR -- ^ @IGNCR@ - Ignore CR | IgnoreParityErrors -- ^ @IGNPAR@ - Ignore characters with parity errors | MapLFtoCR -- ^ @INLCR@ - Map NL to CR on input | CheckParity -- ^ @INPCK@ - Enable input parity check | StripHighBit -- ^ @ISTRIP@ - Strip character | RestartOnAny -- ^ @IXANY@ - Enable any character to restart output | StartStopInput -- ^ @IXOFF@ - Enable start/stop input control | StartStopOutput -- ^ @IXON@ - Enable start/stop output control | MarkParityErrors -- ^ @PARMRK@ - Mark parity errors -- output flags | ProcessOutput -- ^ @OPOST@ - Post-process output | MapLFtoCRLF -- ^ @ONLCR@ - (XSI) Map NL to CR-NL on output -- -- @since 2.8.0.0 | OutputMapCRtoLF -- ^ @OCRNL@ - (XSI) Map CR to NL on output -- -- @since 2.8.0.0 | NoCRAtColumnZero -- ^ @ONOCR@ - (XSI) No CR output at column 0 -- -- @since 2.8.0.0 | ReturnMeansLF -- ^ @ONLRET@ - (XSI) NL performs CR function -- -- @since 2.8.0.0 | TabDelayMask0 -- ^ @TABDLY(TAB0)@ - (XSI) Select horizontal-tab delays: type 0 -- -- @since 2.8.0.0 | TabDelayMask3 -- ^ @TABDLY(TAB3)@ - (XSI) Select horizontal-tab delays: type 3 -- -- @since 2.8.0.0 -- control flags | LocalMode -- ^ @CLOCAL@ - Ignore modem status lines | ReadEnable -- ^ @CREAD@ - Enable receiver | TwoStopBits -- ^ @CSTOPB@ - Send two stop bits, else one | HangupOnClose -- ^ @HUPCL@ - Hang up on last close | EnableParity -- ^ @PARENB@ - Parity enable | OddParity -- ^ @PARODD@ - Odd parity, else even -- local modes | EnableEcho -- ^ @ECHO@ - Enable echo | EchoErase -- ^ @ECHOE@ - Echo erase character as error-correcting backspace | EchoKill -- ^ @ECHOK@ - Echo KILL | EchoLF -- ^ @ECHONL@ - Echo NL | ProcessInput -- ^ @ICANON@ - Canonical input (erase and kill processing) | ExtendedFunctions -- ^ @IEXTEN@ - Enable extended input character processing | KeyboardInterrupts -- ^ @ISIG@ - Enable signals | NoFlushOnInterrupt -- ^ @NOFLSH@ - Disable flush after interrupt or quit | BackgroundWriteInterrupt -- ^ @TOSTOP@ - Send @SIGTTOU@ for background output #if !defined(HAVE_TERMIOS_H) withoutMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes {-# WARNING withoutMode "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} withoutMode _ _ = throw (ioeSetLocation unsupportedOperation "withoutMode") withMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes {-# WARNING withMode "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} withMode _ _ = throw (ioeSetLocation unsupportedOperation "withMode") terminalMode :: TerminalMode -> TerminalAttributes -> Bool {-# WARNING terminalMode "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} terminalMode _ _ = throw (ioeSetLocation unsupportedOperation "terminalMode") bitsPerByte :: TerminalAttributes -> Int {-# WARNING bitsPerByte "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} bitsPerByte _ = throw (ioeSetLocation unsupportedOperation "bitsPerByte") withBits :: TerminalAttributes -> Int -> TerminalAttributes {-# WARNING withBits "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} withBits _ _ = throw (ioeSetLocation unsupportedOperation "withBits") #else withoutMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes withoutMode termios InterruptOnBreak = clearInputFlag (#const BRKINT) termios withoutMode termios MapCRtoLF = clearInputFlag (#const ICRNL) termios withoutMode termios IgnoreBreak = clearInputFlag (#const IGNBRK) termios withoutMode termios IgnoreCR = clearInputFlag (#const IGNCR) termios withoutMode termios IgnoreParityErrors = clearInputFlag (#const IGNPAR) termios withoutMode termios MapLFtoCR = clearInputFlag (#const INLCR) termios withoutMode termios CheckParity = clearInputFlag (#const INPCK) termios withoutMode termios StripHighBit = clearInputFlag (#const ISTRIP) termios withoutMode termios RestartOnAny = clearInputFlag (#const IXANY) termios withoutMode termios StartStopInput = clearInputFlag (#const IXOFF) termios withoutMode termios StartStopOutput = clearInputFlag (#const IXON) termios withoutMode termios MarkParityErrors = clearInputFlag (#const PARMRK) termios withoutMode termios ProcessOutput = clearOutputFlag (#const OPOST) termios withoutMode termios MapLFtoCRLF = clearOutputFlag (#const ONLCR) termios withoutMode termios OutputMapCRtoLF = clearOutputFlag (#const OCRNL) termios withoutMode termios NoCRAtColumnZero = clearOutputFlag (#const ONOCR) termios withoutMode termios ReturnMeansLF = clearOutputFlag (#const ONLRET) termios withoutMode termios TabDelayMask0 = clearOutputFlag (#const TAB0) termios withoutMode termios TabDelayMask3 = clearOutputFlag (#const TAB3) termios withoutMode termios LocalMode = clearControlFlag (#const CLOCAL) termios withoutMode termios ReadEnable = clearControlFlag (#const CREAD) termios withoutMode termios TwoStopBits = clearControlFlag (#const CSTOPB) termios withoutMode termios HangupOnClose = clearControlFlag (#const HUPCL) termios withoutMode termios EnableParity = clearControlFlag (#const PARENB) termios withoutMode termios OddParity = clearControlFlag (#const PARODD) termios withoutMode termios EnableEcho = clearLocalFlag (#const ECHO) termios withoutMode termios EchoErase = clearLocalFlag (#const ECHOE) termios withoutMode termios EchoKill = clearLocalFlag (#const ECHOK) termios withoutMode termios EchoLF = clearLocalFlag (#const ECHONL) termios withoutMode termios ProcessInput = clearLocalFlag (#const ICANON) termios withoutMode termios ExtendedFunctions = clearLocalFlag (#const IEXTEN) termios withoutMode termios KeyboardInterrupts = clearLocalFlag (#const ISIG) termios withoutMode termios NoFlushOnInterrupt = setLocalFlag (#const NOFLSH) termios withoutMode termios BackgroundWriteInterrupt = clearLocalFlag (#const TOSTOP) termios withMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes withMode termios InterruptOnBreak = setInputFlag (#const BRKINT) termios withMode termios MapCRtoLF = setInputFlag (#const ICRNL) termios withMode termios IgnoreBreak = setInputFlag (#const IGNBRK) termios withMode termios IgnoreCR = setInputFlag (#const IGNCR) termios withMode termios IgnoreParityErrors = setInputFlag (#const IGNPAR) termios withMode termios MapLFtoCR = setInputFlag (#const INLCR) termios withMode termios CheckParity = setInputFlag (#const INPCK) termios withMode termios StripHighBit = setInputFlag (#const ISTRIP) termios withMode termios RestartOnAny = setInputFlag (#const IXANY) termios withMode termios StartStopInput = setInputFlag (#const IXOFF) termios withMode termios StartStopOutput = setInputFlag (#const IXON) termios withMode termios MarkParityErrors = setInputFlag (#const PARMRK) termios withMode termios ProcessOutput = setOutputFlag (#const OPOST) termios withMode termios MapLFtoCRLF = setOutputFlag (#const ONLCR) termios withMode termios OutputMapCRtoLF = setOutputFlag (#const OCRNL) termios withMode termios NoCRAtColumnZero = setOutputFlag (#const ONOCR) termios withMode termios ReturnMeansLF = setOutputFlag (#const ONLRET) termios withMode termios TabDelayMask0 = setOutputFlag (#const TAB0) termios withMode termios TabDelayMask3 = setOutputFlag (#const TAB3) termios withMode termios LocalMode = setControlFlag (#const CLOCAL) termios withMode termios ReadEnable = setControlFlag (#const CREAD) termios withMode termios TwoStopBits = setControlFlag (#const CSTOPB) termios withMode termios HangupOnClose = setControlFlag (#const HUPCL) termios withMode termios EnableParity = setControlFlag (#const PARENB) termios withMode termios OddParity = setControlFlag (#const PARODD) termios withMode termios EnableEcho = setLocalFlag (#const ECHO) termios withMode termios EchoErase = setLocalFlag (#const ECHOE) termios withMode termios EchoKill = setLocalFlag (#const ECHOK) termios withMode termios EchoLF = setLocalFlag (#const ECHONL) termios withMode termios ProcessInput = setLocalFlag (#const ICANON) termios withMode termios ExtendedFunctions = setLocalFlag (#const IEXTEN) termios withMode termios KeyboardInterrupts = setLocalFlag (#const ISIG) termios withMode termios NoFlushOnInterrupt = clearLocalFlag (#const NOFLSH) termios withMode termios BackgroundWriteInterrupt = setLocalFlag (#const TOSTOP) termios terminalMode :: TerminalMode -> TerminalAttributes -> Bool terminalMode InterruptOnBreak = testInputFlag (#const BRKINT) terminalMode MapCRtoLF = testInputFlag (#const ICRNL) terminalMode IgnoreBreak = testInputFlag (#const IGNBRK) terminalMode IgnoreCR = testInputFlag (#const IGNCR) terminalMode IgnoreParityErrors = testInputFlag (#const IGNPAR) terminalMode MapLFtoCR = testInputFlag (#const INLCR) terminalMode CheckParity = testInputFlag (#const INPCK) terminalMode StripHighBit = testInputFlag (#const ISTRIP) terminalMode RestartOnAny = testInputFlag (#const IXANY) terminalMode StartStopInput = testInputFlag (#const IXOFF) terminalMode StartStopOutput = testInputFlag (#const IXON) terminalMode MarkParityErrors = testInputFlag (#const PARMRK) terminalMode ProcessOutput = testOutputFlag (#const OPOST) terminalMode MapLFtoCRLF = testOutputFlag (#const ONLCR) terminalMode OutputMapCRtoLF = testOutputFlag (#const OCRNL) terminalMode NoCRAtColumnZero = testOutputFlag (#const ONOCR) terminalMode ReturnMeansLF = testOutputFlag (#const ONLRET) terminalMode TabDelayMask0 = testOutputFlag (#const TAB0) terminalMode TabDelayMask3 = testOutputFlag (#const TAB3) terminalMode LocalMode = testControlFlag (#const CLOCAL) terminalMode ReadEnable = testControlFlag (#const CREAD) terminalMode TwoStopBits = testControlFlag (#const CSTOPB) terminalMode HangupOnClose = testControlFlag (#const HUPCL) terminalMode EnableParity = testControlFlag (#const PARENB) terminalMode OddParity = testControlFlag (#const PARODD) terminalMode EnableEcho = testLocalFlag (#const ECHO) terminalMode EchoErase = testLocalFlag (#const ECHOE) terminalMode EchoKill = testLocalFlag (#const ECHOK) terminalMode EchoLF = testLocalFlag (#const ECHONL) terminalMode ProcessInput = testLocalFlag (#const ICANON) terminalMode ExtendedFunctions = testLocalFlag (#const IEXTEN) terminalMode KeyboardInterrupts = testLocalFlag (#const ISIG) terminalMode NoFlushOnInterrupt = not . testLocalFlag (#const NOFLSH) terminalMode BackgroundWriteInterrupt = testLocalFlag (#const TOSTOP) bitsPerByte :: TerminalAttributes -> Int bitsPerByte termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do cflag <- (#peek struct termios, c_cflag) p return $! (word2Bits (cflag .&. (#const CSIZE))) where word2Bits :: CTcflag -> Int word2Bits x = if x == (#const CS5) then 5 else if x == (#const CS6) then 6 else if x == (#const CS7) then 7 else if x == (#const CS8) then 8 else 0 withBits :: TerminalAttributes -> Int -> TerminalAttributes withBits termios bits = unsafePerformIO $ do withNewTermios termios $ \p -> do cflag <- (#peek struct termios, c_cflag) p (#poke struct termios, c_cflag) p ((cflag .&. complement (#const CSIZE)) .|. mask bits) where mask :: Int -> CTcflag mask 5 = (#const CS5) mask 6 = (#const CS6) mask 7 = (#const CS7) mask 8 = (#const CS8) mask _ = error "withBits bit value out of range [5..8]" #endif // HAVE_TERMIOS_H data ControlCharacter = EndOfFile -- VEOF | EndOfLine -- VEOL | Erase -- VERASE | Interrupt -- VINTR | Kill -- VKILL | Quit -- VQUIT | Start -- VSTART | Stop -- VSTOP | Suspend -- VSUSP #if !defined(HAVE_TERMIOS_H) controlChar :: TerminalAttributes -> ControlCharacter -> Maybe Char {-# WARNING controlChar "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} controlChar _ _ = throw (ioeSetLocation unsupportedOperation "controlChar") withCC :: TerminalAttributes -> (ControlCharacter, Char) -> TerminalAttributes {-# WARNING withCC "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} withCC _ _ = throw (ioeSetLocation unsupportedOperation "withCC") withoutCC :: TerminalAttributes -> ControlCharacter -> TerminalAttributes {-# WARNING withoutCC "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} withoutCC _ _ = throw (ioeSetLocation unsupportedOperation "withoutCC") inputTime :: TerminalAttributes -> Int {-# WARNING inputTime "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} inputTime _ = throw (ioeSetLocation unsupportedOperation "inputTime") withTime :: TerminalAttributes -> Int -> TerminalAttributes {-# WARNING withTime "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} withTime _ _ = throw (ioeSetLocation unsupportedOperation "withTime") minInput :: TerminalAttributes -> Int {-# WARNING minInput "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} minInput _ = throw (ioeSetLocation unsupportedOperation "minInput") withMinInput :: TerminalAttributes -> Int -> TerminalAttributes {-# WARNING withMinInput "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} withMinInput _ _ = throw (ioeSetLocation unsupportedOperation "withMinInput") -- | Placeholder implementation newtype BaudRate = BaudRate Int deriving (Eq, Ord, Show, Enum, Real, Num) -- | Hang up pattern B0 :: BaudRate pattern B0 = BaudRate 0 -- | 50 baud pattern B50 :: BaudRate pattern B50 = BaudRate 50 -- | 75 baud pattern B75 :: BaudRate pattern B75 = BaudRate 75 -- | 110 baud pattern B110 :: BaudRate pattern B110 = BaudRate 110 -- | 134.5 baud pattern B134 :: BaudRate pattern B134 = BaudRate 134 -- | 150 baud pattern B150 :: BaudRate pattern B150 = BaudRate 150 -- | 200 baud pattern B200 :: BaudRate pattern B200 = BaudRate 200 -- | 300 baud pattern B300 :: BaudRate pattern B300 = BaudRate 300 -- | 600 baud pattern B600 :: BaudRate pattern B600 = BaudRate 600 -- | 1200 baud pattern B1200 :: BaudRate pattern B1200 = BaudRate 1200 -- | 1800 baud pattern B1800 :: BaudRate pattern B1800 = BaudRate 1800 -- | 2400 baud pattern B2400 :: BaudRate pattern B2400 = BaudRate 2400 -- | 4800 baud pattern B4800 :: BaudRate pattern B4800 = BaudRate 4800 -- | 9600 baud pattern B9600 :: BaudRate pattern B9600 = BaudRate 9600 -- | 19200 baud pattern B19200 :: BaudRate pattern B19200 = BaudRate 19200 -- | 38400 baud pattern B38400 :: BaudRate pattern B38400 = BaudRate 38400 #else controlChar :: TerminalAttributes -> ControlCharacter -> Maybe Char controlChar termios cc = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p val <- peekElemOff c_cc (cc2Word cc) if val == ((#const _POSIX_VDISABLE)::CCc) then return Nothing else return (Just (chr (fromEnum val))) withCC :: TerminalAttributes -> (ControlCharacter, Char) -> TerminalAttributes withCC termios (cc, c) = unsafePerformIO $ do withNewTermios termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p pokeElemOff c_cc (cc2Word cc) (fromIntegral (ord c) :: CCc) withoutCC :: TerminalAttributes -> ControlCharacter -> TerminalAttributes withoutCC termios cc = unsafePerformIO $ do withNewTermios termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p pokeElemOff c_cc (cc2Word cc) ((#const _POSIX_VDISABLE) :: CCc) inputTime :: TerminalAttributes -> Int inputTime termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do c <- peekElemOff ((#ptr struct termios, c_cc) p) (#const VTIME) return (fromEnum (c :: CCc)) withTime :: TerminalAttributes -> Int -> TerminalAttributes withTime termios time = unsafePerformIO $ do withNewTermios termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p pokeElemOff c_cc (#const VTIME) (fromIntegral time :: CCc) minInput :: TerminalAttributes -> Int minInput termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do c <- peekElemOff ((#ptr struct termios, c_cc) p) (#const VMIN) return (fromEnum (c :: CCc)) withMinInput :: TerminalAttributes -> Int -> TerminalAttributes withMinInput termios count = unsafePerformIO $ do withNewTermios termios $ \p -> do let c_cc = (#ptr struct termios, c_cc) p pokeElemOff c_cc (#const VMIN) (fromIntegral count :: CCc) -- | Serial line baudrate. The set of supported speeds is system-dependent. -- Portable use of the provided pattern synonyms that are outside the list -- mandated by POSIX requires @#ifdef@ guards. -- -- Applications may need to be prepared to encounter speeds not known at -- compile time, these can be handled generically via the 'BaudRate' -- constructor. In other words, the provided pattern synonyms are not -- necessarily a @COMPLETE@ set. -- -- All non-zero /pseudo-terminal/ baud rates are functionally equivalent, and -- the @pty@ driver may accept any speed within a suitable range. Requested -- speeds may be rounded up or down to fit into the supported range. -- newtype BaudRate = BaudRate CSpeed deriving (Eq, Ord, Show, Enum, Real, Num) -- | Hang up pattern B0 :: BaudRate pattern B0 = BaudRate (#const B0) -- | 50 baud pattern B50 :: BaudRate pattern B50 = BaudRate (#const B50) -- | 75 baud pattern B75 :: BaudRate pattern B75 = BaudRate (#const B75) -- | 110 baud pattern B110 :: BaudRate pattern B110 = BaudRate (#const B110) -- | 134.5 baud pattern B134 :: BaudRate pattern B134 = BaudRate (#const B134) -- | 150 baud pattern B150 :: BaudRate pattern B150 = BaudRate (#const B150) -- | 200 baud pattern B200 :: BaudRate pattern B200 = BaudRate (#const B200) -- | 300 baud pattern B300 :: BaudRate pattern B300 = BaudRate (#const B300) -- | 600 baud pattern B600 :: BaudRate pattern B600 = BaudRate (#const B600) -- | 1200 baud pattern B1200 :: BaudRate pattern B1200 = BaudRate (#const B1200) -- | 1800 baud pattern B1800 :: BaudRate pattern B1800 = BaudRate (#const B1800) -- | 2400 baud pattern B2400 :: BaudRate pattern B2400 = BaudRate (#const B2400) -- | 4800 baud pattern B4800 :: BaudRate pattern B4800 = BaudRate (#const B4800) -- | 9600 baud pattern B9600 :: BaudRate pattern B9600 = BaudRate (#const B9600) -- | 19200 baud pattern B19200 :: BaudRate pattern B19200 = BaudRate (#const B19200) -- | 38400 baud pattern B38400 :: BaudRate pattern B38400 = BaudRate (#const B38400) #ifdef B7200 -- | 7200 baud, non-POSIX system-dependent extension pattern B7200 :: BaudRate pattern B7200 = BaudRate (#const B7200) #endif #ifdef B14400 -- | 14400 baud, non-POSIX system-dependent extension pattern B14400 :: BaudRate pattern B14400 = BaudRate (#const B14400) #endif #ifdef B28800 -- | 28800 baud, non-POSIX system-dependent extension pattern B28800 :: BaudRate pattern B28800 = BaudRate (#const B28800) #endif #ifdef B57600 -- | 57600 baud, non-POSIX system-dependent extension pattern B57600 :: BaudRate pattern B57600 = BaudRate (#const B57600) #endif #ifdef B76800 -- | 76800 baud, non-POSIX system-dependent extension pattern B76800 :: BaudRate pattern B76800 = BaudRate (#const B76800) #endif #ifdef B115200 -- | 115200 baud, non-POSIX system-dependent extension pattern B115200 :: BaudRate pattern B115200 = BaudRate (#const B115200) #endif #ifdef B230400 -- | 230400 baud, non-POSIX system-dependent extension pattern B230400 :: BaudRate pattern B230400 = BaudRate (#const B230400) #endif #ifdef B460800 -- | 460800 baud, non-POSIX system-dependent extension pattern B460800 :: BaudRate pattern B460800 = BaudRate (#const B460800) #endif #ifdef B500000 -- | 500000 baud, non-POSIX system-dependent extension pattern B500000 :: BaudRate pattern B500000 = BaudRate (#const B500000) #endif #ifdef B576000 -- | 576000 baud, non-POSIX system-dependent extension pattern B576000 :: BaudRate pattern B576000 = BaudRate (#const B576000) #endif #ifdef B921600 -- | 921600 baud, non-POSIX system-dependent extension pattern B921600 :: BaudRate pattern B921600 = BaudRate (#const B921600) #endif #ifdef B1000000 -- | 1000000 baud, non-POSIX system-dependent extension pattern B1000000 :: BaudRate pattern B1000000 = BaudRate (#const B1000000) #endif #ifdef B1152000 -- | 1152000 baud, non-POSIX system-dependent extension pattern B1152000 :: BaudRate pattern B1152000 = BaudRate (#const B1152000) #endif #ifdef B1500000 -- | 1500000 baud, non-POSIX system-dependent extension pattern B1500000 :: BaudRate pattern B1500000 = BaudRate (#const B1500000) #endif #ifdef B2000000 -- | 2000000 baud, non-POSIX system-dependent extension pattern B2000000 :: BaudRate pattern B2000000 = BaudRate (#const B2000000) #endif #ifdef B2500000 -- | 2500000 baud, non-POSIX system-dependent extension pattern B2500000 :: BaudRate pattern B2500000 = BaudRate (#const B2500000) #endif #ifdef B3000000 -- | 3000000 baud, non-POSIX system-dependent extension pattern B3000000 :: BaudRate pattern B3000000 = BaudRate (#const B3000000) #endif #ifdef B3500000 -- | 3500000 baud, non-POSIX system-dependent extension pattern B3500000 :: BaudRate pattern B3500000 = BaudRate (#const B3500000) #endif #ifdef B4000000 -- | 4000000 baud, non-POSIX system-dependent extension pattern B4000000 :: BaudRate pattern B4000000 = BaudRate (#const B4000000) #endif #endif // HAVE_TERMIOS_H #if !defined(HAVE_TERMIOS_H) inputSpeed :: TerminalAttributes -> BaudRate {-# WARNING inputSpeed "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} inputSpeed _ = throw (ioeSetLocation unsupportedOperation "inputSpeed") withInputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes {-# WARNING withInputSpeed "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} withInputSpeed _ _ = throw (ioeSetLocation unsupportedOperation "withInputSpeed") outputSpeed :: TerminalAttributes -> BaudRate {-# WARNING outputSpeed "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} outputSpeed _ = throw (ioeSetLocation unsupportedOperation "outputSpeed") withOutputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes {-# WARNING withOutputSpeed "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} withOutputSpeed _ _ = throw (ioeSetLocation unsupportedOperation "withOutputSpeed") getTerminalAttributes :: Fd -> IO TerminalAttributes {-# WARNING getTerminalAttributes "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} getTerminalAttributes _ = ioError (ioeSetLocation unsupportedOperation "getTerminalAttributes") #else inputSpeed :: TerminalAttributes -> BaudRate inputSpeed termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do w <- c_cfgetispeed p return (BaudRate w) foreign import capi unsafe "termios.h cfgetispeed" c_cfgetispeed :: Ptr CTermios -> IO CSpeed withInputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes withInputSpeed termios (BaudRate br) = unsafePerformIO $ do withNewTermios termios $ \p -> c_cfsetispeed p br foreign import capi unsafe "termios.h cfsetispeed" c_cfsetispeed :: Ptr CTermios -> CSpeed -> IO CInt outputSpeed :: TerminalAttributes -> BaudRate outputSpeed termios = unsafePerformIO $ do withTerminalAttributes termios $ \p -> do w <- c_cfgetospeed p return (BaudRate w) foreign import capi unsafe "termios.h cfgetospeed" c_cfgetospeed :: Ptr CTermios -> IO CSpeed withOutputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes withOutputSpeed termios (BaudRate br) = unsafePerformIO $ do withNewTermios termios $ \p -> c_cfsetospeed p br foreign import capi unsafe "termios.h cfsetospeed" c_cfsetospeed :: Ptr CTermios -> CSpeed -> IO CInt -- | @getTerminalAttributes fd@ calls @tcgetattr@ to obtain -- the @TerminalAttributes@ associated with @Fd@ @fd@. getTerminalAttributes :: Fd -> IO TerminalAttributes getTerminalAttributes (Fd fd) = do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p -> throwErrnoIfMinus1_ "getTerminalAttributes" (c_tcgetattr fd p) return $ makeTerminalAttributes fp foreign import capi unsafe "termios.h tcgetattr" c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt #endif // HAVE_TERMIOS_H data TerminalState = Immediately | WhenDrained | WhenFlushed #if !defined(HAVE_TERMIOS_H) setTerminalAttributes :: Fd -> TerminalAttributes -> TerminalState -> IO () {-# WARNING setTerminalAttributes "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} setTerminalAttributes _ _ _ = ioError (ioeSetLocation unsupportedOperation "setTerminalAttributes") sendBreak :: Fd -> Int -> IO () {-# WARNING sendBreak "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} sendBreak _ _ = ioError (ioeSetLocation unsupportedOperation "sendBreak") drainOutput :: Fd -> IO () {-# WARNING drainOutput "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} drainOutput _ = ioError (ioeSetLocation unsupportedOperation "drainOutput") #else -- | @setTerminalAttributes fd attr ts@ calls @tcsetattr@ to change -- the @TerminalAttributes@ associated with @Fd@ @fd@ to -- @attr@, when the terminal is in the state indicated by @ts@. setTerminalAttributes :: Fd -> TerminalAttributes -> TerminalState -> IO () setTerminalAttributes (Fd fd) termios state = do withTerminalAttributes termios $ \p -> throwErrnoIfMinus1_ "setTerminalAttributes" (c_tcsetattr fd (state2Int state) p) where state2Int :: TerminalState -> CInt state2Int Immediately = (#const TCSANOW) state2Int WhenDrained = (#const TCSADRAIN) state2Int WhenFlushed = (#const TCSAFLUSH) foreign import capi unsafe "termios.h tcsetattr" c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt -- | @sendBreak fd duration@ calls @tcsendbreak@ to transmit a -- continuous stream of zero-valued bits on @Fd@ @fd@ for the -- specified implementation-dependent @duration@. sendBreak :: Fd -> Int -> IO () sendBreak (Fd fd) duration = throwErrnoIfMinus1_ "sendBreak" (c_tcsendbreak fd (fromIntegral duration)) foreign import capi unsafe "termios.h tcsendbreak" c_tcsendbreak :: CInt -> CInt -> IO CInt -- | @drainOutput fd@ calls @tcdrain@ to block until all output -- written to @Fd@ @fd@ has been transmitted. -- -- Throws 'IOError' (\"unsupported operation\") if platform does not -- provide @tcdrain(3)@ (use @#if HAVE_TCDRAIN@ CPP guard to -- detect availability). drainOutput :: Fd -> IO () #if HAVE_TCDRAIN drainOutput (Fd fd) = throwErrnoIfMinus1_ "drainOutput" (c_tcdrain fd) foreign import capi safe "termios.h tcdrain" c_tcdrain :: CInt -> IO CInt #else {-# WARNING drainOutput "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TCDRAIN@)" #-} drainOutput _ = ioError (ioeSetLocation unsupportedOperation "drainOutput") #endif #endif // HAVE_TERMIOS_H data QueueSelector = InputQueue -- TCIFLUSH | OutputQueue -- TCOFLUSH | BothQueues -- TCIOFLUSH #if !defined(HAVE_TERMIOS_H) discardData :: Fd -> QueueSelector -> IO () {-# WARNING discardData "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} discardData _ _ = ioError (ioeSetLocation unsupportedOperation "discardData") #else -- | @discardData fd queues@ calls @tcflush@ to discard -- pending input and\/or output for @Fd@ @fd@, -- as indicated by the @QueueSelector@ @queues@. discardData :: Fd -> QueueSelector -> IO () discardData (Fd fd) queue = throwErrnoIfMinus1_ "discardData" (c_tcflush fd (queue2Int queue)) where queue2Int :: QueueSelector -> CInt queue2Int InputQueue = (#const TCIFLUSH) queue2Int OutputQueue = (#const TCOFLUSH) queue2Int BothQueues = (#const TCIOFLUSH) foreign import capi unsafe "termios.h tcflush" c_tcflush :: CInt -> CInt -> IO CInt #endif // HAVE_TERMIOS_H data FlowAction = SuspendOutput -- ^ TCOOFF | RestartOutput -- ^ TCOON | TransmitStop -- ^ TCIOFF | TransmitStart -- ^ TCION #if !defined(HAVE_TERMIOS_H) controlFlow :: Fd -> FlowAction -> IO () {-# WARNING controlFlow "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} controlFlow _ _ = ioError (ioeSetLocation unsupportedOperation "controlFlow") getTerminalProcessGroupID :: Fd -> IO ProcessGroupID {-# WARNING getTerminalProcessGroupID "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} getTerminalProcessGroupID _ = ioError (ioeSetLocation unsupportedOperation "getTerminalProcessGroupID") setTerminalProcessGroupID :: Fd -> ProcessGroupID -> IO () {-# WARNING setTerminalProcessGroupID "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TERMIOS_H@)" #-} setTerminalProcessGroupID _ _ = ioError (ioeSetLocation unsupportedOperation "setTerminalProcessGroupID") #else -- | @controlFlow fd action@ calls @tcflow@ to control the -- flow of data on @Fd@ @fd@, as indicated by -- @action@. controlFlow :: Fd -> FlowAction -> IO () controlFlow (Fd fd) action = throwErrnoIfMinus1_ "controlFlow" (c_tcflow fd (action2Int action)) where action2Int :: FlowAction -> CInt action2Int SuspendOutput = (#const TCOOFF) action2Int RestartOutput = (#const TCOON) action2Int TransmitStop = (#const TCIOFF) action2Int TransmitStart = (#const TCION) foreign import capi unsafe "termios.h tcflow" c_tcflow :: CInt -> CInt -> IO CInt -- | @getTerminalProcessGroupID fd@ calls @tcgetpgrp@ to -- obtain the @ProcessGroupID@ of the foreground process group -- associated with the terminal attached to @Fd@ @fd@. getTerminalProcessGroupID :: Fd -> IO ProcessGroupID getTerminalProcessGroupID (Fd fd) = do throwErrnoIfMinus1 "getTerminalProcessGroupID" (c_tcgetpgrp fd) foreign import ccall unsafe "tcgetpgrp" c_tcgetpgrp :: CInt -> IO CPid -- | @setTerminalProcessGroupID fd pgid@ calls @tcsetpgrp@ to -- set the @ProcessGroupID@ of the foreground process group -- associated with the terminal attached to @Fd@ -- @fd@ to @pgid@. setTerminalProcessGroupID :: Fd -> ProcessGroupID -> IO () setTerminalProcessGroupID (Fd fd) pgid = throwErrnoIfMinus1_ "setTerminalProcessGroupID" (c_tcsetpgrp fd pgid) foreign import ccall unsafe "tcsetpgrp" c_tcsetpgrp :: CInt -> CPid -> IO CInt #endif // HAVE_TERMIOS_H -- ----------------------------------------------------------------------------- -- file descriptor queries -- | @queryTerminal fd@ calls @isatty@ to determine whether or -- not @Fd@ @fd@ is associated with a terminal. queryTerminal :: Fd -> IO Bool queryTerminal (Fd fd) = do r <- c_isatty fd return (r == 1) -- ToDo: the spec says that it can set errno to EBADF if the result is zero foreign import ccall unsafe "isatty" c_isatty :: CInt -> IO CInt -- ----------------------------------------------------------------------------- -- Local utility functions -- Convert Haskell ControlCharacter to Int #if defined(HAVE_TERMIOS_H) cc2Word :: ControlCharacter -> Int cc2Word EndOfFile = (#const VEOF) cc2Word EndOfLine = (#const VEOL) cc2Word Erase = (#const VERASE) cc2Word Interrupt = (#const VINTR) cc2Word Kill = (#const VKILL) cc2Word Quit = (#const VQUIT) cc2Word Suspend = (#const VSUSP) cc2Word Start = (#const VSTART) cc2Word Stop = (#const VSTOP) -- Clear termios i_flag clearInputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes clearInputFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) iflag <- (#peek struct termios, c_iflag) p2 (#poke struct termios, c_iflag) p1 (iflag .&. complement flag) return $ makeTerminalAttributes fp -- Set termios i_flag setInputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes setInputFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) iflag <- (#peek struct termios, c_iflag) p2 (#poke struct termios, c_iflag) p1 (iflag .|. flag) return $ makeTerminalAttributes fp -- Examine termios i_flag testInputFlag :: CTcflag -> TerminalAttributes -> Bool testInputFlag flag termios = unsafePerformIO $ withTerminalAttributes termios $ \p -> do iflag <- (#peek struct termios, c_iflag) p return $! ((iflag .&. flag) /= 0) -- Clear termios c_flag clearControlFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes clearControlFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) cflag <- (#peek struct termios, c_cflag) p2 (#poke struct termios, c_cflag) p1 (cflag .&. complement flag) return $ makeTerminalAttributes fp -- Set termios c_flag setControlFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes setControlFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) cflag <- (#peek struct termios, c_cflag) p2 (#poke struct termios, c_cflag) p1 (cflag .|. flag) return $ makeTerminalAttributes fp -- Examine termios c_flag testControlFlag :: CTcflag -> TerminalAttributes -> Bool testControlFlag flag termios = unsafePerformIO $ withTerminalAttributes termios $ \p -> do cflag <- (#peek struct termios, c_cflag) p return $! ((cflag .&. flag) /= 0) -- Clear termios l_flag clearLocalFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes clearLocalFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) lflag <- (#peek struct termios, c_lflag) p2 (#poke struct termios, c_lflag) p1 (lflag .&. complement flag) return $ makeTerminalAttributes fp -- Set termios l_flag setLocalFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes setLocalFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) lflag <- (#peek struct termios, c_lflag) p2 (#poke struct termios, c_lflag) p1 (lflag .|. flag) return $ makeTerminalAttributes fp -- Examine termios l_flag testLocalFlag :: CTcflag -> TerminalAttributes -> Bool testLocalFlag flag termios = unsafePerformIO $ withTerminalAttributes termios $ \p -> do lflag <- (#peek struct termios, c_lflag) p return $! ((lflag .&. flag) /= 0) -- Clear termios o_flag clearOutputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes clearOutputFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) oflag <- (#peek struct termios, c_oflag) p2 (#poke struct termios, c_oflag) p1 (oflag .&. complement flag) return $ makeTerminalAttributes fp -- Set termios o_flag setOutputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes setOutputFlag flag termios = unsafePerformIO $ do fp <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) oflag <- (#peek struct termios, c_oflag) p2 (#poke struct termios, c_oflag) p1 (oflag .|. flag) return $ makeTerminalAttributes fp -- Examine termios o_flag testOutputFlag :: CTcflag -> TerminalAttributes -> Bool testOutputFlag flag termios = unsafePerformIO $ withTerminalAttributes termios $ \p -> do oflag <- (#peek struct termios, c_oflag) p return $! ((oflag .&. flag) /= 0) withNewTermios :: TerminalAttributes -> (Ptr CTermios -> IO a) -> IO TerminalAttributes withNewTermios termios action = do fp1 <- mallocForeignPtrBytes (#const sizeof(struct termios)) withForeignPtr fp1 $ \p1 -> do withTerminalAttributes termios $ \p2 -> do copyBytes p1 p2 (#const sizeof(struct termios)) _ <- action p1 return () return $ makeTerminalAttributes fp1 #endif // HAVE_TERMIOS_H