content: {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
  module Vimus.Key (
    keyNames
  , ExpandKeyError (..)
  , expandKeys
  , unExpandKeys
  , keyEsc
  , keyTab
  , ctrlA
  , ctrlB
  , ctrlC
  , ctrlD
  , ctrlE
  , ctrlF
  , ctrlG
  , ctrlH
  , ctrlI
  , ctrlJ
  , ctrlK
  , ctrlL
  , ctrlM
  , ctrlN
  , ctrlO
  , ctrlP
  , ctrlQ
  , ctrlR
  , ctrlS
  , ctrlT
  , ctrlU
  , ctrlV
  , ctrlW
  , ctrlX
  , ctrlY
  , ctrlZ
  ) where
  
  import           Data.Tuple (swap)
  import           Data.Char (toLower)
  
  import           Data.Maybe (fromMaybe)
  
  import           Data.Map (Map)
  import qualified Data.Map as Map
  
  import           UI.Curses.Key
  
  
  keyEsc = '\ESC'
  keyTab = '\t'
  
  ctrlA = '\SOH'
  ctrlB = '\STX'
  ctrlC = '\ETX'
  ctrlD = '\EOT'
  ctrlE = '\ENQ'
  ctrlF = '\ACK'
  ctrlG = '\BEL'
  ctrlH = '\BS'
  ctrlI = '\HT'
  ctrlJ = '\LF'
  ctrlK = '\VT'
  ctrlL = '\FF'
  ctrlM = '\CR'
  ctrlN = '\SO'
  ctrlO = '\SI'
  ctrlP = '\DLE'
  ctrlQ = '\DC1'
  ctrlR = '\DC2'
  ctrlS = '\DC3'
  ctrlT = '\DC4'
  ctrlU = '\NAK'
  ctrlV = '\SYN'
  ctrlW = '\ETB'
  ctrlX = '\CAN'
  ctrlY = '\EM'
  ctrlZ = '\SUB'
  
  
  -- | Associate each key with Vim's key-notation.
  keys :: [(Char, String)]
  keys = [
      m keyEsc    "Esc"
    , m keyTab    "Tab"
  
    , m ctrlA     "C-A"
    , m ctrlB     "C-B"
    , m ctrlC     "C-C"
    , m ctrlD     "C-D"
    , m ctrlE     "C-E"
    , m ctrlF     "C-F"
    , m ctrlG     "C-G"
    , m ctrlH     "C-H"
    , m ctrlI     "C-I"
    , m ctrlJ     "C-J"
    , m ctrlK     "C-K"
    , m ctrlL     "C-L"
    , m ctrlM     "C-M"
    , m ctrlN     "C-N"
    , m ctrlO     "C-O"
    , m ctrlP     "C-P"
    , m ctrlQ     "C-Q"
    , m ctrlR     "C-R"
    , m ctrlS     "C-S"
    , m ctrlT     "C-T"
    , m ctrlU     "C-U"
    , m ctrlV     "C-V"
    , m ctrlW     "C-W"
    , m ctrlX     "C-X"
    , m ctrlY     "C-Y"
    , m ctrlZ     "C-Z"
  
    -- not defined here
    , m '\n'      "CR"
    , m ' '       "Space"
  
    , m keyUp     "Up"
    , m keyDown   "Down"
    , m keyLeft   "Left"
    , m keyRight  "Right"
  
    , m keyPpage  "PageUp"
    , m keyNpage  "PageDown"
    ]
    where
      m = (,)
  
  keyNames :: [String]
  keyNames = map snd keys
  
  
  -- | A mapping from spcial keys to Vim's key-notation.
  --
  -- The brackets are included.
  keyMap :: Map Char String
  keyMap = Map.fromList (map (fmap (\s -> "<" ++ s ++ ">")) keys)
  
  
  -- | A mapping from Vim's key-notation to their corresponding keys.
  --
  -- The brackets are not included, and only lower-case is used for key-notation.
  keyNotationMap :: Map String Char
  keyNotationMap = Map.fromList (map (swap . fmap (map toLower)) keys)
  
  
  -- | Replace all special keys with their corresponding key reference.
  --
  -- Vim's key-notation is used for key references.
  unExpandKeys :: String -> String
  unExpandKeys = foldr f ("" :: String)
    where
      f c
        -- escape opening brackets..
        | c == '<'  = ("\\<" ++)
  
        -- escape backslashes
        | c == '\\'  = ("\\\\" ++)
  
        | otherwise = (keyNotation c ++)
  
      -- | Convert given character to Vim's key-notation.
      keyNotation c = fromMaybe (return c) (Map.lookup c keyMap)
  
  data ExpandKeyError =
      EmptyKeyReference
    | UnterminatedKeyReference String
    | UnknownKeyReference String
    deriving Eq
  
  instance Show ExpandKeyError where
    show e = case e of
      EmptyKeyReference          -> "empty key reference"
      UnterminatedKeyReference k -> "unterminated key reference " ++ show k
      UnknownKeyReference k      -> "unknown key reference " ++ show k
  
  -- | Expand all key references to their corresponding keys.
  --
  -- Vim's key-notation is used for key references.
  expandKeys :: String -> Either ExpandKeyError String
  expandKeys = go
    where
      go s = case s of
        ""        -> return ""
  
        -- keep escaped characters
        '\\':x:xs -> x `cons` go xs
  
        -- expand key references
        '<' : xs  -> expand xs
  
        -- keep any other characters
        x:xs      -> x `cons` go xs
  
      -- | Prepend given element to a list in the either monad.
      cons :: b -> Either a [b] -> Either a [b]
      cons = fmap . (:)
  
      -- Assume that `xs` starts with a key reference, terminated with a closing
      -- bracket.  Replace that key reference with it's corresponding key.
      expand xs = do
        (k, ys) <- takeKeyReference xs
        case Map.lookup k keyNotationMap of
          Just x -> (x :) `fmap` go ys
          Nothing -> Left (UnknownKeyReference k)
  
      -- Assume that `s` starts with a key reference, terminated with a closing
      -- bracket.  Return the key reference (converted to lower-case) and the
      -- suffix, drop the closing bracket.
      takeKeyReference :: String -> Either ExpandKeyError (String, String)
      takeKeyReference s = case break (== '>') s of
        (xs,     "") -> Left (UnterminatedKeyReference xs)
        ("",     _ ) -> Left EmptyKeyReference
        (xs, '>':ys) -> return (map toLower xs, ys)
        _            -> error "Key.takeKeyReference: this should never happen"
  