    module System.Console.Haskeline.Key(Key(..),
                Modifier(..),
                BaseKey(..),
                noModifier,
                simpleKey,
                simpleChar,
                metaChar,
                ctrlChar,
                metaKey,
                ctrlKey,
                parseKey
                ) where

    import Data.Bits
    import Data.Char
    import Data.Maybe
    import Data.List (intercalate)
    import Control.Monad

    data Key = Key Modifier BaseKey
                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,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)

    instance Show Key where
        show :: Key -> [Char]
    show (Key Modifier
    modifier BaseKey
    base)
            | Modifier
    modifier Modifier -> Modifier -> Bool
    forall a. Eq a => a -> a -> Bool
    == Modifier
    noModifier = BaseKey -> [Char]
    forall a. Show a => a -> [Char]
    show BaseKey
    base
            | Bool
    otherwise = Modifier -> [Char]
    forall a. Show a => a -> [Char]
    show Modifier
    modifier [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "-" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ BaseKey -> [Char]
    forall a. Show a => a -> [Char]
    show BaseKey
    base

    data Modifier = Modifier {Modifier -> Bool
    hasControl, Modifier -> Bool
    hasMeta, Modifier -> Bool
    hasShift :: Bool}
                deriving (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)

    instance Show Modifier where
        show :: Modifier -> [Char]
    show Modifier
    m = [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    "-"
                ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Maybe [Char]] -> [[Char]]
    forall a. [Maybe a] -> [a]
    catMaybes [(Modifier -> Bool) -> [Char] -> Maybe [Char]
    forall {a}. (Modifier -> Bool) -> a -> Maybe a
    maybeUse Modifier -> Bool
    hasControl [Char]
    "ctrl"
                            , (Modifier -> Bool) -> [Char] -> Maybe [Char]
    forall {a}. (Modifier -> Bool) -> a -> Maybe a
    maybeUse Modifier -> Bool
    hasMeta [Char]
    "meta"
                            , (Modifier -> Bool) -> [Char] -> Maybe [Char]
    forall {a}. (Modifier -> Bool) -> a -> Maybe a
    maybeUse Modifier -> Bool
    hasShift [Char]
    "shift"
                            ]
            where
                maybeUse :: (Modifier -> Bool) -> a -> Maybe a
    maybeUse Modifier -> Bool
    f a
    str = if Modifier -> Bool
    f Modifier
    m then a -> Maybe a
    forall a. a -> Maybe a
    Just a
    str else Maybe a
    forall a. Maybe a
    Nothing

    noModifier :: Modifier
    noModifier :: Modifier
    noModifier = Bool -> Bool -> Bool -> Modifier
    Modifier Bool
    False Bool
    False Bool
    False

    -- Note: a few of these aren't really keys (e.g., KillLine),
    -- but they provide useful enough binding points to include.
    data BaseKey = KeyChar Char
                 | FunKey Int
                 | LeftKey | RightKey | DownKey | UpKey
                 | KillLine | Home | End | PageDown | PageUp
                 | Backspace | Delete
                 | SearchReverse | SearchForward
                deriving (BaseKey -> BaseKey -> Bool
    (BaseKey -> BaseKey -> Bool)
    -> (BaseKey -> BaseKey -> Bool) -> Eq BaseKey
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: BaseKey -> BaseKey -> Bool
    == :: BaseKey -> BaseKey -> Bool
    $c/= :: BaseKey -> BaseKey -> Bool
    /= :: BaseKey -> BaseKey -> Bool
    Eq, Eq BaseKey
    Eq BaseKey =>
    (BaseKey -> BaseKey -> Ordering)
    -> (BaseKey -> BaseKey -> Bool)
    -> (BaseKey -> BaseKey -> Bool)
    -> (BaseKey -> BaseKey -> Bool)
    -> (BaseKey -> BaseKey -> Bool)
    -> (BaseKey -> BaseKey -> BaseKey)
    -> (BaseKey -> BaseKey -> BaseKey)
    -> Ord BaseKey
    BaseKey -> BaseKey -> Bool
    BaseKey -> BaseKey -> Ordering
    BaseKey -> BaseKey -> BaseKey
    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 :: BaseKey -> BaseKey -> Ordering
    compare :: BaseKey -> BaseKey -> Ordering
    $c< :: BaseKey -> BaseKey -> Bool
    < :: BaseKey -> BaseKey -> Bool
    $c<= :: BaseKey -> BaseKey -> Bool
    <= :: BaseKey -> BaseKey -> Bool
    $c> :: BaseKey -> BaseKey -> Bool
    > :: BaseKey -> BaseKey -> Bool
    $c>= :: BaseKey -> BaseKey -> Bool
    >= :: BaseKey -> BaseKey -> Bool
    $cmax :: BaseKey -> BaseKey -> BaseKey
    max :: BaseKey -> BaseKey -> BaseKey
    $cmin :: BaseKey -> BaseKey -> BaseKey
    min :: BaseKey -> BaseKey -> BaseKey
    Ord)

    instance Show BaseKey where
        show :: BaseKey -> [Char]
    show (KeyChar Char
    '\n') = [Char]
    "Return"
        show (KeyChar Char
    '\t') = [Char]
    "Tab"
        show (KeyChar Char
    '\ESC') = [Char]
    "Esc"
        show (KeyChar Char
    c)
            | Char -> Bool
    isPrint Char
    c = [Char
    c]
            | Char -> Bool
    isPrint Char
    unCtrld = [Char]
    "ctrl-" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char
    unCtrld]
            | Bool
    otherwise = Char -> [Char]
    forall a. Show a => a -> [Char]
    show Char
    c
          where
            unCtrld :: Char
    unCtrld = Int -> Char
    forall a. Enum a => Int -> a
    toEnum (Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    c Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Int
    ctrlBits)
        show (FunKey Int
    n) = Char
    'f' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n
        show BaseKey
    LeftKey = [Char]
    "Left"
        show BaseKey
    RightKey = [Char]
    "Right"
        show BaseKey
    DownKey = [Char]
    "Down"
        show BaseKey
    UpKey = [Char]
    "Up"
        show BaseKey
    KillLine = [Char]
    "KillLine"
        show BaseKey
    Home = [Char]
    "Home"
        show BaseKey
    End = [Char]
    "End"
        show BaseKey
    PageDown = [Char]
    "PageDown"
        show BaseKey
    PageUp = [Char]
    "PageUp"
        show BaseKey
    Backspace = [Char]
    "Backspace"
        show BaseKey
    Delete = [Char]
    "Delete"
        show BaseKey
    SearchReverse = [Char]
    "SearchReverse"
        show BaseKey
    SearchForward = [Char]
    "SearchForward"

    simpleKey :: BaseKey -> Key
    simpleKey :: BaseKey -> Key
    simpleKey = Modifier -> BaseKey -> Key
    Key Modifier
    noModifier

    metaKey :: Key -> Key
    metaKey :: Key -> Key
    metaKey (Key Modifier
    m BaseKey
    bc) = Modifier -> BaseKey -> Key
    Key Modifier
    m {hasMeta = True} BaseKey
    bc

    ctrlKey :: Key -> Key
    ctrlKey :: Key -> Key
    ctrlKey (Key Modifier
    m BaseKey
    bc) = Modifier -> BaseKey -> Key
    Key Modifier
    m {hasControl = True} BaseKey
    bc

    simpleChar, metaChar, ctrlChar :: Char -> Key
    simpleChar :: Char -> Key
    simpleChar = BaseKey -> Key
    simpleKey (BaseKey -> Key) -> (Char -> BaseKey) -> Char -> Key
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> BaseKey
    KeyChar
    metaChar :: Char -> Key
    metaChar = Key -> Key
    metaKey (Key -> Key) -> (Char -> Key) -> Char -> Key
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Key
    simpleChar

    ctrlChar :: Char -> Key
    ctrlChar = Char -> Key
    simpleChar (Char -> Key) -> (Char -> Char) -> Char -> Key
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Char
    setControlBits

    setControlBits :: Char -> Char
    setControlBits :: Char -> Char
    setControlBits Char
    '?' = Int -> Char
    forall a. Enum a => Int -> a
    toEnum Int
    127
    setControlBits Char
    c = Int -> Char
    forall a. Enum a => Int -> a
    toEnum (Int -> Char) -> Int -> Char
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    c Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int -> Int
    forall a. Bits a => a -> a
    complement Int
    ctrlBits

    ctrlBits :: Int
    ctrlBits :: Int
    ctrlBits = Int -> Int
    forall a. Bits a => Int -> a
    bit Int
    5 Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Int -> Int
    forall a. Bits a => Int -> a
    bit Int
    6

    specialKeys :: [(String,BaseKey)]
    specialKeys :: [([Char], BaseKey)]
    specialKeys = [([Char]
    "left",BaseKey
    LeftKey)
                  ,([Char]
    "right",BaseKey
    RightKey)
                  ,([Char]
    "down",BaseKey
    DownKey)
                  ,([Char]
    "up",BaseKey
    UpKey)
                  ,([Char]
    "killline",BaseKey
    KillLine)
                  ,([Char]
    "home",BaseKey
    Home)
                  ,([Char]
    "end",BaseKey
    End)
                  ,([Char]
    "pagedown",BaseKey
    PageDown)
                  ,([Char]
    "pageup",BaseKey
    PageUp)
                  ,([Char]
    "backspace",BaseKey
    Backspace)
                  ,([Char]
    "delete",BaseKey
    Delete)
                  ,([Char]
    "return",Char -> BaseKey
    KeyChar Char
    '\n')
                  ,([Char]
    "enter",Char -> BaseKey
    KeyChar Char
    '\n')
                  ,([Char]
    "tab",Char -> BaseKey
    KeyChar Char
    '\t')
                  ,([Char]
    "esc",Char -> BaseKey
    KeyChar Char
    '\ESC')
                  ,([Char]
    "escape",Char -> BaseKey
    KeyChar Char
    '\ESC')
                  ,([Char]
    "reversesearchhistory",BaseKey
    SearchReverse)
                  ,([Char]
    "forwardsearchhistory",BaseKey
    SearchForward)
                  ]

    parseModifiers :: [String] -> BaseKey -> Key
    parseModifiers :: [[Char]] -> BaseKey -> Key
    parseModifiers [[Char]]
    strs = Modifier -> BaseKey -> Key
    Key Modifier
    mods
        where mods :: Modifier
    mods = ((Modifier -> Modifier)
     -> (Modifier -> Modifier) -> Modifier -> Modifier)
    -> [Modifier -> Modifier] -> Modifier -> Modifier
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 (Modifier -> Modifier)
    -> (Modifier -> Modifier) -> Modifier -> Modifier
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) (([Char] -> Modifier -> Modifier)
    -> [[Char]] -> [Modifier -> Modifier]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Modifier -> Modifier
    parseModifier [[Char]]
    strs) Modifier
    noModifier

    parseModifier :: String -> (Modifier -> Modifier)
    parseModifier :: [Char] -> Modifier -> Modifier
    parseModifier [Char]
    str Modifier
    m = case (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    str of
        [Char]
    "ctrl" -> Modifier
    m {hasControl = True}
        [Char]
    "control" -> Modifier
    m {hasControl = True}
        [Char]
    "meta" -> Modifier
    m {hasMeta = True}
        [Char]
    "shift" -> Modifier
    m {hasShift = True}
        [Char]
    _ -> Modifier
    m

    breakAtDashes :: String -> [String]
    breakAtDashes :: [Char] -> [[Char]]
    breakAtDashes [Char]
    "" = []
    breakAtDashes [Char]
    str = case (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '-') [Char]
    str of
        ([Char]
    xs,Char
    '-':[Char]
    rest) -> [Char]
    xs [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [Char] -> [[Char]]
    breakAtDashes [Char]
    rest
        ([Char]
    xs,[Char]
    _) -> [[Char]
    xs]

    parseKey :: String -> Maybe Key
    parseKey :: [Char] -> Maybe Key
    parseKey [Char]
    str = (Key -> Key) -> Maybe Key -> Maybe Key
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Key -> Key
    canonicalizeKey (Maybe Key -> Maybe Key) -> Maybe Key -> Maybe Key
    forall a b. (a -> b) -> a -> b
    $
        case [[Char]] -> [[Char]]
    forall a. [a] -> [a]
    reverse ([Char] -> [[Char]]
    breakAtDashes [Char]
    str) of
            [[Char]
    ks] -> (BaseKey -> Key) -> Maybe BaseKey -> Maybe Key
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM BaseKey -> Key
    simpleKey ([Char] -> Maybe BaseKey
    parseBaseKey [Char]
    ks)
            [Char]
    ks:[[Char]]
    ms -> (BaseKey -> Key) -> Maybe BaseKey -> Maybe Key
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ([[Char]] -> BaseKey -> Key
    parseModifiers [[Char]]
    ms) ([Char] -> Maybe BaseKey
    parseBaseKey [Char]
    ks)
            [] -> Maybe Key
    forall a. Maybe a
    Nothing

    parseBaseKey :: String -> Maybe BaseKey
    parseBaseKey :: [Char] -> Maybe BaseKey
    parseBaseKey [Char]
    ks = [Char] -> [([Char], BaseKey)] -> Maybe BaseKey
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup ((Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower [Char]
    ks) [([Char], BaseKey)]
    specialKeys
                    Maybe BaseKey -> Maybe BaseKey -> Maybe BaseKey
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` [Char] -> Maybe BaseKey
    parseFunctionKey [Char]
    ks
                    Maybe BaseKey -> Maybe BaseKey -> Maybe BaseKey
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` [Char] -> Maybe BaseKey
    parseKeyChar [Char]
    ks
        where
            parseKeyChar :: [Char] -> Maybe BaseKey
    parseKeyChar [Char
    c] | Char -> Bool
    isPrint Char
    c = BaseKey -> Maybe BaseKey
    forall a. a -> Maybe a
    Just (Char -> BaseKey
    KeyChar Char
    c)
            parseKeyChar [Char]
    _ = Maybe BaseKey
    forall a. Maybe a
    Nothing

            parseFunctionKey :: [Char] -> Maybe BaseKey
    parseFunctionKey (Char
    f:[Char]
    ns) | Char
    f Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char]
    "fF" = case ReadS Int
    forall a. Read a => ReadS a
    reads [Char]
    ns of
                [(Int
    n,[Char]
    "")]    -> BaseKey -> Maybe BaseKey
    forall a. a -> Maybe a
    Just (Int -> BaseKey
    FunKey Int
    n)
                [(Int, [Char])]
    _           -> Maybe BaseKey
    forall a. Maybe a
    Nothing
            parseFunctionKey [Char]
    _ = Maybe BaseKey
    forall a. Maybe a
    Nothing

    canonicalizeKey :: Key -> Key
    canonicalizeKey :: Key -> Key
    canonicalizeKey (Key Modifier
    m (KeyChar Char
    c))
        | Modifier -> Bool
    hasControl Modifier
    m = Modifier -> BaseKey -> Key
    Key Modifier
    m {hasControl = False}
                            (Char -> BaseKey
    KeyChar (Char -> Char
    setControlBits Char
    c))
        | Modifier -> Bool
    hasShift Modifier
    m = Modifier -> BaseKey -> Key
    Key Modifier
    m {hasShift = False} (Char -> BaseKey
    KeyChar (Char -> Char
    toUpper Char
    c))
    canonicalizeKey Key
    k = Key
    k