module WikiMusic.SSR.Free.Clock
  ( timeElapsedUntilNow,
    now,
    Clock (..),
  )
where

import Data.Time
import Free.AlaCarte
import Relude

type Clock :: Type -> Type
data Clock a
  = TimeElapsedUntilNow UTCTime (Text -> a)
  | Now (UTCTime -> a)
  deriving ((forall a b. (a -> b) -> Clock a -> Clock b)
-> (forall a b. a -> Clock b -> Clock a) -> Functor Clock
forall a b. a -> Clock b -> Clock a
forall a b. (a -> b) -> Clock a -> Clock b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Clock a -> Clock b
fmap :: forall a b. (a -> b) -> Clock a -> Clock b
$c<$ :: forall a b. a -> Clock b -> Clock a
<$ :: forall a b. a -> Clock b -> Clock a
Functor)

timeElapsedUntilNow :: (Clock :<: f) => UTCTime -> Free f Text
timeElapsedUntilNow :: forall (f :: * -> *). (Clock :<: f) => UTCTime -> Free f Text
timeElapsedUntilNow UTCTime
fromTime = Clock (Free f Text) -> Free f Text
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (UTCTime -> (Text -> Free f Text) -> Clock (Free f Text)
forall a. UTCTime -> (Text -> a) -> Clock a
TimeElapsedUntilNow UTCTime
fromTime Text -> Free f Text
forall (f :: * -> *) a. a -> Free f a
Pure)

now :: (Clock :<: f) => Free f UTCTime
now :: forall (f :: * -> *). (Clock :<: f) => Free f UTCTime
now = Clock (Free f UTCTime) -> Free f UTCTime
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree ((UTCTime -> Free f UTCTime) -> Clock (Free f UTCTime)
forall a. (UTCTime -> a) -> Clock a
Now UTCTime -> Free f UTCTime
forall (f :: * -> *) a. a -> Free f a
Pure)