{-# 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 :: forall b a. b -> Maybe a -> Either b a
maybeToEither = (Either b a -> (a -> Either b a) -> Maybe a -> Either b a)
-> (a -> Either b a) -> Either b a -> Maybe a -> Either b a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either b a -> (a -> Either b a) -> Maybe a -> Either b a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> Either b a
forall a b. b -> Either a b
Right (Either b a -> Maybe a -> Either b a)
-> (b -> Either b a) -> b -> Maybe a -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b a
forall a b. a -> Either a b
Left

setLogLevelFromPriorityString :: String -> String -> IO (Either Reply ())
setLogLevelFromPriorityString :: String -> String -> IO (Either Reply ())
setLogLevelFromPriorityString String
logPrefix String
levelString =
  let maybePriority :: Maybe Priority
maybePriority = String -> Maybe Priority
forall a. Read a => String -> Maybe a
readMaybe String
levelString
      getMaybeResult :: IO (Maybe ())
getMaybeResult = Maybe (IO ()) -> IO (Maybe ())
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Maybe (IO ()) -> IO (Maybe ())) -> Maybe (IO ()) -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ String -> Priority -> IO ()
setLogLevel String
logPrefix (Priority -> IO ()) -> Maybe Priority -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Priority
maybePriority
  in Reply -> Maybe () -> Either Reply ()
forall b a. b -> Maybe a -> Either b a
maybeToEither (ErrorName -> [Variant] -> Reply
ReplyError ErrorName
errorInvalidParameters []) (Maybe () -> Either Reply ())
-> IO (Maybe ()) -> IO (Either Reply ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe ())
getMaybeResult

setLogLevel :: String -> Priority -> IO ()
setLogLevel :: String -> Priority -> IO ()
setLogLevel String
logPrefix Priority
level =
  String -> IO Logger
getLogger String
logPrefix IO Logger -> (Logger -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Logger -> IO ()
saveGlobalLogger (Logger -> IO ()) -> (Logger -> Logger) -> Logger -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Priority -> Logger -> Logger
setLevel Priority
level

logInterface :: Interface
logInterface :: Interface
logInterface = Interface
defaultInterface
  { interfaceName :: InterfaceName
interfaceName = InterfaceName
"org.taffybar.LogServer"
  , interfaceMethods :: [Method]
interfaceMethods = [ MemberName -> (String -> String -> IO (Either Reply ())) -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"SetLogLevel" String -> String -> IO (Either Reply ())
setLogLevelFromPriorityString ]
  }

logPath :: ObjectPath
logPath :: ObjectPath
logPath = ObjectPath
"/org/taffybar/LogServer"

startLogServer :: Client -> IO ()
startLogServer :: Client -> IO ()
startLogServer Client
client =
  Client -> ObjectPath -> Interface -> IO ()
export Client
client ObjectPath
logPath Interface
logInterface

logIntrospectionInterface :: I.Interface
logIntrospectionInterface :: Interface
logIntrospectionInterface = Interface -> Interface
buildIntrospectionInterface Interface
logInterface