-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Hooks
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
--
-- This module provides various startup hooks that can be added to 'TaffyConfig'.
-----------------------------------------------------------------------------

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

-- | The type of the channel that provides network information in taffybar.
newtype NetworkInfoChan =
  NetworkInfoChan (BroadcastChan In [(String, (Rational, Rational))])

-- | Build a 'NetworkInfoChan' that refreshes at the provided interval.
buildNetworkInfoChan :: Double -> IO NetworkInfoChan
buildNetworkInfoChan :: Double -> IO NetworkInfoChan
buildNetworkInfoChan 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 a. a -> IO a
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

-- | Get the 'NetworkInfoChan' from 'Context', creating it if it does not exist.
getNetworkChan :: TaffyIO NetworkInfoChan
getNetworkChan :: TaffyIO NetworkInfoChan
getNetworkChan = TaffyIO NetworkInfoChan -> TaffyIO NetworkInfoChan
forall t. Typeable t => Taffy IO t -> Taffy IO t
getStateDefault (TaffyIO NetworkInfoChan -> TaffyIO NetworkInfoChan)
-> TaffyIO NetworkInfoChan -> TaffyIO NetworkInfoChan
forall a b. (a -> b) -> a -> b
$ IO NetworkInfoChan -> TaffyIO NetworkInfoChan
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
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
buildNetworkInfoChan Double
2.0

-- | Set the log formatter used in the taffybar process
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]

-- | Add 'refreshrefreshBatteriesOnPropChange' to the 'startupHook' of the
-- provided 'TaffybarConfig'.
withBatteryRefresh :: TaffybarConfig -> TaffybarConfig
withBatteryRefresh :: TaffybarConfig -> TaffybarConfig
withBatteryRefresh = TaffyIO () -> TaffybarConfig -> TaffybarConfig
appendHook TaffyIO ()
refreshBatteriesOnPropChange

-- | Load the 'DesktopEntry' cache from 'Context' state.
getDirectoryEntriesByClassName :: TaffyIO (MM.MultiMap String DesktopEntry)
getDirectoryEntriesByClassName :: TaffyIO (MultiMap String DesktopEntry)
getDirectoryEntriesByClassName =
  TaffyIO (MultiMap String DesktopEntry)
-> TaffyIO (MultiMap String DesktopEntry)
forall t. Typeable t => Taffy IO t -> Taffy IO t
getStateDefault TaffyIO (MultiMap String DesktopEntry)
readDirectoryEntriesDefault

-- | Update the 'DesktopEntry' cache every 60 seconds.
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 a b.
ReaderT Context IO a
-> (a -> ReaderT Context IO b) -> ReaderT Context IO b
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 (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
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 () -> IO ThreadId
forall (m :: * -> *) d.
(MonadIO m, RealFrac d) =>
d -> IO () -> m ThreadId
foreverWithDelay (Double
60 :: Double) (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (TaffyIO () -> Context -> IO ()) -> Context -> TaffyIO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TaffyIO () -> Context -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Context
ctx (TaffyIO () -> IO ()) -> TaffyIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       TaffyIO (MultiMap String DesktopEntry) -> TaffyIO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (TaffyIO (MultiMap String DesktopEntry) -> TaffyIO ())
-> TaffyIO (MultiMap String DesktopEntry) -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ TaffyIO (MultiMap String DesktopEntry)
-> TaffyIO (MultiMap String DesktopEntry)
forall t. Typeable t => Taffy IO t -> Taffy IO t
putState TaffyIO (MultiMap String DesktopEntry)
readDirectoryEntriesDefault

-- | Read 'DesktopEntry' values into a 'MM.Multimap', where they are indexed by
-- the class name specified in the 'DesktopEntry'.
readDirectoryEntriesDefault :: TaffyIO (MM.MultiMap String DesktopEntry)
readDirectoryEntriesDefault :: TaffyIO (MultiMap String DesktopEntry)
readDirectoryEntriesDefault = IO (MultiMap String DesktopEntry)
-> TaffyIO (MultiMap String DesktopEntry)
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
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