{-# 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 forall a. Eq a => a -> a -> Bool
== Text
"unbound"
    then forall (m :: * -> *) a. Monad m => a -> m a
return BindingState
Unbound
    else [Binding] -> BindingState
BindingList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Either String Binding
parseBinding forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) (Text -> Text -> [Text]
T.splitOn 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
"-" 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
          forall (m :: * -> *) a. Monad m => a -> m a
return Binding { kbMods :: Set Modifier
kbMods = 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"       -> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MShift
            Text
"shift"   -> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MShift
            Text
"m"       -> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MMeta
            Text
"meta"    -> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MMeta
            Text
"a"       -> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MAlt
            Text
"alt"     -> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MAlt
            Text
"c"       -> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
            Text
"ctrl"    -> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
            Text
"control" -> forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
            Text
_         -> forall a b. a -> Either a b
Left (String
"Unknown modifier prefix: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
k)
          [Text] -> [Modifier] -> Either String Binding
go [Text]
ks (Modifier
mforall a. a -> [a] -> [a]
:[Modifier]
mods)
        go [] [Modifier]
_ = forall a b. a -> Either a b
Left String
"Empty keybinding not allowed"
        pKey :: Text -> Either String Key
pKey Text
"esc"       = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEsc
        pKey Text
"backspace" = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBS
        pKey Text
"enter"     = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEnter
        pKey Text
"left"      = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KLeft
        pKey Text
"right"     = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KRight
        pKey Text
"up"        = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUp
        pKey Text
"down"      = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDown
        pKey Text
"upleft"    = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUpLeft
        pKey Text
"upright"   = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUpRight
        pKey Text
"downleft"  = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDownLeft
        pKey Text
"downright" = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDownRight
        pKey Text
"center"    = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KCenter
        pKey Text
"backtab"   = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBackTab
        pKey Text
"printscreen" = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPrtScr
        pKey Text
"pause"     = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPause
        pKey Text
"insert"    = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KIns
        pKey Text
"home"      = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KHome
        pKey Text
"pgup"      = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPageUp
        pKey Text
"del"       = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDel
        pKey Text
"end"       = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEnd
        pKey Text
"pgdown"    = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPageDown
        pKey Text
"begin"     = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBegin
        pKey Text
"menu"      = forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KMenu
        pKey Text
"space"     = forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar Char
' ')
        pKey Text
"tab"       = forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar Char
'\t')
        pKey Text
t
          | Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
1 =
              forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar 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 forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
n) of
                  Maybe Int
Nothing -> forall a b. a -> Either a b
Left (String
"Unknown keybinding: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
t)
                  Just Int
i -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Key
Vty.KFun Int
i)
          | Bool
otherwise = forall a b. a -> Either a b
Left (String
"Unknown keybinding: " forall a. [a] -> [a] -> [a]
++ 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 =
    forall a. Text -> IniParser a -> Either String a
Ini.parseIniFile Text
doc (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 =
    forall k.
KeyEvents k
-> Text -> Text -> Either String (Maybe [(k, BindingState)])
keybindingsFromIni KeyEvents k
evs Text
section 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 =
    forall a. Text -> SectionParser a -> IniParser (Maybe a)
Ini.sectionMb Text
section forall a b. (a -> b) -> a -> b
$ do
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k. KeyEvents k -> [(Text, k)]
keyEventsList KeyEvents k
evs) forall a b. (a -> b) -> a -> b
$ \(Text
name, k
e) -> do
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k
e,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
Ini.fieldMbOf Text
name Text -> Either String BindingState
parseBindingList