BEnv.hs

{-|
Module      : KMonad.Model.BEnv
Description : Implementation details behind 'Button'
Copyright   : (c) David Janssen, 2019
License     : MIT
Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : portable

When running KMonad, we need to keep track the last switchstate of a 'Button',
because we only allowing switching, (we have to filter out repeated 'Press' or
'Release' events). Additionally, we keep track of what 'Keycode' a button is
bound to, to provide the 'myBinding' functionality from 'MonadK'.

-}

module KMonad.Model.BEnv
  ( BEnv(..)
  , HasBEnv(..)
  , initBEnv
  , runBEnv
  )
where

import KMonad.Prelude

import KMonad.Model.Action
import KMonad.Model.Button
import KMonad.Keyboard

--------------------------------------------------------------------------------
-- $benv
--
-- When running KMonad, a button also keeps track of what keycode it's bound to,
-- and what its last switch was. This is used to provide the 'myBinding' feature
-- of MonadK, and the invariant that switches always alternate (there is no
-- press-press or release-release).

-- | The configuration of a 'Button' with some additional state to keep track of
-- the last 'Switch'
data BEnv = BEnv
  { _beButton   :: !Button        -- ^ The configuration for this button
  , _binding    :: !Keycode       -- ^ The 'Keycode' to which this button is bound
  , _lastSwitch :: !(MVar Switch) -- ^ State to keep track of last manipulation
  }
makeClassy ''BEnv

instance HasButton BEnv where button = beButton

-- | Initialize a 'BEnv', note that a key is always initialized in an unpressed
-- state.
initBEnv :: MonadIO m => Button -> Keycode -> m BEnv
initBEnv b c = BEnv b c <$> newMVar Release

-- | Try to switch a 'BEnv'. This only does something if the 'Switch' is
-- different from the 'lastSwitch' field. I.e. pressing a pressed button or
-- releasing a released button does nothing.
runBEnv :: MonadUnliftIO m => BEnv -> Switch -> m (Maybe Action)
runBEnv b a =
  modifyMVar (b^.lastSwitch) $ \l -> pure $ case (a, l) of
    (Press, Release) -> (Press,   Just $ b^.pressAction)
    (Release, Press) -> (Release, Just $ b^.releaseAction)
    _                -> (a,       Nothing)