From e019e80eac1b03a5c177ef5d358b720bdbc774ac Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 5 Dec 2021 16:56:41 +0100
Subject: gkleen@sif: taffybar

---
 .../taffybar/src/System/Taffybar/Widget/Clock.hs   | 111 +++++++++++++++++++++
 1 file changed, 111 insertions(+)
 create mode 100644 accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs

(limited to 'accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs')

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
+
-- 
cgit v1.2.3