{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}

module Thermoprint.Server.Queue.Utils
       ( standardCollapse
       , standardSleep
       , limitHistorySize
       , limitHistoryAge
       ) where

import Data.Sequence (Seq)
import qualified Data.Sequence as Seq

import Data.Time

import Control.Monad.State
import Control.Monad.IO.Class
import Control.Monad.Trans.Identity
import Servant.Utils.Enter

import Thermoprint.Server.Queue

standardCollapse :: MonadIO m => IdentityT IO :~> m
standardCollapse = Nat $ liftIO . runIdentityT

standardSleep :: Monad (QueueManagerM t) => QueueManager t
-- ^ Instruct 'runQM' to sleep some standard amount of time
--
-- /TODO/: Investigate implementing a smarter algorithm (PID-controller)
standardSleep = return $ 20

limitHistorySize :: MonadState Queue (QueueManagerM t) => Int -> QueueManager t
-- ^ Limit a 'Queue's 'history's size to some number of 'QueueEntry's
limitHistorySize max = modify' limitSize >> standardSleep
  where
    limitSize :: Queue -> Queue
    limitSize q@Queue{..} = q { history = Seq.take max history }

limitHistoryAge :: ( MonadState Queue (QueueManagerM t)
                   ) => NominalDiffTime -- ^ Maximum age relative to the youngest 'QueueEntry'
                   -> QueueManager t
-- ^ Limit a 'Queue's 'history's contents to 'QueueEntry's below a certain age
limitHistoryAge  maxAge = modify' limitAge >> standardSleep
  where
    limitAge :: Queue -> Queue
    limitAge q@Queue{..} = q { history = Seq.filter (filterAge . created . fst) history}
      where
        youngest :: UTCTime
        youngest = maximum $ created . fst <$> history
        filterAge :: UTCTime -> Bool
        filterAge time = not $ (youngest `diffUTCTime` time) > maxAge