1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
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
|
