{-# LANGUAGE RecordWildCards, CPP #-}

-- | This module provides the input layer for Vty, including methods
-- for initializing an 'Input' structure and reading 'Event's from the
-- terminal.
--
-- Note that due to the evolution of terminal emulators, some keys
-- and combinations will not reliably map to the expected events by
-- any terminal program. There is no 1:1 mapping from key events to
-- bytes read from the terminal input device. In very limited cases the
-- terminal and vty's input process can be customized to resolve these
-- issues; see "Graphics.Vty.Config" for how to configure vty's input
-- processing.
--
-- = VTY's Implementation
--
-- There are two input modes:
--
--  1. 7-bit
--
--  2. 8-bit
--
-- The 7-bit input mode is the default and the expected mode in most use
-- cases. This is what Vty uses.
--
-- == 7-bit input encoding
--
-- Control key combinations are represented by masking the two high bits
-- of the 7-bit input. Historically the control key actually grounded
-- the two high bit wires: 6 and 7. This is why control key combos
-- map to single character events: the input bytes are identical. The
-- input byte is the bit encoding of the character with bits 6 and 7
-- masked. Bit 6 is set by shift. Bit 6 and 7 are masked by control. For
-- example,
--
-- * Control-I is 'i', `01101001`, and has bit 6 and 7 masked to become
-- `00001001`, which is the ASCII and UTF-8 encoding of the Tab key.
--
-- * Control+Shift-C is 'C', `01000011`, with bit 6 and 7 set to zero
-- which is `0000011` and is the "End of Text" code.
--
-- * Hypothesis: This is why capital-A, 'A', has value 65 in ASCII: this
-- is the value 1 with bit 7 set and 6 unset.
--
-- * Hypothesis: Bit 6 is unset by upper case letters because,
-- initially, there were only upper case letters used and a 5 bit
-- encoding.
--
-- == 8-bit encoding
--
-- The 8th bit was originally used for parity checking which is useless
-- for terminal emulators. Some terminal emulators support an 8-bit
-- input encoding. While this provides some advantages, the actual usage
-- is low. Most systems use 7-bit mode but recognize 8-bit control
-- characters when escaped. This is what Vty does.
--
-- == Escaped Control Keys
--
-- Using 7-bit input encoding, the @ESC@ byte can signal the start of
-- an encoded control key. To differentiate a single @ESC@ event from a
-- control key, the timing of the input is used.
--
-- 1. @ESC@ individually: @ESC@ byte; no bytes following for a period of
-- 'VMIN' milliseconds.
--
-- 2. Control keys that contain @ESC@ in their encoding: The @ESC byte
-- is followed by more bytes read within 'VMIN' milliseconds. All bytes
-- up until the next valid input block are passed to the classifier.
--
-- If the current runtime is the threaded runtime then the terminal's
-- @VMIN@ and @VTIME@ behavior reliably implement the above rules. If
-- the current runtime does not support 'forkOS' then there is currently
-- no implementation.
--
-- == Unicode Input and Escaped Control Key Sequences
--
-- The input encoding determines how UTF-8 encoded characters are
-- recognized.
--
-- * 7-bit mode: UTF-8 can be input unambiguously. UTF-8 input is
-- a superset of ASCII. UTF-8 does not overlap escaped control key
-- sequences. However, the escape key must be differentiated from
-- escaped control key sequences by the timing of the input bytes.
--
-- * 8-bit mode: UTF-8 cannot be input unambiguously. This does not
-- require using the timing of input bytes to differentiate the escape
-- key. Many terminals do not support 8-bit mode.
--
-- == Terminfo
--
-- The terminfo system is used to determine how some keys are encoded.
-- Terminfo is incomplete and in some cases terminfo is incorrect. Vty
-- assumes terminfo is correct but provides a mechanism to override
-- terminfo; see "Graphics.Vty.Config", specifically 'inputOverrides'.
--
-- == Terminal Input is Broken
--
-- Clearly terminal input has fundamental issues. There is no easy way
-- to reliably resolve these issues.
--
-- One resolution would be to ditch standard terminal interfaces
-- entirely and just go directly to scancodes. This would be a
-- reasonable option for Vty if everybody used the linux kernel console
-- but for obvious reasons this is not possible.
--
-- The "Graphics.Vty.Config" module supports customizing the
-- input-byte-to-event mapping and xterm supports customizing the
-- scancode-to-input-byte mapping. With a lot of work a user's system
-- can be set up to encode all the key combos in an almost-sane manner.
--
-- == See also
--
-- * http://www.leonerd.org.uk/hacks/fixterms/
module Graphics.Vty.Input
  ( Key(..)
  , Modifier(..)
  , Button(..)
  , Event(..)
  , Input(..)
  , inputForConfig
  , attributeControl
  )
where

import Graphics.Vty.Config
import Graphics.Vty.Input.Events
import Graphics.Vty.Input.Loop
import Graphics.Vty.Input.Terminfo

import Control.Concurrent.STM
import Lens.Micro

import qualified System.Console.Terminfo as Terminfo
import System.Posix.Signals.Exts
import System.Posix.Terminal
import System.Posix.Types (Fd(..))

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif

-- | Set up the terminal with file descriptor `inputFd` for input.
-- Returns an 'Input'.
--
-- The table used to determine the 'Events' to produce for the input
-- bytes comes from 'classifyMapForTerm' which is then overridden by
-- the the applicable entries from the configuration's 'inputMap'.
--
-- The terminal device's mode flags are configured by the
-- 'attributeControl' function.
inputForConfig :: Config -> IO Input
inputForConfig :: Config -> IO Input
inputForConfig config :: Config
config@Config{ termName :: Config -> Maybe String
termName = Just String
termName
                            , inputFd :: Config -> Maybe Fd
inputFd = Just Fd
termFd
                            , vmin :: Config -> Maybe Int
vmin = Just Int
_
                            , vtime :: Config -> Maybe Int
vtime = Just Int
_
                            , [(String, String)]
InputMap
Maybe Bool
Maybe String
Maybe Fd
Maybe ColorMode
colorMode :: Config -> Maybe ColorMode
allowCustomUnicodeWidthTables :: Config -> Maybe Bool
termWidthMaps :: Config -> [(String, String)]
outputFd :: Config -> Maybe Fd
inputMap :: Config -> InputMap
debugLog :: Config -> Maybe String
bracketedPasteMode :: Config -> Maybe Bool
mouseMode :: Config -> Maybe Bool
colorMode :: Maybe ColorMode
allowCustomUnicodeWidthTables :: Maybe Bool
termWidthMaps :: [(String, String)]
outputFd :: Maybe Fd
inputMap :: InputMap
debugLog :: Maybe String
bracketedPasteMode :: Maybe Bool
mouseMode :: Maybe Bool
.. } = do
    Terminal
terminal <- String -> IO Terminal
Terminfo.setupTerm String
termName
    let inputOverrides :: [(String, Event)]
inputOverrides = [(String
s,Event
e) | (Maybe String
t,String
s,Event
e) <- InputMap
inputMap, Maybe String
t forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
|| Maybe String
t forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
termName]
        activeInputMap :: [(String, Event)]
activeInputMap = String -> Terminal -> [(String, Event)]
classifyMapForTerm String
termName Terminal
terminal forall a. Monoid a => a -> a -> a
`mappend` [(String, Event)]
inputOverrides
    (IO ()
setAttrs, IO ()
unsetAttrs) <- Fd -> IO (IO (), IO ())
attributeControl Fd
termFd
    IO ()
setAttrs
    Input
input <- Config -> [(String, Event)] -> IO Input
initInput Config
config [(String, Event)]
activeInputMap
    let pokeIO :: Handler
pokeIO = IO () -> Handler
Catch forall a b. (a -> b) -> a -> b
$ do
            IO ()
setAttrs
            forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> a -> STM ()
writeTChan (Input
inputforall s a. s -> Getting a s a -> a
^.Lens' Input (TChan InternalEvent)
eventChannel) InternalEvent
ResumeAfterSignal
    Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
windowChange Handler
pokeIO forall a. Maybe a
Nothing
    Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
continueProcess Handler
pokeIO forall a. Maybe a
Nothing

    let restore :: IO ()
restore = IO ()
unsetAttrs

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Input
input
        { shutdownInput :: IO ()
shutdownInput = do
            Input -> IO ()
shutdownInput Input
input
            Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
windowChange Handler
Ignore forall a. Maybe a
Nothing
            Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
continueProcess Handler
Ignore forall a. Maybe a
Nothing
            IO ()
restore
        , restoreInputState :: IO ()
restoreInputState = Input -> IO ()
restoreInputState Input
input forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
restore
        }
inputForConfig Config
config = (forall a. Semigroup a => a -> a -> a
<> Config
config) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Config
standardIOConfig forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> IO Input
inputForConfig

-- | Construct two IO actions: one to configure the terminal for Vty and
-- one to restore the terminal mode flags to the values they had at the
-- time this function was called.
--
-- This function constructs a configuration action to clear the
-- following terminal mode flags:
--
-- * IXON disabled: disables software flow control on outgoing data.
-- This stops the process from being suspended if the output terminal
-- cannot keep up.
--
-- * Raw mode is used for input.
--
-- * ISIG (enables keyboard combinations that result in
-- signals)
--
-- * ECHO (input is not echoed to the output)
--
-- * ICANON (canonical mode (line mode) input is not used)
--
-- * IEXTEN (extended functions are disabled)
--
-- The configuration action also explicitly sets these flags:
--
-- * ICRNL (input carriage returns are mapped to newlines)
attributeControl :: Fd -> IO (IO (), IO ())
attributeControl :: Fd -> IO (IO (), IO ())
attributeControl Fd
fd = do
    TerminalAttributes
original <- Fd -> IO TerminalAttributes
getTerminalAttributes Fd
fd
    let vtyMode :: TerminalAttributes
vtyMode = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl TerminalAttributes -> TerminalMode -> TerminalAttributes
withMode TerminalAttributes
clearedFlags [TerminalMode]
flagsToSet
        clearedFlags :: TerminalAttributes
clearedFlags = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl TerminalAttributes -> TerminalMode -> TerminalAttributes
withoutMode TerminalAttributes
original [TerminalMode]
flagsToUnset
        flagsToSet :: [TerminalMode]
flagsToSet = [ TerminalMode
MapCRtoLF -- ICRNL
                     ]
        flagsToUnset :: [TerminalMode]
flagsToUnset = [ TerminalMode
StartStopOutput -- IXON
                       , TerminalMode
KeyboardInterrupts -- ISIG
                       , TerminalMode
EnableEcho -- ECHO
                       , TerminalMode
ProcessInput -- ICANON
                       , TerminalMode
ExtendedFunctions -- IEXTEN
                       ]
    let setAttrs :: IO ()
setAttrs = Fd -> TerminalAttributes -> TerminalState -> IO ()
setTerminalAttributes Fd
fd TerminalAttributes
vtyMode TerminalState
Immediately
        unsetAttrs :: IO ()
unsetAttrs = Fd -> TerminalAttributes -> TerminalState -> IO ()
setTerminalAttributes Fd
fd TerminalAttributes
original TerminalState
Immediately
    forall (m :: * -> *) a. Monad m => a -> m a
return (IO ()
setAttrs, IO ()
unsetAttrs)