REF make colors and fonts more concise

bin/xmobar.hs

@@ -36,10 +36,7 @@ import           Xmobar.Plugins.Screensaver
 import           Xmobar.Plugins.VPN
 
 import           XMonad                                         (getXMonadDir)
-import           XMonad.Hooks.DynamicLog
+import           XMonad.Hooks.DynamicLog                        (wrap)
-    ( wrap
-    , xmobarColor
-    )
 import           XMonad.Internal.Command.Power                  (hasBattery)
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
@@ -48,6 +45,7 @@ import           XMonad.Internal.Dependency
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme                          as T
 import           Xmobar
+import           Xmobar.Plugins.Common
 
 main :: IO ()
 main = do
@@ -62,10 +60,11 @@ main = do
 
 config :: BarRegions -> String -> Config
 config br confDir = defaultConfig
-  { font = barFont
+  -- TODO head makes me feel icky
-  , additionalFonts = [iconFont, iconFontLarge, iconFontXLarge, iconFontXXLarge]
+  { font = head allFontStrings
-  , textOffset = 16
+  , additionalFonts = drop 1 allFontStrings
-  , textOffsets = [16, 17, 17, 18]
+  , textOffset = head allFontOffsets
+  , textOffsets = drop 1 allFontOffsets
   , bgColor = T.bgColor
   , fgColor = T.fgColor
   , position = BottomSize C 100 24
@@ -120,7 +119,7 @@ ethernetCmd :: String -> CmdSpec
 ethernetCmd iface = CmdSpec
   { csAlias = iface
   , csRunnable = Run
-    $ Device (iface, "<fn=2>\xf0e8</fn>", T.fgColor, T.backdropFgColor)
+    $ Device (iface, fontifyText IconMedium "\xf0e8", colors)
   }
 
 batteryCmd :: CmdSpec
@@ -137,12 +136,14 @@ batteryCmd =  CmdSpec
     , "--"
     , "-a", notify
     , "-P"
-    , "-o" , "<fn=1>\xf0e7</fn>"
+    , "-o" , fontify "\xf0e7"
-    , "-O" , "<fn=1>\xf1e6</fn>"
+    , "-O" , fontify "\xf1e6"
-    , "-i" , "<fn=1>\xf1e6</fn>"
+    , "-i" , fontify "\xf1e6"
     ] 50
   }
   where
+    fontify = fontifyText IconSmall
+    -- TODO format this with standardized notification library from xmonad.internal
     notify = fmtCmd "notify-send"
       [ "-u"
       , "critical"
@@ -154,16 +155,17 @@ batteryCmd =  CmdSpec
 vpnCmd :: CmdSpec
 vpnCmd = CmdSpec
   { csAlias = vpnAlias
-  , csRunnable = Run $ VPN ("<fn=2>\xf023</fn>", T.fgColor, T.backdropFgColor)
+  , csRunnable = Run $ VPN (fontifyText IconMedium "\xf023", colors)
   }
 
 btCmd :: CmdSpec
 btCmd = CmdSpec
   { csAlias = btAlias
   , csRunnable = Run
-    -- $ Bluetooth ("<fn=2>\xf293</fn>", T.fgColor, T.backdropFgColor)
+    $ Bluetooth (fontify "\xf5b0", fontify "\xf5ae") colors
-    $ Bluetooth ("<fn=3>\xf5b0</fn>", "<fn=3>\xf5ae</fn>") (T.fgColor, T.backdropFgColor)
   }
+  where
+    fontify = fontifyText IconLarge
 
 alsaCmd :: CmdSpec
 alsaCmd = CmdSpec
@@ -172,8 +174,8 @@ alsaCmd = CmdSpec
     $ Alsa "default" "Master"
     [ "-t", "<status><volume>%"
     , "--"
-    , "-O", "<fn=1>\xf028</fn>"
+    , "-O", fontifyText IconSmall "\xf028"
-    , "-o", "<fn=1>\xf026 </fn>"
+    , "-o", fontifyText IconSmall "\xf026 "
     , "-c", T.fgColor
     , "-C", T.fgColor
     ]
@@ -182,20 +184,20 @@ alsaCmd = CmdSpec
 blCmd :: CmdSpec
 blCmd = CmdSpec
   { csAlias = blAlias
-  , csRunnable = Run $ IntelBacklight "<fn=1>\xf185</fn>"
+  , csRunnable = Run $ IntelBacklight $ fontifyText IconSmall "\xf185"
   }
 
 ckCmd :: CmdSpec
 ckCmd = CmdSpec
   { csAlias = ckAlias
-  , csRunnable = Run $ ClevoKeyboard "<fn=1>\xf40b</fn>"
+  , csRunnable = Run $ ClevoKeyboard $ fontifyText IconSmall "\xf40b"
   }
 
 ssCmd :: CmdSpec
 ssCmd = CmdSpec
   { csAlias = ssAlias
   , csRunnable = Run
-    $ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.backdropFgColor)
+    $ Screensaver (fontifyText IconSmall "\xf254", colors)
   }
 
 lockCmd :: CmdSpec
