Introducing antikythera

Few weeks ago, I have introduced on Hackage antikythera, a simple job/task/event scheduler/cronjob library.

To give a bit of context, I'm in the long process of automating a lot of my day-to-day tasks.

One of them is to keep track collections of files, and rotate them on various business rules. I had a bunch of bash scripts to handle snapshots and tracking, but they are quite brittle, and many snapshots are corrupted, moreover, rotation are manual operations I had to perform on a remote service.

I have decided to create a simple Haskell-based web UI, bundling the snapshot code in it, as snapshots and rotations are part of the same API.

I could, when I wrote the NixOS module/service, add a systemd.timer.

Not only, as all systemd services, it comes with huge limitations (e.g. in one of my previous position, we used to have a timer which was performing an operation everyday at 4 am Europe/Paris time, which is an issue since we have daylight saving time, so 3 am UTC during winter and 2 am UTC during summer). But it'll also would force me to expose to internals and add moving pieces.

So, I have decided to create a simple library for that.

My first idea was to decompose the problem in two part:

  • a periodicity definition, which gives the next occurrence following a given time
  • a loop, which sleeps until the next occurrence

Let's try a first definition:

newtype Periodicity a = Periodicity
  {  nextPeriod :: a -> a
  }

We can imagine a first trivial Periodicity, which would always occurs:

always :: (a -> a) -> Periodicity a
always f =
  Periodicity
    { nextPeriod = f
    }

However, we can't define never, to do so, we have to change Periodicity to break the assumption there's always an upcoming occurrence:

newtype Periodicity a = Periodicity
  {  nextPeriod :: a -> Maybe a
  }

Let's work on our definitions:

never :: Periodicity a
never =
  Periodicity
    { nextPeriod = const Nothing
    }

always :: (a -> a) -> Periodicity a
always f =
  Periodicity
    { nextPeriod = Just . f
    }

We can now tackle compositions, the first one is or, which, given two Periodicity, take the soonest occurrence:

(.||) :: Ord a => Periodicity a -> Periodicity a -> Periodicity a
x .|| y =
  Periodicity
    { nextPeriod = \c ->
        case (x.nextPeriod c, y.nextPeriod c) of
          (Just n, Just m) -> Just $ min n m
          (Just n, _) -> Just n
          (_, o) -> o
    }

infixr 2 .||

Symmetrically, we want to define and, but it's slightly more complex as, not only we need to have the soonest occurrence which matches both Periodicity rules, we have to include a way to test candidate occurrences:

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

Completing our trivial Periodicity:

never :: Periodicity a
never =
  Periodicity
    { includes = const False,
      nextPeriod = const Nothing
    }

always :: (a -> a) -> Periodicity a
always f =
  Periodicity
    { includes = const True,
      nextPeriod = Just . f
    }

And our composition functions:

(.||) :: Ord a => Periodicity a -> Periodicity a -> Periodicity a
x .|| y =
  Periodicity
    { includes = \c -> x.includes c || y.includes c,
      nextPeriod = -- ...
    }

(.&&) :: Ord a => Periodicity a -> Periodicity a -> Periodicity a
x .&& y =
  Periodicity
    { includes = \c -> x.includes c && y.includes c,
      nextPeriod =
        let go c =
              case (x.nextPeriod c, y.nextPeriod c) of
                (Just n, Just m) ->
                  let c' = min m n
                   in if x.includes c' && y.includes c'
                        then Just c'
                        else go c'
                _ -> Nothing
         in go
    }

Note: and is brute-forcing a solution, get both next occurrence, test the soonest, if it fails, take it as reference for the next computation, which would loop forever on conflicting Periodicity.

We can extend these functions to lists/Foldable:

allOf :: Ord a => NE.NonEmpty (Periodicity a) -> Periodicity a
allOf = foldl1 (.&&)

anyOf :: Ord a => NE.NonEmpty (Periodicity a) -> Periodicity a
anyOf = foldl1 (.||)

allOf' :: (Foldable f, Ord a) => (a -> a) -> f (Periodicity a) -> Periodicity a
allOf' = foldl (.&&) . always

anyOf' :: (Foldable f, Ord a) => f (Periodicity a) -> Periodicity a
anyOf' = foldl (.||) never

And that's it for today, in the next log, we'll see how to do more precise Periodicity such as at and every.