hqkp7vwZ

1{-# LANGUAGE PackageImports #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Main where
4
5import           Control.Exception.Base
6import           Control.Monad
7import           Control.Monad.IO.Class
8import           Control.Monad.Trans.Class
9import           Control.Monad.Trans.Reader
10import qualified Data.ByteString.Char8 as BS
11import           Data.List
12import           Data.List.Split
13import qualified Data.Map as M
14import           Data.Maybe
15--import qualified GitHub.Auth as Auth
16import           StatusNotifier.Tray
17import           System.Directory
18import           System.Environment
19import           System.FilePath.Posix
20import           System.IO
21import           System.Log.Handler.Simple
22import           System.Log.Logger
23import           System.Process
24import           System.Taffybar
25import           System.Taffybar.Auth
26import           System.Taffybar.Context (appendHook)
27import           System.Taffybar.DBus
28import           System.Taffybar.DBus.Toggle
29--import 		 System.Taffybar.TaffyPager
30import           System.Taffybar.Hooks
31import           System.Taffybar.Information.CPU
32import           System.Taffybar.Information.EWMHDesktopInfo
33import           System.Taffybar.Information.Memory
34import           System.Taffybar.Information.X11DesktopInfo
35import           System.Taffybar.SimpleConfig
36import           System.Taffybar.Util
37import           System.Taffybar.Widget
38import           System.Taffybar.Widget.Generic.PollingGraph
39import           System.Taffybar.Widget.Generic.PollingLabel
40import           System.Taffybar.Widget.Util
41import           System.Taffybar.Widget.Workspaces
42import           System.Taffybar.Widget.Volume
43import           System.Taffybar.Widget.XDGMenu.MenuWidget
44import           Text.Printf
45import           Text.Read hiding (lift)
46
47mkRGBA (r, g, b, a) = (r/256, g/256, b/256, a/256)
48blue = mkRGBA (42, 99, 140, 256)
49yellow1 = mkRGBA (242, 163, 54, 256)
50yellow2 = mkRGBA (254, 204, 83, 256)
51yellow3 = mkRGBA (227, 134, 18, 256)
52red = mkRGBA (210, 77, 37, 256)
53
54myGraphConfig =
55  defaultGraphConfig
56  { graphPadding = 0
57  , graphBorderWidth = 0
58  , graphWidth = 75
59  , graphBackgroundColor = (0.0, 0.0, 0.0, 0.0)
60  }
61
62netCfg = myGraphConfig
63  { graphDataColors = [yellow1, yellow2]
64  , graphLabel = Just "net"
65  }
66
67memCfg = myGraphConfig
68  { graphDataColors = [(0.129, 0.588, 0.953, 1)]
69  , graphLabel = Just "mem"
70  }
71
72cpuCfg = myGraphConfig
73  { graphDataColors = [(0, 1, 0, 1), (1, 0, 1, 0.5)]
74  , graphLabel = Just "cpu"
75  }
76
77memCallback :: IO [Double]
78memCallback = do
79  mi <- parseMeminfo
80  return [memoryUsedRatio mi]
81
82cpuCallback = do
83  (_, systemLoad, totalLoad) <- cpuLoad
84  return [totalLoad, systemLoad]
85
86getFullWorkspaceNames :: X11Property [(WorkspaceIdx, String)]
87getFullWorkspaceNames = go <$> readAsListOfString Nothing "_NET_DESKTOP_FULL_NAMES"
88  where go = zip [WSIdx i | i <- [0..]]
89
90workspaceNamesLabelSetter workspace =
91  fromMaybe "" . lookup (workspaceIdx workspace) <$>
92            liftX11Def [] getFullWorkspaceNames
93
94enableLogger logger level = do
95  logger <- getLogger logger
96  saveGlobalLogger $ setLevel level logger
97
98logDebug = do
99  logger <- getLogger "System.Taffybar.Widget.Generic.AutoSizeImage"
100  saveGlobalLogger $ setLevel DEBUG logger
101  logger2 <- getLogger "StatusNotifier.Tray"
102  saveGlobalLogger $ setLevel DEBUG logger2
103  workspacesLogger <- getLogger "System.Taffybar.Widget.Workspaces"
104  saveGlobalLogger $ setLevel WARNING workspacesLogger
105
106-- github = do
107--   Right (token, _) <- passGet "github-token"
108--   githubNotificationsNew $ defaultGithubConfig $ Auth.OAuth $ BS.pack token
109
110main = do
111  homeDirectory <- getHomeDirectory
112  -- logDebug
113  -- logM "What" WARNING "Why"
114  -- enableLogger "System.Taffybar.Widget.Util" DEBUG
115  -- enableLogger "System.Taffybar.Information.XDG.DesktopEntry" DEBUG
116  -- enableLogger "System.Taffybar.WindowIcon" DEBUG
117  let resourcesDirectory = homeDirectory </> ".lib" </> "resources"
118      inResourcesDirectory file = resourcesDirectory </> file
119      highContrastDirectory =
120        "/" </> "usr" </> "share" </> "icons" </> "HighContrast" </> "256x256"
121      inHighContrastDirectory file = highContrastDirectory </> file
122      getIconFileName w@WindowData {windowTitle = title, windowClass = klass}
123        -- | "URxvt" `isInfixOf` klass = Just "urxvt.png"
124        -- | "Termite" `isInfixOf` klass = Just "urxvt.png"
125        -- | "Kodi" `isInfixOf` klass = Just "kodi.png"
126        | "@gmail.com" `isInfixOf` title &&
127            "chrome" `isInfixOf` klass && "Gmail" `isInfixOf` title =
128          Just "gmail.png"
129        | otherwise = Nothing
130      myIcons = scaledWindowIconPixbufGetter $
131                unscaledDefaultGetWindowIconPixbuf <|||>
132                (\size _ -> lift $ loadPixbufByName size "application-default-icon")
133      cpu = pollingGraphNew cpuCfg 0.5 cpuCallback
134      mem = pollingGraphNew memCfg 1 memCallback
135      layout = layoutNew defaultLayoutConfig
136     -- pager = taffyPagerNew defaultPagerConfig
137      windows = windowsNew defaultWindowsConfig
138      menu = menuWidgetNew $ Just "GNOME-"
139      notifySystemD = void $ runCommandFromPath ["systemd-notify", "--ready"]
140      myWorkspacesConfig =
141        defaultWorkspacesConfig
142        { underlineHeight = 3
143        , underlinePadding = 1
144        , minIcons = 0
145        , maxIcons = Nothing
146        , getWindowIconPixbuf = myIcons
147        , windowIconSize = 20
148        , widgetGap = 0
149        , showWorkspaceFn = showEmpty
150        , updateRateLimitMicroseconds = 100000
151	, urgentWorkspaceState = True
152        , labelSetter = workspaceNamesLabelSetter
153        }
154      workspaces = workspacesNew myWorkspacesConfig
155      myPagerConfig :: PagerConfig
156      myPagerConfig = defaultPagerConfig { activeWorkspace =
157                                     colorize "yellow" "" . wrap " [" "] " . escape
158                                   , hiddenWorkspace  = wrap " " " " . escape
159                                   }
160      baseConfig =
161        defaultSimpleTaffyConfig
162        { startWidgets =
163            workspaces : map (>>= buildContentsBox) [windows, menu ,layout]
164        , endWidgets =
165            map
166              (>>= buildContentsBox)
167              [ textBatteryNew "$percentage$%"
168              , batteryIconNew
169              , textClockNew Nothing "%a %b %_d %r" 1
170              , sniTrayNew
171          -- , github
172              , cpu
173              , mem
174              , networkGraphNew netCfg Nothing
175	      , volumeControlNew
176          -- , networkMonitorNew defaultNetFormat Nothing >>= setMinWidth 200
177          -- , fsMonitorNew 60 ["/dev/sdd2"]
178              , mpris2New
179              ]
180        , barPosition = Right
181        , barPadding = 0
182        , barHeight = 24
183        }
184      simpleTaffyConfig = baseConfig
185        -- { endWidgets = []
186        -- , startWidgets = [flip widgetSetClass "Workspaces" =<< workspaces]
187        -- }
188  startTaffybar $
189    appendHook notifySystemD $
190    appendHook (void $ getHost False) $
191    withBatteryRefresh $
192    withLogServer $
193    withToggleServer $
194    toTaffyConfig simpleTaffyConfig
195
196-- Local Variables:
197-- flycheck-ghc-args: ("-Wno-missing-signatures")
198-- End: