{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.DBus.Toggle
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
--
-- This module provides a dbus interface that allows users to toggle the display
-- of taffybar on each monitor while it is running.
-----------------------------------------------------------------------------

module System.Taffybar.DBus.Toggle ( handleDBusToggles ) where

import           Control.Applicative
import qualified Control.Concurrent.MVar as MV
import           Control.Exception
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Maybe
import           Control.Monad.Trans.Reader
import           DBus
import           DBus.Client
import           Data.Int
import qualified Data.Map as M
import           Data.Maybe
import qualified GI.Gdk as Gdk
import qualified GI.Gtk as Gtk
import           Graphics.UI.GIGtkStrut
import           Prelude
import           System.Directory
import           System.Environment.XDG.BaseDir
import           System.FilePath.Posix
import           System.Log.Logger
import           System.Taffybar.Context hiding (logIO)
import           Text.Printf
import           Text.Read ( readMaybe )

-- $usage
--
-- To use this module, import it in your taffybar.hs and wrap your config with
-- the 'handleDBusToggles' function:
--
-- > main = dyreTaffybar $ handleDBusToggles myConfig
--
-- To toggle taffybar on the monitor that is currently active, issue the
-- following command:
--
-- > dbus-send --print-reply=literal --dest=taffybar.toggle /taffybar/toggle taffybar.toggle.toggleCurrent

logIO :: System.Log.Logger.Priority -> String -> IO ()
logIO :: Priority -> String -> IO ()
logIO = String -> Priority -> String -> IO ()
logM String
"System.Taffybar.DBus.Toggle"

logT :: MonadIO m => System.Log.Logger.Priority -> String -> m ()
logT :: Priority -> String -> m ()
logT Priority
p = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Priority -> String -> IO ()
logIO Priority
p

getActiveMonitorNumber :: MaybeT IO Int
getActiveMonitorNumber :: MaybeT IO Int
getActiveMonitorNumber = do
  Display
display <- IO (Maybe Display) -> MaybeT IO Display
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT IO (Maybe Display)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m (Maybe Display)
Gdk.displayGetDefault
  Seat
seat <- IO Seat -> MaybeT IO Seat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Seat -> MaybeT IO Seat) -> IO Seat -> MaybeT IO Seat
forall a b. (a -> b) -> a -> b
$ Display -> IO Seat
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m Seat
Gdk.displayGetDefaultSeat Display
display
  Device
device <- IO (Maybe Device) -> MaybeT IO Device
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Device) -> MaybeT IO Device)
-> IO (Maybe Device) -> MaybeT IO Device
forall a b. (a -> b) -> a -> b
$ Seat -> IO (Maybe Device)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSeat a) =>
a -> m (Maybe Device)
Gdk.seatGetPointer Seat
seat
  IO Int -> MaybeT IO Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Int -> MaybeT IO Int) -> IO Int -> MaybeT IO Int
forall a b. (a -> b) -> a -> b
$ do
    (Screen
_, Int32
x, Int32
y) <- Device -> IO (Screen, Int32, Int32)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m (Screen, Int32, Int32)
Gdk.deviceGetPosition Device
device
    Display -> Int32 -> Int32 -> IO Monitor
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> Int32 -> Int32 -> m Monitor
Gdk.displayGetMonitorAtPoint Display
display Int32
x Int32
y IO Monitor -> (Monitor -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Monitor -> IO Int
getMonitorNumber

getMonitorNumber :: Gdk.Monitor -> IO Int
getMonitorNumber :: Monitor -> IO Int
getMonitorNumber Monitor
monitor = do
  Display
display <- Monitor -> IO Display
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMonitor a) =>
a -> m Display
Gdk.monitorGetDisplay Monitor
monitor
  Int32
monitorCount <- Display -> IO Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m Int32
Gdk.displayGetNMonitors Display
display
  [Maybe Monitor]
