{-# 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 unambiguiously. 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 fundemental 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
  )
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

#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
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
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 Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing Bool -> Bool -> Bool
|| Maybe String
t Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
termName]
        activeInputMap :: [(String, Event)]
activeInputMap = String -> Terminal -> [(String, Event)]
classifyMapForTerm String
termName Terminal
terminal [(String, Event)] -> [(String, Event)] -> [(String, Event)]
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 (IO () -> Handler) -> IO () -> Handler
forall a b. (a -> b) -> a -> b
$ do
            let e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"vty internal failure: this value should not propagate to users"
            IO ()
setAttrs
            STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan Event -> Event -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan (Input
inputInput -> Getting (TChan Event) Input (TChan Event) -> TChan Event
forall s a. s -> Getting a s a -> a
^.Getting (TChan Event) Input (TChan Event)
Lens' Input (TChan Event)
eventChannel) (Int -> Int -> Event
EvResize Int
forall a. a
e Int
forall a. a
e)
    Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
windowChange Handler
pokeIO Maybe SignalSet
forall a. Maybe a
Nothing
    Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
continueProcess Handler
pokeIO Maybe SignalSet
forall a. Maybe a
Nothing

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

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