6c09a2f · effectful · git.iko.soy

effectful-core/src/Effectful/Dispatch/Dynamic.hs+2−2

compare with master

unifiedsplit

@@ -49,7 +49,7 @@ interpret

49 -> Eff es a

50interpret handler m = unsafeEff $ \es -> do

51 les <- forkEnv es

52− (`unEff` es) $ runHandler (Handler les handler) m

52+ (`unEff` es) $ runHandlerA (HandlerA les handler) m

53

54-- | Interpret an effect using other effects.

55reinterpret

@@ -62,7 +62,7 @@ reinterpret

62reinterpret runHandlerEs handler m = unsafeEff $ \es -> do

63 les0 <- forkEnv es

64 (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do

65− (`unEff` es) $ runHandler (Handler les handler) m

65+ (`unEff` es) $ runHandlerA (HandlerA les handler) m

66

67----------------------------------------

68-- Unlifts

effectful-core/src/Effectful/Dispatch/Static.hs+1−1

@@ -1,6 +1,6 @@

1module Effectful.Dispatch.Static

2 ( -- * Low level API

3− IdE(..)

3+ IdA(..)

4

5 -- ** Running

6 , runEffect

effectful-core/src/Effectful/Error.hs+3−3

@@ -72,7 +72,7 @@ runError

72runError m = unsafeEff $ \es0 -> mask $ \release -> do

73 eid <- newErrorId

74 size0 <- sizeEnv es0

75− es <- unsafeConsEnv (IdE (Error @e eid)) noRelinker es0

75+ es <- unsafeConsEnv (IdA (Error @e eid)) noRelinker es0

76 r <- tryErrorIO release eid es `onException` unsafeTailEnv size0 es

77 unsafeTailEnv size0 es

78 pure r

@@ -89,7 +89,7 @@ throwError

89 -- ^ The error.

90 -> Eff es a

91throwError e = unsafeEff $ \es -> do

92− IdE (Error eid) <- getEnv @(Error e) es

92+ IdA (Error eid) <- getEnv @(Error e) es

93 throwIO $ ErrorEx eid callStack e

94

95-- | Handle an error of type @e@.

@@ -101,7 +101,7 @@ catchError

101 -- ^ A handler for errors in the inner computation.

102 -> Eff es a

103catchError m handler = unsafeEff $ \es -> do

104− IdE (Error eid) <- getEnv @(Error e) es

104+ IdA (Error eid) <- getEnv @(Error e) es

105 size <- sizeEnv es

106 catchErrorIO eid (unEff m es) $ \cs e -> do

107 checkSizeEnv size es

effectful-core/src/Effectful/Internal/Effect.hs+3−3

@@ -8,7 +8,7 @@

8module Effectful.Internal.Effect

9 ( Effect

10 , (:>)(..)

11− , IdE(..)

11+ , IdA(..)

12

13 -- * Utils

14 , SuffixOf

@@ -24,8 +24,8 @@ import GHC.TypeLits

24type Effect = (Type -> Type) -> Type -> Type

25

26-- | An adapter for statically dispatched effects.

27−newtype IdE :: Effect -> Type where

27+newtype IdA :: Effect -> Type where

28− IdE :: (forall m r. e m r) -> IdE e

28+ IdA :: (forall m r. e m r) -> IdA e

29

30-- | A constraint that requires that a particular effect @e@ is a member of the

31-- type-level list @es@. This is used to parameterize an 'Effectful.Monad.Eff'

effectful-core/src/Effectful/Internal/Monad.hs+14−14

@@ -43,8 +43,8 @@ module Effectful.Internal.Monad

43 -- ** Handler

44 , EffectHandler

45 , LocalEnv(..)

46− , Handler(..)

46+ , HandlerA(..)

47− , runHandler

47+ , runHandlerA

48

49 -- *** Sending operations

50 , send

@@ -151,12 +151,12 @@ unsafeEff_ m = unsafeEff $ \_ -> m

151-- | Get the current 'UnliftStrategy'.

152unliftStrategy :: IOE :> es => Eff es UnliftStrategy

153unliftStrategy = do

154− IdE (IOE unlift) <- getEffect

154+ IdA (IOE unlift) <- getEffect

155 pure unlift

156

157-- | Locally override the 'UnliftStrategy' with the given value.

158withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a

159−withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)

159+withUnliftStrategy unlift = localEffect $ \_ -> IdA (IOE unlift)

160

161-- | Create an unlifting function with the current 'UnliftStrategy'.

162--

@@ -272,7 +272,7 @@ newtype IOE :: Effect where

272--

273-- For running pure operations see 'runPureEff'.

274runEff :: Eff '[IOE] a -> IO a

275−runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv

275+runEff m = unEff (evalEffect (IdA (IOE SeqUnlift)) m) =<< emptyEnv

276

277instance IOE :> es => MonadIO (Eff es) where

278 liftIO = unsafeEff_

@@ -302,7 +302,7 @@ data Prim :: Effect where

302

303-- | Run an 'Eff' operation with primitive state-transformer actions.

304runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a

305−runPrim = evalEffect (IdE Prim)

305+runPrim = evalEffect (IdA Prim)

306

307instance Prim :> es => PrimMonad (Eff es) where

308 type PrimState (Eff es) = RealWorld

@@ -334,26 +334,26 @@ type EffectHandler e es

334-- | An adapter for dynamically dispatched effects.

335--

336-- Represents the effect handler bundled along with its environment.

337−data Handler :: Effect -> Type where

337+data HandlerA :: Effect -> Type where

338− Handler :: !(Env es) -> !(EffectHandler e es) -> Handler e

338+ HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e

339

340-- | Run the effect with the given handler.

341−runHandler :: Handler e -> Eff (e : es) a -> Eff es a

341+runHandlerA :: HandlerA e -> Eff (e : es) a -> Eff es a

342−runHandler e m = unsafeEff $ \es0 -> do

342+runHandlerA e m = unsafeEff $ \es0 -> do

343 size0 <- sizeEnv es0

344 E.bracket (unsafeConsEnv e relinker es0)

345 (unsafeTailEnv size0)

346 (\es -> unEff m es)

347 where

348− relinker :: Relinker Handler e

348+ relinker :: Relinker HandlerA e

349− relinker = Relinker $ \relink (Handler handlerEs handle) -> do

349+ relinker = Relinker $ \relink (HandlerA handlerEs handle) -> do

350 newHandlerEs <- relink handlerEs

351− pure $ Handler newHandlerEs handle

351+ pure $ HandlerA newHandlerEs handle

352

353-- | Send an operation of the given effect to its handler for execution.

354send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a

355send op = unsafeEff $ \es -> do

356− Handler handlerEs handle <- getEnv es

356+ HandlerA handlerEs handle <- getEnv es

357 unEff (handle (LocalEnv es) op) handlerEs

358

359----------------------------------------

effectful-core/src/Effectful/Reader.hs+3−3

@@ -20,12 +20,12 @@ runReader

20 :: r -- ^ An initial environment.

21 -> Eff (Reader r : es) a

22 -> Eff es a

23−runReader r = evalEffect (IdE (Reader r))

23+runReader r = evalEffect (IdA (Reader r))

24

25-- | Fetch the value of the environment.

26ask :: Reader r :> es => Eff es r

27ask = do

28− IdE (Reader r) <- getEffect

28+ IdA (Reader r) <- getEffect

29 pure r

30

31-- | Retrieve a function of the current environment.

@@ -46,4 +46,4 @@ local

46 => (r -> r) -- ^ The function to modify the environment.

47 -> Eff es a

48 -> Eff es a

49−local f = localEffect $ \(IdE (Reader r)) -> IdE (Reader (f r))

49+local f = localEffect $ \(IdA (Reader r)) -> IdA (Reader (f r))

effectful-core/src/Effectful/State/Local.hs+8−8

@@ -33,7 +33,7 @@ runState

33 -> Eff (State s : es) a

34 -> Eff es (a, s)

35runState s0 m = do

36− (a, IdE (State s)) <- runEffect (IdE (State s0)) m

36+ (a, IdA (State s)) <- runEffect (IdA (State s0)) m

37 pure (a, s)

38

39-- | Run a 'State' effect with the given initial state and return the final

@@ -42,7 +42,7 @@ evalState

42 :: s -- ^ An initial state.

43 -> Eff (State s : es) a

44 -> Eff es a -- ^ A return value.

45−evalState s = evalEffect (IdE (State s))

45+evalState s = evalEffect (IdA (State s))

46

47-- | Run a 'State' effect with the given initial state and return the final

48-- state, discarding the final value.

@@ -51,13 +51,13 @@ execState

51 -> Eff (State s : es) a

52 -> Eff es s

53execState s0 m = do

54− IdE (State s) <- execEffect (IdE (State s0)) m

54+ IdA (State s) <- execEffect (IdA (State s0)) m

55 pure s

56

57-- | Fetch the current value of the state.

58get :: State s :> es => Eff es s

59get = do

60− IdE (State s) <- getEffect

60+ IdA (State s) <- getEffect

61 pure s

62

63-- | Get a function of the current state.

@@ -71,14 +71,14 @@ gets f = f <$> get

71

72-- | Set the current state to the given value.

73put :: State s :> es => s -> Eff es ()

74−put s = putEffect (IdE (State s))

74+put s = putEffect (IdA (State s))

75

76-- | Apply the function to the current state and return a value.

77state

78 :: State s :> es

79 => (s -> (a, s)) -- ^ The function to modify the state.

80 -> Eff es a

81−state f = stateEffect $ \(IdE (State s0)) -> let (a, s) = f s0 in (a, IdE (State s))

81+state f = stateEffect $ \(IdA (State s0)) -> let (a, s) = f s0 in (a, IdA (State s))

82

83-- | Apply the function to the current state.

84--

@@ -94,9 +94,9 @@ stateM

94 :: State s :> es

95 => (s -> Eff es (a, s)) -- ^ The function to modify the state.

96 -> Eff es a

97−stateM f = stateEffectM $ \(IdE (State s0)) -> do

97+stateM f = stateEffectM $ \(IdA (State s0)) -> do

98 (a, s) <- f s0

99− pure (a, IdE (State s))

99+ pure (a, IdA (State s))

100

101-- | Apply the monadic function to the current state.

102--

effectful-core/src/Effectful/State/Shared.hs+7−7

@@ -33,7 +33,7 @@ newtype State s :: Effect where

33runState :: s -> Eff (State s : es) a -> Eff es (a, s)

34runState s m = do

35 v <- unsafeEff_ $ newMVar s

36− a <- evalEffect (IdE (State v)) m

36+ a <- evalEffect (IdA (State v)) m

37 (a, ) <$> unsafeEff_ (readMVar v)

38

39-- | Run a 'State' effect with the given initial state and return the final

@@ -41,20 +41,20 @@ runState s m = do

41evalState :: s -> Eff (State s : es) a -> Eff es a

42evalState s m = do

43 v <- unsafeEff_ $ newMVar s

44− evalEffect (IdE (State v)) m

44+ evalEffect (IdA (State v)) m

45

46-- | Run a 'State' effect with the given initial state and return the final

47-- state, discarding the final value.

48execState :: s -> Eff (State s : es) a -> Eff es s

49execState s m = do

50 v <- unsafeEff_ $ newMVar s

51− _ <- evalEffect (IdE (State v)) m

51+ _ <- evalEffect (IdA (State v)) m

52 unsafeEff_ $ readMVar v

53

54-- | Fetch the current value of the state.

55get :: State s :> es => Eff es s

56get = unsafeEff $ \es -> do

57− IdE (State v) <- getEnv es

57+ IdA (State v) <- getEnv es

58 readMVar v

59

60-- | Get a function of the current state.

@@ -66,7 +66,7 @@ gets f = f <$> get

66-- | Set the current state to the given value.

67put :: State s :> es => s -> Eff es ()

68put s = unsafeEff $ \es -> do

69− IdE (State v) <- getEnv es

69+ IdA (State v) <- getEnv es

70 modifyMVar_ v $ \_ -> s `seq` pure s

71

72-- | Apply the function to the current state and return a value.

@@ -74,7 +74,7 @@ put s = unsafeEff $ \es -> do

74-- /Note:/ this function gets an exclusive access to the state for its duration.

75state :: State s :> es => (s -> (a, s)) -> Eff es a

76state f = unsafeEff $ \es -> do

77− IdE (State v) <- getEnv es

77+ IdA (State v) <- getEnv es

78 modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)

79

80-- | Apply the function to the current state.

@@ -90,7 +90,7 @@ modify f = state (\s -> ((), f s))

90-- /Note:/ this function gets an exclusive access to the state for its duration.

91stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a

92stateM f = unsafeEff $ \es -> do

93− IdE (State v) <- getEnv es

93+ IdA (State v) <- getEnv es

94 modifyMVar v $ \s0 -> do

95 (a, s) <- unEff (f s0) es

96 s `seq` pure (s, a)

effectful-core/src/Effectful/Writer/Local.hs+5−5

@@ -38,19 +38,19 @@ newtype Writer w :: Effect where

38-- output.

39runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)

