{-# LANGUAGE OverloadedStrings #-}
module StatusNotifier.Item.Service where

import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           DBus
import           DBus.Client
import qualified DBus.TH as DBusTH
import qualified Data.ByteString as BS
import           Data.Int
import           Data.String
import qualified StatusNotifier.Watcher.Client as W

data ItemParams = ItemParams
  { ItemParams -> String
iconName :: String
  , ItemParams -> String
iconOverlayName :: String
  , ItemParams -> String
itemDBusName :: String
  } deriving (ItemParams -> ItemParams -> Bool
(ItemParams -> ItemParams -> Bool)
-> (ItemParams -> ItemParams -> Bool) -> Eq ItemParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemParams -> ItemParams -> Bool
$c/= :: ItemParams -> ItemParams -> Bool
== :: ItemParams -> ItemParams -> Bool
$c== :: ItemParams -> ItemParams -> Bool
Eq, Int -> ItemParams -> ShowS
[ItemParams] -> ShowS
ItemParams -> String
(Int -> ItemParams -> ShowS)
-> (ItemParams -> String)
-> ([ItemParams] -> ShowS)
-> Show ItemParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemParams] -> ShowS
$cshowList :: [ItemParams] -> ShowS
show :: ItemParams -> String
$cshow :: ItemParams -> String
showsPrec :: Int -> ItemParams -> ShowS
$cshowsPrec :: Int -> ItemParams -> ShowS
Show, ReadPrec [ItemParams]
ReadPrec ItemParams
Int -> ReadS ItemParams
ReadS [ItemParams]
(Int -> ReadS ItemParams)
-> ReadS [ItemParams]
-> ReadPrec ItemParams
-> ReadPrec [ItemParams]
-> Read ItemParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ItemParams]
$creadListPrec :: ReadPrec [ItemParams]
readPrec :: ReadPrec ItemParams
$creadPrec :: ReadPrec ItemParams
readList :: ReadS [ItemParams]
$creadList :: ReadS [ItemParams]
readsPrec :: Int -> ReadS ItemParams
$creadsPrec :: Int -> ReadS ItemParams
Read)

buildItem :: ItemParams -> IO (Either MethodError ())
buildItem ItemParams
            { iconName :: ItemParams -> String
iconName = String
name
            , iconOverlayName :: ItemParams -> String
iconOverlayName = String
overlayName
            , itemDBusName :: ItemParams -> String
itemDBusName = String
dbusName
            } = do
  Client
client <- IO Client
connectSession
  let
    getTooltip :: IO (String, [(Int32, Int32, BS.ByteString)], String, String)
    getTooltip :: IO (String, [(Int32, Int32, ByteString)], String, String)
getTooltip = (String, [(Int32, Int32, ByteString)], String, String)
-> IO (String, [(Int32, Int32, ByteString)], String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"", [], String
"Title", String
"Text")
  let clientInterface :: Interface
clientInterface =
        Interface :: InterfaceName -> [Method] -> [Property] -> [Signal] -> Interface
Interface { interfaceName :: InterfaceName
interfaceName = InterfaceName
"org.kde.StatusNotifierItem"
                  , interfaceMethods :: [Method]
interfaceMethods = []
                  , interfaceProperties :: [Property]
interfaceProperties =
                    [ MemberName -> IO String -> Property
forall v. IsValue v => MemberName -> IO v -> Property
readOnlyProperty MemberName
"IconName" (IO String -> Property) -> IO String -> Property
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
                    , MemberName -> IO String -> Property
forall v. IsValue v => MemberName -> IO v -> Property
readOnlyProperty MemberName
"OverlayIconName" (IO String -> Property) -> IO String -> Property
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
overlayName
                    , MemberName
-> IO (String, [(Int32, Int32, ByteString)], String, String)
-> Property
forall v. IsValue v => MemberName -> IO v -> Property
readOnlyProperty MemberName
"ToolTip" (IO (String, [(Int32, Int32, ByteString)], String, String)
 -> Property)
-> IO (String, [(Int32, Int32, ByteString)], String, String)
-> Property
forall a b. (a -> b) -> a -> b
$ IO (String, [(Int32, Int32, ByteString)], String, String)
getTooltip
                    ]
                  , interfaceSignals :: [Signal]
interfaceSignals = []
                  }
  Client -> ObjectPath -> Interface -> IO ()
export Client
client (String -> ObjectPath
forall a. IsString a => String -> a
fromString String
"/StatusNotifierItem") Interface
clientInterface
  Client -> BusName -> [RequestNameFlag] -> IO RequestNameReply
requestName Client
client (String -> BusName
busName_ String
dbusName) []
  Client -> String -> IO (Either MethodError ())
W.registerStatusNotifierItem Client
client String
dbusName