{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module Graphics.Vty.Input.Terminfo where

import Graphics.Vty.Input.Events
import qualified Graphics.Vty.Input.Terminfo.ANSIVT as ANSIVT

import Control.Arrow
import System.Console.Terminfo

-- | Queries the terminal for all capability-based input sequences and
-- then adds on a terminal-dependent input sequence mapping.
--
-- For reference see:
--
-- * http://vimdoc.sourceforge.net/htmldoc/term.html
--
-- * vim74/src/term.c
--
-- * http://invisible-island.net/vttest/
--
-- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html
--
-- Terminfo is incomplete. The vim source implies that terminfo is also
-- incorrect. Vty assumes that the internal terminfo table added to the
-- system-provided terminfo table is correct.
--
-- The procedure used here is:
--
-- 1. Build terminfo table for all caps. Missing caps are not added.
--
-- 2. Add tables for visible chars, esc, del, ctrl, and meta.
--
-- 3. Add internally-defined table for given terminal type.
--
-- Precedence is currently implicit in the 'compile' algorithm.
classifyMapForTerm :: String -> Terminal -> ClassifyMap
classifyMapForTerm :: String -> Terminal -> ClassifyMap
classifyMapForTerm String
termName Terminal
term =
    [ClassifyMap] -> ClassifyMap
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ClassifyMap] -> ClassifyMap) -> [ClassifyMap] -> ClassifyMap
forall a b. (a -> b) -> a -> b
$ Terminal -> ClassifyMap -> ClassifyMap
capsClassifyMap Terminal
term ClassifyMap
keysFromCapsTable
           ClassifyMap -> [ClassifyMap] -> [ClassifyMap]
forall a. a -> [a] -> [a]
: ClassifyMap
universalTable
           ClassifyMap -> [ClassifyMap] -> [ClassifyMap]
forall a. a -> [a] -> [a]
: String -> [ClassifyMap]
termSpecificTables String
termName

-- | The key table applicable to all terminals.
--
-- Note that some of these entries are probably only applicable to
-- ANSI/VT100 terminals.
universalTable :: ClassifyMap
universalTable :: ClassifyMap
universalTable = [ClassifyMap] -> ClassifyMap
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ClassifyMap
visibleChars, ClassifyMap
ctrlChars, ClassifyMap
ctrlMetaChars, ClassifyMap
specialSupportKeys]

capsClassifyMap :: Terminal -> [(String,Event)] -> ClassifyMap
capsClassifyMap :: Terminal -> ClassifyMap -> ClassifyMap
capsClassifyMap Terminal
terminal ClassifyMap
table = [(String
x,Event
y) | (Just String
x,Event
y) <- ((String, Event) -> (Maybe String, Event))
-> ClassifyMap -> [(Maybe String, Event)]
forall a b. (a -> b) -> [a] -> [b]
map (String, Event) -> (Maybe String, Event)
forall d. (String, d) -> (Maybe String, d)
extractCap ClassifyMap
table]
    where extractCap :: (String, d) -> (Maybe String, d)
extractCap = (String -> Maybe String) -> (String, d) -> (Maybe String, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Terminal -> Capability String -> Maybe String
forall a. Terminal -> Capability a -> Maybe a
getCapability Terminal
terminal (Capability String -> Maybe String)
-> (String -> Capability String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Capability String
tiGetStr)

-- | Tables specific to a given terminal that are not derivable from
-- terminfo.
--
-- Note that this adds the ANSI/VT100/VT50 tables regardless of term
-- identifier.
termSpecificTables :: String -> [ClassifyMap]
termSpecificTables :: String -> [ClassifyMap]
termSpecificTables String
_termName = [ClassifyMap]
ANSIVT.classifyTable

-- | Visible characters in the ISO-8859-1 and UTF-8 common set.
--
-- We limit to < 0xC1. The UTF8 sequence detector will catch all values
-- 0xC2 and above before this classify table is reached.
visibleChars :: ClassifyMap
visibleChars :: ClassifyMap
visibleChars = [ ([Char
x], Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
x) [])
               | Char
x <- [Char
' ' .. Int -> Char
forall a. Enum a => Int -> a
toEnum Int
0xC1]
               ]