40runWriter m = do

41− (a, IdE (Writer w)) <- runEffect (IdE (Writer mempty)) m

41+ (a, IdA (Writer w)) <- runEffect (IdA (Writer mempty)) m

42 pure (a, w)

43

44-- | Run a 'Writer' effect and return the final output, discarding the final

45-- value.

46execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w

47execWriter m = do

48− IdE (Writer w) <- execEffect (IdE (Writer mempty)) m

48+ IdA (Writer w) <- execEffect (IdA (Writer mempty)) m

49 pure w

50

51-- | Append the given output to the overall output of the 'Writer'.

52tell :: (Writer w :> es, Monoid w) => w -> Eff es ()

53−tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))

53+tell w = stateEffect $ \(IdA (Writer w0)) -> ((), IdA (Writer (w0 <> w)))

54

55-- | Execute an action and append its output to the overall output of the

56-- 'Writer'.

@@ -60,13 +60,13 @@ tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))

60-- the 'Writer'.

61listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)

62listen m = unsafeEff $ \es -> mask $ \restore -> do

63− w0 <- stateEnv es $ \(IdE (Writer w)) -> (w, IdE (Writer mempty))

63+ w0 <- stateEnv es $ \(IdA (Writer w)) -> (w, IdA (Writer mempty))