@@ -203,15 +205,20 @@ lockCmd = CmdSpec
   { csAlias = "locks"
   , csRunnable = Run
     $ Locks
-    [ "-N", "<fn=4>\xf8a5</fn>"
+    [ "-N", numIcon
-    , "-n", xmobarColor T.backdropFgColor "" "<fn=4>\xf8a5</fn>"
+    , "-n", disabledColor numIcon
-    , "-C", "<fn=3>\xf657</fn>"
+    , "-C", capIcon
-    , "-c", xmobarColor T.backdropFgColor "" "<fn=4>\xf657</fn>"
+    , "-c", disabledColor capIcon
     , "-s", ""
     , "-S", ""
     , "-d", " "
     ]
   }
+  where
+    numIcon = fontify "\xf8a5"
+    capIcon = fontify "\xf657"
+    fontify = fontifyText IconXLarge
+    disabledColor = xmobarFGColor T.backdropFgColor
 
 dateCmd :: CmdSpec
 dateCmd = CmdSpec
@@ -229,6 +236,8 @@ dateCmd = CmdSpec
 -- which case ethernet interfaces always start with "en" and wireless
 -- interfaces always start with "wl"
 
+type BarFeature = Feature CmdSpec
+
 isWireless :: String -> Bool
 isWireless ('w':'l':_) = True
 isWireless _           = False
@@ -301,8 +310,6 @@ getBattery = Feature
   , ftrWarning = Default
   }
 
-type BarFeature = Feature CmdSpec
-
 getVPN :: Maybe Client -> BarFeature
 getVPN client = Feature
   { ftrDepTree = DBusTree (Single (const vpnCmd)) client [vpnDep] [dp]
@@ -361,11 +368,64 @@ getAllCommands right = do
     , brRight = catMaybes right
     }
 
+--------------------------------------------------------------------------------
+-- | fonts
+
+data Font = Text
+  | IconSmall
+  | IconMedium
+  | IconLarge
+  | IconXLarge
+  deriving (Eq, Enum, Bounded, Show)
+
+-- font data ~ (offset, fontification string)
+fontData :: Font -> (Int, String)
+fontData Text       = (16, barFont)
+fontData IconSmall  = (16, nerdFont 13)
+fontData IconMedium = (17, nerdFont 15)
+fontData IconLarge  = (17, nerdFont 18)
+fontData IconXLarge = (18, nerdFont 20)
+
+fontString :: Font -> String
+fontString = snd . fontData
+
+fontOffset :: Font -> Int
+fontOffset = fst . fontData
+
+allFonts :: [Font]
+allFonts = enumFrom minBound
+
+allFontOffsets :: [Int]
+allFontOffsets = fontOffset <$> allFonts
+
+allFontStrings :: [String]
+allFontStrings = fontString <$> allFonts
+
+barFont :: String
+barFont = T.fmtFontXFT T.font
+  { T.family = "DejaVu Sans Mono"
+  , T.size = Just 11
+  , T.weight = Just T.Bold
+  }
+
+nerdFont :: Int -> String
+nerdFont size = T.fmtFontXFT T.font
+  { T.family = "Symbols Nerd Font"
+  , T.size = Nothing
+  , T.pixelsize = Just size
+  }
+
+fontifyText :: Font -> String -> String
+fontifyText fnt txt = concat ["<fn=", show $ fromEnum fnt, ">", txt, "</fn>"]
+
 --------------------------------------------------------------------------------
 -- | various formatting things
 
