{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} module Control.Effect.Time where import Control.Algebra import Control.Carrier.Lift import Control.Monad.IO.Class import Data.Functor import Data.Kind import Data.Time (ZonedTime) import qualified Data.Time as T data Time (m :: Type -> Type) k where GetZonedTime :: Time m ZonedTime getZonedTime :: Has Time sig m => m ZonedTime getZonedTime :: m ZonedTime getZonedTime = Time m ZonedTime -> m ZonedTime forall (eff :: (Type -> Type) -> Type -> Type) (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. (Member eff sig, Algebra sig m) => eff m a -> m a send Time m ZonedTime forall (m :: Type -> Type). Time m ZonedTime GetZonedTime newtype TimeC m a = TimeC {TimeC m a -> m a runTimeC :: m a} deriving newtype (a -> TimeC m b -> TimeC m a (a -> b) -> TimeC m a -> TimeC m b (forall a b. (a -> b) -> TimeC m a -> TimeC m b) -> (forall a b. a -> TimeC m b -> TimeC m a) -> Functor (TimeC m) forall a b. a -> TimeC m b -> TimeC m a forall a b. (a -> b) -> TimeC m a -> TimeC m b forall (m :: Type -> Type) a b. Functor m => a -> TimeC m b -> TimeC m a forall (m :: Type -> Type) a b. Functor m => (a -> b) -> TimeC m a -> TimeC m b forall (f :: Type -> Type). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> TimeC m b -> TimeC m a $c<$ :: forall (m :: Type -> Type) a b. Functor m => a -> TimeC m b -> TimeC m a fmap :: (a -> b) -> TimeC m a -> TimeC m b $cfmap :: forall (m :: Type -> Type) a b. Functor m => (a -> b) -> TimeC m a -> TimeC m b Functor, Functor (TimeC m) a -> TimeC m a Functor (TimeC m) -> (forall a. a -> TimeC m a) -> (forall a b. TimeC m (a -> b) -> TimeC m a -> TimeC m b) -> (forall a b c. (a -> b -> c) -> TimeC m a -> TimeC m b -> TimeC m c) -> (forall a b. TimeC m a -> TimeC m b -> TimeC m b) -> (forall a b. TimeC m a -> TimeC m b -> TimeC m a) -> Applicative (TimeC m) TimeC m a -> TimeC m b -> TimeC m b TimeC m a -> TimeC m b -> TimeC m a TimeC m (a -> b) -> TimeC m a -> TimeC m b (a -> b -> c) -> TimeC m a -> TimeC m b -> TimeC m c forall a. a -> TimeC m a forall a b. TimeC m a -> TimeC m b -> TimeC m a forall a b. TimeC m a -> TimeC m b -> TimeC m b forall a b. TimeC m (a -> b) -> TimeC m a -> TimeC m b forall a b c. (a -> b -> c) -> TimeC m a -> TimeC m b -> TimeC m c forall (f :: Type -> Type). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f forall (m :: Type -> Type). Applicative m => Functor (TimeC m) forall (m :: Type -> Type) a. Applicative m => a -> TimeC m a forall (m :: Type -> Type) a b. Applicative m => TimeC m a -> TimeC m b -> TimeC m a forall (m :: Type -> Type) a b. Applicative m => TimeC m a -> TimeC m b -> TimeC m b forall (m :: Type -> Type) a b. Applicative m => TimeC m (a -> b) -> TimeC m a -> TimeC m b forall (m :: Type -> Type) a b c. Applicative m => (a -> b -> c) -> TimeC m a -> TimeC m b -> TimeC m c <* :: TimeC m a -> TimeC m b -> TimeC m a $c<* :: forall (m :: Type -> Type) a b. Applicative m => TimeC m a -> TimeC m b -> TimeC m a *> :: TimeC m a -> TimeC m b -> TimeC m b $c*> :: forall (m :: Type -> Type) a b. Applicative m => TimeC m a -> TimeC m b -> TimeC m b liftA2 :: (a -> b -> c) -> TimeC m a -> TimeC m b -> TimeC m c $cliftA2 :: forall (m :: Type -> Type) a b c. Applicative m => (a -> b -> c) -> TimeC m a -> TimeC m b -> TimeC m c <*> :: TimeC m (a -> b) -> TimeC m a -> TimeC m b $c<*> :: forall (m :: Type -> Type) a b. Applicative m => TimeC m (a -> b) -> TimeC m a -> TimeC m b pure :: a -> TimeC m a $cpure :: forall (m :: Type -> Type) a. Applicative m => a -> TimeC m a $cp1Applicative :: forall (m :: Type -> Type). Applicative m => Functor (TimeC m) Applicative, Applicative (TimeC m) a -> TimeC m a Applicative (TimeC m) -> (forall a b. TimeC m a -> (a -> TimeC m b) -> TimeC m b) -> (forall a b. TimeC m a -> TimeC m b -> TimeC m b) -> (forall a. a -> TimeC m a) -> Monad (TimeC m) TimeC m a -> (a -> TimeC m b) -> TimeC m b TimeC m a -> TimeC m b -> TimeC m b forall a. a -> TimeC m a forall a b. TimeC m a -> TimeC m b -> TimeC m b forall a b. TimeC m a -> (a -> TimeC m b) -> TimeC m b forall (m :: Type -> Type). Monad m => Applicative (TimeC m) forall (m :: Type -> Type) a. Monad m => a -> TimeC m a forall (m :: Type -> Type) a b. Monad m => TimeC m a -> TimeC m b -> TimeC m b forall (m :: Type -> Type) a b. Monad m => TimeC m a -> (a -> TimeC m b) -> TimeC m b forall (m :: Type -> Type). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m return :: a -> TimeC m a $creturn :: forall (m :: Type -> Type) a. Monad m => a -> TimeC m a >> :: TimeC m a -> TimeC m b -> TimeC m b $c>> :: forall (m :: Type -> Type) a b. Monad m => TimeC m a -> TimeC m b -> TimeC m b >>= :: TimeC m a -> (a -> TimeC m b) -> TimeC m b $c>>= :: forall (m :: Type -> Type) a b. Monad m => TimeC m a -> (a -> TimeC m b) -> TimeC m b $cp1Monad :: forall (m :: Type -> Type). Monad m => Applicative (TimeC m) Monad, Monad (TimeC m) Monad (TimeC m) -> (forall a. IO a -> TimeC m a) -> MonadIO (TimeC m) IO a -> TimeC m a forall a. IO a -> TimeC m a forall (m :: Type -> Type). Monad m -> (forall a. IO a -> m a) -> MonadIO m forall (m :: Type -> Type). MonadIO m => Monad (TimeC m) forall (m :: Type -> Type) a. MonadIO m => IO a -> TimeC m a liftIO :: IO a -> TimeC m a $cliftIO :: forall (m :: Type -> Type) a. MonadIO m => IO a -> TimeC m a $cp1MonadIO :: forall (m :: Type -> Type). MonadIO m => Monad (TimeC m) MonadIO) instance Has (Lift IO) sig m => Algebra (Time :+: sig) (TimeC m) where alg :: Handler ctx n (TimeC m) -> (:+:) Time sig n a -> ctx () -> TimeC m (ctx a) alg Handler ctx n (TimeC m) hdl (:+:) Time sig n a sig ctx () ctx = m (ctx a) -> TimeC m (ctx a) forall (m :: Type -> Type) a. m a -> TimeC m a TimeC (m (ctx a) -> TimeC m (ctx a)) -> m (ctx a) -> TimeC m (ctx a) forall a b. (a -> b) -> a -> b $ case (:+:) Time sig n a sig of L Time n a GetZonedTime -> do ZonedTime tz <- IO ZonedTime -> m ZonedTime forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. Has (Lift IO) sig m => IO a -> m a sendIO IO ZonedTime T.getZonedTime ctx ZonedTime -> m (ctx ZonedTime) forall (f :: Type -> Type) a. Applicative f => a -> f a pure (ctx () ctx ctx () -> ZonedTime -> ctx ZonedTime forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b $> ZonedTime tz) R sig n a other -> Handler ctx n m -> sig n a -> ctx () -> m (ctx a) forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) (ctx :: Type -> Type) (n :: Type -> Type) a. (Algebra sig m, Functor ctx) => Handler ctx n m -> sig n a -> ctx () -> m (ctx a) alg (TimeC m (ctx x) -> m (ctx x) forall (m :: Type -> Type) a. TimeC m a -> m a runTimeC (TimeC m (ctx x) -> m (ctx x)) -> (ctx (n x) -> TimeC m (ctx x)) -> ctx (n x) -> m (ctx x) forall b c a. (b -> c) -> (a -> b) -> a -> c . ctx (n x) -> TimeC m (ctx x) Handler ctx n (TimeC m) hdl) sig n a other ctx () ctx