Moved back to dynamic dispatch and bench function

This commit is contained in:
Stefan Risberg 2023-04-17 13:11:02 +02:00
parent d781295480
commit cc0c6bc1e9

View File

@ -2,8 +2,9 @@ module Effects.Time (
currentTime, currentTime,
currentTimeB, currentTimeB,
currentTimeT, currentTimeT,
Time, benchFunction,
runTimeEff, runTimeEff,
Time,
) )
where where
@ -12,41 +13,31 @@ import Chronos qualified as C
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Lazy.Builder qualified as T import Data.Text.Lazy.Builder qualified as T
import Effectful 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 makeEffect ''Time
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
runTimeEff :: runTimeEff ::
IOE :> es => (IOE :> es) =>
Eff (Time : es) a -> Eff (Time : es) a ->
Eff 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)