-- | Non-printable characters in the ISO-8859-1 and UTF-8 common set
-- translated to ctrl + char.
--
-- This treats CTRL-i the same as tab.
ctrlChars :: ClassifyMap
ctrlChars :: ClassifyMap
ctrlChars =
    [ ([Int -> Char
forall a. Enum a => Int -> a
toEnum Int
x],Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
y) [Modifier
MCtrl])
    | (Int
x,Char
y) <- [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..Int
31]) (Char
'@'Char -> String -> String
forall a. a -> [a] -> [a]
:[Char
'a'..Char
'z']String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
'['..Char
'_'])
    , Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'i'  -- Resolve issue #3 where CTRL-i hides TAB.
    , Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'h'  -- CTRL-h should not hide BS
    ]

-- | Ctrl+Meta+Char
ctrlMetaChars :: ClassifyMap
ctrlMetaChars :: ClassifyMap
ctrlMetaChars = ((String, Event) -> (String, Event)) -> ClassifyMap -> ClassifyMap
forall a b. (a -> b) -> [a] -> [b]
map (\(String
s,EvKey Key
c [Modifier]
m) -> (Char
'\ESC'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s, Key -> [Modifier] -> Event
EvKey Key
c (Modifier
MMetaModifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
:[Modifier]
m))) ClassifyMap
ctrlChars

-- | Esc, meta-esc, delete, meta-delete, enter, meta-enter.
specialSupportKeys :: ClassifyMap
specialSupportKeys :: ClassifyMap
specialSupportKeys =
    [ (String
"\ESC\ESC[5~",Key -> [Modifier] -> Event
EvKey Key
KPageUp [Modifier
MMeta])
    , (String
"\ESC\ESC[6~",Key -> [Modifier] -> Event
EvKey Key
KPageDown [Modifier
MMeta])
    -- special support for ESC
    , (String
"\ESC",Key -> [Modifier] -> Event
EvKey Key
KEsc []), (String
"\ESC\ESC",Key -> [Modifier] -> Event
EvKey Key
KEsc [Modifier
MMeta])
    -- Special support for backspace
    , (String
"\DEL",Key -> [Modifier] -> Event
EvKey Key
KBS []), (String
"\ESC\DEL",Key -> [Modifier] -> Event
EvKey Key
KBS [Modifier
MMeta])
    -- Special support for Enter
    , (String
"\ESC\^J",Key -> [Modifier] -> Event
EvKey Key
KEnter [Modifier
MMeta]), (String
"\^J",Key -> [Modifier] -> Event
EvKey Key
KEnter [])
    -- explicit support for tab
    , (String
"\t", Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'\t') [])
    ]

