feat: reposition popups upon dismissal

src/NotificationCenter/Notifications.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TupleSections #-}
 
 module NotificationCenter.Notifications
   ( startNotificationDaemon
@@ -46,7 +46,7 @@ import Data.List
 import qualified Data.Map as Map
 import Data.Time
 import Data.Time.LocalTime
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, fromJust, isNothing)
 
 import qualified Data.Yaml as Yaml
 import qualified Data.Aeson as Aeson
@@ -62,6 +62,7 @@ import Data.GI.Base.GError (catchGErrorJust)
 
 import GI.Gio.Interfaces.AppInfo (appInfoGetIcon, appInfoGetAll, appInfoGetName)
 import GI.Gio.Interfaces.Icon (iconToString, Icon(..))
+import GI.Gtk (windowMove, windowGetPosition)
 
 data NotifyState = NotifyState
   { notiStList :: [ Notification ]
@@ -415,7 +416,10 @@ insertNewNoti newNoti tState = do
         (notiConfig state)
         newNoti
         (notiDisplayingList state)
-        (removeNotiFromDistList tState $ notiId newNoti)
+        (\cfg -> do
+          removeNotiFromDistList tState $ notiId newNoti
+          readjustNotificationPositions cfg tState
+        )
       atomically $ modifyTVar' tState $ \state ->
         state { notiDisplayingList = dnoti : notiDisplayingList state }
       return ()
@@ -441,18 +445,57 @@ removeNotiFromDistList tState id = do
     return False
   return ()
 
+-- | Adjusts the position of all displayed notifications so they follow standardized placement rules.
+readjustNotificationPositions :: Config -> TVar NotifyState -> IO ()
+readjustNotificationPositions config tState = do
+  sortedDisplayedPopups <- sortOn _dNotiTop . filter (not . _dHasCustomPosition) . notiDisplayingList <$> readTVarIO tState
+  newDisplayedPopups <- pushNotificationsUp config sortedDisplayedPopups
+  atomically $ modifyTVar' tState $ \state ->
+    state { notiDisplayingList = newDisplayedPopups ++ filter _dHasCustomPosition (notiDisplayingList state) }
+
+pushNotificationsUp :: Config -> [DisplayingNotificationPopup] -> IO [DisplayingNotificationPopup]
+pushNotificationsUp _      [ ]   = return [ ]
+pushNotificationsUp config (f:r) = do
+  newFirst <- autoplaceNotification config Nothing f
+  pushNotificationsUp' config (newFirst:r)
+
+pushNotificationsUp' :: Config -> [DisplayingNotificationPopup] -> IO [DisplayingNotificationPopup]
+pushNotificationsUp' _      [ ]     = return [ ]
+pushNotificationsUp' _      [l]     = return [l]
+pushNotificationsUp' config (f:s:r) = do
+  newSecond <- autoplaceNotification config (Just f) s
+  newRest <- pushNotificationsUp' config (newSecond:r)
+  return (f:newRest)
+
+-- | Places a notification popup on the screen automatically given a preceding notification.
+autoplaceNotification :: Config -> Maybe DisplayingNotificationPopup -> DisplayingNotificationPopup -> IO DisplayingNotificationPopup
+autoplaceNotification config preceding newpopup = do
+  let monitorId = fromIntegral $ configNotiMonitor config
+      notificationWidth = fromIntegral $ configWidthNoti config
+      distanceRight = fromIntegral $ configDistanceRight config
+      distanceTop = fromIntegral $ configDistanceTop config
+      distanceBetween = fromIntegral $ configDistanceBetween config
+  (screenWidth, screenHeight, _) <- getScreenPos (_dMainWindow newpopup) monitorId
+  let x = screenWidth - (notificationWidth + distanceRight)
+  y <- calculateY preceding distanceBetween distanceTop
+  windowMove (_dMainWindow newpopup) x y
+  return newpopup { _dNotiTop = y }
+  where calculateY Nothing   _  d = return d
+        calculateY (Just dn) db _ = (db + _dNotiTop dn +) <$> _dNotiGetHeight dn
+
 hideAllNotis tState = do
   state <- readTVarIO tState
   mapM (removeNotiFromDistList tState . _dNotiId)
     $ notiDisplayingList state
   return ()
 
-closeNotification tState id = do
+closeNotification config tState id = do
   state <- readTVarIO tState
   let notis = filter (\n -> (notiId n) /= fromIntegral id) (notiStList state)
   sequence $ (\noti -> addSource $ do notiOnClosed noti $ CloseByCall
                                       return False) <$> notis
   removeNotiFromDistList' tState id
+  readjustNotificationPositions config tState
 
 
 notificationDaemon :: (AutoMethod f1, AutoMethod f2) =>
@@ -476,5 +519,5 @@ startNotificationDaemon :: Config -> IO () ->  IO () ->  IO (TVar NotifyState)
 startNotificationDaemon config onUpdate onUpdateForMe = do
   istate <- newTVarIO $ NotifyState [] [] 1 onUpdate onUpdateForMe config []
   forkIO (notificationDaemon config (notify config istate)
-          (closeNotification istate))
+          (closeNotification config istate))
   return istate

src/NotificationCenter/Notifications/NotificationPopup.hs

@@ -62,7 +62,7 @@ instance HasDisplayingNotificationContent DisplayingNotificationPopup where
 
 
 showNotificationWindow :: Config -> Notification
-  -> [DisplayingNotificationPopup] -> (IO ()) -> IO DisplayingNotificationPopup
+  -> [DisplayingNotificationPopup] -> (Config -> IO ()) -> IO DisplayingNotificationPopup
 showNotificationWindow config noti dispNotis onClose = do
 
   let distanceTopFromConfig = configDistanceTop config
@@ -99,7 +99,7 @@ showNotificationWindow config noti dispNotis onClose = do
   setUrgencyLevel (notiUrgency noti)
     $ (flip view) dispNoti <$> [dLabelTitel, dLabelBody, dLabelAppname]
 
-  height <- updateNoti' config onClose noti dispNoti
+  height <- updateNoti' config (onClose config) noti dispNoti
 
   -- Ellipsization of Body
   numLines <- fromIntegral <$> (layoutGetLineCount =<< labelGetLayout lblBody)
@@ -154,23 +154,23 @@ showNotificationWindow config noti dispNotis onClose = do
         defaultAction = configPopupDefaultActionButton config == mouseButton
     if | valid && dismiss -> do
            notiOnClosed noti $ User
-           onClose
+           onClose config
        | valid && defaultAction -> do 
            notiOnAction noti "default" Nothing
            notiOnClosed noti $ User
-           onClose
+           onClose config
        | not validDismiss -> do
            putStrLn $ "Warning: Unknown mouse button '" ++ (show $ configPopupDismissButton config) ++ "'."
            notiOnClosed noti $ User
-           onClose
+           onClose config
        | not validDefaultAction -> do
            putStrLn $ "Warning: Unknown mouse button '" ++ (show $ configPopupDefaultActionButton config) ++ "'."
            notiOnClosed noti $ User
-           onClose
+           onClose config
        | otherwise -> do
            putStrLn $ "Warning: Popup received unknown mouse input '" ++ (show mouseButton) ++ "'."
            notiOnClosed noti $ User
-           onClose
+           onClose config
     return False
 
   widgetShow mainWindow