module Data.Calendar (
module Data.Timeframe,
Event,
event,
eventSize,
erlangs,
Calendar (..),
singleton,
calendar,
insert,
(!?),
(!),
Data.Calendar.toList,
happeningAt,
coalesce,
totalDuration,
) where
import Data.Interval qualified as I
import Data.Interval.Layers (Layers)
import Data.Interval.Layers qualified as Layers
import Data.Map.Strict qualified as Map
import Data.Time.Compat
import Data.Timeframe
-- | An 'Event' is a collection of 'Timeframe's that keeps track of
-- how deeply a particular interval has been overlapped.
--
-- > type Event n = Layers UTCTime (Sum n)
type Event n = Layers UTCTime (Sum n)
-- | Make a new 'Event' from a 'Timeframe' with default thickness 1.
--
-- > event = eventSize 1
event :: (Num n) => Timeframe -> Event n
event = (`Layers.singleton` 1)
-- | Make an 'Event' with the given size from a 'Timeframe'.
eventSize :: (Num n) => n -> Timeframe -> Event n
eventSize n = (`Layers.singleton` Sum n)
-- |
-- Measure the carried load of an 'Event' over a given 'Timeframe'.
-- In other words: how many copies of you would you need, in order to attend
-- all of the simultaneous happenings over a given span (on average)?
erlangs :: (Real n) => Timeframe -> Event n -> Maybe Rational
erlangs ix e =
let diff = realToFrac <<$>> flip diffUTCTime
in liftA2
(/)
(Layers.integrate diff (realToFrac . getSum) ix e)
(I.measuring diff ix)
-- | A 'Calendar' is a map from a given event type to durations.
newtype Calendar ev n = Calendar {getCalendar :: Map ev (Event n)}
deriving (Eq, Ord, Show, Typeable)
instance (Ord ev, Num n) => Semigroup (Calendar ev n) where
Calendar a <> Calendar b = Calendar (Map.unionWith (<>) a b)
instance (Ord ev, Num n) => Monoid (Calendar ev n) where
mempty = Data.Calendar.empty
-- | The empty 'Calendar'.
empty :: Calendar ev n
empty = Calendar Map.empty
-- | Make a 'Calendar' from an 'Event'.
singleton :: (Ord ev, Num n) => ev -> Event n -> Calendar ev n
singleton ev cvg = Calendar (Map.singleton ev cvg)
-- | Make a 'Calendar' from a 'Timeframe'.
calendar :: (Ord ev, Num n) => ev -> Timeframe -> Calendar ev n
calendar ev tf = singleton ev (Layers.singleton tf 1)
-- | Insert an 'Event' of the given sort into a 'Calendar'.
insert :: (Ord ev, Num n) => ev -> Event n -> Calendar ev n -> Calendar ev n
insert ev cvg (Calendar c) = Calendar (Map.insertWith (<>) ev cvg c)
-- |
-- Get the 'Event' corresponding to a given key,
-- or 'Nothing' if the key is not present.
(!?) :: (Ord ev, Num n) => Calendar ev n -> ev -> Maybe (Event n)
Calendar c !? ev = c Map.!? ev
-- |
-- Get the 'Event' corresponding to a given key,
-- or 'mempty' if the key is not present.
(!) :: (Ord ev, Num n) => Calendar ev n -> ev -> Event n
Calendar c ! ev = c Map.!? ev ?: mempty
toList :: (Ord ev, Num n) => Calendar ev n -> [(ev, [(Interval UTCTime, n)])]
toList (Calendar c) = fmap getSum <<$>> Layers.toList <<$>> Map.assocs c
-- |
-- What, and how many events are happening
-- at the given 'UTCTime' on this 'Calendar'?
happeningAt :: (Ord ev, Num n) => UTCTime -> Calendar ev n -> [(ev, n)]
happeningAt time (Data.Calendar.toList -> evs) =
[(ev, n) | (ev, ns) <- evs, (_, n) <- filter (within time . fst) ns]
-- | Consider every kind of event the same, and observe the overall 'Layers'.
coalesce :: (Ord ev, Num n) => Calendar ev n -> Event n
coalesce (Calendar c) = fold c
totalDuration ::
forall ev n.
(Ord ev, Real n) =>
ev ->
Calendar ev n ->
Maybe NominalDiffTime
totalDuration ev (Calendar c) = case c Map.!? ev of
Nothing -> Just 0
Just is -> foldr f (Just 0) (Layers.toList is)
where
f :: (Timeframe, Sum n) -> Maybe NominalDiffTime -> Maybe NominalDiffTime
f _ Nothing = Nothing
f (tf, Sum n) (Just x) = case (realToFrac n *) <$> duration tf of
Nothing -> Nothing
Just y -> Just (x + y)