-- |
-- Module        : Control.Antikythera.Periodicity
-- Copyright     : Gautier DI FOLCO
-- License       : ISC
--
-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability     : Stable
-- Portability   : Portable
--
-- Defining a 'Periodicity', how often/when an event occurs
module Control.Antikythera.Periodicity
  ( Periodicity (..),
    nextPeriods,

    -- * Base helpers
    never,
    always,

    -- * Combinators
    (.&&),
    (.||),
    allOf,
    anyOf,
    allOf',
    anyOf',

    -- * 'Unit'-based builders
    at,
    ats,
    every,
    inclusiveRange,

    -- * Absolute builders
    sinceInclusive,
    untilInclusive,

    -- * Reexports
    Max (..),
    Min (..),
  )
where

import Control.Antikythera.Unit.Unit
import Control.Arrow ((&&&))
import Control.Monad (mfilter)
import Data.List (unfoldr)
import qualified Data.List.NonEmpty as NE
import Data.Semigroup

-- | Event recurring period
--
-- Are we at @17:*@?
--
-- > (at 17 hour).includes now
--
-- Next @*:05@
--
-- > (at 5 minute).nextPeriod now
data Periodicity a = Periodicity
  { forall a. Periodicity a -> a -> Bool
includes :: a -> Bool,
    forall a. Periodicity a -> a -> Maybe a
nextPeriod :: a -> Maybe a
  }

-- | Get a poentially infinite list of upcoming event
--
-- __Warning:__ may loop infinitelly
nextPeriods :: Periodicity a -> a -> [a]
nextPeriods :: forall a. Periodicity a -> a -> [a]
nextPeriods Periodicity a
p = (a -> Maybe (a, a)) -> a -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ((a -> (a, a)) -> Maybe a -> Maybe (a, a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a
forall a. a -> a
id (a -> a) -> (a -> a) -> a -> (a, a)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a -> a
forall a. a -> a
id) (Maybe a -> Maybe (a, a)) -> (a -> Maybe a) -> a -> Maybe (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Periodicity a
p.nextPeriod)

-- * Base helpers

-- | Never happen
never :: Periodicity a
never :: forall a. Periodicity a
never =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False,
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod = Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
    }

-- | Always happen
--
-- Going from minute to minute:
--
-- > always (addUTCTime $ secondsToNominalDiffTime 60)
always ::
  -- | Increment to next value
  (a -> a) ->
  Periodicity a
always :: forall a. (a -> a) -> Periodicity a
always a -> a
f =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True,
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f
    }

-- * Combinators

-- | Intersection of two periods
--
-- Everyday at @15:15@
--
-- > at 15 hour .&& at 15 minute
--
-- __Warning:__ may loop infinitelly when impossible constraints, e.g.
--
-- > at 15 minutes .&& at 15 minute
(.&&) :: (Ord a) => Periodicity a -> Periodicity a -> Periodicity a
Periodicity a
x .&& :: forall a. Ord a => Periodicity a -> Periodicity a -> Periodicity a
.&& Periodicity a
y =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = \a
c -> Periodicity a
x.includes a
c Bool -> Bool -> Bool
&& Periodicity a
y.includes a
c,
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod =
        let go :: a -> Maybe a
go a
c =
              case (Periodicity a
x.nextPeriod a
c, Periodicity a
y.nextPeriod a
c) of
                (Just a
n, Just a
m) ->
                  let c' :: a
c' = a -> a -> a
forall a. Ord a => a -> a -> a
min a
m a
n
                   in if Periodicity a
x.includes a
c' Bool -> Bool -> Bool
&& Periodicity a
y.includes a
c'
                        then a -> Maybe a
forall a. a -> Maybe a
Just a
c'
                        else a -> Maybe a
go a
c'
                (Maybe a, Maybe a)
_ -> Maybe a
forall a. Maybe a
Nothing
         in a -> Maybe a
go
    }

infixr 3 .&&

