diff --git a/package.yaml b/package.yaml index 2165dfc..394c08b 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: ris-utils -version: 0.0.1 +version: 0.0.2 homepage: "https://git.fiskhamn.se/steffenomak/ris-utils#readme" license: BSD3 author: "Stefan Risberg" diff --git a/ris-utils.cabal b/ris-utils.cabal index 2ab5e02..f29b4d9 100644 --- a/ris-utils.cabal +++ b/ris-utils.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: ris-utils -version: 0.0.1 +version: 0.0.2 description: Please see the README at homepage: https://git.fiskhamn.se/steffenomak/ris-utils#readme author: Stefan Risberg diff --git a/src/Effects/Time.hs b/src/Effects/Time.hs index 2e196c6..6be9bea 100644 --- a/src/Effects/Time.hs +++ b/src/Effects/Time.hs @@ -2,8 +2,8 @@ module Effects.Time ( currentTime, currentTimeB, currentTimeT, - runTimeEff, Time, + runTimeEff, ) where @@ -12,25 +12,41 @@ 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 -data Time :: Effect where - CurrentTime :: Time m C.Time - CurrentTimeB :: Time m T.Builder - CurrentTimeT :: Time m Text +import Effectful.Dispatch.Static -makeEffect ''Time +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 runTimeEff :: - (IOE :> es) => + IOE :> es => Eff (Time : es) a -> Eff es a -runTimeEff = interpret $ \_ -> \case - CurrentTime -> liftIO now - CurrentTimeB -> - builder_YmdHMS (SubsecondPrecisionFixed 4) w3c . timeToDatetime - <$> liftIO now - CurrentTimeT -> - encode_YmdHMS (SubsecondPrecisionFixed 4) w3c . timeToDatetime - <$> liftIO now +runTimeEff = evalStaticRep (Time ())