1560ddc · effectful · git.iko.soy

git.iko.soy/effectful

Add public API for statically dispatched effects

commit1560ddcde6175d05a689b4a95f4af63918afdeca authorAndrzej Rybczak <andrzej@rybczak.net> dateSat 4 Dec 2021, 15:05 (5 years ago) parent351169f

33 files changed+131−82

compare with master

unifiedsplit

effectful-core/effectful-core.cabal+3−2

@@ -77,10 +77,11 @@ library

7777

7878 hs-source-dirs: src

7979

80− exposed-modules: Effectful.Error

80+ exposed-modules: Effectful.Dispatch.Dynamic

81+ Effectful.Dispatch.Static

82+ Effectful.Error

8183 Effectful.Error.Dynamic

8284 Effectful.Fail

83− Effectful.Handler

8485 Effectful.Internal.Effect

8586 Effectful.Internal.Env

8687 Effectful.Internal.Monad

effectful-core/src/Effectful/Handler.hs → effectful-core/src/Effectful/Dispatch/Dynamic.hsrenamed+1−1

@@ -1,4 +1,4 @@

1−module Effectful.Handler

1+module Effectful.Dispatch.Dynamic

22 ( -- * Sending operations to the handler

33 send

effectful-core/src/Effectful/Dispatch/Static.hsnew file+51

@@ -0,0 +1,51 @@

1+module Effectful.Dispatch.Static

2+ ( -- * Low level API

3+ IdE(..)

5+ -- ** Running

6+ , runEffect

7+ , evalEffect

8+ , execEffect

10+ -- ** Modification

11+ , getEffect

12+ , putEffect

13+ , stateEffect

14+ , stateEffectM

15+ , localEffect

16+

17+ -- * Primitive API

18+ , Env

19+ , Relinker(..)

20+ , noRelinker

21+

22+ -- ** Operations

23+ , emptyEnv

24+ , cloneEnv

25+ , forkEnv

26+ , sizeEnv

27+ , checkSizeEnv

28+

29+ -- ** Extending and shrinking

30+ , unsafeConsEnv

31+ , unsafeTailEnv

32+

33+ -- ** Data retrieval and update

34+ , getEnv

35+ , putEnv

36+ , stateEnv

37+ , modifyEnv

38+

39+ -- * Unsafe 'Eff' operations

40+ , unsafeEff

41+ , unsafeEff_

42+ , unsafeLiftMapIO

43+ , unsafeUnliftIO

44+

45+ -- * Utils

46+ , unEff

47+ ) where

48+

49+import Effectful.Internal.Effect

50+import Effectful.Internal.Env

51+import Effectful.Internal.Monad

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

@@ -37,9 +37,8 @@ import Data.Typeable

3737import Data.Unique

3838import GHC.Stack

3939

40−import Effectful.Internal.Effect

41−import Effectful.Internal.Env

42−import Effectful.Internal.Monad

40+import Effectful.Dispatch.Static

41+import Effectful.Monad

4342

4443newtype Error e :: Effect where

4544 Error :: ErrorId -> Error e m r

effectful-core/src/Effectful/Error/Dynamic.hs+1−1

@@ -8,7 +8,7 @@ module Effectful.Error.Dynamic

99import Data.Typeable

1010

11−import Effectful.Handler

11+import Effectful.Dispatch.Dynamic

1212import Effectful.Monad

1313import qualified Effectful.Error as E

1414

effectful-core/src/Effectful/Fail.hs+1−1

@@ -3,8 +3,8 @@ module Effectful.Fail

33 , runFail

44 ) where

6+import Effectful.Dispatch.Dynamic

67import Effectful.Error

7−import Effectful.Handler

88import Effectful.Internal.Monad

1010-- | Run the 'Fail' effect via 'Error'.

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

@@ -23,7 +23,7 @@ import GHC.TypeLits

2323-- | The kind of effects.

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

2525

26−-- | Adapter for statically dispatched effects.

26+-- | An adapter for statically dispatched effects.

2727newtype IdE :: Effect -> Type where

2828 IdE :: (forall m r. e m r) -> IdE e

2929

effectful-core/src/Effectful/Internal/Env.hs+12−12

@@ -152,11 +152,11 @@ newForkId (ForkIdGen ref) = do

152152-- the environment.

153153newtype Relinker :: (Effect -> Type) -> Effect -> Type where

154154 Relinker

