4.hs

import Data.Time.Clock.POSIX
import Data.Time.Clock (NominalDiffTime)
import qualified Data.Map as Map

data Check = Check { name :: String, action :: IO Result } 
instance Eq Check where
  c1 == c2 = name c1 == name c2
instance Ord Check where
  compare c1 c2 = compare (name c1) (name c2)
data Result = Pass | Warn String | Fail String deriving (Show, Eq, Ord)
type Schedule = Map.Map POSIXTime [Check]

-- Main initializes the schedule with the program's start time, then initiates the loop.
main :: IO ()
main = do
  t <- getPOSIXTime
  runScheduler $ initialize t

-- runScheduler loops forever, executing each action precisely once when it is scheduled.
runScheduler :: Schedule -> IO ()
runScheduler s = do
  t <- getPOSIXTime -- Get current time in seconds
  let (due,later) = Map.split t s -- Split the schedule into checks due and not.
  (results,new) <- runAndUpdate due --evaluate the currently-due actions
  print results -- Log to STDOUT, but in real life this would go somewhere else.
  runScheduler $ Map.union later new -- Construct the new schedule and recurse.

-- runAndUpdate takes a schedule segment that needs to be executed, runs it, and returns the results along with a new schedule.
-- If the program were to be parallelized, this would be where to do it.
runAndUpdate :: Schedule -> IO ([Result], Schedule)
runAndUpdate m = do
  results <- mapM action . concat $ Map.elems new
  -- Alternatively,
  -- results <- parallelInterleaved . map action . concat $ Map.elems new
  -- will run the checks in parallel and return them in approximate order completed.
  return (results,new)
  where new = Map.foldl' Map.union Map.empty $ Map.mapWithKey updateTimes m
        updateTimes t l = Map.fromListWith (++) $ map (\c -> (t + i c,[c])) l
        i c = checkerIntervals Map.! c 

-- Initialize creates a schedule starting at the specified time.
initialize :: POSIXTime -> Schedule
initialize t = Map.foldlWithKey' scheduleCheck Map.empty checkerIntervals
  where scheduleCheck m c i = Map.insertWith (++) (t+i) [c] m

-- checkerIntervals associates each check to its specified frequency.
-- Add any checks here to actually schedule them.
-- NominalDiffTime is interpreted as seconds. It accepts fractional intervals.
checkerIntervals :: Map.Map Check NominalDiffTime
checkerIntervals = Map.fromList [(exampleCheck1,1),
                                 (exampleCheck2,2.5)] --etc

--Defining a check consists of giving it a name and an IO action.
--The action can have arbitrary side effects, but must return one of the Result variants.
--Names must be unique.
exampleCheck1 :: Check
exampleCheck1 = Check { name = "exampleCheck1", action = do putStrLn "Test"; return Pass }
exampleCheck2 :: Check
exampleCheck2 = Check { name = "exampleCheck2", action = do putStrLn "Test2"; return $ Warn "something or other"}