64 a <- restore (unEff m es) `onException` merge es w0

65 (a, ) <$> merge es w0

66 where

67 merge es w0 =

68 -- If an exception is thrown, restore w0 and keep parts of w1.

69− stateEnv es $ \(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))

69+ stateEnv es $ \(IdA (Writer w1)) -> (w1, IdA (Writer (w0 <> w1)))

70

71-- | Execute an action and append its output to the overall output of the

72-- 'Writer', then return the final value along with a function of the recorded

effectful-core/src/Effectful/Writer/Shared.hs+5−5

@@ -39,7 +39,7 @@ newtype Writer w :: Effect where

39runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)

40runWriter m = do

41 v <- unsafeEff_ $ newMVar mempty

42− a <- evalEffect (IdE (Writer v)) m

42+ a <- evalEffect (IdA (Writer v)) m

43 (a, ) <$> unsafeEff_ (readMVar v)

44

45-- | Run a 'Writer' effect and return the final output, discarding the final

@@ -47,13 +47,13 @@ runWriter m = do

47execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w

48execWriter m = do

49 v <- unsafeEff_ $ newMVar mempty

50− _ <- evalEffect (IdE (Writer v)) m

50+ _ <- evalEffect (IdA (Writer v)) m

51 unsafeEff_ $ readMVar v

