Optimize Date plugin again (refresh timezone only once a minute)

This makes the Date plugin approximately twice as fast, and makes xmobar
up to about 5–10 % faster if Date is the only active plugin. (If more
expensive plugins like Network or MultiCpu are used, it doesn't make any
measurable difference.)

Micro-benchmark results on my HW:

    Date Benchmarks/Date                     mean 2.833 μs  ( +- 16.08 ns  )
    Date Benchmarks/DateZonedTime            mean 5.020 μs  ( +- 32.91 ns  )
    Date Benchmarks/DateWithTimeZone         mean 2.827 μs  ( +- 20.52 ns  )

(DateZonedTime is the original implementation and DateWithTimeZone is
the implementation we had since 0.34 which never refreshes timezone.)

Real-life measurements (done overnight on an idle laptop, with all
measured xmobars running in parallel to ensure comparable conditions;
xmobars configured to only display date and with rate 10 — once per
second):

    $ time timeout 6h xmobar .xmobarrc-DateZonedTime
    real    360m0,010s
    user    0m9,867s
    sys     0m4,644s

    (9.867 + 4.644) / (360 * 60) = 0.000672

    $ time timeout 6h xmobar .xmobarrc-Date
    real    360m0,008s
    user    0m9,535s
    sys     0m4,327s

    (9.535 + 4.327) / (360 * 60) = 0.000642

    $ time timeout 6h xmobar .xmobarrc-Date-10m
    real    360m0,010s
    user    0m9,780s
    sys     0m4,215s

    (9.780 + 4.215) / (360 * 60) = 0.000648

    $ time timeout 6h xmobar .xmobarrc-DateWithTimeZone
    real    360m0,006s
    user    0m9,658s
    sys     0m4,166s

    (9.658 + 4.166) / (360 * 60) = 0.000640

(.xmobarrc-Date-10m is the proposed implementation, but with timezone
refresh every 10 minutes instead of every 1 minute)

Interpretation of these results:

 * refreshing xmobar with just date takes around 650 μs
 * that is xmobar with just date uses around 0.065 % of CPU time
 * refreshing timezone takes additional cca 30 μs

When we only refresh timezone once a minute, these 30 μs become 0.5 μs
amortized, and that should be acceptable to even the most dedicated
perfectionist :-)

Fixes: a58e32f7c8af ("Revert "Optimize date plugin"")
Fixes: 878db3908060 ("Optimize date plugin")
Co-authored-by: Sibi Prabakaran <sibi@psibi.in>

5 files changed, 42 insertions, 8 deletions

diff --git a/bench/main.hs b/bench/main.hs
index f8db78c..10639eb 100644
--- a/bench/main.hs
+++ b/bench/main.hs
@@ -1,12 +1,14 @@
 module Main (main) where
 
+import Data.IORef (newIORef)
+import Data.Time
 import Gauge
 import Xmobar
 import Xmobar.Plugins.Monitors.Cpu
 
 main :: IO ()
 main = do
-  defaultMain =<< sequence [cpuBench]
+  defaultMain =<< sequence [cpuBench, dateBench]
 
 mkCpuArgs :: IO CpuArguments
 mkCpuArgs = getArguments ["-L", "3", "-H", "50", "--normal", "green", "--high", "red", "-t", "Cpu: <total>%"]
@@ -17,3 +19,21 @@ cpuBench = do
   return $ bgroup "Cpu Benchmarks"
     [ bench "CPU normal args" $ nfIO (runCpu cpuArgs)
     ]
+
+dateBench :: IO Benchmark
+dateBench = do
+  let format = "D: %B %d %A W%V"
+  zone <- getCurrentTimeZone
+  zone' <- newIORef =<< getCurrentTimeZone
+  return $ bgroup "Date Benchmarks"
+    [ bench "Date" $ nfIO (date zone' format)
+    , bench "DateZonedTime" $ nfIO (dateZonedTime format)
+    , bench "DateWithTimeZone" $ nfIO (dateWithTimeZone zone format)
+    ]
+
+dateZonedTime :: String -> IO String
+dateZonedTime format = fmap (formatTime defaultTimeLocale format) getZonedTime
+
+dateWithTimeZone :: TimeZone -> String -> IO String
+dateWithTimeZone zone format =
+    fmap (formatTime defaultTimeLocale format . utcToZonedTime zone) getCurrentTime
diff --git a/changelog.md b/changelog.md
index 859d475..28ae950 100644
--- a/changelog.md
+++ b/changelog.md
@@ -6,8 +6,8 @@ _New features_
 
 _Bug fixes_
 
-  - Fix date plugin not picking up DST and timezone changes
-    (Fixed by reverting the optimization merged in 0.34).
+  - Fix date plugin not picking up DST and timezone changes (refresh
+    timezone once a minute to preserve the optimized performace of 0.34).
 
 ## Version 0.36 (August, 2020)
 
diff --git a/readme.md b/readme.md
index 5b8e747..f9b209e 100644
--- a/readme.md
+++ b/readme.md
@@ -1540,6 +1540,7 @@ will display "N/A" if for some reason the `date` invocation fails.
 
 - Format is a time format string, as accepted by the standard ISO C
   `strftime` function (or Haskell's `formatCalendarTime`).
+- Timezone changes are picked up automatically every minute.
 - Sample usage: `Run Date "%a %b %_d %Y <fc=#ee9a00>%H:%M:%S</fc>" "date" 10`
 
 ## `DateZone Format Locale Zone Alias RefreshRate`
diff --git a/src/Xmobar/Plugins/Date.hs b/src/Xmobar/Plugins/Date.hs
index 1cb0596..d7de2e9 100644
--- a/src/Xmobar/Plugins/Date.hs
+++ b/src/Xmobar/Plugins/Date.hs
@@ -17,22 +17,35 @@
 --
 -----------------------------------------------------------------------------
 
-module Xmobar.Plugins.Date (Date(..)) where
+module Xmobar.Plugins.Date (Date(..), date) where
 
 import Xmobar.Run.Exec
 
 #if ! MIN_VERSION_time(1,5,0)
 import System.Locale
 #endif
+import Data.IORef
 import Data.Time
+import Control.Concurrent.Async (concurrently_)
 
 data Date = Date String String Int
     deriving (Read, Show)
 
 instance Exec Date where
     alias (Date _ a _) = a
-    run   (Date f _ _) = date f
     rate  (Date _ _ r) = r
+    start (Date f _ r) cb =
+        -- refresh time zone once a minute to avoid wasting CPU cycles
+        withRefreshingZone 600 $ \zone ->
+            doEveryTenthSeconds r $ date zone f >>= cb
 
-date :: String -> IO String
-date format = fmap (formatTime defaultTimeLocale format) getZonedTime
+date :: IORef TimeZone -> String -> IO String
+date zoneRef format = do
+    zone <- readIORef zoneRef
+    fmap (formatTime defaultTimeLocale format . utcToZonedTime zone) getCurrentTime
+
+withRefreshingZone :: Int -> (IORef TimeZone -> IO ()) -> IO ()
+withRefreshingZone r action = do
+    zone <- newIORef =<< getCurrentTimeZone
+    let refresh = atomicWriteIORef zone =<< getCurrentTimeZone
+    concurrently_ (doEveryTenthSeconds r refresh) (action zone)
diff --git a/xmobar.cabal b/xmobar.cabal
index 57dfcb9..c03db46 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -357,5 +357,5 @@ benchmark xmobarbench
   hs-source-dirs:
       bench
   ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind -O2
-  build-depends: base, gauge, xmobar, mtl
+  build-depends: base, gauge, xmobar, mtl, time
   default-language: Haskell2010