gkleen@sif: taffybar

3 files changed, 295 insertions, 0 deletions

diff --git a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs
new file mode 100644
index 00000000..e8dc480f
--- /dev/null
+++ b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE OverloadedStrings #-}
+module System.Taffybar.Widget.Clock
+  ( textClockNew
+  , textClockNewWith
+  , defaultClockConfig
+  , ClockConfig(..)
+  , ClockUpdateStrategy(..)
+  ) where
+
+import           Control.Monad.IO.Class
+import           Data.Maybe
+import qualified Data.Text as T
+import qualified Data.Time.Clock as Clock
+import           Data.Time.Format
+import           Data.Time.LocalTime
+import qualified Data.Time.Locale.Compat as L
+import           GI.Gtk
+import           System.Taffybar.Widget.Generic.PollingLabel
+
+type ClockFormat = L.TimeLocale -> ZonedTime -> T.Text
+
+-- | Create the widget. I recommend passing @Nothing@ for the TimeLocale
+-- parameter. The format string can include Pango markup
+-- (<http://developer.gnome.org/pango/stable/PangoMarkupFormat.html>).
+textClockNew ::
+  MonadIO m => Maybe L.TimeLocale -> ClockFormat -> Double -> m GI.Gtk.Widget
+textClockNew userLocale format interval =
+  textClockNewWith cfg
+  where
+    cfg = defaultClockConfig { clockTimeLocale = userLocale
+                             , clockFormat = format
+                             , clockUpdateStrategy = ConstantInterval interval
+                             }
+
+data ClockUpdateStrategy
+  = ConstantInterval Double
+  | RoundedTargetInterval Int Double
+  deriving (Eq, Ord, Show)
+
+data ClockConfig = ClockConfig
+  { clockTimeZone :: Maybe TimeZone
+  , clockTimeLocale :: Maybe L.TimeLocale
+  , clockFormat :: ClockFormat
+  , clockUpdateStrategy :: ClockUpdateStrategy
+  }
+
+-- | A clock configuration that defaults to the current locale
+defaultClockConfig :: ClockConfig
+defaultClockConfig = ClockConfig
+  { clockTimeZone = Nothing
+  , clockTimeLocale = Nothing
+  , clockFormat = \locale zonedTime -> T.pack $ formatTime locale "%a %b %_d %r" zonedTime
+  , clockUpdateStrategy = RoundedTargetInterval 5 0.0
+  }
+
+systemGetTZ :: IO TimeZone
+systemGetTZ = getCurrentTimeZone
+
+-- | A configurable text-based clock widget.  It currently allows for
+-- a configurable time zone through the 'ClockConfig'.
+--
+-- See also 'textClockNew'.
+textClockNewWith :: MonadIO m => ClockConfig -> m Widget
+textClockNewWith ClockConfig
+                   { clockTimeZone = userZone
+                   , clockTimeLocale = userLocale
+                   , clockFormat = format
+                   , clockUpdateStrategy = updateStrategy
+                   } = liftIO $ do
+  let getTZ = maybe systemGetTZ return userZone
+      locale = fromMaybe L.defaultTimeLocale userLocale
+
+  let getUserZonedTime =
+        utcToZonedTime <$> getTZ <*> Clock.getCurrentTime
+
+      doTimeFormat = format locale
+
+      getRoundedTimeAndNextTarget = do
+        zonedTime <- getUserZonedTime
+        return $ case updateStrategy of
+          ConstantInterval interval ->
+            (doTimeFormat zonedTime, Nothing, interval)
+          RoundedTargetInterval roundSeconds offset ->
+            let roundSecondsDiffTime = fromIntegral roundSeconds
+                addTheRound = addLocalTime roundSecondsDiffTime
+                localTime = zonedTimeToLocalTime zonedTime
+                ourLocalTimeOfDay = localTimeOfDay localTime
+                seconds = round $ todSec ourLocalTimeOfDay
+                secondsFactor = seconds `div` roundSeconds
+                displaySeconds = secondsFactor * roundSeconds
+                baseLocalTimeOfDay =
+                  ourLocalTimeOfDay { todSec = fromIntegral displaySeconds }
+                ourLocalTime =
+                  localTime { localTimeOfDay = baseLocalTimeOfDay }
+                roundedLocalTime =
+                  if seconds `mod` roundSeconds > roundSeconds `div` 2
+                  then addTheRound ourLocalTime
+                  else ourLocalTime
+                roundedZonedTime =
+                  zonedTime { zonedTimeToLocalTime = roundedLocalTime }
+                nextTarget = addTheRound ourLocalTime
+                amountToWait = realToFrac $ diffLocalTime nextTarget localTime
+            in (doTimeFormat roundedZonedTime, Nothing, amountToWait - offset)
+
+  label <- pollingLabelWithVariableDelay getRoundedTimeAndNextTarget
+  ebox <- eventBoxNew
+  containerAdd ebox label
+  eventBoxSetVisibleWindow ebox False
+  widgetShowAll ebox
+  toWidget ebox
+
diff --git a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs
new file mode 100644
index 00000000..9dc52774
--- /dev/null
+++ b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module System.Taffybar.Widget.TooltipBattery ( batteryIconTooltipNew ) where
+
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Reader
+import           Data.Int (Int64)
+import qualified Data.Text as T
+import           GI.Gtk
+import           Prelude
+import           StatusNotifier.Tray (scalePixbufToSize)
+import           System.Taffybar.Context
+import           System.Taffybar.Information.Battery
+import           System.Taffybar.Util
+import           System.Taffybar.Widget.Generic.AutoSizeImage
+import           System.Taffybar.Widget.Generic.ChannelWidget
+import           Text.Printf
+import           Text.StringTemplate
+import           Data.Function ((&))
+
+-- | Just the battery info that will be used for display (this makes combining
+-- several easier).
+data BatteryWidgetInfo = BWI
+  { seconds :: Maybe Int64
+  , percent :: Double
+  , status :: String
+  , rate :: Maybe Double
+  } deriving (Eq, Show)
+
+-- | Format a duration expressed as seconds to hours and minutes
+formatDuration :: Int64 -> String
+formatDuration secs = let minutes, hours, minutes' :: Int64
+                          minutes = secs `div` 60
+                          (hours, minutes') = minutes `divMod` 60
+                       in printf "%02d:%02d" hours minutes'
+
+getBatteryWidgetInfo :: BatteryInfo -> BatteryWidgetInfo
+getBatteryWidgetInfo info =
+  let battPctNum :: Double
+      battPctNum = batteryPercentage info
+      battTime :: Maybe Int64
+      battTime =
+        case batteryState info of
+          BatteryStateCharging -> Just $ batteryTimeToFull info
+          BatteryStateDischarging -> Just $ batteryTimeToEmpty info
+          _ -> Nothing
+      battStatus :: String
+      battStatus =
+        case batteryState info of
+          BatteryStateCharging -> "↑"
+          BatteryStateDischarging -> "↓"
+          BatteryStateEmpty -> "⤓"
+          BatteryStateFullyCharged -> "⤒"
+          _ -> "?"
+      battRate :: Maybe Double
+      battRate | rawRate < 0.1 = Nothing
+               | otherwise = Just rawRate
+        where rawRate = batteryEnergyRate info
+  in BWI{ seconds = battTime, percent = battPctNum, status = battStatus, rate = battRate }
+
+-- | Given (maybe summarized) battery info and format: provides the string to display
+formatBattInfo :: BatteryWidgetInfo -> String -> T.Text
+formatBattInfo info fmt =
+  let tpl = newSTMP fmt
+      tpl' = tpl
+        & setManyAttrib [ ("percentage", printf "%.0f" $ percent info)
+                        , ("status", status info)
+                        ]
+        & setManyAttrib [ ("time", formatDuration <$> seconds info)
+                        , ("rate", printf "%.0f" <$> rate info)
+                        ]
+  in render tpl'
+
+themeLoadFlags :: [IconLookupFlags]
+themeLoadFlags = [IconLookupFlagsGenericFallback, IconLookupFlagsUseBuiltin]
+
+batteryIconTooltipNew :: String -> TaffyIO Widget
+batteryIconTooltipNew format = do
+  DisplayBatteryChanVar (chan, _) <- setupDisplayBatteryChanVar ["IconName", "State", "Percentage", "TimeToFull", "TimeToEmpty", "EnergyRate"]
+  ctx <- ask
+  liftIO $ do
+    image <- imageNew
+    styleCtx <- widgetGetStyleContext =<< toWidget image
+    defaultTheme <- iconThemeGetDefault
+    let getCurrentBatteryIconNameStringTooltip = do
+          info <- runReaderT getDisplayBatteryInfo ctx
+          let iconNameString = T.pack $ batteryIconName info
+              tooltip = formatBattInfo (getBatteryWidgetInfo info) format
+          return (iconNameString, tooltip)
+        extractPixbuf info =
+          fst <$> iconInfoLoadSymbolicForContext info styleCtx
+        setIconForSize size = do
+          (name, tooltip) <- getCurrentBatteryIconNameStringTooltip
+          widgetSetTooltipMarkup image $ Just tooltip
+          iconThemeLookupIcon defaultTheme name size themeLoadFlags >>=
+            traverse extractPixbuf >>=
+              traverse (scalePixbufToSize size OrientationHorizontal)
+    updateImage <- autoSizeImage image setIconForSize OrientationHorizontal
+    toWidget =<< channelWidgetNew image chan (const $ postGUIASync updateImage)
diff --git a/accounts/gkleen@sif/taffybar/src/taffybar.hs b/accounts/gkleen@sif/taffybar/src/taffybar.hs
new file mode 100644
index 00000000..dd713ea7
--- /dev/null
+++ b/accounts/gkleen@sif/taffybar/src/taffybar.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import System.Taffybar (startTaffybar)
+import System.Taffybar.Context (TaffybarConfig(..))
+import System.Taffybar.Hooks
+import System.Taffybar.SimpleConfig hiding (SimpleTaffyConfig(cssPath))
+import System.Taffybar.Widget
+import qualified System.Taffybar.Widget.Clock as MyClock
+import System.Taffybar.Widget.TooltipBattery
+
+import Data.Time.Format
+import Data.Time.LocalTime
+import Data.Time.Calendar.WeekDate
+
+import qualified Data.Text as T
+
+import Control.Exception (SomeException, try)
+import Control.Monad.Trans.Reader (mapReaderT)
+
+import Paths_gkleen_sif_taffybar
+
+
+main :: IO ()
+main = do
+  myCssPath <- getDataFileName "taffybar.css"
+  startTaffybar exampleTaffybarConfig{ cssPath = Just myCssPath }
+
+
+exampleTaffybarConfig :: TaffybarConfig
+exampleTaffybarConfig =
+  let myWorkspacesConfig =
+        defaultWorkspacesConfig
+        { maxIcons = Just 0
+        , widgetGap = 7
+        , showWorkspaceFn = \case
+            -- Workspace{ workspaceState = Empty } -> False
+            Workspace{ workspaceName } | workspaceName == "NSP" -> False
+            _other -> True
+        , getWindowIconPixbuf = \i d -> either (\(_ :: SomeException) -> Nothing) id <$> mapReaderT try (defaultGetWindowIconPixbuf i d)
+        }
+      workspaces = workspacesNew myWorkspacesConfig
+      clock = MyClock.textClockNewWith MyClock.defaultClockConfig
+        { MyClock.clockUpdateStrategy = MyClock.RoundedTargetInterval 1 0.0
+        , MyClock.clockFormat = \tl zt@ZonedTime{ zonedTimeToLocalTime = LocalTime{ localDay } }
+                                -> let date = formatTime tl "%Y-%m-%d" localDay
+                                       weekdate = "W" <> show2 woy <> "-" <> show dow
+                                         where (_, woy, dow) = toWeekDate localDay
+                                               show2 :: Int -> String
+                                               show2 x = replicate (2 - length s) '0' ++ s
+                                                 where s = show x
+                                       time = formatTime tl "%H:%M:%S%Ez" zt
+                                    in T.intercalate " " $ map T.pack [date, weekdate, time]
+        }
+      layout = layoutNew defaultLayoutConfig
+      windowsW = windowsNew defaultWindowsConfig
+        { getMenuLabel = truncatedGetMenuLabel 80
+        , getActiveLabel = truncatedGetActiveLabel 80
+        }
+      worktime = commandRunnerNew 150 "worktime" [] "worktime"
+      worktimeToday = commandRunnerNew 150 "worktime" ["today"] "worktime today"
+      -- See https://github.com/taffybar/gtk-sni-tray#statusnotifierwatcher
+      -- for a better way to set up the sni tray
+      -- tray = sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt
+      tray = sniTrayNew
+      myConfig = defaultSimpleTaffyConfig
+        { startWidgets =
+            workspaces : map (>>= buildContentsBox) [ layout, windowsW ]
+        , endWidgets = map (>>= buildContentsBox) $ reverse
+          -- , mpris2New
+          [ worktime, worktimeToday
+          , clock
+          , tray
+          , batteryIconTooltipNew "$status$ $percentage$%$if(time)$$if(rate)$ ($rate$W $time$)$else$ ($time$)$endif$$elseif(rate)$ ($rate$W)$endif$"
+          ]
+        , barPosition = Top
+        , barPadding = 2
+        , barHeight = 28
+        , widgetSpacing = 10
+        }
+  in withBatteryRefresh $ withLogServer $
+     withToggleServer $ toTaffyConfig myConfig