monitors <- (Int32 -> IO (Maybe Monitor)) -> [Int32] -> IO [Maybe Monitor]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Display -> Int32 -> IO (Maybe Monitor)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> Int32 -> m (Maybe Monitor)
Gdk.displayGetMonitor Display
display) [Int32
0..(Int32
monitorCountInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
1)]
  Maybe Rectangle
monitorGeometry <- Monitor -> IO (Maybe Rectangle)
forall (m :: * -> *) o.
(MonadIO m, IsMonitor o) =>
o -> m (Maybe Rectangle)
Gdk.getMonitorGeometry Monitor
monitor
  let equalsMonitor :: (Maybe Monitor, Int) -> IO Bool
equalsMonitor (Just Monitor
other, Int
_) =
        do
          Maybe Rectangle
otherGeometry <- Monitor -> IO (Maybe Rectangle)
forall (m :: * -> *) o.
(MonadIO m, IsMonitor o) =>
o -> m (Maybe Rectangle)
Gdk.getMonitorGeometry Monitor
other
          case (Maybe Rectangle
otherGeometry, Maybe Rectangle
monitorGeometry) of
               (Maybe Rectangle
Nothing, Maybe Rectangle
Nothing) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               (Just Rectangle
g1, Just Rectangle
g2) -> Rectangle -> Rectangle -> IO Bool
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rectangle -> Rectangle -> m Bool
Gdk.rectangleEqual Rectangle
g1 Rectangle
g2
               (Maybe Rectangle, Maybe Rectangle)
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      equalsMonitor (Maybe Monitor, Int)
_ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  (Maybe Monitor, Int) -> Int
forall a b. (a, b) -> b
snd ((Maybe Monitor, Int) -> Int)
-> ([(Maybe Monitor, Int)] -> (Maybe Monitor, Int))
-> [(Maybe Monitor, Int)]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Monitor, Int)
-> Maybe (Maybe Monitor, Int) -> (Maybe Monitor, Int)
forall a. a -> Maybe a -> a
fromMaybe (Maybe Monitor
forall a. Maybe a
Nothing, Int
0) (Maybe (Maybe Monitor, Int) -> (Maybe Monitor, Int))
-> ([(Maybe Monitor, Int)] -> Maybe (Maybe Monitor, Int))
-> [(Maybe Monitor, Int)]
-> (Maybe Monitor, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Monitor, Int)] -> Maybe (Maybe Monitor, Int)
forall a. [a] -> Maybe a
listToMaybe ([(Maybe Monitor, Int)] -> Int)
-> IO [(Maybe Monitor, Int)] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ((Maybe Monitor, Int) -> IO Bool)
-> [(Maybe Monitor, Int)] -> IO [(Maybe Monitor, Int)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Maybe Monitor, Int) -> IO Bool
equalsMonitor ([Maybe Monitor] -> [Int] -> [(Maybe Monitor, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe Monitor]
monitors [Int
0..])

taffybarTogglePath :: ObjectPath
taffybarTogglePath :: ObjectPath
taffybarTogglePath = ObjectPath
"/taffybar/toggle"

taffybarToggleInterface :: InterfaceName
taffybarToggleInterface :: InterfaceName
taffybarToggleInterface = InterfaceName
"taffybar.toggle"

taffyDir :: IO FilePath
taffyDir :: IO String
taffyDir = String -> IO String
getUserDataDir String
"taffybar"

toggleStateFile :: IO FilePath
toggleStateFile :: IO String
toggleStateFile = (String -> String -> String
</> String
"toggle_state.dat") (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
taffyDir

newtype TogglesMVar = TogglesMVar (MV.MVar (M.Map Int Bool))

getTogglesVar :: TaffyIO TogglesMVar
getTogglesVar :: TaffyIO TogglesMVar
getTogglesVar = Taffy IO TogglesMVar -> Taffy IO TogglesMVar
forall t. Typeable t => Taffy IO t -> Taffy IO t
getStateDefault (Taffy IO TogglesMVar -> Taffy IO TogglesMVar)
-> Taffy IO TogglesMVar -> Taffy IO TogglesMVar
forall a b. (a -> b) -> a -> b
$ IO TogglesMVar -> TaffyIO TogglesMVar
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MVar (Map Int Bool) -> TogglesMVar
TogglesMVar (MVar (Map Int Bool) -> TogglesMVar)
-> IO (MVar (Map Int Bool)) -> IO TogglesMVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int Bool -> IO (MVar (Map Int Bool))
forall a. a -> IO (MVar a)
MV.newMVar Map Int Bool
forall k a. Map k a
M.empty)

toggleBarConfigGetter :: BarConfigGetter -> BarConfigGetter
toggleBarConfigGetter :: BarConfigGetter -> BarConfigGetter
toggleBarConfigGetter BarConfigGetter
getConfigs = do
  [BarConfig]
barConfigs <- BarConfigGetter
getConfigs
  TogglesMVar MVar (Map Int Bool)
enabledVar <- TaffyIO TogglesMVar
getTogglesVar
  Map Int Bool
numToEnabled <- IO (Map Int Bool) -> ReaderT Context IO (Map Int Bool)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Map Int Bool) -> ReaderT Context IO (Map Int Bool))
-> IO (Map Int Bool) -> ReaderT Context IO (Map Int Bool)
forall a b. (a -> b) -> a -> b
$ MVar (Map Int Bool) -> IO (Map Int Bool)
forall a. MVar a -> IO a
MV.readMVar MVar (Map Int Bool)
enabledVar
  let isEnabled :: Int -> Bool
