blob: 02552502501bf918e3bcf77bb3d396276a51e2e1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
{-# 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 = NT $ 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
|
