-- | A module which can run housekeeping tasks every so often.
{-# LANGUAGE RecordWildCards #-}
module Twee.Task(Task, newTask, checkTask) where

import System.CPUTime
import Data.IORef
import Control.Monad.IO.Class

data TaskData m a =
  TaskData {
    -- When was the task created?
    forall (m :: * -> *) a. TaskData m a -> Integer
task_start :: !Integer,
    -- When was the task last run?
    forall (m :: * -> *) a. TaskData m a -> Integer
task_last :: !Integer,
    -- How long have we spent on this task so far?
    forall (m :: * -> *) a. TaskData m a -> Integer
task_spent :: !Integer,
    -- How often should we run this task at most, in seconds?
    forall (m :: * -> *) a. TaskData m a -> Double
task_frequency :: !Double,
    -- What proportion of our time should we spend on the task?
    forall (m :: * -> *) a. TaskData m a -> Double
task_budget :: !Double,
    -- The task itself
    forall (m :: * -> *) a. TaskData m a -> m a
task_what :: m a }

-- | A task which runs in the monad @m@ and produces a value of type @a@.
newtype Task m a = Task (IORef (TaskData m a))

-- | Create a new task that should be run a certain proportion
-- of the time. The first argument is how often in seconds the
-- task should run, at most. The second argument is the maximum
-- percentage of time that should be spent on the task.
newTask :: MonadIO m => Double -> Double -> m a -> m (Task m a)
newTask :: forall (m :: * -> *) a.
MonadIO m =>
Double -> Double -> m a -> m (Task m a)
newTask Double
freq Double
budget m a
what = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Integer
now <- IO Integer
getCPUTime
  forall (m :: * -> *) a. IORef (TaskData m a) -> Task m a
Task forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef (forall (m :: * -> *) a.
Integer
-> Integer -> Integer -> Double -> Double -> m a -> TaskData m a
TaskData Integer
now Integer
now Integer
0 Double
freq Double
budget m a
what)

-- | Run a task if it's time to run it.
checkTask :: MonadIO m => Task m a -> m (Maybe a)
checkTask :: forall (m :: * -> *) a. MonadIO m => Task m a -> m (Maybe a)
checkTask (Task IORef (TaskData m a)
ref) = do
  task :: TaskData m a
task@TaskData{m a
Double
Integer
task_what :: m a
task_budget :: Double
task_frequency :: Double
task_spent :: Integer
task_last :: Integer
task_start :: Integer
task_what :: forall (m :: * -> *) a. TaskData m a -> m a
task_budget :: forall (m :: * -> *) a. TaskData m a -> Double
task_frequency :: forall (m :: * -> *) a. TaskData m a -> Double
task_spent :: forall (m :: * -> *) a. TaskData m a -> Integer
task_last :: forall (m :: * -> *) a. TaskData m a -> Integer
task_start :: forall (m :: * -> *) a. TaskData m a -> Integer
..} <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (TaskData m a)
ref
  Integer
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
  if Bool -> Bool
not (forall (m :: * -> *) a. Integer -> TaskData m a -> Bool
taskDue Integer
now TaskData m a
task) then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else do
    a
res <- m a
task_what
    Integer
after <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (TaskData m a)
ref TaskData m a
task {
      task_last :: Integer
task_last = Integer
after,
      task_spent :: Integer
task_spent = Integer
task_spent forall a. Num a => a -> a -> a
+ (Integer
afterforall a. Num a => a -> a -> a
-Integer
now) }
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
res)

-- Check if a task should be run now.
taskDue :: Integer -> TaskData m a -> Bool
taskDue :: forall (m :: * -> *) a. Integer -> TaskData m a -> Bool
taskDue Integer
now TaskData{m a
Double
Integer
task_what :: m a
task_budget :: Double
task_frequency :: Double
task_spent :: Integer
task_last :: Integer
task_start :: Integer
task_what :: forall (m :: * -> *) a. TaskData m a -> m a
task_budget :: forall (m :: * -> *) a. TaskData m a -> Double
task_frequency :: forall (m :: * -> *) a. TaskData m a -> Double
task_spent :: forall (m :: * -> *) a. TaskData m a -> Integer
task_last :: forall (m :: * -> *) a. TaskData m a -> Integer
task_start :: forall (m :: * -> *) a. TaskData m a -> Integer
..} =
  -- Don't run more than the frequency says.
  forall a. Num a => Integer -> a
fromInteger (Integer
now forall a. Num a => a -> a -> a
- Integer
task_last) forall a. Ord a => a -> a -> Bool
>= Double
task_frequency forall a. Num a => a -> a -> a
* Double
10forall a b. (Num a, Integral b) => a -> b -> a
^Integer
12 Bool -> Bool -> Bool
&&
  -- Run if we spent less than task_budget proportion of the total time so far.
  -- Use > rather than >= so that tasks with zero budget never get run.
  forall a. Num a => Integer -> a
fromInteger (Integer
now forall a. Num a => a -> a -> a
- Integer
task_start) forall a. Num a => a -> a -> a
* Double
task_budget forall a. Ord a => a -> a -> Bool
> forall a. Num a => Integer -> a
fromInteger Integer
task_spent