module Data.Calendar (
  module Data.Timeframe,
  Event,
  event,
  eventSize,
  erlangs,
  Calendar (..),
  singleton,
  calendar,
  insert,
  (!?),
  (!),
  Data.Calendar.toList,
  happeningAt,
  coalesce,
  totalDuration,
) where

import Control.Applicative (liftA2)
import Data.Data (Typeable)
import Data.Foldable (fold)
import Data.Interval qualified as I
import Data.Interval.Layers (Layers)
import Data.Interval.Layers qualified as Layers
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Semigroup hiding (diff)
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 :: forall n. Num n => Timeframe -> Event n
event = (forall x y. Ord x => Interval x -> y -> Layers x y
`Layers.singleton` Sum n
1)

-- | Make an 'Event' with the given size from a 'Timeframe'.
eventSize :: (Num n) => n -> Timeframe -> Event n
eventSize :: forall n. Num n => n -> Timeframe -> Event n
eventSize n
n = (forall x y. Ord x => Interval x -> y -> Layers x y
`Layers.singleton` forall a. a -> Sum a
Sum n
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 :: forall n. Real n => Timeframe -> Event n -> Maybe Rational
erlangs Timeframe
ix Event n
e =
  let diff :: UTCTime -> UTCTime -> Rational
diff = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. (a -> b -> c) -> b -> a -> c
flip UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime
   in forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
        forall a. Fractional a => a -> a -> a
(/)
        (forall x y z.
(Ord x, Ord y, Semigroup y, Num z) =>
(x -> x -> z) -> (y -> z) -> Interval x -> Layers x y -> Maybe z
Layers.integrate UTCTime -> UTCTime -> Rational
diff (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Sum a -> a
getSum) Timeframe
ix Event n
e)
        (forall y x.
(Ord x, Num y) =>
(x -> x -> y) -> Interval x -> Maybe y
I.measuring UTCTime -> UTCTime -> Rational
diff Timeframe
ix)

-- | A 'Calendar' is a map from a given event type to durations.
newtype Calendar ev n = Calendar {forall ev n. Calendar ev n -> Map ev (Event n)
getCalendar :: Map ev (Event n)}
  deriving (Calendar ev n -> Calendar ev n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ev n.
(Eq ev, Eq n) =>
Calendar ev n -> Calendar ev n -> Bool
/= :: Calendar ev n -> Calendar ev n -> Bool
$c/= :: forall ev n.
(Eq ev, Eq n) =>
Calendar ev n -> Calendar ev n -> Bool
== :: Calendar ev n -> Calendar ev n -> Bool
$c== :: forall ev n.
(Eq ev, Eq n) =>
Calendar ev n -> Calendar ev n -> Bool
Eq, Calendar ev n -> Calendar ev n -> Bool
Calendar ev n -> Calendar ev n -> Ordering
Calendar ev n -> Calendar ev n -> Calendar ev n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {ev} {n}. (Ord ev, Ord n) => Eq (Calendar ev n)
forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Bool
forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Ordering
forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Calendar ev n
min :: Calendar ev n -> Calendar ev n -> Calendar ev n
$cmin :: forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Calendar ev n
max :: Calendar ev n -> Calendar ev n -> Calendar ev n
$cmax :: forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Calendar ev n
>= :: Calendar ev n -> Calendar ev n -> Bool
$c>= :: forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Bool
> :: Calendar ev n -> Calendar ev n -> Bool
$c> :: forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Bool
<= :: Calendar ev n -> Calendar ev n -> Bool
$c<= :: forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Bool
< :: Calendar ev n -> Calendar ev n -> Bool
$c< :: forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Bool
compare :: Calendar ev n -> Calendar ev n -> Ordering
$ccompare :: forall ev n.
(Ord ev, Ord n) =>
Calendar ev n -> Calendar ev n -> Ordering
Ord, Int -> Calendar ev n -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ev n. (Show ev, Show n) => Int -> Calendar ev n -> ShowS
forall ev n. (Show ev, Show n) => [Calendar ev n] -> ShowS
forall ev n. (Show ev, Show n) => Calendar ev n -> String
showList :: [Calendar ev n] -> ShowS
$cshowList :: forall ev n. (Show ev, Show n) => [Calendar ev n] -> ShowS
show :: Calendar ev n -> String
$cshow :: forall ev n. (Show ev, Show n) => Calendar ev n -> String
showsPrec :: Int -> Calendar ev n -> ShowS
$cshowsPrec :: forall ev n. (Show ev, Show n) => Int -> Calendar ev n -> ShowS
Show, Typeable)

instance (Ord ev, Ord n, Num n) => Semigroup (Calendar ev n) where
  Calendar Map ev (Event n)
a <> :: Calendar ev n -> Calendar ev n -> Calendar ev n
<> Calendar Map ev (Event n)
b = forall ev n. Map ev (Event n) -> Calendar ev n
Calendar (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map ev (Event n)
a Map ev (Event n)
b)

instance (Ord ev, Ord n, Num n) => Monoid (Calendar ev n) where
  mempty :: Calendar ev n
mempty = forall ev n. Calendar ev n
Data.Calendar.empty

-- | The empty 'Calendar'.
empty :: Calendar ev n
empty :: forall ev n. Calendar ev n
empty = forall ev n. Map ev (Event n) -> Calendar ev n
Calendar forall k a. Map k a
Map.empty

-- | Make a 'Calendar' from an 'Event'.
singleton :: (Ord ev, Ord n, Num n) => ev -> Event n -> Calendar ev n
singleton :: forall ev n.
(Ord ev, Ord n, Num n) =>
ev -> Event n -> Calendar ev n
singleton ev
ev Event n
cvg = forall ev n. Map ev (Event n) -> Calendar ev n
Calendar (forall k a. k -> a -> Map k a
Map.singleton ev
ev Event n
cvg)

-- | Make a 'Calendar' from a 'Timeframe'.
calendar :: (Ord ev, Ord n, Num n) => ev -> Timeframe -> Calendar ev n
calendar :: forall ev n.
(Ord ev, Ord n, Num n) =>
ev -> Timeframe -> Calendar ev n
calendar ev
ev Timeframe
tf = forall ev n.
(Ord ev, Ord n, Num n) =>
ev -> Event n -> Calendar ev n
singleton ev
ev (forall x y. Ord x => Interval x -> y -> Layers x y
Layers.singleton Timeframe
tf Sum n
1)

-- | Insert an 'Event' of the given sort into a 'Calendar'.
insert :: (Ord ev, Ord n, Num n) => ev -> Event n -> Calendar ev n -> Calendar ev n
insert :: forall ev n.
(Ord ev, Ord n, Num n) =>
ev -> Event n -> Calendar ev n -> Calendar ev n
insert ev
ev Event n
cvg (Calendar Map ev (Event n)
c) = forall ev n. Map ev (Event n) -> Calendar ev n
Calendar (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) ev
ev Event n
cvg Map ev (Event n)
c)

