[taffybar] Config cleanup

This commit is contained in:
Ivan Malison 2018-05-16 11:56:22 -07:00
parent 5fec5c48aa
commit d10996d2f9
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8

View File

@ -52,25 +52,10 @@ import Text.Printf
import Text.Read hiding (lift) import Text.Read hiding (lift)
import Unsafe.Coerce import Unsafe.Coerce
buildPadBoxNoShrink orig = liftIO $ do
widget <- buildPadBox orig
widgetSetClass orig "Contents"
-- toGIWidget widget >>= widgetPreventShrink
return widget
setMinWidth width widget = liftIO $ do setMinWidth width widget = liftIO $ do
Gtk.widgetSetSizeRequest widget width (-1) Gtk.widgetSetSizeRequest widget width (-1)
return widget return widget
makeContents waction klass = do
widget <- waction
liftIO $ do
widgetSetClass widget "Contents"
widgetSetClass widget klass
b <- buildPadBox widget
Gtk.widgetShowAll b
return $ Gtk.toWidget b
mkRGBA (r, g, b, a) = (r/256, g/256, b/256, a/256) mkRGBA (r, g, b, a) = (r/256, g/256, b/256, a/256)
blue = mkRGBA (42, 99, 140, 256) blue = mkRGBA (42, 99, 140, 256)
yellow1 = mkRGBA (242, 163, 54, 256) yellow1 = mkRGBA (242, 163, 54, 256)
@ -86,23 +71,30 @@ myGraphConfig =
, graphBackgroundColor = (1.0, 1.0, 1.0, 0.0) , graphBackgroundColor = (1.0, 1.0, 1.0, 0.0)
} }
netCfg = netCfg = myGraphConfig
myGraphConfig
{ graphDataColors = [yellow1, yellow2] { graphDataColors = [yellow1, yellow2]
, graphLabel = Just "net" , graphLabel = Just "net"
} }
memCfg = memCfg = myGraphConfig
myGraphConfig
{ graphDataColors = [(0.129, 0.588, 0.953, 1)] { graphDataColors = [(0.129, 0.588, 0.953, 1)]
, graphLabel = Just "mem" , graphLabel = Just "mem"
} }
cpuCfg = myGraphConfig
{ graphDataColors = [(0, 1, 0, 1), (1, 0, 1, 0.5)]
, graphLabel = Just "cpu"
}
memCallback :: IO [Double] memCallback :: IO [Double]
memCallback = do memCallback = do
mi <- parseMeminfo mi <- parseMeminfo
return [memoryUsedRatio mi] return [memoryUsedRatio mi]
cpuCallback = do
(_, systemLoad, totalLoad) <- cpuLoad
return [totalLoad, systemLoad]
getFullWorkspaceNames :: X11Property [(WorkspaceIdx, String)] getFullWorkspaceNames :: X11Property [(WorkspaceIdx, String)]
getFullWorkspaceNames = go <$> readAsListOfString Nothing "_NET_DESKTOP_FULL_NAMES" getFullWorkspaceNames = go <$> readAsListOfString Nothing "_NET_DESKTOP_FULL_NAMES"
where go = zip [WSIdx i | i <- [0..]] where go = zip [WSIdx i | i <- [0..]]
@ -111,46 +103,6 @@ workspaceNamesLabelSetter workspace =
fromMaybe "" . lookup (workspaceIdx workspace) <$> fromMaybe "" . lookup (workspaceIdx workspace) <$>
liftX11Def [] getFullWorkspaceNames liftX11Def [] getFullWorkspaceNames
cpuCallback = do
(_, systemLoad, totalLoad) <- cpuLoad
return [totalLoad, systemLoad]
containerAddReturn c w =
Gtk.containerAdd c w >> Gtk.widgetShowAll c >> return (Gtk.toWidget c)
underlineWidget cfg buildWidget name = do
w <- buildWidget
t <- T.tableNew 2 1 False
u <- Gtk.eventBoxNew
W.widgetSetSizeRequest u (-1) $ underlineHeight cfg
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
Gtk.widgetSetName u (printf "%s-underline" name :: String)
Gtk.widgetShowAll t
return $ Gtk.toWidget t
myFormatEntry wsNames ((ws, wtitle, wclass), _) =
printf "%s: %s - %s" wsName (head $ splitOn "\NUL" wclass) wtitle
where
wsName = M.findWithDefault ("WS#" ++ show wsN) ws wsNames
WSIdx wsN = ws
getInterfaces = do
(_, output, _) <- readCreateProcessWithExitCode (shell "list_interfaces.sh") ""
return $ splitOn "\n" output
addClass klass action = do
widget <- action
lift $ widgetSetClass widget klass
return widget
(buildWidgetCons, _) = mkWidget
logDebug = do logDebug = do
handler <- streamHandler stdout DEBUG handler <- streamHandler stdout DEBUG
logger <- getLogger "System.Taffybar" logger <- getLogger "System.Taffybar"
@ -163,29 +115,13 @@ github = do
githubNotificationsNew $ defaultGithubConfig $ Auth.OAuth $ BS.pack token githubNotificationsNew $ defaultGithubConfig $ Auth.OAuth $ BS.pack token
main = do main = do
interfaceNames <- getInterfaces
homeDirectory <- getHomeDirectory homeDirectory <- getHomeDirectory
logDebug
let resourcesDirectory = homeDirectory </> ".lib" </> "resources" let resourcesDirectory = homeDirectory </> ".lib" </> "resources"
inResourcesDirectory file = resourcesDirectory </> file inResourcesDirectory file = resourcesDirectory </> file
highContrastDirectory = highContrastDirectory =
"/" </> "usr" </> "share" </> "icons" </> "HighContrast" </> "256x256" "/" </> "usr" </> "share" </> "icons" </> "HighContrast" </> "256x256"
inHighContrastDirectory file = highContrastDirectory </> file inHighContrastDirectory file = highContrastDirectory </> file
getWorkspacePixBuf size Workspace {workspaceIdx = WSIdx wsId} =
pixBufFromFile size . inHighContrastDirectory <$>
case wsId + 1 of
-- 1 -> Just $ "apps" </> "utilities-terminal.png"
-- 2 -> Just $ "emblems" </> "emblem-documents.png"
-- 3 -> Just $ "actions" </> "bookmark-add.png"
-- 4 -> Just $ "devices" </> "video-display.png"
_ -> Nothing
-- buildConstantIconController :: ControllerConstructor
-- buildConstantIconController ws = do
-- cfg <- asks hudConfig
-- lift $ do
-- img <- Gtk.imageNew
-- pb <- sequence $ getWorkspacePixBuf (windowIconSize cfg) ws
-- setImage (windowIconSize cfg) img pb
-- return $ WWC ConstantIconController {cicImage = img}
makeIcon = return . IIFilePath . inResourcesDirectory makeIcon = return . IIFilePath . inResourcesDirectory
myGetIconInfo w@WindowData {windowTitle = title, windowClass = klass} myGetIconInfo w@WindowData {windowTitle = title, windowClass = klass}
| "URxvt" `isInfixOf` klass = makeIcon "urxvt.png" | "URxvt" `isInfixOf` klass = makeIcon "urxvt.png"
@ -200,16 +136,11 @@ main = do
case res of case res of
IINone -> IIFilePath $ inResourcesDirectory "exe-icon.png" IINone -> IIFilePath $ inResourcesDirectory "exe-icon.png"
_ -> res _ -> res
cpuCfg =
myGraphConfig
{ graphDataColors = [(0, 1, 0, 1), (1, 0, 1, 0.5)]
, graphBackgroundColor = (1.0, 1.0, 1.0, 0.0)
, graphLabel = Just "cpu"
}
clock = textClockNew Nothing "%a %b %_d %r" 1 clock = textClockNew Nothing "%a %b %_d %r" 1
mpris = mpris2New
cpu = pollingGraphNew cpuCfg 0.5 cpuCallback cpu = pollingGraphNew cpuCfg 0.5 cpuCallback
mem = pollingGraphNew memCfg 1 memCallback mem = pollingGraphNew memCfg 1 memCallback
layout = layoutNew defaultLayoutConfig
windows = windowsNew defaultWindowsConfig
myWorkspacesConfig = myWorkspacesConfig =
defaultWorkspacesConfig defaultWorkspacesConfig
{ underlineHeight = 3 { underlineHeight = 3
@ -217,19 +148,20 @@ main = do
, minWSWidgetSize = Nothing , minWSWidgetSize = Nothing
, minIcons = 1 , minIcons = 1
, getIconInfo = myGetIconInfo , getIconInfo = myGetIconInfo
, windowIconSize = 25 , windowIconSize = 33
, widgetGap = 0 , widgetGap = 0
, showWorkspaceFn = hideEmpty , showWorkspaceFn = hideEmpty
, updateRateLimitMicroseconds = 100000 , updateRateLimitMicroseconds = 100000
, labelSetter = workspaceNamesLabelSetter , labelSetter = workspaceNamesLabelSetter
} }
workspaces = workspacesNew myWorkspacesConfig
baseConfig = defaultSimpleTaffyConfig baseConfig = defaultSimpleTaffyConfig
{ startWidgets = { startWidgets =
[ workspaces [ workspaces
, los >>= buildPadBox , layout >>= buildPadBox
, wnd >>= buildPadBox , windows >>= buildPadBox
] ]
, endWidgets = map (>>= buildPadBoxNoShrink) , endWidgets = map (>>= buildPadBox)
[ clock >>= setMinWidth 200 [ clock >>= setMinWidth 200
, sniTrayNew , sniTrayNew
, github , github
@ -238,22 +170,15 @@ main = do
, networkGraphNew netCfg Nothing , networkGraphNew netCfg Nothing
-- , networkMonitorNew defaultNetFormat Nothing >>= setMinWidth 200 -- , networkMonitorNew defaultNetFormat Nothing >>= setMinWidth 200
, fsMonitorNew 60 ["/dev/sdd2"] , fsMonitorNew 60 ["/dev/sdd2"]
, mpris , mpris2New
] ]
, barPosition = Top , barPosition = Top
, barPadding = 0 , barPadding = 0
, barHeight = (windowIconSize myWorkspacesConfig + 25) , barHeight = 100
, widgetSpacing = 0 , widgetSpacing = 0
} }
workspaces = workspacesNew myWorkspacesConfig
los = layoutNew defaultLayoutConfig
wnd = windowsNew defaultWindowsConfig
simpleTaffyConfig = simpleTaffyConfig =
baseConfig baseConfig
-- { startWidgets = [workspaces]
-- , centerWidgets = [makeContents (addClass "Window" wnd) "Cpu"]
-- , endWidgets = [makeContents los "Cpu"]
-- }
dyreTaffybar $ withLogServer $ withToggleServer $ toTaffyConfig simpleTaffyConfig dyreTaffybar $ withLogServer $ withToggleServer $ toTaffyConfig simpleTaffyConfig
-- Local Variables: -- Local Variables: