{-# OPTIONS_GHC -Wno-orphans #-}
-- | Definitions and instances for MTL compatibility.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Effectful.Internal.MTL where

import Control.Monad.Except qualified as MTL
import Control.Monad.Reader qualified as MTL
import Control.Monad.State qualified as MTL
import Control.Monad.Writer qualified as MTL
import GHC.Stack (CallStack)

import Effectful.Internal.Effect
import Effectful.Internal.Env
import Effectful.Internal.Monad

-- | Provide the ability to handle errors of type @e@.
data Error e :: Effect where
  -- | @since 2.4.0.0
  ThrowErrorWith :: (e -> String) -> e -> Error e m a
  CatchError :: m a -> (CallStack -> e -> m a) -> Error e m a

type instance DispatchOf (Error e) = Dynamic

-- | Instance included for compatibility with existing code.
instance
  ( Show e
  , Error e :> es
  , MTL.MonadError e (Eff es)
  ) => MTL.MonadError e (Eff es) where
  throwError :: forall a. e -> Eff es a
throwError = Error e (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 (Error e (Eff es) a -> Eff es a)
-> (e -> Error e (Eff es) a) -> e -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> String) -> e -> Error e (Eff es) a
forall e (m :: Type -> Type) a. (e -> String) -> e -> Error e m a
ThrowErrorWith e -> String
forall a. Show a => a -> String
show
  catchError :: forall a. Eff es a -> (e -> Eff es a) -> Eff es a
catchError Eff es a
action = Error e (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 (Error e (Eff es) a -> Eff es a)
-> ((e -> Eff es a) -> Error e (Eff es) a)
-> (e -> Eff es a)
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es a -> (CallStack -> e -> Eff es a) -> Error e (Eff es) a
forall (m :: Type -> Type) a e.
m a -> (CallStack -> e -> m a) -> Error e m a
CatchError Eff es a
action ((CallStack -> e -> Eff es a) -> Error e (Eff es) a)
-> ((e -> Eff es a) -> CallStack -> e -> Eff es a)
-> (e -> Eff es a)
-> Error e (Eff es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Eff es a) -> CallStack -> e -> Eff es a
forall a b. a -> b -> a
const

----------------------------------------

data Reader r :: Effect where
  Ask   :: Reader r m r
  Local :: (r -> r) -> m a -> Reader r m a

type instance DispatchOf (Reader r) = Dynamic

-- | Instance included for compatibility with existing code.
instance
  ( Reader r :> es
  , MTL.MonadReader r (Eff es)
  ) => MTL.MonadReader r (Eff es) where
  ask :: Eff es r
ask = Reader r (Eff es) r -> Eff es r
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Reader r (Eff es) r
forall r (m :: Type -> Type). Reader r m r
Ask
  local :: forall a. (r -> r) -> Eff es a -> Eff es a
local r -> r
f = Reader r (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 (Reader r (Eff es) a -> Eff es a)
-> (Eff es a -> Reader r (Eff es) a) -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> Eff es a -> Reader r (Eff es) a
forall r (m :: Type -> Type) a. (r -> r) -> m a -> Reader r m a
Local r -> r
f
  reader :: forall a. (r -> a) -> Eff es a
reader r -> a
f = r -> a
f (r -> a) -> Eff es r -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader r (Eff es) r -> Eff es r
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Reader r (Eff es) r
forall r (m :: Type -> Type). Reader r m r
Ask

----------------------------------------

-- | Provide access to a mutable value of type @s@.
data State s :: Effect where
  Get    :: State s m s
  Put    :: s -> State s m ()
  State  :: (s ->   (a, s)) -> State s m a
  StateM :: (s -> m (a, s)) -> State s m a

type instance DispatchOf (State s) = Dynamic

-- | Instance included for compatibility with existing code.
instance
  ( State s :> es
  , MTL.MonadState s (Eff es)
  ) => MTL.MonadState s (Eff es) where
  get :: Eff es s
get = State s (Eff es) s -> Eff es s
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send State s (Eff es) s
forall s (m :: Type -> Type). State s m s
Get
  put :: s -> Eff es ()
put = State s (Eff es) () -> Eff es ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (State s (Eff es) () -> Eff es ())
-> (s -> State s (Eff es) ()) -> s -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> State s (Eff es) ()
forall s (m :: Type -> Type). s -> State s m ()
Put
  state :: forall a. (s -> (a, s)) -> Eff es a
state = State s (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 (State s (Eff es) a -> Eff es a)
-> ((s -> (a, s)) -> State s (Eff es) a)
-> (s -> (a, s))
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> State s (Eff es) a
forall s a (m :: Type -> Type). (s -> (a, s)) -> State s m a
State

----------------------------------------

-- | Provide access to a write only value of type @w@.
data Writer w :: Effect where
  Tell   :: w   -> Writer w m ()
  Listen :: m a -> Writer w m (a, w)

type instance DispatchOf (Writer w) = Dynamic

-- | Instance included for compatibility with existing code.
instance
  ( Monoid w
  , Writer w :> es
  , MTL.MonadWriter w (Eff es)
  ) => MTL.MonadWriter w (Eff es) where
  writer :: forall a. (a, w) -> Eff es a
writer (a
a, w
w) = a
a a -> Eff es () -> Eff es a
forall a b. a -> Eff es b -> Eff es a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ Writer w (Eff es) () -> Eff es ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (w -> Writer w (Eff es) ()
forall w (m :: Type -> Type). w -> Writer w m ()
Tell w
w)
  tell :: w -> Eff es ()
tell = Writer w (Eff es) () -> Eff es ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Writer w (Eff es) () -> Eff es ())
-> (w -> Writer w (Eff es) ()) -> w -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Writer w (Eff es) ()
forall w (m :: Type -> Type). w -> Writer w m ()
Tell
  listen :: forall a. Eff es a -> Eff es (a, w)
listen = Writer w (Eff es) (a, w) -> Eff es (a, w)
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Writer w (Eff es) (a, w) -> Eff es (a, w))
-> (Eff es a -> Writer w (Eff es) (a, w))
-> Eff es a
-> Eff es (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es a -> Writer w (Eff es) (a, w)
forall (m :: Type -> Type) a w. m a -> Writer w m (a, w)
Listen
  pass :: forall a. Eff es (a, w -> w) -> Eff es a
pass = String -> Eff es (a, w -> w) -> Eff es a
forall a. HasCallStack => String -> a
error String
"pass is not implemented due to ambiguous semantics in presence of runtime exceptions"