52

53-- | Append the given output to the overall output of the 'Writer'.

54tell :: (Writer w :> es, Monoid w) => w -> Eff es ()

55tell w1 = unsafeEff $ \es -> do

56− IdE (Writer v) <- getEnv es

56+ IdA (Writer v) <- getEnv es

57 modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w

58

59-- | Execute an action and append its output to the overall output of the

@@ -70,14 +70,14 @@ listen m = unsafeEff $ \es -> do

70 uninterruptibleMask $ \restore -> do

71 v1 <- newMVar mempty

72 -- Replace thread local MVar with a fresh one for isolated listening.

73− v0 <- stateEnv es $ \(IdE (Writer v)) -> (v, IdE (Writer v1))

73+ v0 <- stateEnv es $ \(IdA (Writer v)) -> (v, IdA (Writer v1))

74 a <- restore (unEff m es) `onException` merge es v0 v1

75 (a, ) <$> merge es v0 v1

76 where

77 -- Merge results accumulated in the local MVar with the mainline. If an

78 -- exception was received while listening, merge results recorded so far.

79 merge es v0 v1 = do

80− putEnv es $ IdE (Writer v0)

80+ putEnv es $ IdA (Writer v0)

81 w1 <- readMVar v1

82 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w

83 pure w1

effectful/src/Effectful/Concurrent/Effect.hs+1−1

