packages feed

xnobar 0.0.0.1 → 0.0.0.2

raw patch · 6 files changed

+69/−34 lines, 6 filesdep ~basedep ~containersdep ~dbusnew-component:exe:Echo

Dependency ranges changed: base, containers, dbus, extra, flow, xmobar

Files

+ exe/Echo.hs view
@@ -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
lib/Scroller/XNobar/Internal/Scroller.hs view
@@ -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
lib/Scroller/XNobar/Scroller.hs view
@@ -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
lib/Server/XNobar/Server.hs view
@@ -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
lib/XNobar/XNobar.hs view
@@ -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 "<fc=#FF0000>Server could not start</fc>"+    = startServer >>= \case Right (notifs, stopServer) -> do scroller config cb notifs+                                                             `finally`+                                                              stopServer+                            Left err -> cb $ unwords ["<action=`xdg-open ", docUrl, "`>",+                                                      "<fc=#FF0000>",+                                                      "<box type=Bottom width=3 color=red>",+                                                      "Server could not start: ", show err, "",+                                                      "</box>",+                                                      "</fc>",+                                                      "</action>"+                                                      ]+    where+      docUrl = "https://hackage-content.haskell.org/package/dbus-1.4.1/docs/DBus-Client.html#t:RequestNameReply"
xnobar.cabal view
@@ -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