isEnabled Int
monNumber = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Map Int Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
monNumber Map Int Bool
numToEnabled
      isConfigEnabled :: BarConfig -> Bool
isConfigEnabled =
        Int -> Bool
isEnabled (Int -> Bool) -> (BarConfig -> Int) -> BarConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> (BarConfig -> Int32) -> BarConfig -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 (Maybe Int32 -> Int32)
-> (BarConfig -> Maybe Int32) -> BarConfig -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrutConfig -> Maybe Int32
strutMonitor (StrutConfig -> Maybe Int32)
-> (BarConfig -> StrutConfig) -> BarConfig -> Maybe Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarConfig -> StrutConfig
strutConfig
  [BarConfig] -> BarConfigGetter
forall (m :: * -> *) a. Monad m => a -> m a
return ([BarConfig] -> BarConfigGetter) -> [BarConfig] -> BarConfigGetter
forall a b. (a -> b) -> a -> b
$ (BarConfig -> Bool) -> [BarConfig] -> [BarConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter BarConfig -> Bool
isConfigEnabled [BarConfig]
barConfigs

exportTogglesInterface :: TaffyIO ()
exportTogglesInterface :: TaffyIO ()
exportTogglesInterface = do
  TogglesMVar MVar (Map Int Bool)
enabledVar <- TaffyIO TogglesMVar
getTogglesVar
  Context
ctx <- ReaderT Context IO Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  IO () -> TaffyIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> TaffyIO ()) -> IO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ IO String
taffyDir IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> String -> IO ()
createDirectoryIfMissing Bool
True
  String
stateFile <- IO String -> ReaderT Context IO String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO String
toggleStateFile
  let toggleTaffyOnMon :: (Bool -> Bool) -> Int -> IO ()
