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 qualified Data.ByteString.Char8 as BS8
import Data.ByteString.Char8 (ByteString)

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

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

-- | Does the specified string begin with a focus event?
isFocusEvent :: ByteString -> Bool
isFocusEvent :: ByteString -> Bool
isFocusEvent ByteString
s = ByteString -> ByteString -> Bool
BS8.isPrefixOf ByteString
focusIn ByteString
s Bool -> Bool -> Bool
||
                 ByteString -> ByteString -> Bool
BS8.isPrefixOf ByteString
focusOut ByteString
s

focusIn :: ByteString
focusIn :: ByteString
focusIn = String -> ByteString
BS8.pack String
"\ESC[I"

focusOut :: ByteString
focusOut :: ByteString
focusOut = String -> ByteString
BS8.pack String
"\ESC[O"

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

    Char -> MaybeT (State ByteString) ()
expectChar Char
'\ESC'
    Char -> MaybeT (State ByteString) ()
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