@@ -17,4 +17,4 @@ data Concurrent :: Effect where

17

18-- | Run the 'Concurrent' effect.

19runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a

20−runConcurrent = evalEffect (IdE Concurrent)

20+runConcurrent = evalEffect (IdA Concurrent)

effectful/src/Effectful/Environment.hs+1−1

@@ -29,7 +29,7 @@ data Environment :: Effect where

29

30-- | Run the 'Environment' effect.

31runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a

32−runEnvironment = evalEffect (IdE Environment)

32+runEnvironment = evalEffect (IdA Environment)

33

34-- | Lifted 'E.getArgs'.

35getArgs :: Environment :> es => Eff es [String]

effectful/src/Effectful/FileSystem.hs+1−1

@@ -101,7 +101,7 @@ data FileSystem :: Effect where

101

102-- | Run the 'FileSystem' effect.

103runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a

104−runFileSystem = evalEffect (IdE FileSystem)

104+runFileSystem = evalEffect (IdA FileSystem)

105

106----------------------------------------

107-- Actions on directories

effectful/src/Effectful/FileSystem/Effect.hs+1−1

@@ -12,4 +12,4 @@ data FileSystem :: Effect where

12

13-- | Run the 'FileSystem' effect.

14runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a

15−runFileSystem = evalEffect (IdE FileSystem)

15+runFileSystem = evalEffect (IdA FileSystem)

effectful/src/Effectful/Process.hs+1−1

@@ -59,7 +59,7 @@ data Process :: Effect where

59 Process :: Process m r

60

61runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a

62−runProcess = evalEffect (IdE Process)

62+runProcess = evalEffect (IdA Process)

63

64----------------------------------------

65-- Running sub-processes

effectful/src/Effectful/Resource.hs+4−4

@@ -37,7 +37,7 @@ runResource m = unsafeEff $ \es0 -> do

37 size0 <- sizeEnv es0

38 istate <- R.createInternalState

39 mask $ \restore -> do

40− es <- unsafeConsEnv (IdE (Resource istate)) noRelinker es0

40+ es <- unsafeConsEnv (IdA (Resource istate)) noRelinker es0

41 a <- restore (unEff m es) `catch` \e -> do

42 unsafeTailEnv size0 es

43 RI.stateCleanupChecked (Just e) istate

@@ -52,18 +52,18 @@ runResource m = unsafeEff $ \es0 -> do

52-- | Get the 'R.InternalState' of the current 'Resource' effect.

53getInternalState :: Resource :> es => Eff es R.InternalState

54getInternalState = do

55− IdE (Resource istate) <- getEffect

55+ IdA (Resource istate) <- getEffect

56 pure istate

57

58-- | Run the 'Resource' effect with existing 'R.InternalState'.

59--

60-- /Note:/ the 'R.InternalState' will not be closed at the end.

61runInternalState :: R.InternalState -> Eff (Resource : es) a -> Eff es a

62−runInternalState istate = evalEffect $ IdE (Resource istate)

62+runInternalState istate = evalEffect $ IdA (Resource istate)

63

64----------------------------------------

65-- Orphan instance

66

67instance (IOE :> es, Resource :> es) => R.MonadResource (Eff es) where

68 liftResourceT (RI.ResourceT m) = unsafeEff $ \es -> do

69− getEnv es >>= \(IdE (Resource istate)) -> m istate

69+ getEnv es >>= \(IdA (Resource istate)) -> m istate

effectful/src/Effectful/Temporary.hs+1−1

@@ -19,7 +19,7 @@ data Temporary :: Effect where

19

20-- | Run the 'Temporary' effect.

21runTemporary :: IOE :> es => Eff (Temporary : es) a -> Eff es a

22−runTemporary = evalEffect (IdE Temporary)

22+runTemporary = evalEffect (IdA Temporary)

23

24-- | Lifted 'T.withSystemTempFile'.

25withSystemTempFile

effectful/src/Effectful/Timeout.hs+1−1

@@ -15,7 +15,7 @@ data Timeout :: Effect where

15

16-- | Run the 'Timeout' effect.

17runTimeout :: IOE :> es => Eff (Timeout : es) a -> Eff es a

18−runTimeout = evalEffect (IdE Timeout)

18+runTimeout = evalEffect (IdA Timeout)

19

20-- | Lifted 'T.timeout'.

21timeout