-- | A classification table directly generated from terminfo cap
-- strings.  These are:
--
-- * ka1 - keypad up-left
--
-- * ka3 - keypad up-right
--
-- * kb2 - keypad center
--
-- * kbs - keypad backspace
--
-- * kbeg - begin
--
-- * kcbt - back tab
--
-- * kc1 - keypad left-down
--
-- * kc3 - keypad right-down
--
-- * kdch1 - delete
--
-- * kcud1 - down
--
-- * kend - end
--
-- * kent - enter
--
-- * kf0 - kf63 - function keys
--
-- * khome - KHome
--
-- * kich1 - insert
--
-- * kcub1 - left
--
-- * knp - next page (page down)
--
-- * kpp - previous page (page up)
--
-- * kcuf1 - right
--
-- * kDC - shift delete
--
-- * kEND - shift end
--
-- * kHOM - shift home
--
-- * kIC - shift insert
--
-- * kLFT - shift left
--
-- * kRIT - shift right
--
-- * kcuu1 - up
keysFromCapsTable :: ClassifyMap
keysFromCapsTable :: ClassifyMap
keysFromCapsTable =
    [ (String
"ka1",   Key -> [Modifier] -> Event
EvKey Key
KUpLeft    [])
    , (String
"ka3",   Key -> [Modifier] -> Event
EvKey Key
KUpRight   [])
    , (String
"kb2",   Key -> [Modifier] -> Event
EvKey Key
KCenter    [])
    , (String
"kbs",   Key -> [Modifier] -> Event
EvKey Key
KBS        [])
    , (String
"kbeg",  Key -> [Modifier] -> Event
EvKey Key
KBegin     [])
    , (String
"kcbt",  Key -> [Modifier] -> Event
EvKey Key
KBackTab   [])
    , (String
"kc1",   Key -> [Modifier] -> Event
EvKey Key
KDownLeft  [])
    , (String
"kc3",   Key -> [Modifier] -> Event
EvKey Key
KDownRight [])
    , (String
"kdch1", Key -> [Modifier] -> Event
EvKey Key
KDel       [])
    , (String
"kcud1", Key -> [Modifier] -> Event
EvKey Key
KDown      [])
    , (String
"kend",  Key -> [Modifier] -> Event
EvKey Key
KEnd       [])
    , (String
"kent",  Key -> [Modifier] -> Event
EvKey Key
KEnter     [])
    , (String
"khome", Key -> [Modifier] -> Event
EvKey Key
KHome      [])
    , (String
"kich1", Key -> [Modifier] -> Event
EvKey Key
KIns       [])
    , (String
"kcub1", Key -> [Modifier] -> Event
EvKey Key
KLeft      [])
    , (String
"knp",   Key -> [Modifier] -> Event
EvKey Key
KPageDown  [])
    , (String
"kpp",   Key -> [Modifier] -> Event
EvKey Key
KPageUp    [])
    , (String
"kcuf1", Key -> [Modifier] -> Event
EvKey Key
KRight     [])
    , (String
"kDC",   Key -> [Modifier] -> Event
EvKey Key
KDel       [Modifier
MShift])
    , (String
"kEND",  Key -> [Modifier] -> Event
EvKey Key
KEnd       [Modifier
MShift])
    , (String
"kHOM",  Key -> [Modifier] -> Event
EvKey Key
KHome      [Modifier
MShift])
    , (String
"kIC",   Key -> [Modifier] -> Event
EvKey Key
KIns       [Modifier
MShift])
    , (String
"kLFT",  Key -> [Modifier] -> Event
EvKey Key
KLeft      [Modifier
MShift])
    , (String
"kRIT",  Key -> [Modifier] -> Event
EvKey Key
KRight     [Modifier
MShift])
    , (String
"kcuu1", Key -> [Modifier] -> Event
EvKey Key
KUp        [])
    ] ClassifyMap -> ClassifyMap -> ClassifyMap
forall a. [a] -> [a] -> [a]
++ ClassifyMap
functionKeyCapsTable

-- | Cap names for function keys.
functionKeyCapsTable :: ClassifyMap
functionKeyCapsTable :: ClassifyMap
functionKeyCapsTable = ((Int -> (String, Event)) -> [Int] -> ClassifyMap)
-> [Int] -> (Int -> (String, Event)) -> ClassifyMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> (String, Event)) -> [Int] -> ClassifyMap
forall a b. (a -> b) -> [a] -> [b]
map [Int
0..Int
63] ((Int -> (String, Event)) -> ClassifyMap)
-> (Int -> (String, Event)) -> ClassifyMap
forall a b. (a -> b) -> a -> b
$ \Int
n -> (String
"kf" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n, Key -> [Modifier] -> Event
EvKey (Int -> Key
KFun Int
n) [])