-- | Union of two periods
--
-- Everyday at @15:*@ or every hour at @*:15@
--
-- > at 15 hour .|| at 15 minute
(.||) :: (Ord a) => Periodicity a -> Periodicity a -> Periodicity a
Periodicity a
x .|| :: forall a. Ord a => Periodicity a -> Periodicity a -> Periodicity a
.|| Periodicity a
y =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = \a
c -> Periodicity a
x.includes a
c Bool -> Bool -> Bool
|| Periodicity a
y.includes a
c,
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod = \a
c ->
        case (Periodicity a
x.nextPeriod a
c, Periodicity a
y.nextPeriod a
c) of
          (Just a
n, Just a
m) -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
min a
n a
m
          (Just a
n, Maybe a
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
n
          (Maybe a
_, Maybe a
o) -> Maybe a
o
    }

infixr 2 .||

-- | Intersections of all periods
--
-- Same as
--
-- > allOf = foldl1 (.&&)
--
-- __Warning:__ may loop infinitelly when impossible constraints, see '(.&&)'
allOf :: (Ord a) => NE.NonEmpty (Periodicity a) -> Periodicity a
allOf :: forall a. Ord a => NonEmpty (Periodicity a) -> Periodicity a
allOf = (Periodicity a -> Periodicity a -> Periodicity a)
-> NonEmpty (Periodicity a) -> Periodicity a
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Periodicity a -> Periodicity a -> Periodicity a
forall a. Ord a => Periodicity a -> Periodicity a -> Periodicity a
(.&&)

-- | Unions of all periods
--
-- Same as
--
-- > anyOf = foldl1 (.||)
anyOf :: (Ord a) => NE.NonEmpty (Periodicity a) -> Periodicity a
anyOf :: forall a. Ord a => NonEmpty (Periodicity a) -> Periodicity a
anyOf = (Periodicity a -> Periodicity a -> Periodicity a)
-> NonEmpty (Periodicity a) -> Periodicity a
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Periodicity a -> Periodicity a -> Periodicity a
forall a. Ord a => Periodicity a -> Periodicity a -> Periodicity a
(.||)

-- | Intersections of all periods
--
-- Same as
--
-- > allOf' = foldl (.&&) . always
--
-- __Warning:__ may loop infinitelly when impossible constraints, see '(.&&)'
allOf' :: (Foldable f, Ord a) => (a -> a) -> f (Periodicity a) -> Periodicity a
allOf' :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
(a -> a) -> f (Periodicity a) -> Periodicity a
allOf' = (Periodicity a -> Periodicity a -> Periodicity a)
-> Periodicity a -> f (Periodicity a) -> Periodicity a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Periodicity a -> Periodicity a -> Periodicity a
forall a. Ord a => Periodicity a -> Periodicity a -> Periodicity a
(.&&) (Periodicity a -> f (Periodicity a) -> Periodicity a)
-> ((a -> a) -> Periodicity a)
-> (a -> a)
-> f (Periodicity a)
-> Periodicity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> Periodicity a
forall a. (a -> a) -> Periodicity a
always

-- | Unions of all periods
--
-- Same as
--
-- > anyOf' = foldl (.||) never
anyOf' :: (Foldable f, Ord a) => f (Periodicity a) -> Periodicity a
anyOf' :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
f (Periodicity a) -> Periodicity a
anyOf' = (Periodicity a -> Periodicity a -> Periodicity a)
-> Periodicity a -> f (Periodicity a) -> Periodicity a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Periodicity a -> Periodicity a -> Periodicity a
forall a. Ord a => Periodicity a -> Periodicity a -> Periodicity a
(.||) Periodicity a
forall a. Periodicity a
never

-- * 'Unit'-based builders

-- | Happens when the 'Unit' has a value
--
-- Every hour at @*:05@
--
-- > at 5 minute
at :: (Eq i) => i -> Unit i a -> Periodicity a
at :: forall i a. Eq i => i -> Unit i a -> Periodicity a
at i
n Unit i a
u =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = (i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
n) (i -> Bool) -> (a -> i) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit i a
u.extract,
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod = Unit i a
u.nextUnitWith i
n
    }