+colors :: Colors
+colors = Colors { colorsOn = T.fgColor, colorsOff = T.backdropFgColor }
+
 sep :: String
-sep = xmobarColor T.backdropFgColor "" " : "
+sep = xmobarFGColor T.backdropFgColor " : "
 
 lSep :: Char
 lSep = '}'
@@ -385,28 +445,3 @@ fmtRegions :: BarRegions -> String
 fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } =
   fmtSpecs l ++ [lSep] ++ fmtSpecs c ++ [rSep] ++ fmtSpecs r
 
-barFont :: String
-barFont = T.fmtFontXFT T.font
-  { T.family = "DejaVu Sans Mono"
-  , T.size = Just 11
-  , T.weight = Just T.Bold
-  }
-
-nerdFont :: Int -> String
-nerdFont size = T.fmtFontXFT T.font
-  { T.family = "Symbols Nerd Font"
-  , T.size = Nothing
-  , T.pixelsize = Just size
-  }
-
-iconFont :: String
-iconFont = nerdFont 13
-
-iconFontLarge :: String
-iconFontLarge = nerdFont 15
-
-iconFontXLarge :: String
-iconFontXLarge = nerdFont 18
-
-iconFontXXLarge :: String
-iconFontXXLarge = nerdFont 20

lib/Xmobar/Plugins/Bluetooth.hs

@@ -93,16 +93,14 @@ type IconFormatter = (Maybe Bool -> Bool -> String)
 
 type Icons = (String, String)
 
-type Colors = (String, String)
-
 displayIcon :: Callback -> IconFormatter -> MutableBtState -> IO ()
 displayIcon callback formatter =
   callback . uncurry formatter <=< readState
 
 -- TODO maybe I want this to fail when any of the device statuses are Nothing
 iconFormatter :: Icons -> Colors -> IconFormatter
-iconFormatter (iconConn, iconDisc) (colorOn, colorOff) powered connected =
+iconFormatter (iconConn, iconDisc) cs powered connected =
-  maybe na (chooseColor icon colorOn colorOff) powered
+  maybe na (\p -> colorText cs p icon) powered
   where
     icon = if connected then iconConn else iconDisc
 

lib/Xmobar/Plugins/Common.hs

@@ -1,14 +1,16 @@
 
 module Xmobar.Plugins.Common
