Add schedule module move some ExceptTs around

src/Yore/Schedule.hs

@@ -0,0 +1,21 @@
+module Yore.Schedule (schedule) where
+
+import Control.Monad (when)
+import Data.Time (ZonedTime, getZonedTime, secondsToNominalDiffTime, nominalDiffTimeToSeconds)
+import Control.Concurrent (threadDelay, forkIO)
+import Data.Time.Clock.POSIX (getPOSIXTime)
+
+schedule :: (ZonedTime -> Bool) -> IO () -> IO ()
+schedule shouldRunAt f = everyMinute $ \now -> when (shouldRunAt now) f
+
+everyMinute :: (ZonedTime -> IO ()) -> IO ()
+everyMinute f = do
+  -- Use POSIX time to avoid having to handle leap seconds
+  now <- getPOSIXTime
+  let posixSeconds :: Int 
+      posixSeconds = floor $ nominalDiffTimeToSeconds now
+      lastFullMinute = secondsToNominalDiffTime $ fromIntegral $ posixSeconds - posixSeconds `mod` 60
+      secondsSinceLastFullMinute = now - lastFullMinute
+  threadDelay $ ceiling $ (60 - secondsSinceLastFullMinute) * 1_000_000
+  _ <- forkIO $ f =<< getZonedTime
+  everyMinute f