antikythera Unit and runner

In my previous log, I have introduced on Hackage antikythera, a simple job/task/event scheduler/cronjob library.

We've settled down for a type-agnostic definition:

data Periodicity a = Periodicity
  { includes :: a -> Bool,
    nextPeriod :: a -> Maybe a
  }

While we had defined few builders and combinators, we wanted to define unit-specific builders such as at and every.

Until now, we have carefully avoided having type-specific operations, but here, things are a little more involved.

Intuitively, we would want to be able to write things like:

• at @Minute 15
• every @Hour 12

But it would involve to come up with many new types and defining multiple while the semantic isn't type-specific, instead, we could define a new data-type taking care of type-specific operations:

data Unit a = Unit
  { extract :: a -> Int,
    -- | should apply modulo
    nextUnitWith :: Int -> a -> Maybe a
  }

We can use it to define at and every:

at :: Int -> Unit a -> Periodicity a
at n u =
  Periodicity
    { includes = (== n) . u.extract,
      nextPeriod = u.nextUnitWith n
    }

every :: Unit a -> Periodicity a
every n u =
  Periodicity
    { includes = ((== 0) . flip mod n) . u.extract,
      nextPeriod = \x -> u.nextUnitWith (nextCandidate $ u.extract x) x
    }
  where
    nextCandidate x = n * succ (x `div` n)

Working on units is actually tedious, but to give a taste of what it's like:

class HasHour a where
  hour :: Unit a

instance HasHour TimeOfDay where
  hour =
    Unit
      { extract = todHour,
        nextUnitWith = \n _ ->
          Just $ TimeOfDay (n `mod` 24) 0 0
      }

And it should be done for every time, and unit (e.g. minute, hour day, etc.).

It went well, until DayOfWeek, which is not an Int, I could cheat and use Enum, to go back and forth Int, but it would make the eDSL too rigid, so, one more time, I have parameterized Unit:

data Unit i a = Unit
  { extract :: a -> i,
    -- | should apply modulo
    nextUnitWith :: i -> a -> Maybe a
  }

Then, at and every had to change:

at :: Eq i => i -> Unit i a -> Periodicity a
at n u =
  Periodicity
    { includes = (== n) . u.extract,
      nextPeriod = u.nextUnitWith n
    }

every :: (Integral i, Eq i) => i -> Unit i a -> Periodicity a
every n u =
  Periodicity
    { includes = ((== 0) . flip mod n) . u.extract,
      nextPeriod = \x -> u.nextUnitWith (nextCandidate $ u.extract x) x
    }
  where
    nextCandidate x = n * succ (x `div` n)

Finally, write DayOfWeek (and co):

class HasWeekDay a where
  weekDay :: Unit DayOfWeek a

instance HasWeekDay DayOfWeek where
  weekDay =
    Unit
      { extract = id,
        nextUnitWith = const . Just
      }

Our last step is to come up with a loop looking for the next period and sleeping until then.

Let's start with a data-type for our type-specific operations:

data PositionInTime t = PositionInTime
  { getTime :: IO t,
    -- | now -> nextPeriod -> µs
    delayMicroSeconds :: t -> t -> Integer
  }

We can define it for UTCTime:

utcTime :: PositionInTime UTCTime
utcTime =
  PositionInTime
    { getTime = getCurrentTime,
      delayMicroSeconds = \now next ->
        ceiling $ 1_000_000 * nominalDiffTimeToSeconds (diffUTCTime next now)
    }

Ultimately, the looping function:

runPeriodicityWithHooks :: PositionInTime t -> Periodicity t -> IO a -> IO ()
runPeriodicityWithHooks pit p f = do
  now <- pit.getTime
  forM_ (p.nextPeriod now) $ \next -> do
    delay $ pit.delayMicroSeconds now next
    f >>= hookAfter

Which allows us to write:

runPeriodicity utcTime (inclusiveRange (Min 8) (Max 23) hour .&& every 30 minute) $
  putStrLn "Don't forget to hydrate"

We've seen two things during the design of antikythera:

• Delay type class use as much as possible: type class mechanism is a great feature, but it only works when you one and only one sane implementation for a given, otherwise, use records
• Have a foundation at the core of the eDSL: Periodicity is a simple abstraction, yet, it allows us to express a complete algebra

antikythera is far from being perfect (it can potentially loop forever on (.&&) and cannot "explain" the underlying computations), but it provides a strong foundation for highly customizable scheduling.