Skip to content

Commit bce10df

Browse files
arybczakarybczak
authored
Add Monad{Error,Reader,State,Writer} instances for Eff (#335)
1 parent e21a152 commit bce10df

File tree

17 files changed

+87
-17
lines changed

17 files changed

+87
-17
lines changed

‎.github/workflows/haskell-ci.yml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -268,11 +268,11 @@ jobs:
268268
- name: doctest
269269
run: |
270270
if [ $((HCNUMVER < 91200)) -ne 0 ] ; then cd ${PKGDIR_effectful_core} || false ; fi
271-
if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi
271+
if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators -XUndecidableInstances src ; fi
272272
if [ $((HCNUMVER < 91200)) -ne 0 ] ; then cd ${PKGDIR_effectful_th} || false ; fi
273-
if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi
273+
if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators -XUndecidableInstances src ; fi
274274
if [ $((HCNUMVER < 91200)) -ne 0 ] ; then cd ${PKGDIR_effectful} || false ; fi
275-
if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi
275+
if [ $((HCNUMVER < 91200)) -ne 0 ] ; then doctest -XHaskell2010 -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XDerivingStrategies -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XImportQualifiedPost -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XPolyKinds -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators -XUndecidableInstances src ; fi
276276
- name: cabal check
277277
run: |
278278
cd ${PKGDIR_effectful_core} || false

‎doctest.sh

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,8 @@ run_doctest() {
3737
-XTupleSections \
3838
-XTypeApplications \
3939
-XTypeFamilies \
40-
-XTypeOperators
40+
-XTypeOperators \
41+
-XUndecidableInstances
4142
popd
4243
}
4344

‎effectful-core/CHANGELOG.md

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
# effectful-core-2.6.1.0 (????-??-??)
2+
* Add `MonadError`, `MonadReader`, `MonadState` and `MonadWriter` instances for
3+
`Eff` for compatibility with existing code.
4+
15
# effectful-core-2.6.0.0 (2025-06-13)
26
* Adjust `generalBracket` with `base >= 4.21` to make use of the new exception
37
annotation mechanism.

‎effectful-core/effectful-core.cabal

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
cabal-version: 3.0
22
build-type: Simple
33
name: effectful-core
4-
version: 2.6.0.0
4+
version: 2.6.1.0
55
license: BSD-3-Clause
66
license-file: LICENSE
77
category: Control
@@ -60,6 +60,7 @@ common language
6060
TypeApplications
6161
TypeFamilies
6262
TypeOperators
63+
UndecidableInstances
6364

6465
library
6566
import: language
@@ -70,6 +71,7 @@ library
7071
, containers >= 0.6
7172
, deepseq >= 1.2
7273
, exceptions >= 0.10.4
74+
, mtl >= 2.2.1
7375
, monad-control >= 1.0.3
7476
, primitive >= 0.7.3.0
7577
, strict-mutable-base >= 1.1.0.0

‎effectful-core/src/Effectful/Dispatch/Dynamic.hs

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
22
{-# LANGUAGE ImplicitParams #-}
3-
{-# LANGUAGE UndecidableInstances #-}
43
-- | Dynamically dispatched effects.
54
module Effectful.Dispatch.Dynamic
65
( -- * Introduction
@@ -349,8 +348,6 @@ import Effectful.Internal.Utils
349348
-- __orphan__, __canonical__ instance of @MonadRNG@ for 'Eff' that delegates to
350349
-- the @RNG@ effect:
351350
--
352-
-- >>> :set -XUndecidableInstances
353-
--
354351
-- >>> :{
355352
-- instance RNG :> es => MonadRNG (Eff es) where
356353
-- randomInt = send RandomInt

‎effectful-core/src/Effectful/Error/Dynamic.hs

Lines changed: 16 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
1+
{-# OPTIONS_GHC -Wno-orphans #-}
12
-- | The dynamically dispatched variant of the 'Error' effect.
23
--
3-
-- /Note:/ unless you plan to change interpretations at runtime, it's
4+
-- /Note:/ unless you plan to change interpretations at runtime or you need the
5+
-- 'MTL.MonadError' instance for compatibility with existing code, it's
46
-- recommended to use the statically dispatched variant,
57
-- i.e. "Effectful.Error.Static".
68
module Effectful.Error.Dynamic
@@ -28,6 +30,7 @@ module Effectful.Error.Dynamic
2830
, E.prettyCallStack
2931
) where
3032

33+
import Control.Monad.Except qualified as MTL
3134
import GHC.Stack (withFrozenCallStack)
3235

3336
import Effectful
@@ -148,3 +151,15 @@ tryError
148151
-- ^ The inner computation.
149152
-> Eff es (Either (E.CallStack, e) a)
150153
tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)
154+
155+
----------------------------------------
156+
-- Orphan instance
157+
158+
-- | Instance included for compatibility with existing code.
159+
instance
160+
( Show e
161+
, Error e :> es
162+
, MTL.MonadError e (Eff es)
163+
) => MTL.MonadError e (Eff es) where
164+
throwError = send . ThrowErrorWith show
165+
catchError action = send . CatchError action . const

‎effectful-core/src/Effectful/Internal/Effect.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
2-
{-# LANGUAGE UndecidableInstances #-}
32
{-# OPTIONS_HADDOCK not-home #-}
43
-- | Type-safe indexing for 'Effectful.Internal.Monad.Env'.
54
--

‎effectful-core/src/Effectful/Internal/Monad.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE CPP #-}
2-
{-# LANGUAGE UndecidableInstances #-}
32
{-# OPTIONS_GHC -Wno-orphans #-}
43
{-# OPTIONS_HADDOCK not-home #-}
54
-- | The 'Eff' monad.

‎effectful-core/src/Effectful/Reader/Dynamic.hs

Lines changed: 17 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
1+
{-# OPTIONS_GHC -Wno-orphans #-}
12
-- | The dynamically dispatched variant of the 'Reader' effect.
23
--
3-
-- /Note:/ unless you plan to change interpretations at runtime, it's
4+
-- /Note:/ unless you plan to change interpretations at runtime or you need the
5+
-- 'MTL.MonadReader' instance for compatibility with existing code, it's
46
-- recommended to use the statically dispatched variant,
57
-- i.e. "Effectful.Reader.Static".
68
module Effectful.Reader.Dynamic
@@ -17,6 +19,8 @@ module Effectful.Reader.Dynamic
1719
, local
1820
) where
1921

22+
import Control.Monad.Reader qualified as MTL
23+
2024
import Effectful
2125
import Effectful.Dispatch.Dynamic
2226

@@ -81,3 +85,15 @@ local
8185
-> Eff es a
8286
-> Eff es a
8387
local f = send . Local f
88+
89+
----------------------------------------
90+
-- Orphan instance
91+
92+
-- | Instance included for compatibility with existing code.
93+
instance
94+
( Reader r :> es
95+
, MTL.MonadReader r (Eff es)
96+
) => MTL.MonadReader r (Eff es) where
97+
ask = send Ask
98+
local f = send . Local f
99+
reader f = f <$> send Ask

‎effectful-core/src/Effectful/State/Dynamic.hs

Lines changed: 17 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
1+
{-# OPTIONS_GHC -Wno-orphans #-}
12
-- | The dynamically dispatched variant of the 'State' effect.
23
--
3-
-- /Note:/ unless you plan to change interpretations at runtime, it's
4+
-- /Note:/ unless you plan to change interpretations at runtime or you need the
5+
-- 'MTL.MonadState' instance for compatibility with existing code, it's
46
-- recommended to use one of the statically dispatched variants,
57
-- i.e. "Effectful.State.Static.Local" or "Effectful.State.Static.Shared".
68
module Effectful.State.Dynamic
@@ -29,6 +31,8 @@ module Effectful.State.Dynamic
2931
, modifyM
3032
) where
3133

34+
import Control.Monad.State qualified as MTL
35+
3236
import Effectful
3337
import Effectful.Dispatch.Dynamic
3438
import Effectful.State.Static.Local qualified as L
@@ -149,3 +153,15 @@ modifyM
149153
=> (s -> Eff es s)
150154
-> Eff es ()
151155
modifyM f = stateM (\s -> ((), ) <$> f s)
156+
157+
----------------------------------------
158+
-- Orphan instance
159+
160+
-- | Instance included for compatibility with existing code.
161+
instance
162+
( State s :> es
163+
, MTL.MonadState s (Eff es)
164+
) => MTL.MonadState s (Eff es) where
165+
get = send Get
166+
put = send . Put
167+
state = send . State

0 commit comments

Comments
 (0)