xmonad-dbus (empty) → 0.1.0.0
raw patch · 7 files changed
+260/−0 lines, 7 filesdep +basedep +dbusdep +utf8-stringsetup-changed
Dependencies added: base, dbus, utf8-string, xmonad-dbus
Files
- LICENSE +30/−0
- README.md +53/−0
- Setup.hs +2/−0
- app/Main.hs +38/−0
- src/XMonad/DBus.hs +50/−0
- test/Spec.hs +20/−0
- xmonad-dbus.cabal +67/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Dmitry Geurkov (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,53 @@+# xmonad-dbus+xmonad-dbus is DBus monitoring solution inspired by [xmonad-log](https://github.com/xintron/xmonad-log) completely written in Haskell.+It allows you to easily send your status via DBus using XMonad's DynamicLog to any application that can execute custom scripts.+It can be used to easily display XMonad status in [polybar](https://github.com/jaagr/polybar)++## Building++ stack build++## Running++```bash+ # start xmonad-dbus, you can optionally specify a path that would be used when receiveing messages, + # otherwise all xmonad-dbus related messages will be received)+ stack exec xmonad-dbus -- [path]+ # you can manually send messages from command line too+ stack exec xmonad-dbus -- send string+ # and if you want to send messages only to particular path you can use sendToPath + stack exec xmonad-dbus -- sendToPath path string+```++## Configuring XMonad+To send status information from XMonad you need to add xmonad-dbus as dependency either via stack or manually when building your xmonad.hs++```haskell+ import XMonad+ import XMonad.Hooks.DynamicLog+ import qualified XMonad.DBus as D++ -- Override the PP values as you would like (see XMonad.Hooks.DynamicLog documentation)+ myLogHook :: D.Client -> PP+ myLogHook dbus = def { ppOutput = D.send dbus }++ main :: IO ()+ main = do+ -- Connect to DBus+ dbus <- D.connect+ -- Request access (needed when sending messages)+ D.requestAccess dbus+ -- start xmonad+ xmonad $ def { logHook = dynamicLogWithPP (myLogHook dbus) }+```++## Configuring polybar+To receive status you need to add custom/script module to your polybar config+Don't forget to add compiled xmonad-dbus executable to your PATH++ [module/xmonad]+ type = custom/script+ exec = xmonad-dbus+ tail = true+ interval = 1+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,38 @@+module Main where++import XMonad.DBus+import Control.Concurrent+import Data.List (intercalate)+import System.IO (hFlush,stdout)+import System.Environment (getArgs)++import qualified DBus.Client as DC++printer m = do r <- takeMVar m+ mapM_ putStrLn r+ hFlush stdout+ printer m++work :: DC.Client -> [String] -> IO ()++work c ("send":xs) = do+ requestAccess c+ send c $ intercalate " " xs++work c ("sendToPath":x:xs) = do+ requestAccess c+ sendToPath c x $ intercalate " " xs++work c args = do+ m <- newEmptyMVar+ case args of+ (path:_) -> subscribeToPath c path+ _ -> subscribe c+ $ \s -> putMVar m (bodyToString s)+ printer m++main :: IO ()+main = do+ c <- connect+ args <- getArgs+ work c args
+ src/XMonad/DBus.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+module XMonad.DBus (connect,subscribe,subscribeToPath,bodyToString,requestAccess,send,sendToPath) where++import Data.Maybe (mapMaybe)+import qualified DBus as D+import qualified DBus.Client as DC+import qualified Codec.Binary.UTF8.String as UTF8++busName = "org.XMonad.DBus"+interface = "org.XMonad.DBus"+pathPrefix = "/org/XMonad"+pathPrefixObjectPath = D.objectPath_ pathPrefix+member = "Update"++connect :: IO DC.Client+connect = DC.connectSession++requestAccess c = DC.requestName c busName [DC.nameAllowReplacement, DC.nameReplaceExisting, DC.nameDoNotQueue]+++matchAnyPath :: DC.MatchRule+matchAnyPath = DC.matchAny {+ DC.matchInterface = Just interface,+ DC.matchPathNamespace = Just pathPrefixObjectPath,+ DC.matchMember = Just member+ }++matchPath :: String -> DC.MatchRule+matchPath name = DC.matchAny {+ DC.matchInterface = Just interface,+ DC.matchPath = (D.parseObjectPath $ pathPrefix++"/"++name),+ DC.matchMember = Just member+ }++subscribe c handler = DC.addMatch c matchAnyPath handler+subscribeToPath c path handler = DC.addMatch c (matchPath path) handler++bodyToString :: D.Signal -> [String]+bodyToString s = mapMaybe D.fromVariant (D.signalBody s)+++send :: DC.Client -> String -> IO ()+send c s = DC.emit c $ (D.signal pathPrefixObjectPath interface member) {+ D.signalBody = [D.toVariant $ UTF8.decodeString s]+ }++sendToPath :: DC.Client -> String -> String -> IO ()+sendToPath c p s = DC.emit c $ (D.signal (D.objectPath_ $ pathPrefix++"/"++p) interface member) {+ D.signalBody = [D.toVariant $ UTF8.decodeString s]+ }
+ test/Spec.hs view
@@ -0,0 +1,20 @@+import XMonad.DBus+import Control.Concurrent+import Control.Applicative ((<|>))+import System.Exit++main :: IO ()+main = do+ m <- newEmptyMVar+ c1 <- connect+ c2 <- connect+ subscribe c2 (\s -> putMVar m (head $ bodyToString s))+ requestAccess c1+ send c1 "Test String!"+ threadDelay 1000000+ r <- tryTakeMVar m <|> return (Just "")+ case r of+ Just "Test String!" -> putStrLn "Test passed"+ _ -> do+ putStrLn "Test didn't passed"+ exitWith $ ExitFailure 1
+ xmonad-dbus.cabal view
@@ -0,0 +1,67 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 0d057425d35362bdaa148e7ccfd6f96c239dcc5fadb0d03b6cbfb7b36d434e15++name: xmonad-dbus+version: 0.1.0.0+description: Please see the README on Github at <https://github.com/githubuser/xmonad-dbus#readme>+homepage: https://github.com/troydm/xmonad-dbus#readme+bug-reports: https://github.com/troydm/xmonad-dbus/issues+author: Dmitry Geurkov+maintainer: d.geurkov@gmail.com+copyright: 2018 Dmitry Geurkov+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/troydm/xmonad-dbus++library+ exposed-modules:+ XMonad.DBus+ other-modules:+ Paths_xmonad_dbus+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , dbus >=0.10+ , utf8-string >=1.0+ default-language: Haskell2010++executable xmonad-dbus+ main-is: Main.hs+ other-modules:+ Paths_xmonad_dbus+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , dbus >=0.10+ , utf8-string >=1.0+ , xmonad-dbus+ default-language: Haskell2010++test-suite xmonad-dbus-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_xmonad_dbus+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , dbus >=0.10+ , utf8-string >=1.0+ , xmonad-dbus+ default-language: Haskell2010