    {-# 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
             }