-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Hooks
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
-----------------------------------------------------------------------------

module System.Taffybar.Hooks
  ( module System.Taffybar.DBus
  , module System.Taffybar.Hooks
  , ChromeTabImageData(..)
  , getChromeTabImageDataChannel
  , getChromeTabImageDataTable
  , getX11WindowToChromeTabId
  , refreshBatteriesOnPropChange
  ) where

import           BroadcastChan
import           Control.Concurrent
import           Control.Monad
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Reader
import qualified Data.MultiMap as MM
import           System.Log.Logger
import           System.Taffybar.Context
import           System.Taffybar.DBus
import           System.Taffybar.Information.Battery
import           System.Taffybar.Information.Chrome
import           System.Taffybar.Information.Network
import           System.Environment.XDG.DesktopEntry
import           System.Taffybar.LogFormatter
import           System.Taffybar.Util

newtype NetworkInfoChan = NetworkInfoChan (BroadcastChan In [(String, (Rational, Rational))])

buildInfoChan :: Double -> IO NetworkInfoChan
buildInfoChan :: Double -> IO NetworkInfoChan
buildInfoChan Double
interval = do
  BroadcastChan In [(String, (Rational, Rational))]
chan <- IO (BroadcastChan In [(String, (Rational, Rational))])
forall (m :: * -> *) a. MonadIO m => m (BroadcastChan In a)
newBroadcastChan
  ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Double -> ([(String, (Rational, Rational))] -> IO ()) -> IO ()
forall a1.
RealFrac a1 =>
a1 -> ([(String, (Rational, Rational))] -> IO ()) -> IO ()
monitorNetworkInterfaces Double
interval (IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ())
-> ([(String, (Rational, Rational))] -> IO Bool)
-> [(String, (Rational, Rational))]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BroadcastChan In [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))] -> IO Bool
forall (m :: * -> *) a.
MonadIO m =>
BroadcastChan In a -> a -> m Bool
writeBChan BroadcastChan In [(String, (Rational, Rational))]
chan)
  NetworkInfoChan -> IO NetworkInfoChan
forall (m :: * -> *) a. Monad m => a -> m a
return (NetworkInfoChan -> IO NetworkInfoChan)
-> NetworkInfoChan -> IO NetworkInfoChan
forall a b. (a -> b) -> a -> b
$ BroadcastChan In [(String, (Rational, Rational))]
-> NetworkInfoChan
NetworkInfoChan BroadcastChan In [(String, (Rational, Rational))]
chan

getNetworkChan :: TaffyIO NetworkInfoChan
getNetworkChan :: TaffyIO NetworkInfoChan
getNetworkChan = Taffy IO NetworkInfoChan -> Taffy IO NetworkInfoChan
forall t. Typeable t => Taffy IO t -> Taffy IO t
getStateDefault (Taffy IO NetworkInfoChan -> Taffy IO NetworkInfoChan)
-> Taffy IO NetworkInfoChan -> Taffy IO NetworkInfoChan
forall a b. (a -> b) -> a -> b
$ IO NetworkInfoChan -> TaffyIO NetworkInfoChan
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO NetworkInfoChan -> TaffyIO NetworkInfoChan)
-> IO NetworkInfoChan -> TaffyIO NetworkInfoChan
forall a b. (a -> b) -> a -> b
$ Double -> IO NetworkInfoChan
buildInfoChan Double
2.0

setTaffyLogFormatter :: String -> IO ()
setTaffyLogFormatter :: String -> IO ()
setTaffyLogFormatter String
loggerName = do
  GenericHandler Handle
handler <- IO (GenericHandler Handle)
taffyLogHandler
  String -> (Logger -> Logger) -> IO ()
updateGlobalLogger String
loggerName ((Logger -> Logger) -> IO ()) -> (Logger -> Logger) -> IO ()
forall a b. (a -> b) -> a -> b
$ [GenericHandler Handle] -> Logger -> Logger
forall a. LogHandler a => [a] -> Logger -> Logger
setHandlers [GenericHandler Handle
handler]