toggleTaffyOnMon Bool -> Bool
fn Int
mon = (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
$ do
        IO () -> TaffyIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> TaffyIO ()) -> IO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ MVar (Map Int Bool) -> (Map Int Bool -> IO (Map Int Bool)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MV.modifyMVar_ MVar (Map Int Bool)
enabledVar ((Map Int Bool -> IO (Map Int Bool)) -> IO ())
-> (Map Int Bool -> IO (Map Int Bool)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Map Int Bool
numToEnabled -> do
          let current :: Bool
current = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Map Int Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
mon Map Int Bool
numToEnabled
              result :: Map Int Bool
result = Int -> Bool -> Map Int Bool -> Map Int Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
mon (Bool -> Bool
fn Bool
current) Map Int Bool
numToEnabled
          Priority -> String -> IO ()
logIO Priority
DEBUG (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Toggle state before: %s, after %s"
                  (Map Int Bool -> String
forall a. Show a => a -> String
show Map Int Bool
numToEnabled) (Map Int Bool -> String
forall a. Show a => a -> String
show Map Int Bool
result)
          IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (String -> String -> IO ()
writeFile String
stateFile (Map Int Bool -> String
forall a. Show a => a -> String
show Map Int Bool
result)) ((SomeException -> IO ()) -> IO ())
-> (SomeException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
            Priority -> String -> IO ()
logIO Priority
WARNING (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Unable to write to toggle state file %s, error: %s"
                  (String -> String
forall a. Show a => a -> String
show String
stateFile) (SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException))
          Map Int Bool -> IO (Map Int Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Int Bool
result
        TaffyIO ()
refreshTaffyWindows
      toggleTaffy :: IO ()
toggleTaffy = do
        Maybe Int
num <- MaybeT IO Int -> IO (Maybe Int)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT IO Int
getActiveMonitorNumber
        (Bool -> Bool) -> Int -> IO ()
toggleTaffyOnMon Bool -> Bool
not (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
num
      takeInt :: (Int -> a) -> (Int32 -> a)
      takeInt :: (Int -> a) -> Int32 -> a
takeInt = ((Int -> a) -> (Int32 -> Int) -> Int32 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  Client
client <- (Context -> Client) -> ReaderT Context IO Client
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Context -> Client
sessionDBusClient
  let interface :: Interface
interface =
        Interface
defaultInterface
        { interfaceName :: InterfaceName
interfaceName = InterfaceName
taffybarToggleInterface
        , interfaceMethods :: [Method]
interfaceMethods =
          [ MemberName -> IO () -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"toggleCurrent" IO ()
toggleTaffy
          , MemberName -> (Int32 -> IO ()) -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"toggleOnMonitor" ((Int32 -> IO ()) -> Method) -> (Int32 -> IO ()) -> Method
forall a b. (a -> b) -> a -> b
$ (Int -> IO ()) -> Int32 -> IO ()
forall a. (Int -> a) -> Int32 -> a
takeInt ((Int -> IO ()) -> Int32 -> IO ())
-> (Int -> IO ()) -> Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> Int -> IO ()
toggleTaffyOnMon Bool -> Bool
not
          , MemberName -> (Int32 -> IO ()) -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"hideOnMonitor" ((Int32 -> IO ()) -> Method) -> (Int32 -> IO ()) -> Method
forall a b. (a -> b) -> a -> b
$
            (Int -> IO ()) -> Int32 -> IO ()
forall a. (Int -> a) -> Int32 -> a
takeInt ((Int -> IO ()) -> Int32 -> IO ())
-> (Int -> IO ()) -> Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> Int -> IO ()
toggleTaffyOnMon (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
False)
          , MemberName -> (Int32 -> IO ()) -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"showOnMonitor" ((Int32 -> IO ()) -> Method) -> (Int32 -> IO ()) -> Method
forall a b. (a -> b) -> a -> b
$
            (Int -> IO ()) -> Int32 -> IO ()
forall a. (Int -> a) -> Int32 -> a
takeInt ((Int -> IO ()) -> Int32 -> IO ())
-> (Int -> IO ()) -> Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> Int -> IO ()
toggleTaffyOnMon (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True)
          , MemberName -> IO () -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"refresh" (IO () -> Method) -> IO () -> Method
forall a b. (a -> b) -> a -> b
$ TaffyIO () -> Context -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT TaffyIO ()
refreshTaffyWindows Context
ctx
          , MemberName -> IO () -> Method
forall fn. AutoMethod fn => MemberName -> fn -> Method
autoMethod MemberName
"exit" (IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
Gtk.mainQuit :: IO ())
          ]
        }
  IO () -> TaffyIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> TaffyIO ()) -> IO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ do
    RequestNameReply
_ <- Client -> BusName -> [RequestNameFlag] -> IO RequestNameReply
requestName Client
client BusName
"taffybar.toggle"
       [RequestNameFlag
nameAllowReplacement, RequestNameFlag
nameReplaceExisting]
    Client -> ObjectPath -> Interface -> IO ()
export Client
client ObjectPath
taffybarTogglePath Interface
interface

dbusTogglesStartupHook :: TaffyIO ()
dbusTogglesStartupHook :: TaffyIO ()
dbusTogglesStartupHook = do
  TogglesMVar MVar (Map Int Bool)
enabledVar <- TaffyIO TogglesMVar
getTogglesVar
  Priority -> String -> TaffyIO ()
forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
logT Priority
DEBUG String
"Loading toggle state"
  IO () -> TaffyIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> TaffyIO ()) -> IO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ do
    String
stateFilepath <- IO String
toggleStateFile
    Bool
filepathExists <- String -> IO Bool
doesFileExist String
stateFilepath
    Maybe (Map Int Bool)
mStartingMap <-
      if Bool
filepathExists
      then
        String -> Maybe (Map Int Bool)
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe (Map Int Bool))
-> IO String -> IO (Maybe (Map Int Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
stateFilepath
      else
        Maybe (Map Int Bool) -> IO (Maybe (Map Int Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map Int Bool)
forall a. Maybe a
Nothing
    MVar (Map Int Bool) -> (Map Int Bool -> IO (Map Int Bool)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MV.modifyMVar_ MVar (Map Int Bool)
enabledVar ((Map Int Bool -> IO (Map Int Bool)) -> IO ())
-> (Map Int Bool -> IO (Map Int Bool)) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO (Map Int Bool) -> Map Int Bool -> IO (Map Int Bool)
forall a b. a -> b -> a
const (IO (Map Int Bool) -> Map Int Bool -> IO (Map Int Bool))
-> IO (Map Int Bool) -> Map Int Bool -> IO (Map Int Bool)
forall a b. (a -> b) -> a -> b
$ Map Int Bool -> IO (Map Int Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Int Bool -> IO (Map Int Bool))
-> Map Int Bool -> IO (Map Int Bool)
forall a b. (a -> b) -> a -> b
$ Map Int Bool -> Maybe (Map Int Bool) -> Map Int Bool
forall a. a -> Maybe a -> a
fromMaybe Map Int Bool
forall k a. Map k a
M.empty Maybe (Map Int Bool)
mStartingMap
  Priority -> String -> TaffyIO ()
forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
logT Priority
DEBUG String
"Exporting toggles interface"
  TaffyIO ()
exportTogglesInterface

handleDBusToggles :: TaffybarConfig -> TaffybarConfig
handleDBusToggles :: TaffybarConfig -> TaffybarConfig
handleDBusToggles TaffybarConfig
config =
  TaffybarConfig
config { getBarConfigsParam :: BarConfigGetter
getBarConfigsParam =
             BarConfigGetter -> BarConfigGetter
toggleBarConfigGetter (BarConfigGetter -> BarConfigGetter)
-> BarConfigGetter -> BarConfigGetter
forall a b. (a -> b) -> a -> b
$ TaffybarConfig -> BarConfigGetter
getBarConfigsParam TaffybarConfig
config
         , startupHook :: TaffyIO ()
startupHook = TaffybarConfig -> TaffyIO ()
startupHook TaffybarConfig
config TaffyIO () -> TaffyIO () -> TaffyIO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TaffyIO ()
dbusTogglesStartupHook
         }