module Graphics.Vty.Input.Focus
  ( requestFocusEvents
  , disableFocusEvents
  , isFocusEvent
  , classifyFocusEvent
  )
where

import Graphics.Vty.Input.Events
import Graphics.Vty.Input.Classify.Types
import Graphics.Vty.Input.Classify.Parse

import Control.Monad.State
import Data.List (isPrefixOf)

-- | These sequences set xterm-based terminals to send focus event
-- sequences.
requestFocusEvents :: String
requestFocusEvents :: String
requestFocusEvents = String
"\ESC[?1004h"

-- | These sequences disable focus events.
disableFocusEvents :: String
disableFocusEvents :: String
disableFocusEvents = String
"\ESC[?1004l"

-- | Does the specified string begin with a focus event?
isFocusEvent :: String -> Bool
isFocusEvent :: String -> Bool
isFocusEvent String
s = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
focusIn String
s Bool -> Bool -> Bool
||
                 String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
focusOut String
s

focusIn :: String
focusIn :: String
focusIn = String
"\ESC[I"

focusOut :: String
focusOut :: String
focusOut = String
"\ESC[O"

-- | Attempt to classify an input string as a focus event.
classifyFocusEvent :: String -> KClass
classifyFocusEvent :: String -> KClass
classifyFocusEvent String
s = String -> Parser Event -> KClass
runParser String
s (Parser Event -> KClass) -> Parser Event -> KClass
forall a b. (a -> b) -> a -> b
$ do
    Bool -> MaybeT (State String) () -> MaybeT (State String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
isFocusEvent String
s) MaybeT (State String) ()
forall a. Parser a
failParse

    Char -> MaybeT (State String) ()
expectChar Char
'\ESC'
    Char -> MaybeT (State String) ()
expectChar Char
'['
    Char
ty <- Parser Char
readChar
    case Char
ty of
        Char
'I' -> Event -> Parser Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
EvGainedFocus
        Char
'O' -> Event -> Parser Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
EvLostFocus
        Char
_   -> Parser Event
forall a. Parser a
failParse