{-# 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 (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)
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) (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Binding :: Key -> Set Modifier -> Binding
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 (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MShift
            Text
"shift"   -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MShift
            Text
"m"       -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MMeta
            Text
"meta"    -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MMeta
            Text
"a"       -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MAlt
            Text
"alt"     -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MAlt
            Text
"c"       -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
            Text
"ctrl"    -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
            Text
"control" -> Modifier -> Either String Modifier
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 (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEsc
        pKey Text
"backspace" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBS
        pKey Text
"enter"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEnter
        pKey Text
"left"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KLeft
        pKey Text
"right"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KRight
        pKey Text
"up"        = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUp
        pKey Text
"down"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDown
        pKey Text
"upleft"    = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUpLeft
        pKey Text
"upright"   = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUpRight
        pKey Text
"downleft"  = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDownLeft
        pKey Text
"downright" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDownRight
        pKey Text
"center"    = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KCenter
        pKey Text
"backtab"   = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBackTab
        pKey Text
"printscreen" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPrtScr
        pKey Text
"pause"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPause
        pKey Text
"insert"    = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KIns
        pKey Text
"home"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KHome
        pKey Text
"pgup"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPageUp
        pKey Text
"del"       = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDel
        pKey Text
"end"       = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEnd
        pKey Text
"pgdown"    = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPageDown
        pKey Text
"begin"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBegin
        pKey Text
"menu"      = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KMenu
        pKey Text
"space"     = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar Char
' ')
        pKey Text
"tab"       = Key -> Either String Key
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 (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar (Char -> Key) -> Char -> Key
forall a b. (a -> b) -> a -> b
$ 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 (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 :: 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 binidngs 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 :: 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 :: 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 (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 (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