Daemon2ndRecurring.hs

module Daemon2ndRecurring where

import List(sort, insert)
import System(system)
import Control.Concurrent(threadDelay)
import Maybe(mapMaybe)

import Entry2ndRecurring

main = do putStrLn "The HCron daemon"
          spec                             <- readFile specLocation
          calTime                          <- getCalendarTime
          (TOD currentSecondsSinceEpoch _) <- getClockTime
          let entries    = (read spec)::[Entry Time]
              entries'   = sort $ mapMaybe renewAndPrune $ map toSeconds entries
              renewAndPrune e@(Entry t recur _) =
                  case (t > currentSecondsSinceEpoch, recur) of
                    (True, _)            -> Just e
                    (False, Nothing)     -> Nothing
                    (False, Just (TimeDiff 0 0 0 0 0 0 0)) -> Nothing
                    (False, Just recur') -> renewAndPrune $ addTimeDiff recur' e
              toSeconds x         = x { when = timeToSeconds calTime (when x) }
          putStrLn "Successfully read entries. Starting daemon."
          putStrLn $ unlines $ map show entries
          putStrLn "After pruning:"
          putStrLn $ unlines $ map show entries'
          daemon entries'

daemon :: [Entry Integer] -> IO()
daemon [] = return ()
daemon (x@(Entry time recur command'):xs) =
    do (TOD clockTime _) <- getClockTime
       delaySeconds $ max 0 (time - clockTime)
       system command'
       let xs' = case recur of
                   Nothing     -> xs
                   Just recur' -> insert (addTimeDiff recur' x) xs
       daemon xs'

addTimeDiff :: TimeDiff -> Entry Integer -> Entry Integer
addTimeDiff diff e = e { when = let (TOD t _ ) = addToClockTime diff (TOD (when e) 0)
                                in t
                       }

getCalendarTime :: IO CalendarTime
getCalendarTime =
    do clockTime <- getClockTime
       toCalendarTime clockTime

timeToSeconds :: CalendarTime -> Time -> Integer
timeToSeconds calTime t =
       let t' = calTime { ctYear = year t, ctMonth = month t, ctDay = day t
                        , ctHour = hour t, ctMin = minute t, ctSec = 0, ctPicosec = 0 }
           (TOD time _) = (toClockTime t')
       in time

delaySeconds :: Integer -> IO ()
delaySeconds seconds = delayMicro (seconds * 1)   -- FIXME: multiple by 10^6
    where
      delayMicro ms | ms <= 0   = return ()
                    | otherwise = do let d = min (toInteger (maxBound::Int)) ms
                                     print (d `div` 10^6)
                                     threadDelay (fromInteger d)
                                     delayMicro (ms - d)