{-# LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__ >= 702
# if defined(WINDOWS)
{-# LANGUAGE Trustworthy #-}
# else
#  if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#  else
{-# LANGUAGE Trustworthy #-}
#  endif
# endif
#endif

{-|
Module:      System.IO.Echo.Internal
Copyright:   (C) 2016-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: Portable

Exports functions that handle whether or not terminal input is handled in a way
that should be portable across different platforms and consoles.

Unlike "System.IO.Echo", this module exports internal functionality which, if
used improperly, can lead to runtime errors. Make sure to read the
documentation beforehand!
-}
module System.IO.Echo.Internal (
      -- * Safe public interface
      withoutInputEcho, bracketInputEcho
    , getInputEchoState, setInputEchoState
    , echoOff, echoOn

      -- * Alternative (safe) interface
    , getInputEcho, setInputEcho

      -- * Unsafe STTY internals
    , EchoState(..), STTYSettings
    , getInputEchoSTTY, setInputEchoSTTY, sttyRaw

      -- * MinTTY
    , minTTY
    ) where

import Control.Exception (bracket, throw)
import Control.Monad (void)

import Data.List (isInfixOf)

import System.Exit (ExitCode(..))
import System.IO (hGetContents, hGetEcho, hSetEcho, stdin)
import System.Process (StdStream(..), createProcess, shell,
                       std_in, std_out, waitForProcess)

#if defined(WINDOWS)
import Graphics.Win32.Misc (getStdHandle, sTD_INPUT_HANDLE)
import System.Console.MinTTY (isMinTTYHandle)
import System.IO.Unsafe (unsafePerformIO)
#endif

-- | Return whether the terminal's echoing is on ('True') or off ('False').
--
-- Note that while this works on MinTTY, it is not as efficient as
-- 'getInputEchoState', as it involves a somewhat expensive substring
-- computation.
getInputEcho :: IO Bool
getInputEcho :: IO Bool
getInputEcho = if Bool
minTTY
                  then do STTYSettings
settings <- STTYSettings -> IO STTYSettings
sttyRaw STTYSettings
"-a"
                          -- This assumes that other settings come after
                          -- [-]echo in the output of `stty -a`. Luckily, this
                          -- seems to be the case on every incarnation of
                          -- MinTTY that I've tried.
                          Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (STTYSettings
"-echo " STTYSettings -> STTYSettings -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` STTYSettings
settings)
                  else Handle -> IO Bool
hGetEcho Handle
stdin

-- | Return the terminal's current input 'EchoState'.
getInputEchoState :: IO EchoState
getInputEchoState :: IO EchoState
getInputEchoState = if Bool
minTTY
                       then (STTYSettings -> EchoState) -> IO STTYSettings -> IO EchoState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap STTYSettings -> EchoState
MinTTY IO STTYSettings
getInputEchoSTTY
                       else (Bool -> EchoState) -> IO Bool -> IO EchoState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> EchoState
DefaultTTY (IO Bool -> IO EchoState) -> IO Bool -> IO EchoState
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
hGetEcho Handle
stdin

-- | Return all of @stty@'s current settings in a non-human-readable format.
--
-- This function is not very useful on its own. Its greater purpose is to
-- provide a compact 'STTYSettings' that can be fed back into
-- 'setInputEchoState'.
getInputEchoSTTY :: IO STTYSettings
getInputEchoSTTY :: IO STTYSettings
getInputEchoSTTY = STTYSettings -> IO STTYSettings
sttyRaw STTYSettings
"-g"

-- | Set the terminal's echoing on ('True') or off ('False').
setInputEcho :: Bool -> IO ()
setInputEcho :: Bool -> IO ()
setInputEcho Bool
echo = if Bool
minTTY
                       then STTYSettings -> IO ()
setInputEchoSTTY (STTYSettings -> IO ()) -> STTYSettings -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char
'-' | Bool -> Bool
not Bool
echo] STTYSettings -> STTYSettings -> STTYSettings
forall a. [a] -> [a] -> [a]
++ STTYSettings
"echo"
                       else Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
echo

-- | Set the terminal's input 'EchoState'.
setInputEchoState :: EchoState -> IO ()
setInputEchoState :: EchoState -> IO ()
setInputEchoState (MinTTY STTYSettings
settings) = STTYSettings -> IO ()
setInputEchoSTTY STTYSettings
settings
setInputEchoState (DefaultTTY Bool
echo) = Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
echo

-- | Create an @stty@ process and wait for it to complete. This is useful for
-- changing @stty@'s settings, after which @stty@ does not output anything.
--
-- @
-- setInputEchoSTTY = 'void' . 'sttyRaw'
-- @
setInputEchoSTTY :: STTYSettings -> IO ()
setInputEchoSTTY :: STTYSettings -> IO ()
setInputEchoSTTY = IO STTYSettings -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO STTYSettings -> IO ())
-> (STTYSettings -> IO STTYSettings) -> STTYSettings -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STTYSettings -> IO STTYSettings
sttyRaw

-- | Save the terminal's current input 'EchoState', perform a computation,
-- restore the saved 'EchoState', and then return the result of the
-- computation.
--
-- @
-- bracketInputEcho action = 'bracket' 'getInputEchoState' 'setInputEchoState' (const action)
-- @
bracketInputEcho :: IO a -> IO a
bracketInputEcho :: IO a -> IO a
bracketInputEcho IO a
action = IO EchoState -> (EchoState -> IO ()) -> (EchoState -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO EchoState
getInputEchoState EchoState -> IO ()
setInputEchoState (IO a -> EchoState -> IO a
forall a b. a -> b -> a
const IO a
action)

-- | Perform a computation with the terminal's input echoing disabled. Before
-- running the computation, the terminal's input 'EchoState' is saved, and the
-- saved 'EchoState' is restored after the computation finishes.
--
-- @
-- withoutInputEcho action = 'bracketInputEcho' ('setInputEchoState' 'echoOff' >> action)
-- @
withoutInputEcho :: IO a -> IO a
withoutInputEcho :: IO a -> IO a
withoutInputEcho IO a
action = IO a -> IO a
forall a. IO a -> IO a
bracketInputEcho (EchoState -> IO ()
setInputEchoState EchoState
echoOff IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
action)

-- | Create an @stty@ process, wait for it to complete, and return its output.
sttyRaw :: String -> IO STTYSettings
sttyRaw :: STTYSettings -> IO STTYSettings
sttyRaw STTYSettings
arg = do
  let stty :: CreateProcess
stty = (STTYSettings -> CreateProcess
shell (STTYSettings -> CreateProcess) -> STTYSettings -> CreateProcess
forall a b. (a -> b) -> a -> b
$ STTYSettings
"stty " STTYSettings -> STTYSettings -> STTYSettings
forall a. [a] -> [a] -> [a]
++ STTYSettings
arg) {
        std_in :: StdStream
std_in  = Handle -> StdStream
UseHandle Handle
stdin
      , std_out :: StdStream
std_out = StdStream
CreatePipe
      }
  (Maybe Handle
_, Maybe Handle
mbStdout, Maybe Handle
_, ProcessHandle
rStty) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
stty
  ExitCode
exStty <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
rStty
  case ExitCode
exStty of
    e :: ExitCode
e@ExitFailure{} -> ExitCode -> IO STTYSettings
forall a e. Exception e => e -> a
throw ExitCode
e
    ExitCode
ExitSuccess     -> IO STTYSettings
-> (Handle -> IO STTYSettings) -> Maybe Handle -> IO STTYSettings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (STTYSettings -> IO STTYSettings
forall (m :: * -> *) a. Monad m => a -> m a
return STTYSettings
"") Handle -> IO STTYSettings
hGetContents Maybe Handle
mbStdout

-- | A representation of the terminal input's current echoing state. Example
-- values include 'echoOff' and 'echoOn'.
data EchoState
  = MinTTY STTYSettings
    -- ^ The argument to (or value returned from) an invocation of the @stty@
    -- command-line utility. Most POSIX-like shells have @stty@, including
    -- MinTTY on Windows. Since neither 'hGetEcho' nor 'hSetEcho' work on
    -- MinTTY, when 'getInputEchoState' runs on MinTTY, it returns a value
    -- built with this constructor.
    --
    -- However, native Windows consoles like @cmd.exe@ or PowerShell do not
    -- have @stty@, so if you construct an 'EchoState' with this constructor
    -- manually, take care not to use it with a native Windows console.
  | DefaultTTY Bool
    -- ^ A simple on ('True') or off ('False') toggle. This is returned by
    -- 'hGetEcho' and given as an argument to 'hSetEcho', which work on most
    -- consoles, with the notable exception of MinTTY on Windows. If you
    -- construct an 'EchoState' with this constructor manually, take care not
    -- to use it with MinTTY.
  deriving (EchoState -> EchoState -> Bool
(EchoState -> EchoState -> Bool)
-> (EchoState -> EchoState -> Bool) -> Eq EchoState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EchoState -> EchoState -> Bool
$c/= :: EchoState -> EchoState -> Bool
== :: EchoState -> EchoState -> Bool
$c== :: EchoState -> EchoState -> Bool
Eq, Eq EchoState
Eq EchoState
-> (EchoState -> EchoState -> Ordering)
-> (EchoState -> EchoState -> Bool)
-> (EchoState -> EchoState -> Bool)
-> (EchoState -> EchoState -> Bool)
-> (EchoState -> EchoState -> Bool)
-> (EchoState -> EchoState -> EchoState)
-> (EchoState -> EchoState -> EchoState)
-> Ord EchoState
EchoState -> EchoState -> Bool
EchoState -> EchoState -> Ordering
EchoState -> EchoState -> EchoState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EchoState -> EchoState -> EchoState
$cmin :: EchoState -> EchoState -> EchoState
max :: EchoState -> EchoState -> EchoState
$cmax :: EchoState -> EchoState -> EchoState
>= :: EchoState -> EchoState -> Bool
$c>= :: EchoState -> EchoState -> Bool
> :: EchoState -> EchoState -> Bool
$c> :: EchoState -> EchoState -> Bool
<= :: EchoState -> EchoState -> Bool
$c<= :: EchoState -> EchoState -> Bool
< :: EchoState -> EchoState -> Bool
$c< :: EchoState -> EchoState -> Bool
compare :: EchoState -> EchoState -> Ordering
$ccompare :: EchoState -> EchoState -> Ordering
$cp1Ord :: Eq EchoState
Ord, Int -> EchoState -> STTYSettings -> STTYSettings
[EchoState] -> STTYSettings -> STTYSettings
EchoState -> STTYSettings
(Int -> EchoState -> STTYSettings -> STTYSettings)
-> (EchoState -> STTYSettings)
-> ([EchoState] -> STTYSettings -> STTYSettings)
-> Show EchoState
forall a.
(Int -> a -> STTYSettings -> STTYSettings)
-> (a -> STTYSettings)
-> ([a] -> STTYSettings -> STTYSettings)
-> Show a
showList :: [EchoState] -> STTYSettings -> STTYSettings
$cshowList :: [EchoState] -> STTYSettings -> STTYSettings
show :: EchoState -> STTYSettings
$cshow :: EchoState -> STTYSettings
showsPrec :: Int -> EchoState -> STTYSettings -> STTYSettings
$cshowsPrec :: Int -> EchoState -> STTYSettings -> STTYSettings
Show)

-- | Indicates that the terminal's input echoing is (or should be) off.
echoOff :: EchoState
echoOff :: EchoState
echoOff = if Bool
minTTY then STTYSettings -> EchoState
MinTTY STTYSettings
"-echo" else Bool -> EchoState
DefaultTTY Bool
False

-- | Indicates that the terminal's input echoing is (or should be) on.
echoOn :: EchoState
echoOn :: EchoState
echoOn = if Bool
minTTY then STTYSettings -> EchoState
MinTTY STTYSettings
"echo" else Bool -> EchoState
DefaultTTY Bool
True

-- | Settings used to configure the @stty@ command-line utility.
type STTYSettings = String

-- | Is the current process attached to a MinTTY console (e.g., Cygwin or MSYS)?
minTTY :: Bool
#if defined(WINDOWS)
minTTY = unsafePerformIO $ do
  h <- getStdHandle sTD_INPUT_HANDLE
  isMinTTYHandle h
{-# NOINLINE minTTY #-}
#else
minTTY :: Bool
minTTY = Bool
False
#endif