withBatteryRefresh :: TaffybarConfig -> TaffybarConfig
withBatteryRefresh :: TaffybarConfig -> TaffybarConfig
withBatteryRefresh = TaffyIO () -> TaffybarConfig -> TaffybarConfig
appendHook TaffyIO ()
refreshBatteriesOnPropChange

getDirectoryEntriesByClassName :: TaffyIO (MM.MultiMap String DesktopEntry)
getDirectoryEntriesByClassName :: TaffyIO (MultiMap String DesktopEntry)
getDirectoryEntriesByClassName =
  Taffy IO (MultiMap String DesktopEntry)
-> Taffy IO (MultiMap String DesktopEntry)
forall t. Typeable t => Taffy IO t -> Taffy IO t
getStateDefault TaffyIO (MultiMap String DesktopEntry)
Taffy IO (MultiMap String DesktopEntry)
readDirectoryEntriesDefault

updateDirectoryEntriesCache :: TaffyIO ()
updateDirectoryEntriesCache :: TaffyIO ()
updateDirectoryEntriesCache = ReaderT Context IO Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT Context IO Context -> (Context -> TaffyIO ()) -> TaffyIO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Context
ctx ->
  ReaderT Context IO ThreadId -> TaffyIO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT Context IO ThreadId -> TaffyIO ())
-> ReaderT Context IO ThreadId -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> ReaderT Context IO ThreadId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ThreadId -> ReaderT Context IO ThreadId)
-> IO ThreadId -> ReaderT Context IO ThreadId
forall a b. (a -> b) -> a -> b
$ Double -> IO (MultiMap String DesktopEntry) -> IO ThreadId
forall d a. RealFrac d => d -> IO a -> IO ThreadId
foreverWithDelay (Double
60 :: Double) (IO (MultiMap String DesktopEntry) -> IO ThreadId)
-> IO (MultiMap String DesktopEntry) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (TaffyIO (MultiMap String DesktopEntry)
 -> Context -> IO (MultiMap String DesktopEntry))
-> Context
-> TaffyIO (MultiMap String DesktopEntry)
-> IO (MultiMap String DesktopEntry)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TaffyIO (MultiMap String DesktopEntry)
-> Context -> IO (MultiMap String DesktopEntry)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Context
ctx (TaffyIO (MultiMap String DesktopEntry)
 -> IO (MultiMap String DesktopEntry))
-> TaffyIO (MultiMap String DesktopEntry)
-> IO (MultiMap String DesktopEntry)
forall a b. (a -> b) -> a -> b
$
       Taffy IO (MultiMap String DesktopEntry)
-> Taffy IO (MultiMap String DesktopEntry)
forall t. Typeable t => Taffy IO t -> Taffy IO t
putState TaffyIO (MultiMap String DesktopEntry)
Taffy IO (MultiMap String DesktopEntry)
readDirectoryEntriesDefault

readDirectoryEntriesDefault :: TaffyIO (MM.MultiMap String DesktopEntry)
readDirectoryEntriesDefault :: TaffyIO (MultiMap String DesktopEntry)
readDirectoryEntriesDefault = IO (MultiMap String DesktopEntry)
-> TaffyIO (MultiMap String DesktopEntry)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (MultiMap String DesktopEntry)
 -> TaffyIO (MultiMap String DesktopEntry))
-> IO (MultiMap String DesktopEntry)
-> TaffyIO (MultiMap String DesktopEntry)
forall a b. (a -> b) -> a -> b
$
  [DesktopEntry] -> MultiMap String DesktopEntry
forall (t :: * -> *).
Foldable t =>
t DesktopEntry -> MultiMap String DesktopEntry
indexDesktopEntriesByClassName ([DesktopEntry] -> MultiMap String DesktopEntry)
-> IO [DesktopEntry] -> IO (MultiMap String DesktopEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [DesktopEntry]
getDirectoryEntriesDefault