155− :: ((forall es. Env es -> IO (Env es)) -> handler e -> IO (handler e))

156− -> Relinker handler e

155+ :: ((forall es. Env es -> IO (Env es)) -> adapter e -> IO (adapter e))

156+ -> Relinker adapter e

157157

158158-- | A dummy 'Relinker' that does nothing.

159−noRelinker :: Relinker handler e

159+noRelinker :: Relinker adapter e

160160noRelinker = Relinker $ \_ -> pure

161161

162162----------------------------------------

@@ -344,7 +344,7 @@ checkSizeEnv k (Env (Forks _ baseIx lref _) _ _) = do

344344-- This function is __highly unsafe__ because it renders the input 'Env'

345345-- unusable until the corresponding 'unsafeTailEnv' call is made, but it's not

346346-- checked anywhere.

347−unsafeConsEnv :: handler e -> Relinker handler e -> Env es -> IO (Env (e : es))

347+unsafeConsEnv :: adapter e -> Relinker adapter e -> Env es -> IO (Env (e : es))

348348unsafeConsEnv e f (Env fork gref gen) = case fork of

349349 NoFork -> do

350350 extendEnvRef gref

@@ -403,18 +403,18 @@ unsafeTailEnv len (Env fork gref _) = case fork of

403403

404404-- | Extract a specific data type from the environment.

405405getEnv

406− :: forall e es handler. e :> es

406+ :: forall e es adapter. e :> es

407407 => Env es

408− -> IO (handler e)

408+ -> IO (adapter e)

409409getEnv env = do

410410 (i, es) <- getLocation (reifyIndex @e @es) env

411411 fromAny <$> readSmallArray es i

412412

413413-- | Replace the data type in the environment with a new value (in place).

414414putEnv

415− :: forall e es handler. e :> es

415+ :: forall e es adapter. e :> es

416416 => Env es

417− -> handler e

417+ -> adapter e

418418 -> IO ()

419419putEnv env e = do

420420 (i, es) <- getLocation (reifyIndex @e @es) env

@@ -422,9 +422,9 @@ putEnv env e = do

422422

423423-- | Modify the data type in the environment (in place) and return a value.

424424stateEnv

425− :: forall e es handler a. e :> es

425+ :: forall e es adapter a. e :> es

426426 => Env es

427− -> (handler e -> (a, handler e))

427+ -> (adapter e -> (a, adapter e))

428428 -> IO a

429429stateEnv env f = do

430430 (i, es) <- getLocation (reifyIndex @e @es) env

@@ -434,9 +434,9 @@ stateEnv env f = do

434434

435435-- | Modify the data type in the environment (in place).

436436modifyEnv

437− :: forall e es handler. e :> es

437+ :: forall e es adapter. e :> es

438438 => Env es

439− -> (handler e -> handler e)

439+ -> (adapter e -> adapter e)

440440 -> IO ()

441441modifyEnv env f = do

442442 (i, es) <- getLocation (reifyIndex @e @es) env

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

@@ -367,7 +367,9 @@ type EffectHandler e es

367367 -- ^ The effect performed in the local environment.

368368 -> Eff es a

369369

370−-- | An effect handler bundled along with its environment.

370+-- | An adapter for dynamically dispatched effects.

371+--

372+-- Represents the effect handler bundled along with its environment.

371373data Handler :: Effect -> Type where

372374 Handler :: !(Env es) -> !(EffectHandler e es) -> Handler e

373375

@@ -387,49 +389,49 @@ runHandler e m = unsafeEff $ \es0 -> do

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

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

389391send op = unsafeEff $ \es -> do

390− Handler env handle <- getEnv es

391− unEff (handle (LocalEnv es) op) env

392+ Handler handlerEs handle <- getEnv es

393+ unEff (handle (LocalEnv es) op) handlerEs

392394

393395----------------------------------------

394396-- Helpers

395397

396−runEffect :: handler e -> Eff (e : es) a -> Eff es (a, handler e)

398+runEffect :: adapter e -> Eff (e : es) a -> Eff es (a, adapter e)

397399runEffect e0 m = unsafeEff $ \es0 -> do

398400 size0 <- sizeEnv es0

399401 E.bracket (unsafeConsEnv e0 noRelinker es0)

400402 (unsafeTailEnv size0)

401403 (\es -> (,) <$> unEff m es <*> getEnv es)

402404

