    {-# 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 termName :: String
    termName term :: 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
    terminal table :: ClassifyMap
    table = [(String
    x,Event
    y) | (Just x :: String
    x,y :: 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 _termName :: 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 <- [' ' .. Int -> Char
    forall a. Enum a => Int -> a
    toEnum 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])
        | (x :: Int
    x,y :: Char
    y) <- [Int] -> String -> [(Int, Char)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([0..31]) ('@'Char -> String -> String
    forall a. a -> [a] -> [a]
    :['a'..'z']String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++['['..'_'])
        , Char
    y Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 'i'  -- Resolve issue #3 where CTRL-i hides TAB.
        , Char
    y Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '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 (\(s :: String
    s,EvKey c :: Key
    c m :: [Modifier]
    m) -> ('\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 =
        [ -- special support for ESC
          ("\ESC",Key -> [Modifier] -> Event
    EvKey Key
    KEsc []), ("\ESC\ESC",Key -> [Modifier] -> Event
    EvKey Key
    KEsc [Modifier
    MMeta])
        -- Special support for backspace
        , ("\DEL",Key -> [Modifier] -> Event
    EvKey Key
    KBS []), ("\ESC\DEL",Key -> [Modifier] -> Event
    EvKey Key
    KBS [Modifier
    MMeta])
        -- Special support for Enter
        , ("\ESC\^J",Key -> [Modifier] -> Event
    EvKey Key
    KEnter [Modifier
    MMeta]), ("\^J",Key -> [Modifier] -> Event
    EvKey Key
    KEnter [])
        -- explicit support for tab
        , ("\t", Key -> [Modifier] -> Event
    EvKey (Char -> Key
    KChar '\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 =
        [ ("ka1",   Key -> [Modifier] -> Event
    EvKey Key
    KUpLeft    [])
        , ("ka3",   Key -> [Modifier] -> Event
    EvKey Key
    KUpRight   [])
        , ("kb2",   Key -> [Modifier] -> Event
    EvKey Key
    KCenter    [])
        , ("kbs",   Key -> [Modifier] -> Event
    EvKey Key
    KBS        [])
        , ("kbeg",  Key -> [Modifier] -> Event
    EvKey Key
    KBegin     [])
        , ("kcbt",  Key -> [Modifier] -> Event
    EvKey Key
    KBackTab   [])
        , ("kc1",   Key -> [Modifier] -> Event
    EvKey Key
    KDownLeft  [])
        , ("kc3",   Key -> [Modifier] -> Event
    EvKey Key
    KDownRight [])
        , ("kdch1", Key -> [Modifier] -> Event
    EvKey Key
    KDel       [])
        , ("kcud1", Key -> [Modifier] -> Event
    EvKey Key
    KDown      [])
        , ("kend",  Key -> [Modifier] -> Event
    EvKey Key
    KEnd       [])
        , ("kent",  Key -> [Modifier] -> Event
    EvKey Key
    KEnter     [])
        , ("khome", Key -> [Modifier] -> Event
    EvKey Key
    KHome      [])
        , ("kich1", Key -> [Modifier] -> Event
    EvKey Key
    KIns       [])
        , ("kcub1", Key -> [Modifier] -> Event
    EvKey Key
    KLeft      [])
        , ("knp",   Key -> [Modifier] -> Event
    EvKey Key
    KPageDown  [])
        , ("kpp",   Key -> [Modifier] -> Event
    EvKey Key
    KPageUp    [])
        , ("kcuf1", Key -> [Modifier] -> Event
    EvKey Key
    KRight     [])
        , ("kDC",   Key -> [Modifier] -> Event
    EvKey Key
    KDel       [Modifier
    MShift])
        , ("kEND",  Key -> [Modifier] -> Event
    EvKey Key
    KEnd       [Modifier
    MShift])
        , ("kHOM",  Key -> [Modifier] -> Event
    EvKey Key
    KHome      [Modifier
    MShift])
        , ("kIC",   Key -> [Modifier] -> Event
    EvKey Key
    KIns       [Modifier
    MShift])
        , ("kLFT",  Key -> [Modifier] -> Event
    EvKey Key
    KLeft      [Modifier
    MShift])
        , ("kRIT",  Key -> [Modifier] -> Event
    EvKey Key
    KRight     [Modifier
    MShift])
        , ("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 [0..63] ((Int -> (String, Event)) -> ClassifyMap)
    -> (Int -> (String, Event)) -> ClassifyMap
    forall a b. (a -> b) -> a -> b
    $ \n :: Int
    n -> ("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) [])