    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE OverloadedStrings #-}
    -- | This module provides key binding string parsing functions for use
    -- in e.g. reading key bindings from configuration files.
    module Brick.Keybindings.Parse
      ( parseBinding
      , parseBindingList

      , keybindingsFromIni
      , keybindingsFromFile
      , keybindingIniParser
      )
    where

    import Control.Monad (forM)
    import Data.Maybe (catMaybes)
    import qualified Data.Set as S
    import qualified Data.Text as T
    import qualified Data.Text.IO as T
    import qualified Graphics.Vty as Vty
    import Text.Read (readMaybe)
    import qualified Data.Ini.Config as Ini

    import Brick.Keybindings.KeyEvents
    import Brick.Keybindings.KeyConfig

    -- | Parse a key binding list into a 'BindingState'.
    --
    -- A key binding list either the string @"unbound"@ or is a
    -- comma-separated list of 'Binding's parsed with 'parseBinding'.
    parseBindingList :: T.Text -> Either String BindingState
    parseBindingList :: Text -> Either String BindingState
    parseBindingList Text
    t =
        if Text -> Text
    T.toLower Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "unbound"
        then BindingState -> Either String BindingState
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return BindingState
    Unbound
        else [Binding] -> BindingState
    BindingList ([Binding] -> BindingState)
    -> Either String [Binding] -> Either String BindingState
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Text -> Either String Binding)
    -> [Text] -> Either String [Binding]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Text -> Either String Binding
    parseBinding (Text -> Either String Binding)
    -> (Text -> Text) -> Text -> Either String Binding
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    T.strip) (HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "," (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.strip Text
    t)

    -- | Parse a key binding string. Key binding strings specify zero or
    -- more modifier keys and a base key, separated by hyphens.
    --
    -- @
    -- (modifier "-")* key
    -- @
    --
    -- e.g. @c-down@, @backspace@, @ctrl-shift-f1@.
    --
    -- where each @modifier@ is parsed case-insensitively as follows:
    --
    -- * @"s", "shift"@: 'Vty.MShift'
    -- * @"m", "meta"@: 'Vty.MMeta'
    -- * @"a", "alt"@: 'Vty.MAlt'
    -- * @"c", "ctrl", "control"@: 'Vty.MCtrl'
    --
    -- and @key@ is parsed case-insensitively as follows:
    --
    -- * "f1", "f2", ...: 'Vty.KFun'
    -- * "esc": 'Vty.KEsc'
    -- * "backspace": 'Vty.KBS'
    -- * "enter": 'Vty.KEnter'
    -- * "left": 'Vty.KLeft'
    -- * "right": 'Vty.KRight'
    -- * "up": 'Vty.KUp'
    -- * "down": 'Vty.KDown'
    -- * "upleft": 'Vty.KUpLeft'
    -- * "upright": 'Vty.KUpRight'
    -- * "downleft": 'Vty.KDownLeft'
    -- * "downright": 'Vty.KDownRight'
    -- * "center": 'Vty.KCenter'
    -- * "backtab": 'Vty.KBackTab'
    -- * "printscreen": 'Vty.KPrtScr'
    -- * "pause": 'Vty.KPause'
    -- * "insert": 'Vty.KIns'
    -- * "home": 'Vty.KHome'
    -- * "pgup": 'Vty.KPageUp'
    -- * "del": 'Vty.KDel'
    -- * "end": 'Vty.KEnd'
    -- * "pgdown": 'Vty.KPageDown'
    -- * "begin": 'Vty.KBegin'
    -- * "menu": 'Vty.KMenu'
    -- * "space": @' '@
    -- * "tab": @'\\t'@
    -- * Otherwise, 'Vty.KChar'
    parseBinding :: T.Text -> Either String Binding
    parseBinding :: Text -> Either String Binding
    parseBinding Text
    s = [Text] -> [Modifier] -> Either String Binding
    go (HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "-" (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.toLower Text
    s) []
      where go :: [Text] -> [Modifier] -> Either String Binding
    go [Text
    k] [Modifier]
    mods = do
              Key
    k' <- Text -> Either String Key
    pKey Text
    k
              Binding -> Either String Binding
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binding { kbMods :: Set Modifier
    kbMods = [Modifier] -> Set Modifier
    forall a. Ord a => [a] -> Set a
    S.fromList [Modifier]
    mods, kbKey :: Key
    kbKey = Key
    k' }
            go (Text
    k:[Text]
    ks) [Modifier]
    mods = do
              Modifier
    m <- case Text
    k of
                Text
    "s"       -> Modifier -> Either String Modifier
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Modifier
    Vty.MShift
                Text
    "shift"   -> Modifier -> Either String Modifier
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Modifier
    Vty.MShift
                Text
    "m"       -> Modifier -> Either String Modifier
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Modifier
    Vty.MMeta
                Text
    "meta"    -> Modifier -> Either String Modifier
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Modifier
    Vty.MMeta
                Text
    "a"       -> Modifier -> Either String Modifier
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Modifier
    Vty.MAlt
                Text
    "alt"     -> Modifier -> Either String Modifier
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Modifier
    Vty.MAlt
                Text
    "c"       -> Modifier -> Either String Modifier
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Modifier
    Vty.MCtrl
                Text
    "ctrl"    -> Modifier -> Either String Modifier
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Modifier
    Vty.MCtrl
                Text
    "control" -> Modifier -> Either String Modifier
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Modifier
    Vty.MCtrl
                Text
    _         -> String -> Either String Modifier
    forall a b. a -> Either a b
    Left (String
    "Unknown modifier prefix: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    forall a. Show a => a -> String
    show Text
    k)
              [Text] -> [Modifier] -> Either String Binding
    go [Text]
    ks (Modifier
    mModifier -> [Modifier] -> [Modifier]
    forall a. a -> [a] -> [a]
    :[Modifier]
    mods)
            go [] [Modifier]
    _ = String -> Either String Binding
    forall a b. a -> Either a b
    Left String
    "Empty keybinding not allowed"
            pKey :: Text -> Either String Key
    pKey Text
    "esc"       = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KEsc
            pKey Text
    "backspace" = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KBS
            pKey Text
    "enter"     = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KEnter
            pKey Text
    "left"      = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KLeft
            pKey Text
    "right"     = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KRight
            pKey Text
    "up"        = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KUp
            pKey Text
    "down"      = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KDown
            pKey Text
    "upleft"    = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KUpLeft
            pKey Text
    "upright"   = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KUpRight
            pKey Text
    "downleft"  = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KDownLeft
            pKey Text
    "downright" = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KDownRight
            pKey Text
    "center"    = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KCenter
            pKey Text
    "backtab"   = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KBackTab
            pKey Text
    "printscreen" = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KPrtScr
            pKey Text
    "pause"     = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KPause
            pKey Text
    "insert"    = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KIns
            pKey Text
    "home"      = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KHome
            pKey Text
    "pgup"      = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KPageUp
            pKey Text
    "del"       = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KDel
            pKey Text
    "end"       = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KEnd
            pKey Text
    "pgdown"    = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KPageDown
            pKey Text
    "begin"     = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KBegin
            pKey Text
    "menu"      = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Key
    Vty.KMenu
            pKey Text
    "space"     = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char -> Key
    Vty.KChar Char
    ' ')
            pKey Text
    "tab"       = Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char -> Key
    Vty.KChar Char
    '\t')
            pKey Text
    t
              | Text -> Int
    T.length Text
    t Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 =
                  Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char -> Key
    Vty.KChar (Char -> Key) -> Char -> Key
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Char
    Text -> Char
    T.last Text
    s)
              | Just Text
    n <- Text -> Text -> Maybe Text
    T.stripPrefix Text
    "f" Text
    t =
                  case String -> Maybe Int
    forall a. Read a => String -> Maybe a
    readMaybe (Text -> String
    T.unpack Text
    n) of
                      Maybe Int
    Nothing -> String -> Either String Key
    forall a b. a -> Either a b
    Left (String
    "Unknown keybinding: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    forall a. Show a => a -> String
    show Text
    t)
                      Just Int
    i -> Key -> Either String Key
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Key
    Vty.KFun Int
    i)
              | Bool
    otherwise = String -> Either String Key
    forall a b. a -> Either a b
    Left (String
    "Unknown keybinding: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    forall a. Show a => a -> String
    show Text
    t)

    -- | Parse custom key bindings from the specified INI file using the
    -- provided event name mapping.
    --
    -- Each line in the specified section can take the form
    --
    -- > <event-name> = <"unbound"|[binding,...]>
    --
    -- where the event name must be a valid event name in the specified
    -- 'KeyEvents' and each binding is valid as parsed by 'parseBinding'.
    --
    -- Returns @Nothing@ if the named section was not found; otherwise
    -- returns a (possibly empty) list of binding states for each event in
    -- @evs@.
    keybindingsFromIni :: KeyEvents k
                       -- ^ The key event name mapping to use to parse the
                       -- configuration data.
                       -> T.Text
                       -- ^ The name of the INI configuration section to
                       -- read.
                       -> T.Text
                       -- ^ The text of the INI document to read.
                       -> Either String (Maybe [(k, BindingState)])
    keybindingsFromIni :: forall k.
    KeyEvents k
    -> Text -> Text -> Either String (Maybe [(k, BindingState)])
    keybindingsFromIni KeyEvents k
    evs Text
    section Text
    doc =
        Text
    -> IniParser (Maybe [(k, BindingState)])
    -> Either String (Maybe [(k, BindingState)])
    forall a. Text -> IniParser a -> Either String a
    Ini.parseIniFile Text
    doc (KeyEvents k -> Text -> IniParser (Maybe [(k, BindingState)])
    forall k.
    KeyEvents k -> Text -> IniParser (Maybe [(k, BindingState)])
    keybindingIniParser KeyEvents k
    evs Text
    section)

    -- | Parse custom key bindings from the specified INI file path. This
    -- does not catch or convert any exceptions resulting from I/O errors.
    -- See 'keybindingsFromIni' for details.
    keybindingsFromFile :: KeyEvents k
                        -- ^ The key event name mapping to use to parse the
                        -- configuration data.
                        -> T.Text
                        -- ^ The name of the INI configuration section to
                        -- read.
                        -> FilePath
                        -- ^ The path to the INI file to read.
                        -> IO (Either String (Maybe [(k, BindingState)]))
    keybindingsFromFile :: forall k.
    KeyEvents k
    -> Text -> String -> IO (Either String (Maybe [(k, BindingState)]))
    keybindingsFromFile KeyEvents k
    evs Text
    section String
    path =
        KeyEvents k
    -> Text -> Text -> Either String (Maybe [(k, BindingState)])
    forall k.
    KeyEvents k
    -> Text -> Text -> Either String (Maybe [(k, BindingState)])
    keybindingsFromIni KeyEvents k
    evs Text
    section (Text -> Either String (Maybe [(k, BindingState)]))
    -> IO Text -> IO (Either String (Maybe [(k, BindingState)]))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Text
    T.readFile String
    path

    -- | The low-level INI parser for custom key bindings used by this
    -- module, exported for applications that use the @config-ini@ package.
    keybindingIniParser :: KeyEvents k -> T.Text -> Ini.IniParser (Maybe [(k, BindingState)])
    keybindingIniParser :: forall k.
    KeyEvents k -> Text -> IniParser (Maybe [(k, BindingState)])
    keybindingIniParser KeyEvents k
    evs Text
    section =
        Text
    -> SectionParser [(k, BindingState)]
    -> IniParser (Maybe [(k, BindingState)])
    forall a. Text -> SectionParser a -> IniParser (Maybe a)
    Ini.sectionMb Text
    section (SectionParser [(k, BindingState)]
     -> IniParser (Maybe [(k, BindingState)]))
    -> SectionParser [(k, BindingState)]
    -> IniParser (Maybe [(k, BindingState)])
    forall a b. (a -> b) -> a -> b
    $ do
            ([Maybe (k, BindingState)] -> [(k, BindingState)])
    -> SectionParser [Maybe (k, BindingState)]
    -> SectionParser [(k, BindingState)]
    forall a b. (a -> b) -> SectionParser a -> SectionParser b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Maybe (k, BindingState)] -> [(k, BindingState)]
    forall a. [Maybe a] -> [a]
    catMaybes (SectionParser [Maybe (k, BindingState)]
     -> SectionParser [(k, BindingState)])
    -> SectionParser [Maybe (k, BindingState)]
    -> SectionParser [(k, BindingState)]
    forall a b. (a -> b) -> a -> b
    $ [(Text, k)]
    -> ((Text, k) -> SectionParser (Maybe (k, BindingState)))
    -> SectionParser [Maybe (k, BindingState)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (KeyEvents k -> [(Text, k)]
    forall k. KeyEvents k -> [(Text, k)]
    keyEventsList KeyEvents k
    evs) (((Text, k) -> SectionParser (Maybe (k, BindingState)))
     -> SectionParser [Maybe (k, BindingState)])
    -> ((Text, k) -> SectionParser (Maybe (k, BindingState)))
    -> SectionParser [Maybe (k, BindingState)]
    forall a b. (a -> b) -> a -> b
    $ \(Text
    name, k
    e) -> do
                (BindingState -> (k, BindingState))
    -> Maybe BindingState -> Maybe (k, BindingState)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (k
    e,) (Maybe BindingState -> Maybe (k, BindingState))
    -> SectionParser (Maybe BindingState)
    -> SectionParser (Maybe (k, BindingState))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text
    -> (Text -> Either String BindingState)
    -> SectionParser (Maybe BindingState)
    forall a.
    Text -> (Text -> Either String a) -> SectionParser (Maybe a)
    Ini.fieldMbOf Text
    name Text -> Either String BindingState
    parseBindingList