403−evalEffect :: handler e -> Eff (e : es) a -> Eff es a

405+evalEffect :: adapter e -> Eff (e : es) a -> Eff es a

404406evalEffect e m = unsafeEff $ \es0 -> do

405407 size0 <- sizeEnv es0

406408 E.bracket (unsafeConsEnv e noRelinker es0)

407409 (unsafeTailEnv size0)

408410 (\es -> unEff m es)

409411

410−execEffect :: handler e -> Eff (e : es) a -> Eff es (handler e)

412+execEffect :: adapter e -> Eff (e : es) a -> Eff es (adapter e)

411413execEffect e0 m = unsafeEff $ \es0 -> do

412414 size0 <- sizeEnv es0

413415 E.bracket (unsafeConsEnv e0 noRelinker es0)

414416 (unsafeTailEnv size0)

415417 (\es -> unEff m es *> getEnv es)

416418

417−getEffect :: e :> es => Eff es (handler e)

419+getEffect :: e :> es => Eff es (adapter e)

418420getEffect = unsafeEff $ \es -> getEnv es

419421

420−putEffect :: e :> es => handler e -> Eff es ()

422+putEffect :: e :> es => adapter e -> Eff es ()

421423putEffect e = unsafeEff $ \es -> putEnv es e

422424

423−stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a

425+stateEffect :: e :> es => (adapter e -> (a, adapter e)) -> Eff es a

424426stateEffect f = unsafeEff $ \es -> stateEnv es f

425427

426−stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a

428+stateEffectM :: e :> es => (adapter e -> Eff es (a, adapter e)) -> Eff es a

427429stateEffectM f = unsafeEff $ \es -> E.mask $ \release -> do

428430 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es

429431 putEnv es e

430432 pure a

431433

432−localEffect :: e :> es => (handler e -> handler e) -> Eff es a -> Eff es a

434+localEffect :: e :> es => (adapter e -> adapter e) -> Eff es a -> Eff es a

433435localEffect f m = unsafeEff $ \es -> do

434436 E.bracket (stateEnv es $ \e -> (e, f e))

435437 (\e -> putEnv es e)

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

@@ -7,8 +7,8 @@ module Effectful.Reader

77 , local

88 ) where

10−import Effectful.Internal.Effect

11−import Effectful.Internal.Monad

10+import Effectful.Dispatch.Static

11+import Effectful.Monad

1212

1313-- | Provide access to a strict (WHNF), thread local, read only value of type

1414-- @r@.

effectful-core/src/Effectful/Reader/Dynamic.hs+1−1

@@ -6,7 +6,7 @@ module Effectful.Reader.Dynamic

66 , local

77 ) where

9−import Effectful.Handler

9+import Effectful.Dispatch.Dynamic

1010import Effectful.Monad

1111import qualified Effectful.Reader as R

1212

effectful-core/src/Effectful/State/Dynamic.hs+1−1

@@ -22,7 +22,7 @@ module Effectful.State.Dynamic

2222 , modifyM

2323 ) where

2424

25−import Effectful.Handler

25+import Effectful.Dispatch.Dynamic

2626import Effectful.Monad

2727import qualified Effectful.State.Local as L

2828import qualified Effectful.State.Shared as S

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

@@ -21,8 +21,8 @@ module Effectful.State.Local

2121 , modifyM

2222 ) where

2323

24−import Effectful.Internal.Effect

25−import Effectful.Internal.Monad

24+import Effectful.Dispatch.Static

25+import Effectful.Monad

2626

2727-- | Provide access to a strict (WHNF), thread local, mutable state of type @s@.

2828newtype State s :: Effect where

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

@@ -22,9 +22,8 @@ module Effectful.State.Shared

2222

2323import Control.Concurrent.MVar

2424

25−import Effectful.Internal.Effect

26−import Effectful.Internal.Env

27−import Effectful.Internal.Monad

25+import Effectful.Dispatch.Static

26+import Effectful.Monad

2827

2928-- | Provide access to a strict (WHNF), shareable, mutable state of type @s@.

3029newtype State s :: Effect where

effectful-core/src/Effectful/Writer/Dynamic.hs+1−1

@@ -15,7 +15,7 @@ module Effectful.Writer.Dynamic

1515 , listens

1616 ) where

1717

18−import Effectful.Handler

18+import Effectful.Dispatch.Dynamic

1919import Effectful.Monad

