    module Yi.Event
        (
         Event(..), prettyEvent,
         Key(..), Modifier(..),

         -- * Key codes
         eventToChar
        ) where

    import Data.Bits   (setBit)
    import Data.Char   (chr, ord)

    data Modifier = MShift | MCtrl | MMeta | MSuper | MHyper
                    deriving (Int -> Modifier -> ShowS
    [Modifier] -> ShowS
    Modifier -> String
    (Int -> Modifier -> ShowS)
    -> (Modifier -> String) -> ([Modifier] -> ShowS) -> Show Modifier
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Modifier -> ShowS
    showsPrec :: Int -> Modifier -> ShowS
    $cshow :: Modifier -> String
    show :: Modifier -> String
    $cshowList :: [Modifier] -> ShowS
    showList :: [Modifier] -> ShowS
    Show,Modifier -> Modifier -> Bool
    (Modifier -> Modifier -> Bool)
    -> (Modifier -> Modifier -> Bool) -> Eq Modifier
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Modifier -> Modifier -> Bool
    == :: Modifier -> Modifier -> Bool
    $c/= :: Modifier -> Modifier -> Bool
    /= :: Modifier -> Modifier -> Bool
    Eq,Eq Modifier
    Eq Modifier =>
    (Modifier -> Modifier -> Ordering)
    -> (Modifier -> Modifier -> Bool)
    -> (Modifier -> Modifier -> Bool)
    -> (Modifier -> Modifier -> Bool)
    -> (Modifier -> Modifier -> Bool)
    -> (Modifier -> Modifier -> Modifier)
    -> (Modifier -> Modifier -> Modifier)
    -> Ord Modifier
    Modifier -> Modifier -> Bool
    Modifier -> Modifier -> Ordering
    Modifier -> Modifier -> Modifier
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Modifier -> Modifier -> Ordering
    compare :: Modifier -> Modifier -> Ordering
    $c< :: Modifier -> Modifier -> Bool
    < :: Modifier -> Modifier -> Bool
    $c<= :: Modifier -> Modifier -> Bool
    <= :: Modifier -> Modifier -> Bool
    $c> :: Modifier -> Modifier -> Bool
    > :: Modifier -> Modifier -> Bool
    $c>= :: Modifier -> Modifier -> Bool
    >= :: Modifier -> Modifier -> Bool
    $cmax :: Modifier -> Modifier -> Modifier
    max :: Modifier -> Modifier -> Modifier
    $cmin :: Modifier -> Modifier -> Modifier
    min :: Modifier -> Modifier -> Modifier
    Ord)

    data Key = KEsc | KFun Int | KPrtScr | KPause | KASCII Char | KBS | KIns
             | KHome | KPageUp | KDel | KEnd | KPageDown | KNP5 | KUp | KMenu
             | KLeft | KDown | KRight | KEnter | KTab deriving (Key -> Key -> Bool
    (Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Key -> Key -> Bool
    == :: Key -> Key -> Bool
    $c/= :: Key -> Key -> Bool
    /= :: Key -> Key -> Bool
    Eq,Int -> Key -> ShowS
    [Key] -> ShowS
    Key -> String
    (Int -> Key -> ShowS)
    -> (Key -> String) -> ([Key] -> ShowS) -> Show Key
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Key -> ShowS
    showsPrec :: Int -> Key -> ShowS
    $cshow :: Key -> String
    show :: Key -> String
    $cshowList :: [Key] -> ShowS
    showList :: [Key] -> ShowS
    Show,Eq Key
    Eq Key =>
    (Key -> Key -> Ordering)
    -> (Key -> Key -> Bool)
    -> (Key -> Key -> Bool)
    -> (Key -> Key -> Bool)
    -> (Key -> Key -> Bool)
    -> (Key -> Key -> Key)
    -> (Key -> Key -> Key)
    -> Ord Key
    Key -> Key -> Bool
    Key -> Key -> Ordering
    Key -> Key -> Key
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Key -> Key -> Ordering
    compare :: Key -> Key -> Ordering
    $c< :: Key -> Key -> Bool
    < :: Key -> Key -> Bool
    $c<= :: Key -> Key -> Bool
    <= :: Key -> Key -> Bool
    $c> :: Key -> Key -> Bool
    > :: Key -> Key -> Bool
    $c>= :: Key -> Key -> Bool
    >= :: Key -> Key -> Bool
    $cmax :: Key -> Key -> Key
    max :: Key -> Key -> Key
    $cmin :: Key -> Key -> Key
    min :: Key -> Key -> Key
    Ord)

    data Event = Event Key [Modifier] deriving (Event -> Event -> Bool
    (Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Event -> Event -> Bool
    == :: Event -> Event -> Bool
    $c/= :: Event -> Event -> Bool
    /= :: Event -> Event -> Bool
    Eq)

    instance Ord Event where
        compare :: Event -> Event -> Ordering
    compare (Event Key
    k1 [Modifier]
    m1) (Event Key
    k2 [Modifier]
    m2) = [Modifier] -> [Modifier] -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare [Modifier]
    m1 [Modifier]
    m2 Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend` Key -> Key -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Key
    k1 Key
    k2
        -- so, all Ctrl+char, meta+char, etc. all form a continuous range

    instance Show Event where
        show :: Event -> String
    show = Event -> String
    prettyEvent

    prettyEvent :: Event -> String
    prettyEvent :: Event -> String
    prettyEvent (Event Key
    k [Modifier]
    mods) =
               (Modifier -> String) -> [Modifier] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "-") ShowS -> (Modifier -> String) -> Modifier -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Modifier -> String
    forall {a}. Show a => a -> String
    prettyModifier) [Modifier]
    mods String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Key -> String
    prettyKey Key
    k
      where prettyKey :: Key -> String
    prettyKey (KFun Int
    i) = Char
    'F' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall {a}. Show a => a -> String
    show Int
    i
            prettyKey (KASCII Char
    c) = [Char
    c]
            prettyKey Key
    key = ShowS
    forall a. HasCallStack => [a] -> [a]
    tail ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Key -> String
    forall {a}. Show a => a -> String
    show Key
    key
            prettyModifier :: a -> String
    prettyModifier a
    m = [ a -> String
    forall {a}. Show a => a -> String
    show a
    m String -> Int -> Char
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    1]

    -- | Map an Event to a Char. This is used in the emacs keymap for Ctrl-Q and vim keymap 'insertSpecialChar'
    eventToChar :: Event -> Char
    eventToChar :: Event -> Char
    eventToChar (Event Key
    KEnter [Modifier]
    _) = Char
    '\CR'
    eventToChar (Event Key
    KEsc [Modifier]
    _)   = Char
    '\ESC'
    eventToChar (Event Key
    KBS [Modifier]
    _)    = Char
    '\127'
    eventToChar (Event Key
    KTab [Modifier]
    _)   = Char
    '\t'

    eventToChar (Event (KASCII Char
    c) [Modifier]
    mods) = (if Modifier
    MMeta Modifier -> [Modifier] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Modifier]
    mods then Char -> Char
    setMeta else Char -> Char
    forall a. a -> a
    id) (Char -> Char) -> Char -> Char
    forall a b. (a -> b) -> a -> b
    $
                                          (if Modifier
    MCtrl Modifier -> [Modifier] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Modifier]
    mods then Char -> Char
    ctrlLowcase else Char -> Char
    forall a. a -> a
    id) Char
    c

    eventToChar Event
    _ev = Char
    '?'

    remapChar :: Char -> Char -> Char -> Char -> Char -> Char
    remapChar :: Char -> Char -> Char -> Char -> Char -> Char
    remapChar Char
    a1 Char
    b1 Char
    a2 Char
    _ Char
    c
        | Char
    a1 Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    c Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    b1 = Int -> Char
    chr (Int -> Char) -> Int -> Char
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    a1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    a2
        | Bool
    otherwise          = Char
    c

    ctrlLowcase :: Char -> Char
    ctrlLowcase :: Char -> Char
    ctrlLowcase   = Char -> Char -> Char -> Char -> Char -> Char
    remapChar Char
    'a'   Char
    'z'   Char
    '\^A' Char
    '\^Z'

    -- set the meta bit, as if Mod1/Alt had been pressed
    setMeta :: Char -> Char
    setMeta :: Char -> Char
    setMeta Char
    c = Int -> Char
    chr (Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    setBit (Char -> Int
    ord Char
    c) Int
    metaBit)

    metaBit :: Int
    metaBit :: Int
    metaBit = Int
    7