@@ -14,6 +14,7 @@ module Effectful.Interpreter
16import Control.Monad.Catch
16import Control.Monad.Catch
18import Effectful.Internal.Effect
19import Effectful.Internal.Effect
19import Effectful.Internal.Env
20import Effectful.Internal.Env
@@ -24,8 +25,10 @@ import Effectful.Internal.Monad
25data Interpreter (e :: Effect) = forall localEs. Interpreter
26data Interpreter (e :: Effect) = forall localEs. Interpreter
26 { _env :: Env localEs
27 { _env :: Env localEs
28+ , _interpret :: forall a es. HasCallStack
27− , _interpret :: forall a es. (forall r. Eff es r -> IO r)
29+ => (forall r. Eff es r -> IO r)
28− -> e (Eff es) a -> Eff localEs a
31+ -> Eff localEs a
31runInterpreter :: Env es -> Interpreter e -> Eff (e : es) a -> IO a
34runInterpreter :: Env es -> Interpreter e -> Eff (e : es) a -> IO a
@@ -44,7 +47,7 @@ runInterpreter es0 e (Eff m) = do
44-- Sending commands
47-- Sending commands
46-- | Send an operation of a given effect to the interpreter.
49-- | Send an operation of a given effect to the interpreter.
47−send :: e :> es => e (Eff es) a -> Eff es a
50+send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
48send op = readerEffectM $ \Interpreter{..} -> do
51send op = readerEffectM $ \Interpreter{..} -> do
49 unsafeUnliftEff $ \run -> unEff (_interpret run op) _env
52 unsafeUnliftEff $ \run -> unEff (_interpret run op) _env
@@ -53,28 +56,32 @@ send op = readerEffectM $ \Interpreter{..} -> do
54-- | Interpret a first order effect.
57-- | Interpret a first order effect.
56− :: (forall r es. e (Eff es) r -> Eff baseEs r)
59+ :: (forall r es. HasCallStack => e (Eff es) r -> Eff baseEs r)
57 -> Eff (e : baseEs) a
60 -> Eff (e : baseEs) a
58 -> Eff baseEs a
61 -> Eff baseEs a
59−interpret f = interpretIO $ \_ -> f
62+interpret interpreter m = unsafeEff $ \es -> do
64+ runInterpreter es (Interpreter les $ \_ -> interpreter) m
61-- | Interpret a higher order effect with help of a natural transformation from
66-- | Interpret a higher order effect with help of a natural transformation from
62-- 'Eff' to 'Eff'.
67-- 'Eff' to 'Eff'.
64− :: (forall r es. (forall t. Eff es t -> Eff baseEs t) -> e (Eff es) r -> Eff baseEs r)
69+ :: (forall r es. HasCallStack => (forall t. Eff es t -> Eff baseEs t) -> e (Eff es) r -> Eff baseEs r)
65 -> Eff (e : baseEs) a
70 -> Eff (e : baseEs) a
66 -> Eff baseEs a
71 -> Eff baseEs a
67−interpretM f = interpretIO $ \k -> f $ unsafeEff_ . k
72+interpretM interpreter m = unsafeEff $ \es -> do
74+ runInterpreter es (Interpreter les $ \k -> interpreter $ unsafeEff_ . k) m
69-- | Interpret a higher order effect with help of a natural transformation from
76-- | Interpret a higher order effect with help of a natural transformation from
70-- 'Eff' to 'IO'.
77-- 'Eff' to 'IO'.
71interpretIO
78interpretIO
72− :: (forall r es. (forall t. Eff es t -> IO t) -> e (Eff es) r -> Eff baseEs r)
79+ :: (forall r es. HasCallStack => (forall t. Eff es t -> IO t) -> e (Eff es) r -> Eff baseEs r)
73 -> Eff (e : baseEs) a
80 -> Eff (e : baseEs) a
74 -> Eff baseEs a
81 -> Eff baseEs a
75−interpretIO f m = unsafeEff $ \es -> do
82+interpretIO interpreter m = unsafeEff $ \es -> do
76 les <- forkEnv es
83 les <- forkEnv es
77− runInterpreter es (Interpreter les f) m
84+ runInterpreter es (Interpreter les interpreter) m
79----------------------------------------
86----------------------------------------
80-- Reinterpretation
87-- Reinterpretation
@@ -82,28 +89,34 @@ interpretIO f m = unsafeEff $ \es -> do
82-- | Reinterpret local effects as a first order effect.
89-- | Reinterpret local effects as a first order effect.
83reinterpret
90reinterpret
84 :: (Eff localEs a -> Eff baseEs b)
91 :: (Eff localEs a -> Eff baseEs b)
85− -> (forall r es. e (Eff es) r -> Eff localEs r)
92+ -> (forall r es. HasCallStack => e (Eff es) r -> Eff localEs r)
86 -> Eff (e : baseEs) a
93 -> Eff (e : baseEs) a
87 -> Eff baseEs b
94 -> Eff baseEs b
88−reinterpret runLocal f = reinterpretIO runLocal $ \_ -> f
95+reinterpret runLocal interpreter m = unsafeEff $ \es -> do
97+ (`unEff` les0) . runLocal . unsafeEff $ \les -> do
98+ runInterpreter es (Interpreter les $ \_ -> interpreter) m
90-- | Reinterpret local effects as a higher order effect with help of a natural
100-- | Reinterpret local effects as a higher order effect with help of a natural
91-- transformation from 'Eff' to 'Eff'.
101-- transformation from 'Eff' to 'Eff'.
92reinterpretM
102reinterpretM
93 :: (Eff localEs a -> Eff baseEs b)
103 :: (Eff localEs a -> Eff baseEs b)
94− -> (forall r es. (forall t. Eff es t -> Eff localEs t) -> e (Eff es) r -> Eff localEs r)
104+ -> (forall r es. HasCallStack => (forall t. Eff es t -> Eff localEs t) -> e (Eff es) r -> Eff localEs r)
95 -> Eff (e : baseEs) a
105 -> Eff (e : baseEs) a
96 -> Eff baseEs b
106 -> Eff baseEs b
97−reinterpretM runLocal f = reinterpretIO runLocal $ \k -> f $ unsafeEff_ . k
107+reinterpretM runLocal interpreter m = unsafeEff $ \es -> do
109+ (`unEff` les0) . runLocal . unsafeEff $ \les -> do
110+ runInterpreter es (Interpreter les $ \k -> interpreter $ unsafeEff_ . k) m
99-- | Reinterpret local effects as a higher order effect with help of a natural
112-- | Reinterpret local effects as a higher order effect with help of a natural
100-- transformation from 'Eff' to 'IO'.
113-- transformation from 'Eff' to 'IO'.
101reinterpretIO
114reinterpretIO
102 :: (Eff localEs a -> Eff baseEs b)
115 :: (Eff localEs a -> Eff baseEs b)
103− -> (forall r es. (forall t. Eff es t -> IO t) -> e (Eff es) r -> Eff localEs r)
116+ -> (forall r es. HasCallStack => (forall t. Eff es t -> IO t) -> e (Eff es) r -> Eff localEs r)
104 -> Eff (e : baseEs) a
117 -> Eff (e : baseEs) a
105 -> Eff baseEs b
118 -> Eff baseEs b
106−reinterpretIO runLocal f m = unsafeEff $ \es -> do
119+reinterpretIO runLocal interpreter m = unsafeEff $ \es -> do
107 les0 <- forkEnv es
120 les0 <- forkEnv es
108 (`unEff` les0) . runLocal . unsafeEff $ \les -> do
121 (`unEff` les0) . runLocal . unsafeEff $ \les -> do
109− runInterpreter es (Interpreter les f) m
122+ runInterpreter es (Interpreter les interpreter) m