module Potato.Flow.Vty.AppKbCmd where
import Relude
import Potato.Reflex.Vty.Helpers
import Reflex
import Reflex.Vty
import qualified Graphics.Vty.Input.Events as V
data AppKbCmd t = AppKbCmd {
forall t. AppKbCmd t -> Event t ()
_appKbCmd_save :: Event t ()
, forall t. AppKbCmd t -> Event t ()
_appKbCmd_open :: Event t ()
, forall t. AppKbCmd t -> Event t ()
_appKbCmd_print :: Event t ()
, forall t. AppKbCmd t -> Event t ()
_appKbCmd_quit :: Event t ()
, forall t. AppKbCmd t -> Event t ()
_appKbCmd_forceQuit :: Event t ()
, forall t. AppKbCmd t -> Event t ()
_appKbCmd_new :: Event t ()
, forall t. AppKbCmd t -> Event t ()
_appKbCmd_capturedInput :: Event t ()
}
holdAppKbCmd :: (MonadWidget t m) => m (AppKbCmd t)
holdAppKbCmd :: forall t (m :: * -> *). MonadWidget t m => m (AppKbCmd t)
holdAppKbCmd = do
Event t VtyEvent
inp <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
let
captureKeyWithCtrl :: Char -> Event t ()
captureKeyWithCtrl Char
c = forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
inp forall a b. (a -> b) -> a -> b
$ \VtyEvent
i -> case VtyEvent
i of
V.EvKey (V.KChar Char
c') [Modifier
V.MCtrl] | Char
c' forall a. Eq a => a -> a -> Bool
== Char
c -> forall a. a -> Maybe a
Just ()
VtyEvent
_ -> forall a. Maybe a
Nothing
saveEv :: Event t ()
saveEv = Char -> Event t ()
captureKeyWithCtrl Char
's'
openEv :: Event t ()
openEv = Char -> Event t ()
captureKeyWithCtrl Char
'o'
printEv :: Event t ()
printEv = Char -> Event t ()
captureKeyWithCtrl Char
'p'
quitEv :: Event t ()
quitEv = Char -> Event t ()
captureKeyWithCtrl Char
'q'
newEv :: Event t ()
newEv = Char -> Event t ()
captureKeyWithCtrl Char
'n'
forceQuitEv :: Event t ()
forceQuitEv = forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
inp forall a b. (a -> b) -> a -> b
$ \VtyEvent
i -> case VtyEvent
i of
V.EvKey (V.KChar Char
'q') [Modifier
V.MCtrl, Modifier
V.MShift] -> forall a. a -> Maybe a
Just ()
V.EvKey (V.KChar Char
'q') [Modifier
V.MShift, Modifier
V.MCtrl] -> forall a. a -> Maybe a
Just ()
VtyEvent
_ -> forall a. Maybe a
Nothing
captureEv :: Event t ()
captureEv = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
saveEv, Event t ()
openEv, Event t ()
quitEv, Event t ()
newEv, Event t ()
forceQuitEv]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AppKbCmd {
_appKbCmd_save :: Event t ()
_appKbCmd_save = Event t ()
saveEv
, _appKbCmd_open :: Event t ()
_appKbCmd_open = Event t ()
openEv
, _appKbCmd_print :: Event t ()
_appKbCmd_print = Event t ()
printEv
, _appKbCmd_quit :: Event t ()
_appKbCmd_quit = Event t ()
quitEv
, _appKbCmd_forceQuit :: Event t ()
_appKbCmd_forceQuit = Event t ()
forceQuitEv
, _appKbCmd_new :: Event t ()
_appKbCmd_new = Event t ()
newEv
, _appKbCmd_capturedInput :: Event t ()
_appKbCmd_capturedInput = Event t ()
captureEv
}