{-# LANGUAGE OverloadedStrings #-}
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 )
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
}