-  ( chooseColor
+  ( colorText
   , startListener
   , procSignalMatch
   , na
   , fromSingletonVariant
   , withDBusClientConnection
   , Callback
+  , Colors(..)
   , displayMaybe
   , displayMaybe'
+  , xmobarFGColor
   )
   where
 
@@ -22,6 +24,12 @@ import           XMonad.Hooks.DynamicLog (xmobarColor)
 
 type Callback = String -> IO ()
 
+data Colors = Colors
+  { colorsOn  :: String
+  , colorsOff :: String
+  }
+  deriving (Eq, Show, Read)
+
 startListener :: IsVariant a => MatchRule -> (Client -> IO [Variant])
   -> ([Variant] -> SignalMatch a) -> (a -> IO String) -> Callback
   -> Client -> IO ()
@@ -35,9 +43,12 @@ startListener rule getProp fromSignal toColor cb client = do
 procSignalMatch :: Callback -> (a -> IO String) -> SignalMatch a -> IO ()
 procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
 
-chooseColor :: String -> String -> String -> Bool -> String
+colorText :: Colors -> Bool -> String -> String
-chooseColor text colorOn colorOff state =
+colorText Colors { colorsOn = c } True   = xmobarFGColor c
-  xmobarColor (if state then colorOn else colorOff) "" text
+colorText Colors { colorsOff = c } False = xmobarFGColor c
+
+xmobarFGColor :: String -> String -> String
+xmobarFGColor c = xmobarColor c ""
 
 na :: String
 na = "N/A"

lib/Xmobar/Plugins/Device.hs

@@ -21,7 +21,7 @@ import           XMonad.Internal.Dependency
 import           Xmobar
 import           Xmobar.Plugins.Common
 
-newtype Device = Device (String, String, String, String) deriving (Read, Show)
+newtype Device = Device (String, String, Colors) deriving (Read, Show)
 
 nmBus :: BusName
 nmBus = busName_ "org.freedesktop.NetworkManager"
@@ -59,8 +59,8 @@ matchStatus :: [Variant] -> SignalMatch Word32
 matchStatus = matchPropertyChanged nmDeviceInterface devSignal
 
 instance Exec Device where
-  alias (Device (iface, _, _, _)) = iface
+  alias (Device (iface, _, _)) = iface
-  start (Device (iface, text, colorOn, colorOff)) cb = do
+  start (Device (iface, text, colors)) cb = do
     withDBusClientConnection True cb $ \client -> do
       path <- getDevice client iface
       displayMaybe' cb (listener client) path
@@ -70,4 +70,4 @@ instance Exec Device where
         -- TODO warn the user here rather than silently drop the listener
         forM_ rule $ \r ->
           startListener r (getDeviceConnected path) matchStatus chooseColor' cb client
-      chooseColor' = return . chooseColor text colorOn colorOff . (> 1)
+      chooseColor' = return . (\s -> colorText colors s text) . (> 1)

lib/Xmobar/Plugins/Screensaver.hs

@@ -14,17 +14,17 @@ import           Xmobar
 import           XMonad.Internal.DBus.Screensaver
 import           Xmobar.Plugins.Common
 
-newtype Screensaver = Screensaver (String, String, String) deriving (Read, Show)
+newtype Screensaver = Screensaver (String, Colors) deriving (Read, Show)
 
 ssAlias :: String
 ssAlias = "screensaver"
 
 instance Exec Screensaver where
   alias (Screensaver _) = ssAlias
-  start (Screensaver (text, colorOn, colorOff)) cb = do
+  start (Screensaver (text, colors)) cb = do
     withDBusClientConnection False cb $ \c -> do
       matchSignal display c
       display =<< callQuery c
     where
-      display = displayMaybe cb $ return . chooseColor text colorOn colorOff
+      display = displayMaybe cb $ return . (\s -> colorText colors s text)
 

lib/Xmobar/Plugins/VPN.hs

@@ -18,7 +18,7 @@ import           XMonad.Internal.Dependency
 import           Xmobar
 import           Xmobar.Plugins.Common
 
-newtype VPN = VPN (String, String, String) deriving (Read, Show)
+newtype VPN = VPN (String, Colors) deriving (Read, Show)
 
 vpnBus :: BusName
 vpnBus = busName_ "org.freedesktop.NetworkManager"
@@ -40,7 +40,7 @@ vpnDep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType
 
 instance Exec VPN where
   alias (VPN _) = vpnAlias
-  start (VPN (text, colorOn, colorOff)) cb =
+  start (VPN (text, colors)) cb =
     withDBusClientConnection True cb $ \c -> do
       rule <- matchPropertyFull c vpnBus (Just vpnPath)
       -- TODO intelligently warn user
@@ -48,4 +48,4 @@ instance Exec VPN where
     where
       getProp = callPropertyGet vpnBus vpnPath vpnInterface $ memberName_ vpnConnType
       fromSignal = matchPropertyChanged vpnInterface vpnConnType
-      chooseColor' = return . chooseColor text colorOn colorOff . ("vpn" ==)
+      chooseColor' = return . (\s -> colorText colors s text) . ("vpn" ==)