dbus-hslogger (empty) → 0.1.0.0

raw patch · 7 files changed

+182/−0 lines, 7 filesdep +basedep +dbusdep +dbus-hsloggersetup-changed

Dependencies added: base, dbus, dbus-hslogger, hslogger, optparse-applicative

Files

• LICENSE +30/−0
• README.md +1/−0
• Setup.hs +2/−0
• app/Main.hs +49/−0
• dbus-hslogger.cabal +55/−0
• src/System/Log/DBus/Client.hs +8/−0
• src/System/Log/DBus/Server.hs +37/−0

@@ -0,0 +1,30 @@+Copyright 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.

@@ -0,0 +1,1 @@+# dbus-hslogger

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,49 @@+{-# 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 =+  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

@@ -0,0 +1,55 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 7f7304d4396af4a02fe6724a708865b37be2a9fd5567e40adba06ee8dbe63176++name:           dbus-hslogger+version:        0.1.0.0+synopsis:       Expose a dbus server to control hslogger+description:    Please see the README on Github at <https://github.com/IvanMalison/dbus-hslogger#readme>+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

@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}+module System.Log.DBus.Client where++import DBus.Generation+import System.Log.DBus.Server++generateClient defaultGenerationParams { genObjectPath = Just logPath }+               logIntrospectionInterface

@@ -0,0 +1,37 @@+{-# 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