2020import qualified Effectful.Writer.Local as L

2121import qualified Effectful.Writer.Shared as S

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

@@ -28,9 +28,8 @@ module Effectful.Writer.Local

2828

2929import Control.Exception

3030

31−import Effectful.Internal.Effect

32−import Effectful.Internal.Env

33−import Effectful.Internal.Monad

31+import Effectful.Dispatch.Static

32+import Effectful.Monad

3433

3534-- | Provide access to a strict (WHNF), thread local, write only value of type

3635-- @w@.

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

@@ -10,9 +10,8 @@ module Effectful.Writer.Shared

1010import Control.Concurrent.MVar

1111import Control.Exception

1212

13−import Effectful.Internal.Effect

14−import Effectful.Internal.Env

15−import Effectful.Internal.Monad

13+import Effectful.Dispatch.Static

14+import Effectful.Monad

1615

1716-- | Provide access to a strict (WHNF), shareable, write only value of type @w@.

1817newtype Writer w :: Effect where

effectful/effectful.cabal+3−2

@@ -89,10 +89,11 @@ library

8989

9090 other-modules: Effectful.Concurrent.Effect

9191

92− reexported-modules: Effectful.Error

92+ reexported-modules: Effectful.Dispatch.Dynamic

93+ , Effectful.Dispatch.Static

94+ , Effectful.Error

9395 , Effectful.Error.Dynamic

9496 , Effectful.Fail

95− , Effectful.Handler

9697 , Effectful.Monad

9798 , Effectful.Prim

9899 , Effectful.Reader

effectful/src/Effectful.hs+1−1

@@ -55,5 +55,5 @@ module Effectful

5555 , MonadUnliftIO(..)

5656 ) where

5757

58−import Effectful.Handler

58+import Effectful.Dispatch.Dynamic

5959import Effectful.Monad

effectful/src/Effectful/Concurrent.hs+2−3

@@ -52,9 +52,8 @@ import qualified Control.Concurrent as C

5252import qualified GHC.Conc as GHC

5353

5454import Effectful.Concurrent.Effect

55−import Effectful.Internal.Effect

56−import Effectful.Internal.Env

57−import Effectful.Internal.Monad

55+import Effectful.Dispatch.Static

56+import Effectful.Monad

5857

5958----------------------------------------

6059-- Basic concurrency operations

effectful/src/Effectful/Concurrent/Async.hs+3−3

@@ -76,14 +76,14 @@ import Control.Concurrent (threadDelay)

7676import Control.Concurrent.Async (Async)

7777import Control.Exception (Exception, SomeException)

7878import Control.Monad (forever)

79+import Data.Kind (Type)

7980import qualified Control.Concurrent.Async as A

8081import qualified UnliftIO.Async as U

8182import qualified UnliftIO.Internals.Async as I

8283

8384import Effectful.Concurrent.Effect

84−import Effectful.Internal.Effect

85−import Effectful.Internal.Env

86−import Effectful.Internal.Monad

85+import Effectful.Dispatch.Static

86+import Effectful.Monad

8787

8888-- | Lifted 'A.async'.

8989async :: Concurrent :> es => Eff es a -> Eff es (Async a)

effectful/src/Effectful/Concurrent/Chan.hs+2−2

@@ -13,8 +13,8 @@ import Control.Concurrent.Chan (Chan)

1313import qualified Control.Concurrent.Chan as C

1414

1515import Effectful.Concurrent.Effect

16−import Effectful.Internal.Effect

17−import Effectful.Internal.Monad

16+import Effectful.Dispatch.Static

17+import Effectful.Monad

1818

1919-- | Lifted 'C.newChan'.

2020newChan :: Concurrent :> es => Eff es (Chan a)

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

@@ -4,8 +4,8 @@ module Effectful.Concurrent.Effect

44 , runConcurrent

55 ) where

7−import Effectful.Internal.Effect

8−import Effectful.Internal.Monad

7+import Effectful.Dispatch.Static

8+import Effectful.Monad

1010-- | Run 'Eff' operations asynchronously via the @async@ library.

1111--

effectful/src/Effectful/Concurrent/MVar.hs+2−2

@@ -25,8 +25,8 @@ import Control.Concurrent.MVar (MVar)

2525import qualified Control.Concurrent.MVar as M

2626

2727import Effectful.Concurrent.Effect

28−import Effectful.Internal.Effect