-- | Happens when the 'Unit' has one of the values
--
-- Every hour at @*:05@ and @*:35@
--
-- > ats [5, 35] minute
--
-- Equivalent to
--
-- > at 5 minute .|| at 35 minute
ats :: (Ord i) => NE.NonEmpty i -> Unit i a -> Periodicity a
ats :: forall i a. Ord i => NonEmpty i -> Unit i a -> Periodicity a
ats NonEmpty i
ns Unit i a
u =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = (i -> NonEmpty i -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` NonEmpty i
ns') (i -> Bool) -> (a -> i) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit i a
u.extract,
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod = \a
x -> Unit i a
u.nextUnitWith (i -> i
nextCandidate (i -> i) -> i -> i
forall a b. (a -> b) -> a -> b
$ Unit i a
u.extract a
x) a
x
    }
  where
    ns' :: NonEmpty i
ns' = NonEmpty i -> NonEmpty i
forall a. Ord a => NonEmpty a -> NonEmpty a
NE.sort NonEmpty i
ns
    nextCandidate :: i -> i
nextCandidate i
x =
      case (i -> Bool) -> NonEmpty i -> [i]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.dropWhile (i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
x) NonEmpty i
ns' of
        (i
c : [i]
_) -> i
c
        [i]
_ -> NonEmpty i -> i
forall a. NonEmpty a -> a
NE.head NonEmpty i
ns'

-- | Happens when the 'Unit' has a value with a modulo
--
-- Every hour at @*:00@, @*:15@, @*:30@, and @*:45@
--
-- > every 15 minute
every :: (Integral i) => i -> Unit i a -> Periodicity a
every :: forall i a. Integral i => i -> Unit i a -> Periodicity a
every i
n Unit i a
u =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = ((i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
0) (i -> Bool) -> (i -> i) -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> i -> i) -> i -> i -> i
forall a b c. (a -> b -> c) -> b -> a -> c
flip i -> i -> i
forall a. Integral a => a -> a -> a
mod i
n) (i -> Bool) -> (a -> i) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit i a
u.extract,
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod = \a
x -> Unit i a
u.nextUnitWith (i -> i
nextCandidate (i -> i) -> i -> i
forall a b. (a -> b) -> a -> b
$ Unit i a
u.extract a
x) a
x
    }
  where
    nextCandidate :: i -> i
nextCandidate i
x = i
n i -> i -> i
forall a. Num a => a -> a -> a
* i -> i
forall a. Enum a => a -> a
succ (i
x i -> i -> i
forall a. Integral a => a -> a -> a
`div` i
n)

-- | Happens when the 'Unit' has a value in an inclusive range
--
-- Every hour at @*:05@, @*:06@, @*:07@, @*:08@, @*:09@, @*:10@
--
-- > inclusiveRange (Min 5) (Max 10) minute
inclusiveRange :: (Enum i, Ord i) => Min i -> Max i -> Unit i a -> Periodicity a
inclusiveRange :: forall i a.
(Enum i, Ord i) =>
Min i -> Max i -> Unit i a -> Periodicity a
inclusiveRange (Min i
lowerBound) (Max i
upperBound) Unit i a
u =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = (\i
n -> i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
lowerBound Bool -> Bool -> Bool
&& i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
upperBound) (i -> Bool) -> (a -> i) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit i a
u.extract,
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod = \a
x -> Unit i a
u.nextUnitWith (i -> i
nextCandidate (i -> i) -> i -> i
forall a b. (a -> b) -> a -> b
$ Unit i a
u.extract a
x) a
x
    }
  where
    nextCandidate :: i -> i
nextCandidate i
x =
      if i
x i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
upperBound
        then i -> i
forall a. Enum a => a -> a
succ i
x
        else i
lowerBound

-- * Absolute builders

-- | An event only hapenning /since/
sinceInclusive ::
  (Ord a) =>
  -- | Increment to next value
  (a -> a) ->
  a ->
  Periodicity a
sinceInclusive :: forall a. Ord a => (a -> a) -> a -> Periodicity a
sinceInclusive a -> a
f a
startingAt =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
startingAt),
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod =
        \a
x ->
          a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$
            if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
startingAt
              then a
startingAt
              else a -> a
f a
x
    }

-- | An event only hapenning /until/
untilInclusive ::
  (Ord a) =>
  -- | Increment to next value
  (a -> a) ->
  a ->
  Periodicity a
untilInclusive :: forall a. Ord a => (a -> a) -> a -> Periodicity a
untilInclusive a -> a
f a
endingAt =
  Periodicity
    { $sel:includes:Periodicity :: a -> Bool
includes = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
endingAt),
      $sel:nextPeriod:Periodicity :: a -> Maybe a
nextPeriod = (a -> Bool) -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
endingAt) (Maybe a -> Maybe a) -> (a -> Maybe a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f
    }