From cc0c6bc1e98434bcce9f5692cf7442d964ddaf5d Mon Sep 17 00:00:00 2001
From: Stefan Risberg <stefan.risberg@teliacompany.com>
Date: Mon, 17 Apr 2023 13:11:02 +0200
Subject: [PATCH] Moved back to dynamic dispatch and bench function

---
 src/Effects/Time.hs | 57 +++++++++++++++++++--------------------------
 1 file changed, 24 insertions(+), 33 deletions(-)

diff --git a/src/Effects/Time.hs b/src/Effects/Time.hs
index 6be9bea..ca51046 100644
--- a/src/Effects/Time.hs
+++ b/src/Effects/Time.hs
@@ -2,8 +2,9 @@ module Effects.Time (
   currentTime,
   currentTimeB,
   currentTimeT,
-  Time,
+  benchFunction,
   runTimeEff,
+  Time,
 )
 where
 
@@ -12,41 +13,31 @@ import Chronos qualified as C
 import Data.Text (Text)
 import Data.Text.Lazy.Builder qualified as T
 import Effectful
+import Effectful.Dispatch.Dynamic
+import Effectful.TH
 
-import Effectful.Dispatch.Static
+data Time :: Effect where
+  CurrentTime :: Time m C.Time
+  CurrentTimeB :: Time m T.Builder
+  CurrentTimeT :: Time m Text
+  BenchFunction :: m a -> Time m (Timespan, a)
 
-data Time :: Effect
-
-type instance DispatchOf Time = 'Static 'WithSideEffects
-newtype instance StaticRep Time = Time ()
-
-currentTime ::
-  Time :> es =>
-  Eff es C.Time
-currentTime = do
-  Time _ <- getStaticRep
-  unsafeEff_ now
-
-currentTimeB ::
-  Time :> es =>
-  Eff es T.Builder
-currentTimeB = do
-  Time _ <- getStaticRep
-  unsafeEff_ $
-    builder_YmdHMS (SubsecondPrecisionFixed 4) w3c . timeToDatetime
-      <$> now
-
-currentTimeT ::
-  Time :> es =>
-  Eff es Text
-currentTimeT = do
-  Time _ <- getStaticRep
-  unsafeEff_ $
-    encode_YmdHMS (SubsecondPrecisionFixed 4) w3c . timeToDatetime
-      <$> now
+makeEffect ''Time
 
 runTimeEff ::
-  IOE :> es =>
+  (IOE :> es) =>
   Eff (Time : es) a ->
   Eff es a
-runTimeEff = evalStaticRep (Time ())
+runTimeEff = interpret $ \env -> \case
+  CurrentTime -> liftIO now
+  CurrentTimeB ->
+    builder_YmdHMS (SubsecondPrecisionFixed 4) w3c . timeToDatetime
+      <$> liftIO now
+  CurrentTimeT ->
+    encode_YmdHMS (SubsecondPrecisionFixed 4) w3c . timeToDatetime
+      <$> liftIO now
+  BenchFunction f -> do
+    s <- liftIO now
+    !d <- localSeqUnlift env $ \unlift -> unlift f
+    e <- liftIO now
+    pure (C.width $ s ... e, d)