-- |
-- Get the 'Event' corresponding to a given key,
-- or 'Nothing' if the key is not present.
(!?) :: (Ord ev, Ord n, Num n) => Calendar ev n -> ev -> Maybe (Event n)
Calendar Map ev (Event n)
c !? :: forall ev n.
(Ord ev, Ord n, Num n) =>
Calendar ev n -> ev -> Maybe (Event n)
!? ev
ev = Map ev (Event n)
c forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? ev
ev

-- |
-- Get the 'Event' corresponding to a given key,
-- or 'mempty' if the key is not present.
(!) :: (Ord ev, Ord n, Num n) => Calendar ev n -> ev -> Event n
Calendar Map ev (Event n)
c ! :: forall ev n.
(Ord ev, Ord n, Num n) =>
Calendar ev n -> ev -> Event n
! ev
ev = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (Map ev (Event n)
c forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? ev
ev)

toList :: (Ord ev, Ord n, Num n) => Calendar ev n -> [(ev, [(Interval UTCTime, n)])]
toList :: forall ev n.
(Ord ev, Ord n, Num n) =>
Calendar ev n -> [(ev, [(Timeframe, n)])]
toList (Calendar Map ev (Event n)
c) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Sum a -> a
getSum) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y. Ord x => Layers x y -> [(Interval x, y)]
Layers.toList) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.assocs Map ev (Event n)
c

-- |
-- What, and how many events are happening
-- at the given 'UTCTime' on this 'Calendar'?
happeningAt :: (Ord ev, Ord n, Num n) => UTCTime -> Calendar ev n -> [(ev, n)]
happeningAt :: forall ev n.
(Ord ev, Ord n, Num n) =>
UTCTime -> Calendar ev n -> [(ev, n)]
happeningAt UTCTime
time (forall ev n.
(Ord ev, Ord n, Num n) =>
Calendar ev n -> [(ev, [(Timeframe, n)])]
Data.Calendar.toList -> [(ev, [(Timeframe, n)])]
evs) =
  [(ev
ev, n
n) | (ev
ev, [(Timeframe, n)]
ns) <- [(ev, [(Timeframe, n)])]
evs, (Timeframe
_, n
n) <- forall a. (a -> Bool) -> [a] -> [a]
filter (forall x. Ord x => x -> Interval x -> Bool
within UTCTime
time forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Timeframe, n)]
ns]

-- | Consider every kind of event the same, and observe the overall 'Layers'.
coalesce :: (Ord ev, Ord n, Num n) => Calendar ev n -> Event n
coalesce :: forall ev n. (Ord ev, Ord n, Num n) => Calendar ev n -> Event n
coalesce (Calendar Map ev (Event n)
c) = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map ev (Event n)
c

totalDuration ::
  forall ev n.
  (Ord ev, Real n) =>
  ev ->
  Calendar ev n ->
  Maybe NominalDiffTime
totalDuration :: forall ev n.
(Ord ev, Real n) =>
ev -> Calendar ev n -> Maybe NominalDiffTime
totalDuration ev
ev (Calendar Map ev (Event n)
c) = case Map ev (Event n)
c forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? ev
ev of
  Maybe (Event n)
Nothing -> forall a. a -> Maybe a
Just NominalDiffTime
0
  Just Event n
is -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Timeframe, Sum n)
-> Maybe NominalDiffTime -> Maybe NominalDiffTime
f (forall a. a -> Maybe a
Just NominalDiffTime
0) (forall x y. Ord x => Layers x y -> [(Interval x, y)]
Layers.toList Event n
is)
 where
  f :: (Timeframe, Sum n) -> Maybe NominalDiffTime -> Maybe NominalDiffTime
  f :: (Timeframe, Sum n)
-> Maybe NominalDiffTime -> Maybe NominalDiffTime
f (Timeframe, Sum n)
_ Maybe NominalDiffTime
Nothing = forall a. Maybe a
Nothing
  f (Timeframe
tf, Sum n
n) (Just NominalDiffTime
x) = case (forall a b. (Real a, Fractional b) => a -> b
realToFrac n
n forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Timeframe -> Maybe NominalDiffTime
duration Timeframe
tf of
    Maybe NominalDiffTime
Nothing -> forall a. Maybe a
Nothing
    Just NominalDiffTime
y -> forall a. a -> Maybe a
Just (NominalDiffTime
x forall a. Num a => a -> a -> a
+ NominalDiffTime
y)