{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Access to a Redis database via 'MonadRedis'.
module Effectful.Redis
  ( -- * Effect
    Redis (..)

    -- * Handler
  , runRedis
  )
where

import Database.Redis qualified as R
import Effectful
import Effectful.Dispatch.Dynamic

-- | Provide the ability to use the 'R.MonadRedis' instance of 'Eff'.
data Redis :: Effect where
  LiftRedis :: R.Redis a -> Redis m a

type instance DispatchOf Redis = Dynamic

-- | Run the 'Redis' effect.
runRedis :: IOE :> es => R.Connection -> Eff (Redis : es) a -> Eff es a
runRedis :: forall (es :: [Effect]) a.
(IOE :> es) =>
Connection -> Eff (Redis : es) a -> Eff es a
runRedis Connection
conn = EffectHandler Redis es -> Eff (Redis : es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler Redis es -> Eff (Redis : es) a -> Eff es a)
-> EffectHandler Redis es -> Eff (Redis : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs es
_ -> \case
  LiftRedis Redis a
action -> IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Connection -> Redis a -> IO a
forall a. Connection -> Redis a -> IO a
R.runRedis Connection
conn Redis a
action

----------------------------------------
-- Orphan instance

instance Redis :> es => R.MonadRedis (Eff es) where
  liftRedis :: forall a. Redis a -> Eff es a
liftRedis = Redis (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Redis (Eff es) a -> Eff es a)
-> (Redis a -> Redis (Eff es) a) -> Redis a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis a -> Redis (Eff es) a
forall a (m :: Type -> Type). Redis a -> Redis m a
LiftRedis