Add notify-while config option

src/Client/Configuration.hs

@@ -47,6 +47,7 @@ module Client.Configuration
   , configJumpModifier
   , configDigraphs
   , configNotifications
+  , configNotifyWhile
 
   , configNetworkPalette
   , extensionPath
@@ -76,7 +77,7 @@ import Client.Commands.Interpolation (Macro)
 import Client.Commands.Recognizer (Recognizer)
 import Client.Configuration.Colors (attrSpec)
 import Client.Configuration.Macros (macroMapSpec)
-import Client.Configuration.Notifications (NotifyWith, notifySpec, notifyWithDefault)
+import Client.Configuration.Notifications (NotifyWith, NotifyWhile(NotifyWhileUnfocused), notifySpec, notifyWithDefault, notifyWhileSpec)
 import Client.Configuration.ServerSettings
 import Client.EventLoop.Actions
 import Client.Image.Palette
@@ -128,6 +129,7 @@ data Configuration = Configuration
   , _configJumpModifier    :: [Modifier] -- ^ Modifier used for jumping windows
   , _configDigraphs        :: Map Digraph Text -- ^ Extra digraphs
   , _configNotifications   :: NotifyWith
+  , _configNotifyWhile     :: NotifyWhile
   }
   deriving Show
 
@@ -298,7 +300,9 @@ configurationSpec = sectionsSpec "config-file" $
      _configDigraphs        <- sec' mempty "extra-digraphs" (Map.fromList <$> listSpec digraphSpec)
                                "Extra digraphs"
      _configNotifications   <- sec' notifyWithDefault "notifications" notifySpec
-                               "Whether and how to show desktop notifications"
+                               "Whether and how to show notifications. Notification data is passed as arguments to custom commands."
+     _configNotifyWhile     <- sec' NotifyWhileUnfocused "notify-while" notifyWhileSpec
+                               "When notifications (if enabled) may be displayed"
      return (\def ->
              let _configDefaults = snd ssDefUpdate def
                  _configServers  = buildServerMap _configDefaults ssUpdates

src/Client/Configuration/Notifications.hs

@@ -6,7 +6,7 @@ Copyright   : (c) TheDaemoness, 2023
 License     : ISC
 Maintainer  : emertens@gmail.com
 -}
-module Client.Configuration.Notifications ( NotifyWith(..), notifyCmd, notifySpec, notifyWithDefault ) where
+module Client.Configuration.Notifications ( NotifyWith(..), NotifyWhile(..), notifyCmd, notifySpec, notifyWithDefault, notifyWhileSpec ) where
 
 import           Config.Schema (ValueSpec, atomSpec, nonemptySpec, stringSpec, (<!>))
 import qualified Data.Text.Lazy as LText
@@ -21,6 +21,12 @@ data NotifyWith
   | NotifyWithTerminalNotifier
   deriving Show
 
+data NotifyWhile
+  = NotifyWhileUnfocused
+  | NotifyWhileFocused
+  | NotifyWhileAlways
+  deriving Show
+
 notifyCmd :: NotifyWith -> Maybe ((LText.Text, LText.Text) -> ProcessConfig () () ())
 notifyCmd (NotifyWithCustom (cmd:args)) = Just $ \(header, body) ->
   proc cmd (args ++ [LText.unpack header, LText.unpack body])
@@ -49,3 +55,9 @@ notifySpec =
   NotifyWithOsaScript        <$ atomSpec "osascript" <!>
   NotifyWithTerminalNotifier <$ atomSpec "terminal-notifier" <!>
   NotifyWithCustom . NonEmpty.toList <$> nonemptySpec stringSpec
+
+notifyWhileSpec :: ValueSpec NotifyWhile
+notifyWhileSpec =
+  NotifyWhileUnfocused <$ atomSpec "unfocused" <!>
+  NotifyWhileFocused <$ atomSpec "focused" <!>
+  NotifyWhileAlways <$ atomSpec "always"

src/Client/EventLoop.hs

@@ -182,7 +182,7 @@ processLogEntries =
 processNotifications :: ClientState -> IO ()
 processNotifications st =
   case notifyCmd (view (clientConfig . configNotifications) st) of
-    Just cmd | not (view clientUiFocused st) -> traverse_ (spawn cmd) (view clientNotifications st)
+    Just cmd | clientMayNotify st -> traverse_ (spawn cmd) (view clientNotifications st)
     _ -> return ()
   where
     -- TODO: May be a nicer way to handle notification failure than just silently squashing the exception

src/Client/State.hs

@@ -61,6 +61,7 @@ module Client.State
   , buildMatcher
   , clientToggleHideMeta
   , channelUserList
+  , clientMayNotify
 
   , consumeInput
   , currentCompletionList
@@ -115,6 +116,7 @@ module Client.State
 import           Client.CApi
 import           Client.Commands.WordCompletion
 import           Client.Configuration
+import           Client.Configuration.Notifications (NotifyWhile(..))
 import           Client.Configuration.ServerSettings
 import           Client.Configuration.Sts
 import           Client.Image.Message
@@ -672,6 +674,13 @@ addNotify True  focus wl st
     focusText (NetworkFocus net) = LText.fromChunks ["Notice from ", net]
     focusText (ChannelFocus net chan) = LText.fromChunks ["Activity on ", net, ":", idText chan]
 
+clientMayNotify :: ClientState -> Bool
+clientMayNotify st = case view (clientConfig . configNotifyWhile) st of
+  NotifyWhileUnfocused -> not $ _clientUiFocused st
+  NotifyWhileFocused -> _clientUiFocused st
+  NotifyWhileAlways -> True
+
+
 toWindowLine :: MessageRendererParams -> WindowLineImportance -> ClientMessage -> WindowLine
 toWindowLine params importance msg = WindowLine
   { _wlSummary    = msgSummary (view msgBody msg)