{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.SSR.Clock.LiveClock () where

import Data.Text qualified as T
import Data.Time
import Free.AlaCarte
import Relude
import WikiMusic.SSR.Free.Clock

instance Exec Clock where
  execAlgebra :: forall a. Clock (IO a) -> IO a
execAlgebra (TimeElapsedUntilNow UTCTime
fromTime Text -> IO a
f) = do
    UTCTime -> IO Text
forall (m :: * -> *). MonadIO m => UTCTime -> m Text
diffWithNow UTCTime
fromTime IO Text -> (Text -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO a
f
  execAlgebra (Now UTCTime -> IO a
f) = do
    IO UTCTime
getCurrentTime IO UTCTime -> (UTCTime -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UTCTime -> IO a
f

diffWithNow :: (MonadIO m) => UTCTime -> m Text
diffWithNow :: forall (m :: * -> *). MonadIO m => UTCTime -> m Text
diffWithNow UTCTime
fromTime = do
  UTCTime
now' <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text)
-> (NominalDiffTime -> String) -> NominalDiffTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> String
forall b a. (Show a, IsString b) => a -> b
show (NominalDiffTime -> Text) -> NominalDiffTime -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now' UTCTime
fromTime