29−import Effectful.Internal.Monad

28+import Effectful.Dispatch.Static

29+import Effectful.Monad

3030

3131-- | Lifted 'M.newEmptyMVar'.

3232newEmptyMVar :: Concurrent :> es => Eff es (MVar a)

effectful/src/Effectful/Concurrent/QSem.hs+2−2

@@ -10,8 +10,8 @@ import Control.Concurrent.QSem (QSem)

1010import qualified Control.Concurrent.QSem as Q

1111

1212import Effectful.Concurrent.Effect

13−import Effectful.Internal.Effect

14−import Effectful.Internal.Monad

13+import Effectful.Dispatch.Static

14+import Effectful.Monad

1515

1616-- | Lifted 'Q.newQSem'.

1717newQSem :: Concurrent :> es => Int -> Eff es QSem

effectful/src/Effectful/Concurrent/QSemN.hs+2−2

@@ -10,8 +10,8 @@ import Control.Concurrent.QSemN (QSemN)

1010import qualified Control.Concurrent.QSemN as Q

1111

1212import Effectful.Concurrent.Effect

13−import Effectful.Internal.Effect

14−import Effectful.Internal.Monad

13+import Effectful.Dispatch.Static

14+import Effectful.Monad

1515

1616-- | Lifted 'Q.newQSemN'.

1717newQSemN :: Concurrent :> es => Int -> Eff es QSemN

effectful/src/Effectful/Concurrent/STM.hs+2−2

@@ -89,8 +89,8 @@ import System.Mem.Weak (Weak)

8989import GHC.Natural (Natural)

9090

9191import Effectful.Concurrent.Effect

92−import Effectful.Internal.Effect

93−import Effectful.Internal.Monad

92+import Effectful.Dispatch.Static

93+import Effectful.Monad

9494

9595-- | Lifted version of 'STM.atomically'

9696atomically :: Concurrent :> es => STM a -> Eff es a

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

@@ -20,8 +20,8 @@ module Effectful.Environment

2020

2121import qualified System.Environment as E

2222

23−import Effectful.Internal.Effect

24−import Effectful.Internal.Monad

23+import Effectful.Dispatch.Static hiding (getEnv)

24+import Effectful.Monad

2525

2626-- | An effect for querying and modifying the system environment.

2727data Environment :: Effect where

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

@@ -91,8 +91,8 @@ module Effectful.FileSystem

9191import Data.Time (UTCTime)

9292import qualified System.Directory as D

9393

94−import Effectful.Internal.Effect

95−import Effectful.Internal.Monad

94+import Effectful.Dispatch.Static

95+import Effectful.Monad

9696

9797-- | An effect for interacting with the filesystem.

9898data FileSystem :: Effect where

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

@@ -51,8 +51,8 @@ import System.IO (Handle)

5151import System.Posix.Internals (FD)

5252import qualified System.Process as P

5353

54−import Effectful.Internal.Effect

55−import Effectful.Internal.Monad

54+import Effectful.Dispatch.Static

55+import Effectful.Monad

5656

5757-- | An effect for running child processes using the @process@ library.

5858data Process :: Effect where

effectful/src/Effectful/Resource.hs+2−3

@@ -24,9 +24,8 @@ import Control.Exception

2424import qualified Control.Monad.Trans.Resource as R

2525import qualified Control.Monad.Trans.Resource.Internal as RI

2626

27−import Effectful.Internal.Effect

28−import Effectful.Internal.Env

29−import Effectful.Internal.Monad

27+import Effectful.Dispatch.Static

28+import Effectful.Monad

3029

3130-- | Data tag for a resource effect.

3231newtype Resource :: Effect where

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

@@ -10,8 +10,8 @@ module Effectful.Temporary

1010import System.IO

1111import qualified UnliftIO.Temporary as T

1212

13−import Effectful.Internal.Effect

14−import Effectful.Internal.Monad

13+import Effectful.Dispatch.Static

14+import Effectful.Monad

1515

1616-- | An effect for interacting with temporary files.

1717data Temporary :: Effect where

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

@@ -6,8 +6,8 @@ module Effectful.Timeout

77import qualified System.Timeout as T

9−import Effectful.Internal.Effect

10−import Effectful.Internal.Monad

9+import Effectful.Dispatch.Static

10+import Effectful.Monad

1111

1212-- | An effect for timing out computations.

1313data Timeout :: Effect where