diff --git a/exe/Echo.hs b/exe/Echo.hs new file mode 100644 --- /dev/null +++ b/exe/Echo.hs @@ -0,0 +1,19 @@ +import Control.Exception (finally) +import Control.Monad (forever) +import XNobar.Internal.Scroller +import XNobar.Server +import Xmobar (tenthSeconds) + +main :: IO () +main = do + putStrLn "Starting the server" + startServer >>= \case Left err -> print err + Right (notifs, stopServer) -> do + putStrLn "Fetching notifications" + (forever $ do + ns <- fetch notifs + tenthSeconds 1 + print $ (show . snd) <$> ns) + -- TODO: even without this, I observe the exact same behavior + -- `finally` do putStrLn "Stopping the server" + -- stopServer diff --git a/lib/Scroller/XNobar/Internal/Scroller.hs b/lib/Scroller/XNobar/Internal/Scroller.hs --- a/lib/Scroller/XNobar/Internal/Scroller.hs +++ b/lib/Scroller/XNobar/Internal/Scroller.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module XNobar.Internal.Scroller where import Control.Arrow ((&&&)) @@ -78,13 +79,7 @@ onlyIf b a = if b then a else id showNotifs :: Config -> [Char] -> (Id, Int, [(Id, Notification)]) -> [Char] -showNotifs (Config { fontNumber = fontNumber - , lineBreak = lineBreak - , newsPrefix = newsPrefix - , marqueeLength = marqueeLength - , criticalPrefix = criticalPrefix - , nonCriticalPrefix = nonCriticalPrefix - }) +showNotifs (Config{..}) pipe (curId, curOffset, oldNotifs') = oldNotifs' & cycle diff --git a/lib/Scroller/XNobar/Scroller.hs b/lib/Scroller/XNobar/Scroller.hs --- a/lib/Scroller/XNobar/Scroller.hs +++ b/lib/Scroller/XNobar/Scroller.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module XNobar.Scroller (scroller, Config(..)) where import Control.Concurrent.Async (withAsync) @@ -18,16 +19,8 @@ import Control.Monad.IO.Class (MonadIO) scroller :: Config -> (String -> IO ()) -> NotificationsRef -> IO () -scroller config@(Config { idleText = idleText - , marqueeLength = marqueeLength - , fontNumber = fontNumber - , scrollPeriod = scrollPeriod - , noNewsPrefix = noNewsPrefix - , newsPrefix = newsPrefix - , lineBreak = lineBreak }) - callback - notifs = withIOState - (\clicked pipe -> const $ evalStateT (forever (update clicked pipe)) Nothing) +scroller config@(Config{..}) callback notifs + = withIOState (\clicked pipe -> const $ evalStateT (forever (update clicked pipe)) Nothing) where removeLinebreak = init update clicked pipe = do diff --git a/lib/Server/XNobar/Server.hs b/lib/Server/XNobar/Server.hs --- a/lib/Server/XNobar/Server.hs +++ b/lib/Server/XNobar/Server.hs @@ -75,13 +75,15 @@ -- @ -- -- The caller can interact with the notitications only via 'fetch'. -startServer :: IO (Maybe NotificationsRef) +startServer :: IO (Either RequestNameReply (NotificationsRef, IO ())) startServer = do client <- connectSession - reply <- requestName client "org.freedesktop.Notifications" [nameDoNotQueue] + let busName = "org.freedesktop.Notifications" + reply <- requestName client busName [nameDoNotQueue] notifications <- initNotifs notify <- state2IORef - export client "/org/freedesktop/Notifications" defaultInterface { + let objPath = "/org/freedesktop/Notifications" + export client objPath defaultInterface { interfaceName = "org.freedesktop.Notifications", interfaceMethods = [ autoMethod "GetServerInformation" getServerInformation, @@ -89,9 +91,12 @@ makeMethod "Notify" (signature_ notifyInSig) (signature_ notifyOutSig) (notify notifications) ] } + let revoke = do unexport client objPath + releaseName client busName + disconnect client return $ if reply == NamePrimaryOwner - then Just notifications - else Nothing + then Right (notifications, revoke) + else Left reply where initNotifs :: IO NotificationsRef initNotifs = NotificationsRef <$> newIORef mempty @@ -113,6 +118,10 @@ then get else return (makeId reqId, error "This should not be used") when (reqId == 0) $ modify' (bimap succ succ) + -- This function is run everytime by a different Haskell thread, whereas `scroller` runs + -- always on the same thread (because it's never ending, essentially). Anyway, they are + -- different threads. I wonder if a better approach than appending to an immutable list, + -- thus having to create a new one everytime, would be to use a channel liftIO $ append ns (assignedId, notif) return $ ReplyReturn [toVariant $ getMax $ toWord32 assignedId] where diff --git a/lib/XNobar/XNobar.hs b/lib/XNobar/XNobar.hs --- a/lib/XNobar/XNobar.hs +++ b/lib/XNobar/XNobar.hs @@ -21,6 +21,7 @@ import Xmobar (Exec (..)) import XNobar.Server (startServer) import XNobar.Scroller (scroller, Config(..)) +import Control.Exception (finally) -- |XNobar plugin smart ctor. You would use it like this in your @xmobar.hs@ -- (__note__: the non-library usage of @@ -56,6 +57,16 @@ instance Exec Config where alias _ = "XNobar" start config cb - = startServer >>= \case Just notifs -> do scroller config cb notifs - error "What? scroller returned. Has it been killed?!" - Nothing -> cb "Server could not start" + = startServer >>= \case Right (notifs, stopServer) -> do scroller config cb notifs + `finally` + stopServer + Left err -> cb $ unwords ["", + "", + "", + "Server could not start: ", show err, "", + "", + "", + "" + ] + where + docUrl = "https://hackage-content.haskell.org/package/dbus-1.4.1/docs/DBus-Client.html#t:RequestNameReply" diff --git a/xnobar.cabal b/xnobar.cabal --- a/xnobar.cabal +++ b/xnobar.cabal @@ -1,10 +1,10 @@ -cabal-version: 3.0 +cabal-version: 3.4 name: xnobar -version: 0.0.0.1 +version: 0.0.0.2 maintainer: Enrico Maria De Angelis homepage: https://codeberg.org/Aster89/xnobar synopsis: Text-based notification server for XMobar -description: Text-based notification server for XMobar. It also exposes just the back-end, to be used as a library. +description: Text-based notification server for XMobar. It also exposes just the back-end, to be used as a library, as shown in exe/Echo.hs. category: System license: BSD-3-Clause @@ -14,23 +14,31 @@ branch: master common common - default-language: GHC2021 - build-depends: base >= 4.19.1 && < 5 + default-language: GHC2024 + build-depends: base >= 4.18.1 && < 5 library import: common exposed-modules: XNobar - build-depends: xmobar >= 0.48.1 && <= 0.49 + build-depends: xmobar >= 0.48.1 && <= 0.51 , xnobar:Server , xnobar:Scroller hs-source-dirs: lib/XNobar +executable Echo + import: common + build-depends: xnobar:Server + , xnobar:Scroller + , xmobar + hs-source-dirs: exe + main-is: Echo.hs + library Server import: common visibility: public exposed-modules: XNobar.Server - build-depends: dbus >= 1.3.6 && < 1.4 - , extra >= 1.7.16 && < 1.8 + build-depends: dbus >= 1.3.6 && < 1.5 + , extra >= 1.7.16 && <= 1.8 , flow >= 2.0.0 && < 2.1 , transformers >= 0.6.1 && < 0.7 , xnobar:Notification @@ -40,7 +48,7 @@ library Notification import: common exposed-modules: XNobar.Internal.Notification - build-depends: containers >= 0.6.8 && < 0.7 + build-depends: containers >= 0.6.8 && < 0.9 , dbus , flow , xnobar:Positive32