{-# 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.FilePath.Posix
import           System.Log.Logger
import           System.Taffybar.Context
import           System.Taffybar.Util
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 -> FilePath -> IO ()
logIO = FilePath -> Priority -> FilePath -> IO ()
logM FilePath
"System.Taffybar.DBus.Toggle"

logT :: MonadIO m => System.Log.Logger.Priority -> String -> m ()
logT :: forall (m :: * -> *). MonadIO m => Priority -> FilePath -> m ()
logT Priority
p = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (FilePath -> IO ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Priority -> FilePath -> 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 (m :: * -> *) a. Monad m => m a -> MaybeT m a
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 (m :: * -> *) a. Monad m => m a -> MaybeT m a
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 a b. IO a -> (a -> IO b) -> IO b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      equalsMonitor (Maybe Monitor, Int)
_ = Bool -> IO Bool
forall a. a -> IO a
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"

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

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

getTogglesVar :: TaffyIO TogglesMVar
getTogglesVar :: TaffyIO TogglesMVar
getTogglesVar = TaffyIO TogglesMVar -> TaffyIO TogglesMVar
forall t. Typeable t => Taffy IO t -> Taffy IO t
getStateDefault (TaffyIO TogglesMVar -> TaffyIO TogglesMVar)
-> TaffyIO TogglesMVar -> TaffyIO TogglesMVar
forall a b. (a -> b) -> a -> b
$ IO TogglesMVar -> TaffyIO TogglesMVar
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 (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 (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 (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 a. a -> ReaderT Context IO a
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 (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 () -> TaffyIO ()) -> IO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ IO FilePath
taffyStateDir IO FilePath -> (FilePath -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True
  FilePath
stateFile <- IO FilePath -> ReaderT Context IO FilePath
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 FilePath
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 (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 () -> 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 -> FilePath -> IO ()
logIO Priority
DEBUG (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"Toggle state before: %s, after %s"
                  (Map Int Bool -> FilePath
forall a. Show a => a -> FilePath
show Map Int Bool
numToEnabled) (Map Int Bool -> FilePath
forall a. Show a => a -> FilePath
show Map Int Bool
result)
          IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (FilePath -> FilePath -> IO ()
writeFile FilePath
stateFile (Map Int Bool -> FilePath
forall a. Show a => a -> FilePath
show Map Int Bool
result)) ((SomeException -> IO ()) -> IO ())
-> (SomeException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
            Priority -> FilePath -> IO ()
logIO Priority
WARNING (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"Unable to write to toggle state file %s, error: %s"
                  (FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
stateFile) (SomeException -> FilePath
forall a. Show a => a -> FilePath
show (SomeException
e :: SomeException))
          Map Int Bool -> IO (Map Int Bool)
forall a. a -> IO a
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 :: forall a. (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 (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 () -> 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 -> FilePath -> TaffyIO ()
forall (m :: * -> *). MonadIO m => Priority -> FilePath -> m ()
logT Priority
DEBUG FilePath
"Loading toggle state"
  IO () -> TaffyIO ()
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 () -> TaffyIO ()) -> IO () -> TaffyIO ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath
stateFilepath <- IO FilePath
toggleStateFile
    Bool
filepathExists <- FilePath -> IO Bool
doesFileExist FilePath
stateFilepath
    Maybe (Map Int Bool)
mStartingMap <-
      if Bool
filepathExists
      then
        FilePath -> Maybe (Map Int Bool)
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe (Map Int Bool))
-> IO FilePath -> IO (Maybe (Map Int Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile FilePath
stateFilepath
      else
        Maybe (Map Int Bool) -> IO (Maybe (Map Int Bool))
forall a. a -> IO a
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 a. a -> IO a
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 -> FilePath -> TaffyIO ()
forall (m :: * -> *). MonadIO m => Priority -> FilePath -> m ()
logT Priority
DEBUG FilePath
"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 a b.
ReaderT Context IO a
-> ReaderT Context IO b -> ReaderT Context IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TaffyIO ()
dbusTogglesStartupHook
         }