{-# options_haddock prune #-}

-- |Time interpreters for "Chronos", Internal
module Polysemy.Chronos.Interpreter.Time where

import qualified Chronos as Chronos
import Chronos (Timespan (Timespan), dateToDay, dayToDate, dayToTimeMidnight, timeToDayTruncate)
import Polysemy.Time.At (interceptTimeAt, interceptTimeConstant, interceptTimeConstantNow)
import qualified Polysemy.Time.Effect.Time as Core
import Polysemy.Time.Effect.Time (Time)
import Polysemy.Time.Sleep (tSleep)

import Polysemy.Chronos.Orphans ()

-- |Convenience alias for "Chronos".
type ChronosTime =
  Time Chronos.Time Chronos.Date

now ::
  Member (Embed IO) r =>
  Sem r Chronos.Time
now :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Sem r Time
now =
  IO Time -> Sem r Time
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO Time
Chronos.now

timeToDate :: Chronos.Time -> Chronos.Date
timeToDate :: Time -> Date
timeToDate =
  Day -> Date
dayToDate (Day -> Date) -> (Time -> Day) -> Time -> Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Day
timeToDayTruncate

dateToTime :: Chronos.Date -> Chronos.Time
dateToTime :: Date -> Time
dateToTime =
  Day -> Time
dayToTimeMidnight (Day -> Time) -> (Date -> Day) -> Date -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Day
dateToDay

-- |Interpret 'Time' with the types from "Chronos".
interpretTimeChronos ::
  Member (Embed IO) r =>
  InterpreterFor ChronosTime r
interpretTimeChronos :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
interpretTimeChronos =
  (forall (rInitial :: [(* -> *) -> * -> *]) x.
 ChronosTime (Sem rInitial) x -> Sem r x)
-> Sem (ChronosTime : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    ChronosTime (Sem rInitial) x
Core.Now ->
      Sem r x
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Sem r Time
now
    ChronosTime (Sem rInitial) x
Core.Today ->
      Time -> Date
timeToDate (Time -> Date) -> Sem r Time -> Sem r Date
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r Time
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Sem r Time
now
    Core.Sleep u
t ->
      u -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) t.
(Member (Embed IO) r, TimeUnit t) =>
t -> Sem r ()
tSleep u
t
    Core.SetTime Time
_ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit
    Core.Adjust u1
_ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit
    Core.SetDate Date
_ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit
{-# inline interpretTimeChronos #-}

-- |Interpret 'Time' with the types from "Chronos", customizing the current time at the start of interpretation.
interpretTimeChronosAt ::
  Member (Embed IO) r =>
  Chronos.Time ->
  InterpreterFor ChronosTime r
interpretTimeChronosAt :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Time -> InterpreterFor ChronosTime r
interpretTimeChronosAt Time
t =
  Sem (ChronosTime : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
interpretTimeChronos (Sem (ChronosTime : r) a -> Sem r a)
-> (Sem (ChronosTime : r) a -> Sem (ChronosTime : r) a)
-> Sem (ChronosTime : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall diff t d (r :: [(* -> *) -> * -> *]) a.
(TimeUnit diff, Torsor t diff, HasDate t d,
 Members '[Time t d, Embed IO] r) =>
t -> Sem r a -> Sem r a
interceptTimeAt @Timespan Time
t
{-# inline interpretTimeChronosAt #-}

-- |Interpret 'Time' with the types from "Chronos", customizing the current time to be constant.
interpretTimeChronosConstant ::
  Member (Embed IO) r =>
  Chronos.Time ->
  InterpreterFor ChronosTime r
interpretTimeChronosConstant :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Time -> InterpreterFor ChronosTime r
interpretTimeChronosConstant Time
t =
  Sem (ChronosTime : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
interpretTimeChronos (Sem (ChronosTime : r) a -> Sem r a)
-> (Sem (ChronosTime : r) a -> Sem (ChronosTime : r) a)
-> Sem (ChronosTime : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Sem (ChronosTime : r) a -> Sem (ChronosTime : r) a
forall t d diff (r :: [(* -> *) -> * -> *]) a.
(Ord diff, HasDate t d, TimeUnit diff, Torsor t diff,
 Members '[Time t d, Embed IO] r) =>
t -> Sem r a -> Sem r a
interceptTimeConstant Time
t
{-# inline interpretTimeChronosConstant #-}

-- |Interpret 'Time' with the types from "Chronos", customizing the current time to be constantly the time at the
-- start of interpretation.
interpretTimeChronosConstantNow ::
  Member (Embed IO) r =>
  InterpreterFor ChronosTime r
interpretTimeChronosConstantNow :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
interpretTimeChronosConstantNow =
  Sem (ChronosTime : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
interpretTimeChronos (Sem (ChronosTime : r) a -> Sem r a)
-> (Sem (ChronosTime : r) a -> Sem (ChronosTime : r) a)
-> Sem (ChronosTime : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t d diff (r :: [(* -> *) -> * -> *]) a.
(Ord diff, HasDate t d, TimeUnit diff, Torsor t diff,
 Members '[Time t d, Embed IO] r) =>
Sem r a -> Sem r a
interceptTimeConstantNow @Chronos.Time
{-# inline interpretTimeChronosConstantNow #-}

negateTimespan :: Timespan -> Timespan
negateTimespan :: Timespan -> Timespan
negateTimespan (Timespan Int64
t) =
  Int64 -> Timespan
Timespan (-Int64
t)