module Polysemy.Time.Ghc where

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

import Polysemy.Time.At (interpretTimeAt)
import qualified Polysemy.Time.Data.Time as Time
import Polysemy.Time.Data.Time (Time)
import Polysemy.Time.Data.TimeUnit (MicroSeconds(MicroSeconds), convert)
import Polysemy.Time.Orphans ()

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

now ::
  Member (Embed IO) r =>
  Sem r UTCTime
now :: 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 :: InterpreterFor GhcTime r
interpretTimeGhc =
  (forall x (rInitial :: [(* -> *) -> * -> *]).
 GhcTime (Sem rInitial) x -> Sem r x)
-> Sem (GhcTime : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: [(* -> *) -> * -> *]).
 e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Time.Now ->
      Sem r x
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Sem r UTCTime
now
    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 (convert -> MicroSeconds 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 _ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit
    Time.Adjust _ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit
    Time.SetDate _ ->
      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 :: UTCTime -> InterpreterFor GhcTime r
interpretTimeGhcAt =
  Sem (GhcTime : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor GhcTime r
interpretTimeGhc (Sem (GhcTime : r) a -> Sem r a)
-> (UTCTime -> Sem (GhcTime : r) a -> Sem (GhcTime : r) a)
-> UTCTime
-> Sem (GhcTime : r) a
-> Sem r a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall t d (r :: [(* -> *) -> * -> *]) a.
(TimeUnit NominalDiffTime, Torsor t NominalDiffTime, HasDate t d,
 Members '[Time t d, Embed IO] r) =>
t -> Sem r a -> Sem r a
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
interpretTimeAt @NominalDiffTime