{-# options_haddock prune #-}

-- |'Time' interpreters for the data types from "Data.Time", Internal
module Polysemy.Time.Interpreter.Ghc where

import Control.Concurrent (threadDelay)
import Data.Time (Day, NominalDiffTime, UTCTime, utctDay)
import Data.Time.Clock.System (getSystemTime, systemToUTCTime)

import Polysemy.Time.At (interceptTimeAt, interceptTimeConstant, interceptTimeConstantNow)
import Polysemy.Time.Data.TimeUnit (MicroSeconds (MicroSeconds), convert)
import qualified Polysemy.Time.Effect.Time as Time
import Polysemy.Time.Effect.Time (Time)
import Polysemy.Time.Orphans ()

-- |Convenience alias for 'Data.Time'.
type GhcTime =
  Time UTCTime Day

now ::
  Member (Embed IO) r =>
  Sem r UTCTime
now :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Sem r UTCTime
now =
  SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime) -> Sem r SystemTime -> Sem r UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> Sem r SystemTime
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO SystemTime
getSystemTime

-- |Interpret 'Time' with the types from 'Data.Time'.
interpretTimeGhc ::
  Member (Embed IO) r =>
  InterpreterFor GhcTime r
interpretTimeGhc :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhc =
  (forall (rInitial :: [(* -> *) -> * -> *]) x.
 GhcTime (Sem rInitial) x -> Sem r x)
-> Sem (GhcTime : 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
    GhcTime (Sem rInitial) x
Time.Now ->
      Sem r x
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Sem r UTCTime
now
    GhcTime (Sem rInitial) x
Time.Today ->
      UTCTime -> Day
utctDay (UTCTime -> Day) -> Sem r UTCTime -> Sem r Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r UTCTime
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Sem r UTCTime
now
    Time.Sleep (u -> MicroSeconds
forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert -> MicroSeconds Int64
us) ->
      IO () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Int -> IO ()
threadDelay (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
us))
    Time.SetTime UTCTime
_ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit
    Time.Adjust u1
_ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit
    Time.SetDate Day
_ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit

-- |Interpret 'Time' with the types from 'Data.Time', customizing the current time at the start of interpretation.
interpretTimeGhcAt ::
  Member (Embed IO) r =>
  UTCTime ->
  InterpreterFor GhcTime r
interpretTimeGhcAt :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
UTCTime -> InterpreterFor GhcTime r
interpretTimeGhcAt UTCTime
t =
  Sem (GhcTime : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhc (Sem (GhcTime : r) a -> Sem r a)
-> (Sem (GhcTime : r) a -> Sem (GhcTime : r) a)
-> Sem (GhcTime : 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 @NominalDiffTime UTCTime
t

-- |Interpret 'Time' with the types from 'Data.Time', customizing the current time to be constant.
-- Sleeping will only terminate after the time has been advanced by `Time.adjust`.
interpretTimeGhcConstant ::
  Member (Embed IO) r =>
  UTCTime ->
  InterpreterFor GhcTime r
interpretTimeGhcConstant :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
UTCTime -> InterpreterFor GhcTime r
interpretTimeGhcConstant UTCTime
t =
  Sem (GhcTime : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhc (Sem (GhcTime : r) a -> Sem r a)
-> (Sem (GhcTime : r) a -> Sem (GhcTime : r) a)
-> Sem (GhcTime : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Sem (GhcTime : r) a -> Sem (GhcTime : 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 UTCTime
t

-- |Interpret 'Time' with the types from 'Data.Time', customizing the current time to be constantly the time at the
-- start of interpretation.
-- Sleeping will only terminate after the time has been advanced by `Time.adjust`.
interpretTimeGhcConstantNow ::
  Member (Embed IO) r =>
  InterpreterFor GhcTime r
interpretTimeGhcConstantNow :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhcConstantNow =
  Sem (GhcTime : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhc (Sem (GhcTime : r) a -> Sem r a)
-> (Sem (GhcTime : r) a -> Sem (GhcTime : r) a)
-> Sem (GhcTime : 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 @UTCTime