diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2025-01-17 22:20:56 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2025-01-17 22:20:56 +0100 |
commit | 37e55957fbf411b928184465acb2b1ecd5ca6852 (patch) | |
tree | d986d3d3bb3f1ae999693aca2aa18363fd7607c8 /accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs | |
parent | 26e4293cd31c849fff712d57d15afa1baee2819c (diff) | |
download | nixos-37e55957fbf411b928184465acb2b1ecd5ca6852.tar nixos-37e55957fbf411b928184465acb2b1ecd5ca6852.tar.gz nixos-37e55957fbf411b928184465acb2b1ecd5ca6852.tar.bz2 nixos-37e55957fbf411b928184465acb2b1ecd5ca6852.tar.xz nixos-37e55957fbf411b928184465acb2b1ecd5ca6852.zip |
mako
Diffstat (limited to 'accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs')
-rw-r--r-- | accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs | 111 |
1 files changed, 0 insertions, 111 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 deleted file mode 100644 index e8dc480f..00000000 --- a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs +++ /dev/null | |||
@@ -1,111 +0,0 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | module System.Taffybar.Widget.Clock | ||
3 | ( textClockNew | ||
4 | , textClockNewWith | ||
5 | , defaultClockConfig | ||
6 | , ClockConfig(..) | ||
7 | , ClockUpdateStrategy(..) | ||
8 | ) where | ||
9 | |||
10 | import Control.Monad.IO.Class | ||
11 | import Data.Maybe | ||
12 | import qualified Data.Text as T | ||
13 | import qualified Data.Time.Clock as Clock | ||
14 | import Data.Time.Format | ||
15 | import Data.Time.LocalTime | ||
16 | import qualified Data.Time.Locale.Compat as L | ||
17 | import GI.Gtk | ||
18 | import System.Taffybar.Widget.Generic.PollingLabel | ||
19 | |||
20 | type ClockFormat = L.TimeLocale -> ZonedTime -> T.Text | ||
21 | |||
22 | -- | Create the widget. I recommend passing @Nothing@ for the TimeLocale | ||
23 | -- parameter. The format string can include Pango markup | ||
24 | -- (<http://developer.gnome.org/pango/stable/PangoMarkupFormat.html>). | ||
25 | textClockNew :: | ||
26 | MonadIO m => Maybe L.TimeLocale -> ClockFormat -> Double -> m GI.Gtk.Widget | ||
27 | textClockNew userLocale format interval = | ||
28 | textClockNewWith cfg | ||
29 | where | ||
30 | cfg = defaultClockConfig { clockTimeLocale = userLocale | ||
31 | , clockFormat = format | ||
32 | , clockUpdateStrategy = ConstantInterval interval | ||
33 | } | ||
34 | |||
35 | data ClockUpdateStrategy | ||
36 | = ConstantInterval Double | ||
37 | | RoundedTargetInterval Int Double | ||
38 | deriving (Eq, Ord, Show) | ||
39 | |||
40 | data ClockConfig = ClockConfig | ||
41 | { clockTimeZone :: Maybe TimeZone | ||
42 | , clockTimeLocale :: Maybe L.TimeLocale | ||
43 | , clockFormat :: ClockFormat | ||
44 | , clockUpdateStrategy :: ClockUpdateStrategy | ||
45 | } | ||
46 | |||
47 | -- | A clock configuration that defaults to the current locale | ||
48 | defaultClockConfig :: ClockConfig | ||
49 | defaultClockConfig = ClockConfig | ||
50 | { clockTimeZone = Nothing | ||
51 | , clockTimeLocale = Nothing | ||
52 | , clockFormat = \locale zonedTime -> T.pack $ formatTime locale "%a %b %_d %r" zonedTime | ||
53 | , clockUpdateStrategy = RoundedTargetInterval 5 0.0 | ||
54 | } | ||
55 | |||
56 | systemGetTZ :: IO TimeZone | ||
57 | systemGetTZ = getCurrentTimeZone | ||
58 | |||
59 | -- | A configurable text-based clock widget. It currently allows for | ||
60 | -- a configurable time zone through the 'ClockConfig'. | ||
61 | -- | ||
62 | -- See also 'textClockNew'. | ||
63 | textClockNewWith :: MonadIO m => ClockConfig -> m Widget | ||
64 | textClockNewWith ClockConfig | ||
65 | { clockTimeZone = userZone | ||
66 | , clockTimeLocale = userLocale | ||
67 | , clockFormat = format | ||
68 | , clockUpdateStrategy = updateStrategy | ||
69 | } = liftIO $ do | ||
70 | let getTZ = maybe systemGetTZ return userZone | ||
71 | locale = fromMaybe L.defaultTimeLocale userLocale | ||
72 | |||
73 | let getUserZonedTime = | ||
74 | utcToZonedTime <$> getTZ <*> Clock.getCurrentTime | ||
75 | |||
76 | doTimeFormat = format locale | ||
77 | |||
78 | getRoundedTimeAndNextTarget = do | ||
79 | zonedTime <- getUserZonedTime | ||
80 | return $ case updateStrategy of | ||
81 | ConstantInterval interval -> | ||
82 | (doTimeFormat zonedTime, Nothing, interval) | ||
83 | RoundedTargetInterval roundSeconds offset -> | ||
84 | let roundSecondsDiffTime = fromIntegral roundSeconds | ||
85 | addTheRound = addLocalTime roundSecondsDiffTime | ||
86 | localTime = zonedTimeToLocalTime zonedTime | ||
87 | ourLocalTimeOfDay = localTimeOfDay localTime | ||
88 | seconds = round $ todSec ourLocalTimeOfDay | ||
89 | secondsFactor = seconds `div` roundSeconds | ||
90 | displaySeconds = secondsFactor * roundSeconds | ||
91 | baseLocalTimeOfDay = | ||
92 | ourLocalTimeOfDay { todSec = fromIntegral displaySeconds } | ||
93 | ourLocalTime = | ||
94 | localTime { localTimeOfDay = baseLocalTimeOfDay } | ||
95 | roundedLocalTime = | ||
96 | if seconds `mod` roundSeconds > roundSeconds `div` 2 | ||
97 | then addTheRound ourLocalTime | ||
98 | else ourLocalTime | ||
99 | roundedZonedTime = | ||
100 | zonedTime { zonedTimeToLocalTime = roundedLocalTime } | ||
101 | nextTarget = addTheRound ourLocalTime | ||
102 | amountToWait = realToFrac $ diffLocalTime nextTarget localTime | ||
103 | in (doTimeFormat roundedZonedTime, Nothing, amountToWait - offset) | ||
104 | |||
105 | label <- pollingLabelWithVariableDelay getRoundedTimeAndNextTarget | ||
106 | ebox <- eventBoxNew | ||
107 | containerAdd ebox label | ||
108 | eventBoxSetVisibleWindow ebox False | ||
109 | widgetShowAll ebox | ||
110 | toWidget ebox | ||
111 | |||