dbus-hslogger-0.1.0.1/0000755000000000000000000000000013272537127012613 5ustar0000000000000000dbus-hslogger-0.1.0.1/Setup.hs0000644000000000000000000000005613272537127014250 0ustar0000000000000000import Distribution.Simple main = defaultMain dbus-hslogger-0.1.0.1/dbus-hslogger.cabal0000644000000000000000000000272113272537127016346 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- -- hash: d10ade94173aa22bc569628b2b342aadba89e35c4b5bcd8eeef077de9db3b2e7 name: dbus-hslogger version: 0.1.0.1 synopsis: Expose a dbus server to control hslogger description: Please see the README on Github at category: System homepage: https://github.com/IvanMalison/dbus-hslogger#readme bug-reports: https://github.com/IvanMalison/dbus-hslogger/issues author: Ivan Malison maintainer: IvanMalison@gmail.com copyright: Ivan Malison license: BSD3 license-file: LICENSE build-type: Simple cabal-version: >= 1.10 extra-source-files: README.md source-repository head type: git location: https://github.com/IvanMalison/dbus-hslogger library exposed-modules: System.Log.DBus.Client System.Log.DBus.Server other-modules: Paths_dbus_hslogger hs-source-dirs: src build-depends: base >=4.7 && <5 , dbus >=1.0.1 && <2 , hslogger default-language: Haskell2010 executable dbus-hslogger-client main-is: Main.hs other-modules: Paths_dbus_hslogger hs-source-dirs: app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 , dbus >=1.0.0 && <2.0.0 , dbus-hslogger , hslogger , optparse-applicative default-language: Haskell2010 dbus-hslogger-0.1.0.1/LICENSE0000644000000000000000000000276013272537127013625 0ustar0000000000000000Copyright Ivan Malison (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 Ivan Malison 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.dbus-hslogger-0.1.0.1/README.md0000644000000000000000000000002013272537127014062 0ustar0000000000000000# dbus-hslogger dbus-hslogger-0.1.0.1/src/0000755000000000000000000000000013272537127013402 5ustar0000000000000000dbus-hslogger-0.1.0.1/src/System/0000755000000000000000000000000013272537127014666 5ustar0000000000000000dbus-hslogger-0.1.0.1/src/System/Log/0000755000000000000000000000000013272537127015407 5ustar0000000000000000dbus-hslogger-0.1.0.1/src/System/Log/DBus/0000755000000000000000000000000013272537127016244 5ustar0000000000000000dbus-hslogger-0.1.0.1/src/System/Log/DBus/Client.hs0000644000000000000000000000035513272537127020021 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module System.Log.DBus.Client where import DBus.Generation import System.Log.DBus.Server generateClient defaultGenerationParams { genObjectPath = Just logPath } logIntrospectionInterface dbus-hslogger-0.1.0.1/src/System/Log/DBus/Server.hs0000644000000000000000000000231213272537127020044 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module System.Log.DBus.Server where import DBus import DBus.Client import qualified DBus.Introspection as I import System.Log.Logger import Text.Read maybeToEither :: b -> Maybe a -> Either b a maybeToEither = flip maybe Right . Left setLogLevelFromPriorityString :: String -> String -> IO (Either Reply ()) setLogLevelFromPriorityString logPrefix levelString = let maybePriority = readMaybe levelString getMaybeResult = sequenceA $ setLogLevel logPrefix <$> maybePriority in maybeToEither (ReplyError errorInvalidParameters []) <$> getMaybeResult setLogLevel :: String -> Priority -> IO () setLogLevel logPrefix level = getLogger logPrefix >>= saveGlobalLogger . setLevel level logInterface :: Interface logInterface = defaultInterface { interfaceName = "org.taffybar.LogServer" , interfaceMethods = [ autoMethod "SetLogLevel" setLogLevelFromPriorityString ] } logPath :: ObjectPath logPath = "/org/taffybar/LogServer" startLogServer :: Client -> IO () startLogServer client = export client logPath logInterface logIntrospectionInterface :: I.Interface logIntrospectionInterface = buildIntrospectionInterface logInterface dbus-hslogger-0.1.0.1/app/0000755000000000000000000000000013272537127013373 5ustar0000000000000000dbus-hslogger-0.1.0.1/app/Main.hs0000644000000000000000000000212313272537127014611 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad import DBus import DBus.Client import Data.Semigroup ((<>)) import Options.Applicative import System.Log.DBus.Client levelP :: Parser String levelP = strOption ( long "level" <> short 'l' <> help "The level to which to set the log" <> metavar "LEVEL" <> value "INFO" ) prefixP :: Parser String prefixP = strOption ( long "prefix" <> short 'p' <> help "The log prefix whose level will be set" <> metavar "PREFIX" <> value "System.Taffybar" ) busNameP :: Parser BusName busNameP = busName_ <$> strOption ( long "bus-name" <> short 'b' <> help "The bus name to which the message should be sent" <> value "org.taffybar.Bar" ) doSetLogLevel :: Client -> Parser (IO (Either MethodError ())) doSetLogLevel client = setLogLevel client <$> busNameP <*> prefixP <*> levelP main = do client <- connectSession res <- join $ execParser $ info (doSetLogLevel client <**> helper) ( fullDesc <> progDesc "Set the log level of a running process") print res