{-# 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.
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (STTYSettings
"-echo " 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap STTYSettings -> EchoState
MinTTY IO STTYSettings
getInputEchoSTTY
                       else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> EchoState
DefaultTTY 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 forall a b. (a -> b) -> a -> b
$ [Char
'-' | Bool -> Bool
not Bool
echo] 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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 :: forall a. IO a -> IO a
bracketInputEcho IO a
action = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO EchoState
getInputEchoState EchoState -> IO ()
setInputEchoState (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 :: forall a. IO a -> IO a
withoutInputEcho IO a
action = forall a. IO a -> IO a
bracketInputEcho (EchoState -> IO ()
setInputEchoState EchoState
echoOff 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 forall a b. (a -> b) -> a -> b
$ STTYSettings
"stty " 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{} -> forall a e. Exception e => e -> a
throw ExitCode
e
    ExitCode
ExitSuccess     -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
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
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
Ord, Int -> EchoState -> ShowS
[EchoState] -> ShowS
EchoState -> STTYSettings
forall a.
(Int -> a -> ShowS)
-> (a -> STTYSettings) -> ([a] -> ShowS) -> Show a
showList :: [EchoState] -> ShowS
$cshowList :: [EchoState] -> ShowS
show :: EchoState -> STTYSettings
$cshow :: EchoState -> STTYSettings
showsPrec :: Int -> EchoState -> ShowS
$cshowsPrec :: Int -> EchoState -> ShowS
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