2017-03-13 13:58:38 -07:00
|
|
|
import qualified Control.Concurrent.MVar as MV
|
2017-03-04 12:03:10 -08:00
|
|
|
import Control.Exception.Base
|
2017-03-28 22:16:08 -07:00
|
|
|
import Control.Monad
|
2017-03-04 03:59:38 -08:00
|
|
|
import Data.List
|
2017-03-13 13:58:38 -07:00
|
|
|
import qualified Data.Map as M
|
2017-03-28 22:16:08 -07:00
|
|
|
import Data.Maybe
|
2017-03-04 03:59:38 -08:00
|
|
|
import qualified Graphics.UI.Gtk as Gtk
|
|
|
|
import qualified Graphics.UI.Gtk.Abstract.Widget as W
|
|
|
|
import qualified Graphics.UI.Gtk.Layout.Table as T
|
|
|
|
import System.Directory
|
|
|
|
import System.Environment
|
|
|
|
import System.FilePath.Posix
|
|
|
|
import System.Information.CPU
|
|
|
|
import System.Information.Memory
|
|
|
|
import System.Taffybar
|
2017-03-05 18:30:55 -08:00
|
|
|
import System.Taffybar.LayoutSwitcher
|
2017-03-04 03:59:38 -08:00
|
|
|
import System.Taffybar.MPRIS2
|
2017-03-29 18:53:03 -07:00
|
|
|
import System.Taffybar.NetMonitor
|
2017-03-04 03:59:38 -08:00
|
|
|
import System.Taffybar.Pager
|
|
|
|
import System.Taffybar.SimpleClock
|
|
|
|
import System.Taffybar.Systray
|
|
|
|
import System.Taffybar.TaffyPager
|
|
|
|
import System.Taffybar.Widgets.PollingGraph
|
2017-03-05 18:30:55 -08:00
|
|
|
import System.Taffybar.WindowSwitcher
|
2017-03-04 03:59:38 -08:00
|
|
|
import System.Taffybar.WorkspaceHUD
|
|
|
|
import Text.Printf
|
2017-03-13 13:58:38 -07:00
|
|
|
import Text.Read hiding (get)
|
|
|
|
import ToggleMonitor
|
2017-03-28 22:16:08 -07:00
|
|
|
import XMonad.Core ( whenJust )
|
2017-03-13 13:58:38 -07:00
|
|
|
|
2016-09-16 14:11:52 -07:00
|
|
|
|
|
|
|
memCallback = do
|
|
|
|
mi <- parseMeminfo
|
|
|
|
return [memoryUsedRatio mi]
|
|
|
|
|
|
|
|
cpuCallback = do
|
2016-09-19 12:08:59 -07:00
|
|
|
(_, systemLoad, totalLoad) <- cpuLoad
|
2016-09-16 14:11:52 -07:00
|
|
|
return [totalLoad, systemLoad]
|
|
|
|
|
2017-03-04 13:13:03 -08:00
|
|
|
underlineWidget cfg buildWidget name = do
|
2017-03-04 03:59:38 -08:00
|
|
|
w <- buildWidget
|
|
|
|
t <- T.tableNew 2 1 False
|
|
|
|
u <- Gtk.eventBoxNew
|
|
|
|
|
2017-03-04 13:13:03 -08:00
|
|
|
W.widgetSetSizeRequest u (-1) $ underlineHeight cfg
|
2017-03-04 03:59:38 -08:00
|
|
|
|
|
|
|
T.tableAttach t w 0 1 0 1 [T.Expand] [T.Expand] 0 0
|
|
|
|
T.tableAttach t u 0 1 1 2 [T.Fill] [T.Shrink] 0 0
|
|
|
|
|
2017-03-05 18:30:55 -08:00
|
|
|
Gtk.widgetSetName u (printf "%s-underline" name :: String)
|
2017-03-04 03:59:38 -08:00
|
|
|
|
|
|
|
Gtk.widgetShowAll t
|
|
|
|
|
|
|
|
return $ Gtk.toWidget t
|
|
|
|
|
2017-03-28 22:15:31 -07:00
|
|
|
movableWidget builder =
|
|
|
|
do
|
|
|
|
-- Delay creation of the widget or else failure from trying to get screen
|
|
|
|
widVar <- MV.newEmptyMVar
|
|
|
|
let moveWidget = do
|
|
|
|
isEmpty <- MV.isEmptyMVar widVar
|
|
|
|
when isEmpty $
|
|
|
|
do
|
|
|
|
putwid <- builder
|
|
|
|
MV.putMVar widVar putwid
|
|
|
|
wid <- MV.readMVar widVar
|
|
|
|
hbox <- Gtk.hBoxNew False 0
|
|
|
|
parent <- Gtk.widgetGetParent wid
|
|
|
|
if isJust parent
|
|
|
|
then
|
|
|
|
Gtk.widgetReparent wid hbox
|
|
|
|
else
|
|
|
|
Gtk.containerAdd hbox wid
|
|
|
|
return $ Gtk.toWidget hbox
|
|
|
|
return moveWidget
|
|
|
|
|
2016-09-16 14:11:52 -07:00
|
|
|
main = do
|
2017-03-04 13:13:03 -08:00
|
|
|
monEither <-
|
|
|
|
(try $ getEnv "TAFFYBAR_MONITOR") :: IO (Either SomeException String)
|
2017-03-05 18:30:55 -08:00
|
|
|
homeDirectory <- getHomeDirectory
|
|
|
|
let resourcesDirectory file =
|
2017-03-13 13:58:38 -07:00
|
|
|
homeDirectory </> ".lib" </> "resources" </> file
|
2017-03-05 18:30:55 -08:00
|
|
|
fallbackIcons _ klass
|
|
|
|
| "URxvt" `isInfixOf` klass =
|
|
|
|
IIFilePath $ resourcesDirectory "urxvt.png"
|
|
|
|
| "Kodi" `isInfixOf` klass = IIFilePath $ resourcesDirectory "kodi.png"
|
|
|
|
| otherwise = IIColor (0xFF, 0xFF, 0, 0xFF)
|
|
|
|
myGetIconInfo = windowTitleClassIconGetter False fallbackIcons
|
2017-03-10 17:42:38 -08:00
|
|
|
(monFilter, monNumber) =
|
2017-03-04 12:03:10 -08:00
|
|
|
case monEither of
|
2017-03-10 17:42:38 -08:00
|
|
|
Left _ -> (allMonitors, 0)
|
2017-03-12 21:25:59 -07:00
|
|
|
Right monString ->
|
|
|
|
case readMaybe monString of
|
|
|
|
Nothing -> (allMonitors, 0)
|
2017-03-28 22:16:08 -07:00
|
|
|
Just num -> (useMonitorNumber, num)
|
2017-03-05 18:30:55 -08:00
|
|
|
memCfg =
|
2017-03-01 19:21:58 -08:00
|
|
|
defaultGraphConfig
|
2017-03-12 21:25:59 -07:00
|
|
|
{graphDataColors = [(0.129, 0.588, 0.953, 1)], graphLabel = Just "mem"}
|
2017-03-01 19:21:58 -08:00
|
|
|
cpuCfg =
|
|
|
|
defaultGraphConfig
|
|
|
|
{ graphDataColors = [(0, 1, 0, 1), (1, 0, 1, 0.5)]
|
|
|
|
, graphLabel = Just "cpu"
|
|
|
|
}
|
2017-03-05 18:30:55 -08:00
|
|
|
clock = textClockNew Nothing "%a %b %_d %r" 1
|
2016-09-19 12:08:25 -07:00
|
|
|
mpris = mpris2New
|
2016-09-16 14:11:52 -07:00
|
|
|
mem = pollingGraphNew memCfg 1 memCallback
|
|
|
|
cpu = pollingGraphNew cpuCfg 0.5 cpuCallback
|
2017-03-05 18:30:55 -08:00
|
|
|
tray = do
|
2017-03-12 21:25:59 -07:00
|
|
|
tray <- systrayNew
|
|
|
|
container <- Gtk.eventBoxNew
|
|
|
|
Gtk.containerAdd container tray
|
|
|
|
Gtk.widgetSetName container "Taffytray"
|
|
|
|
Gtk.widgetSetName tray "Taffytray"
|
|
|
|
return $ Gtk.toWidget container
|
2017-03-01 19:21:58 -08:00
|
|
|
hudConfig =
|
|
|
|
defaultWorkspaceHUDConfig
|
|
|
|
{ underlineHeight = 3
|
2017-03-05 18:30:55 -08:00
|
|
|
, underlinePadding = 5
|
2017-03-01 19:21:58 -08:00
|
|
|
, minWSWidgetSize = Nothing
|
|
|
|
, minIcons = 3
|
|
|
|
, getIconInfo = myGetIconInfo
|
2017-03-05 18:30:55 -08:00
|
|
|
, windowIconSize = 25
|
2017-03-01 19:21:58 -08:00
|
|
|
, widgetGap = 0
|
|
|
|
-- , widgetBuilder = buildBorderButtonController
|
|
|
|
, showWorkspaceFn = hideEmpty
|
|
|
|
, updateRateLimitMicroseconds = 100000
|
|
|
|
, updateIconsOnTitleChange = True
|
|
|
|
, updateOnWMIconChange = True
|
2017-03-04 14:13:49 -08:00
|
|
|
, debugMode = False
|
2017-03-04 03:45:10 -08:00
|
|
|
, redrawIconsOnStateChange = True
|
2017-03-05 18:30:55 -08:00
|
|
|
, innerPadding = 5
|
|
|
|
, outerPadding = 5
|
2017-03-01 19:21:58 -08:00
|
|
|
}
|
2017-03-29 18:53:03 -07:00
|
|
|
netMonitor = netMonitorMultiNew 1.5 ["enp0s31f6"]
|
2017-03-05 18:30:55 -08:00
|
|
|
pagerConfig = defaultPagerConfig {useImages = True}
|
2017-03-01 19:21:58 -08:00
|
|
|
pager = taffyPagerNew pagerConfig
|
2017-03-05 18:30:55 -08:00
|
|
|
makeUnderline = underlineWidget hudConfig
|
|
|
|
pgr <- pagerNew pagerConfig
|
2017-03-13 13:58:38 -07:00
|
|
|
enabledVar <- MV.newMVar M.empty
|
2017-03-28 22:16:08 -07:00
|
|
|
tray2 <- movableWidget tray
|
2017-03-12 21:25:59 -07:00
|
|
|
let hud = buildWorkspaceHUD hudConfig pgr
|
2017-03-05 18:30:55 -08:00
|
|
|
los = makeUnderline (layoutSwitcherNew pgr) "red"
|
|
|
|
wnd = makeUnderline (windowSwitcherNew pgr) "teal"
|
2017-03-12 21:25:59 -07:00
|
|
|
taffyConfig =
|
|
|
|
defaultTaffybarConfig
|
|
|
|
{ startWidgets = [hud, los, wnd]
|
|
|
|
, endWidgets =
|
2017-03-29 18:53:03 -07:00
|
|
|
[ makeUnderline tray "yellow"
|
2017-03-12 21:25:59 -07:00
|
|
|
, makeUnderline clock "teal"
|
|
|
|
, makeUnderline mem "blue"
|
|
|
|
, makeUnderline cpu "green"
|
2017-03-29 18:53:03 -07:00
|
|
|
, makeUnderline netMonitor "yellow"
|
2017-03-12 21:25:59 -07:00
|
|
|
, makeUnderline mpris "red"
|
|
|
|
]
|
|
|
|
, monitorNumber = monNumber
|
|
|
|
, barPosition = Top
|
|
|
|
, barHeight = 50
|
|
|
|
, widgetSpacing = 5
|
2017-03-28 22:16:08 -07:00
|
|
|
, startRefresher = handleToggleRequests enabledVar
|
|
|
|
, getMonitorConfig = toggleableMonitors enabledVar
|
2017-03-12 21:25:59 -07:00
|
|
|
}
|
|
|
|
|
|
|
|
defaultTaffybar taffyConfig
|
2016-09-16 14:11:52 -07:00
|
|
|
|
|
|
|
-- Local Variables:
|
|
|
|
-- flycheck-ghc-args: ("-Wno-missing-signatures")
|
|
|
|
-- End:
|