module KMonad.App.BEnv
( BEnv(..)
, HasBEnv(..)
, initBEnv
, runBEnv
)
where
import KMonad.Prelude
import KMonad.Action
import KMonad.Button
import KMonad.Keyboard
data BEnv = BEnv
{ BEnv -> Button
_beButton :: !Button
, BEnv -> Keycode
_binding :: !Keycode
, BEnv -> MVar Switch
_lastSwitch :: !(MVar Switch)
}
makeClassy ''BEnv
instance HasButton BEnv where button :: (Button -> f Button) -> BEnv -> f BEnv
button = (Button -> f Button) -> BEnv -> f BEnv
forall c. HasBEnv c => Lens' c Button
beButton
initBEnv :: MonadIO m => Button -> Keycode -> m BEnv
initBEnv :: Button -> Keycode -> m BEnv
initBEnv b :: Button
b c :: Keycode
c = Button -> Keycode -> MVar Switch -> BEnv
BEnv Button
b Keycode
c (MVar Switch -> BEnv) -> m (MVar Switch) -> m BEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Switch -> m (MVar Switch)
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Switch
Release
runBEnv :: MonadUnliftIO m => BEnv -> Switch -> m (Maybe Action)
runBEnv :: BEnv -> Switch -> m (Maybe Action)
runBEnv b :: BEnv
b a :: Switch
a =
MVar Switch
-> (Switch -> m (Switch, Maybe Action)) -> m (Maybe Action)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar (BEnv
bBEnv -> Getting (MVar Switch) BEnv (MVar Switch) -> MVar Switch
forall s a. s -> Getting a s a -> a
^.Getting (MVar Switch) BEnv (MVar Switch)
forall c. HasBEnv c => Lens' c (MVar Switch)
lastSwitch) ((Switch -> m (Switch, Maybe Action)) -> m (Maybe Action))
-> (Switch -> m (Switch, Maybe Action)) -> m (Maybe Action)
forall a b. (a -> b) -> a -> b
$ \l :: Switch
l -> (Switch, Maybe Action) -> m (Switch, Maybe Action)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Switch, Maybe Action) -> m (Switch, Maybe Action))
-> (Switch, Maybe Action) -> m (Switch, Maybe Action)
forall a b. (a -> b) -> a -> b
$ case (Switch
a, Switch
l) of
(Press, Release) -> (Switch
Press, Action -> Maybe Action
forall a. a -> Maybe a
Just (Action -> Maybe Action) -> Action -> Maybe Action
forall a b. (a -> b) -> a -> b
$ BEnv
bBEnv -> Getting Action BEnv Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action BEnv Action
forall c. HasButton c => Lens' c Action
pressAction)
(Release, Press) -> (Switch
Release, Action -> Maybe Action
forall a. a -> Maybe a
Just (Action -> Maybe Action) -> Action -> Maybe Action
forall a b. (a -> b) -> a -> b
$ BEnv
bBEnv -> Getting Action BEnv Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action BEnv Action
forall c. HasButton c => Lens' c Action
releaseAction)
_ -> (Switch
a, Maybe Action
forall a. Maybe a
Nothing)